From 4511994b498e349393eb56d3f19756ca458c7d65 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 1 Feb 2023 12:09:37 -0500 Subject: [PATCH 01/36] update CMEPS (#82) --- .github/workflows/bumpversion.yml | 2 +- .github/workflows/extbuild.yml | 131 ++-- .github/workflows/srt.yml | 235 ++++---- .pre-commit-config.yaml | 24 + cesm/driver/ensemble_driver.F90 | 129 ++-- cesm/driver/esm.F90 | 72 +-- cesm/driver/esm_time_mod.F90 | 30 +- cesm/driver/t_driver_timers_mod.F90 | 1 - cesm/flux_atmocn/shr_flux_mod.F90 | 3 +- cesm/nuopc_cap_share/driver_pio_mod.F90 | 13 +- cesm/nuopc_cap_share/esm_utils_mod.F90 | 2 +- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 22 +- cesm/nuopc_cap_share/shr_carma_mod.F90 | 4 +- cesm/nuopc_cap_share/shr_drydep_mod.F90 | 11 +- cesm/nuopc_cap_share/shr_megan_mod.F90 | 5 +- cesm/nuopc_cap_share/shr_ndep_mod.F90 | 8 +- .../shr_ozone_coupling_mod.F90 | 6 +- cime_config/buildnml | 567 ++++++++++-------- cime_config/config_component.xml | 4 +- cime_config/config_component_cesm.xml | 2 +- cime_config/namelist_definition_drv.xml | 4 +- doc/source/addendum/req_attributes.rst | 2 +- doc/source/conf.py | 16 +- doc/source/index.rst | 2 +- mediator/CMakeLists.txt | 4 +- mediator/esmFlds.F90 | 60 +- mediator/esmFldsExchange_cesm_mod.F90 | 44 +- mediator/esmFldsExchange_hafs_mod.F90 | 14 +- mediator/esmFldsExchange_nems_mod.F90 | 5 +- mediator/med.F90 | 85 ++- mediator/med_diag_mod.F90 | 80 ++- mediator/med_fraction_mod.F90 | 7 +- mediator/med_internalstate_mod.F90 | 17 +- mediator/med_io_mod.F90 | 105 ++-- mediator/med_map_mod.F90 | 62 +- mediator/med_merge_mod.F90 | 19 +- mediator/med_methods_mod.F90 | 26 +- mediator/med_phases_aofluxes_mod.F90 | 42 +- mediator/med_phases_history_mod.F90 | 50 +- mediator/med_phases_ocnalb_mod.F90 | 47 +- mediator/med_phases_post_atm_mod.F90 | 2 +- mediator/med_phases_post_glc_mod.F90 | 21 +- mediator/med_phases_post_ice_mod.F90 | 4 +- mediator/med_phases_post_lnd_mod.F90 | 2 +- mediator/med_phases_post_ocn_mod.F90 | 2 +- mediator/med_phases_post_rof_mod.F90 | 4 +- mediator/med_phases_post_wav_mod.F90 | 2 +- mediator/med_phases_prep_atm_mod.F90 | 7 +- mediator/med_phases_prep_glc_mod.F90 | 45 +- mediator/med_phases_prep_ice_mod.F90 | 13 +- mediator/med_phases_prep_lnd_mod.F90 | 9 +- mediator/med_phases_prep_ocn_mod.F90 | 18 +- mediator/med_phases_prep_rof_mod.F90 | 21 +- mediator/med_phases_prep_wav_mod.F90 | 7 +- mediator/med_phases_profile_mod.F90 | 12 +- mediator/med_phases_restart_mod.F90 | 23 +- mediator/med_time_mod.F90 | 5 +- mediator/med_utils_mod.F90 | 18 +- ufs/flux_atmocn_ccpp_mod.F90 | 10 +- ufs/flux_atmocn_mod.F90 | 8 +- ufs/glc_elevclass_mod.F90 | 3 +- ufs/ufs_io_mod.F90 | 10 +- 62 files changed, 1078 insertions(+), 1130 deletions(-) create mode 100644 .pre-commit-config.yaml diff --git a/.github/workflows/bumpversion.yml b/.github/workflows/bumpversion.yml index 7364cb8d8..b17d491f0 100644 --- a/.github/workflows/bumpversion.yml +++ b/.github/workflows/bumpversion.yml @@ -2,7 +2,7 @@ name: Bump version on: push: branches: - - master + - main jobs: build: runs-on: ubuntu-latest diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index b0b01f785..fafc46f46 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -2,12 +2,12 @@ name: extbuild # Controls when the action will run. Triggers the workflow on push or pull request -# events but only for the master branch +# events but only for the main branch on: push: - branches: [ master ] + branches: [ main ] pull_request: - branches: [ master ] + branches: [ main ] # A workflow run is made up of one or more jobs that can run sequentially or in parallel jobs: @@ -19,109 +19,60 @@ jobs: CXX: mpicxx CPPFLAGS: "-I/usr/include -I/usr/local/include" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.3.0b13 - PNETCDF_VERSION: pnetcdf-1.12.3 - NETCDF_FORTRAN_VERSION: v4.5.2 - PIO_VERSION: pio2_5_7 + ESMF_VERSION: v8.4.0 + PNETCDF_VERSION: checkpoint.1.12.3 + NETCDF_FORTRAN_VERSION: v4.6.0 + PIO_VERSION: pio2_5_10 steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 # Build the ESMF library, if the cache contains a previous build # it will be used instead - - id: cache-esmf - uses: actions/cache@v2 - with: - path: ~/ESMF - key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF - id: load-env run: | sudo apt-get update - sudo apt-get install gfortran wget openmpi-bin netcdf-bin libopenmpi-dev libnetcdf-dev - - id: checkout-ESMF - uses: actions/checkout@v3 - with: - repository: esmf-org/esmf - path: esmf-src - ref: ${{ env.ESMF_VERSION }} - - id: build-ESMF - if: steps.cache-esmf.outputs.cache-hit != 'true' - run: | - #wget https://github.com/esmf-org/esmf/archive/${{ env.ESMF_VERSION }}.tar.gz - #tar -xzvf ${{ env.ESMF_VERSION }}.tar.gz - #pushd esmf-${{ env.ESMF_VERSION }} - pushd esmf-src - export ESMF_DIR=`pwd` - export ESMF_COMM=openmpi - export ESMF_YAMLCPP="internal" - export ESMF_INSTALL_PREFIX=$HOME/ESMF - export ESMF_BOPT=g - make - make install - popd - - id: cache-pnetcdf - uses: actions/cache@v2 - with: - path: ~/pnetcdf - key: ${{ runner.os }}-${{ env.PNETCDF_VERSION}}-pnetcdf - - name: pnetcdf build - if: steps.cache-pnetcdf.outputs.cache-hit != 'true' - run: | - wget https://parallel-netcdf.github.io/Release/${{ env.PNETCDF_VERSION }}.tar.gz - tar -xzvf ${{ env.PNETCDF_VERSION }}.tar.gz - ls -l - pushd ${{ env.PNETCDF_VERSION }} - ./configure --prefix=$HOME/pnetcdf --enable-shared --disable-cxx - make - make install - popd - - name: Cache netcdf-fortran - id: cache-netcdf-fortran - uses: actions/cache@v2 + sudo apt-get update + sudo apt-get install gfortran + sudo apt-get install wget + sudo apt-get install openmpi-bin libopenmpi-dev + sudo apt-get install netcdf-bin libnetcdf-dev libnetcdff-dev + sudo apt-get install pnetcdf-bin libpnetcdf-dev + sudo apt-get install autotools-dev autoconf + - id: cache-esmf + uses: actions/cache@v3 with: - path: ~/netcdf-fortran - key: ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran - - name: netcdf fortran build - if: steps.cache-netcdf-fortran.outputs.cache-hit != 'true' - run: | - wget https://github.com/Unidata/netcdf-fortran/archive/${{ env.NETCDF_FORTRAN_VERSION }}.tar.gz - tar -xzvf ${{ env.NETCDF_FORTRAN_VERSION }}.tar.gz - ls -l - pushd netcdf-fortran-* - ./configure --prefix=$HOME/netcdf-fortran - make - make install - - - name: Cache PIO - id: cache-PIO - uses: actions/cache@v2 + path: ~/ESMF + key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF + - name: Cache ParallelIO + id: cache-ParallelIO + uses: actions/cache@v3 with: path: ~/pio key: ${{ runner.os }}-${{ env.PIO_VERSION }}.pio - restore-keys: | - ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran - ${{ runner.os }}-${{ env.PNETCDF_VERSION }}-pnetcdf - - - id: checkout-PIO - uses: actions/checkout@v3 + - name: Build ParallelIO + if: steps.cache-ParallelIO.outputs.cache-hit != 'true' + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@9390e30e29d4ebbfbef0fc72162cacd9e8f25e4e with: - repository: NCAR/ParallelIO - path: parallelio-src - ref: ${{ env.PIO_VERSION }} - - name: Build PIO - if: steps.cache-PIO.outputs.cache-hit != 'true' - run: | - mkdir build-pio - pushd build-pio - cmake -Wno-dev -DNetCDF_C_LIBRARY=/usr/lib/x86_64-linux-gnu/libnetcdf.so -DNetCDF_C_INCLUDE_DIR=/usr/include -DCMAKE_PREFIX_PATH=/usr -DCMAKE_INSTALL_PREFIX=$HOME/pio -DPIO_HDF5_LOGGING=On -DPIO_USE_MALLOC=On -DPIO_ENABLE_TESTS=Off -DPIO_ENABLE_LOGGING=On -DPIO_ENABLE_EXAMPLES=Off -DPIO_ENABLE_TIMING=Off -DNetCDF_Fortran_PATH=$HOME/netcdf-fortran -DPnetCDF_PATH=$HOME/pnetcdf ../parallelio-src - make VERBOSE=1 - make install - popd - + parallelio_version: ${{ env.ParallelIO_VERSION }} + enable_fortran: True + install_prefix: $HOME/pio + - name: Build ESMF + if: steps.cache-esmf.outputs.cache-hit != 'true' + uses: ESCOMP/CDEPS/.github/actions/buildesmf@e06246b560d3132170bb1a5443fa3d65dfbd2040 + with: + esmf_version: ${{ env.ESMF_VERSION }} + esmf_bopt: g + esmf_comm: openmpi + install_prefix: $HOME/ESMF + netcdf_c_path: /usr + netcdf_fortran_path: /usr + pnetcdf_path: /usr + parallelio_path: $HOME/pio - name: Build CMEPS run: | export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk export PIO=$HOME/pio mkdir build-cmeps pushd build-cmeps - cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Wall -ffree-form -ffree-line-length-none" ../ + cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Wall -Werror -ffree-form -ffree-line-length-none -Wno-unused-dummy-argument" ../ make VERBOSE=1 popd diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 74859525d..39526be99 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -3,12 +3,12 @@ name: scripts regression tests # Controls when the action will run. Triggers the workflow on push or pull request -# events but only for the master branch +# events but only for the main branch on: push: - branches: main + branches: [ main ] pull_request: - branches: main + branches: [ main ] # A workflow run is made up of one or more jobs that can run sequentially or in parallel jobs: @@ -18,134 +18,161 @@ jobs: runs-on: ubuntu-latest strategy: matrix: - python-version: [3.8, 3.9] + python-version: [ 3.10.9 ] env: CC: mpicc FC: mpifort CXX: mpicxx - CPPFLAGS: "-I/usr/include -I/usr/local/include" + CPPFLAGS: "-I/usr/include -I/usr/local/include " + LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here - PNETCDF_VERSION: pnetcdf-1.12.2 - NETCDF_FORTRAN_VERSION: v4.5.2 - MCT_VERSION: MCT_2.11.0 - PARALLELIO_VERSION: pio2_5_4 - NETCDF_C_PATH: /usr - NETCDF_FORTRAN_PATH: ${HOME}/netcdf-fortran - PNETCDF_PATH: ${HOME}/pnetcdf + ESMF_VERSION: v8.4.0 + PARALLELIO_VERSION: pio2_5_10 CIME_MODEL: cesm - CIME_DRIVER: mct - + CIME_DRIVER: nuopc + 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: cime checkout - uses: actions/checkout@v2 - with: - repository: ESMCI/cime - - - name: share checkout - uses: actions/checkout@v2 - with: - repository: ESCOMP/CESM_share - path: share - - - name: cpl7 checkout - uses: actions/checkout@v2 - with: - repository: ESCOMP/CESM_CPL7andDataComps - path: components/cpl7 - - - id: load-env + - name: Setup Ubuntu Environment + id: load-env run: | - sudo apt-get update - sudo apt-get install libxml2-utils pylint wget gfortran openmpi-bin netcdf-bin libopenmpi-dev cmake libnetcdf-dev + set -x + sudo apt-get update + sudo apt-get install libxml2-utils + sudo apt-get install netcdf-bin + sudo apt-get install libnetcdf-dev + sudo apt-get install libnetcdff-dev + sudo apt-get install pnetcdf-bin + sudo apt-get install libpnetcdf-dev + sudo apt-get install doxygen + sudo apt-get install graphviz + sudo apt-get install wget + sudo apt-get install gfortran + sudo apt-get install libjpeg-dev + sudo apt-get install libz-dev + sudo apt-get install openmpi-bin + sudo apt-get install libopenmpi-dev - name: Set up Python ${{ matrix.python-version }} - uses: actions/setup-python@v2 + uses: actions/setup-python@v4 with: python-version: ${{ matrix.python-version }} - - - name: mct install - run: | - git clone -b ${{ env.MCT_VERSION }} https://github.com/MCSclimate/MCT libraries/mct - ls -l libraries/mct - - - name: parallelio install - run: | - git clone -b ${{ env.PARALLELIO_VERSION }} https://github.com/NCAR/ParallelIO libraries/parallelio - ls -l libraries/parallelio - - - name: cache pnetcdf - id: cache-pnetcdf - uses: actions/cache@v2 + - run: echo "PyYAML" > requirements.txt + - name: Install PyYAML + run: pip install -r requirements.txt + # use the latest cesm main + - name: cesm checkout + uses: actions/checkout@v3 with: - path: ~/pnetcdf - key: ${{ runner.os }}-${{ env.PNETCDF_VERSION}}-pnetcdf-redo - - - name: pnetcdf build - if: steps.cache-pnetcdf.outputs.cache-hit != 'true' - run: | - wget https://parallel-netcdf.github.io/Release/${{ env.PNETCDF_VERSION }}.tar.gz - tar -xzvf ${{ env.PNETCDF_VERSION }}.tar.gz - ls -l - pushd ${{ env.PNETCDF_VERSION }} - ./configure --prefix=$HOME/pnetcdf --enable-shared --disable-cxx - make - make install - popd - - - name: Cache netcdf-fortran - id: cache-netcdf-fortran - uses: actions/cache@v2 + repository: ESCOMP/CESM + path: cesm + # this cmeps commit + - name: cmeps checkout + uses: actions/checkout@v3 with: - path: ~/netcdf-fortran - key: ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran-redo - - - name: netcdf fortran build - if: steps.cache-netcdf-fortran.outputs.cache-hit != 'true' + path: cesm/components/cmeps + + # Checkout cesm datamodels and support + # cpl7 is needed - i think that's a bug + - name: checkout externals run: | - sudo apt-get install libnetcdf-dev - wget https://github.com/Unidata/netcdf-fortran/archive/${{ env.NETCDF_FORTRAN_VERSION }}.tar.gz - tar -xzvf ${{ env.NETCDF_FORTRAN_VERSION }}.tar.gz - ls -l - pushd netcdf-fortran-* - ./configure --prefix=$HOME/netcdf-fortran - make - make install - - - name: link netcdf-c to netcdf-fortran path - # link netcdf c library here to simplify build - run: | - pushd ${{ env.NETCDF_FORTRAN_PATH }}/include - ln -fs /usr/include/*netcdf* . - pushd ${{ env.NETCDF_FORTRAN_PATH }}/lib - clibdir=`nc-config --libdir` - ln -fs $clibdir/lib* . - + pushd cesm + ./manage_externals/checkout_externals ccs_config cdeps cime share mct cpl7 parallelio + + - name: Cache ESMF + id: cache-esmf + uses: actions/cache@v3 + with: + path: ~/ESMF + key: ${{ runner.os }}-${{ env.ESMF_VERSION }}-ESMF1 + # - name: cache pnetcdf + # id: cache-pnetcdf + # uses: actions/cache@v3 + # with: + # path: ~/pnetcdf + # key: ${{ runner.os }}-${{ env.PNETCDF_VERSION}}-pnetcdf + + # - name: Cache netcdf-fortran + # id: cache-netcdf-fortran + # uses: actions/cache@v3 + # with: + # path: ~/netcdf-fortran + # key: ${{ runner.os }}-${{ env.NETCDF_FORTRAN_VERSION }}-netcdf-fortran + + - name: Cache ParallelIO + id: cache-ParallelIO + uses: actions/cache@v3 + with: + path: ~/pio + key: ${{ runner.os }}-${{ env.PARALLELIO_VERSION }}.parallelio - name: Cache inputdata id: cache-inputdata - uses: actions/cache@v2 + uses: actions/cache@v3 with: path: $HOME/cesm/inputdata key: inputdata -# -# The following can be used to ssh to the testnode for debugging -# see https://github.com/mxschmitt/action-tmate for details -# - name: Setup tmate session -# uses: mxschmitt/action-tmate@v3 + # - name: Build PNetCDF + # if: steps.cache-pnetcdf.outputs.cache-hit != 'true' + # uses: ESCOMP/CDEPS/.github/actions/buildpnetcdf@e06246b560d3132170bb1a5443fa3d65dfbd2040 + # with: + # pnetcdf_version: ${{ env.PNETCDF_VERSION }} + # install_prefix: $HOME/pnetcdf + # - name: Build NetCDF Fortran + # if: steps.cache-netcdf-fortran.outputs.cache-hit != 'true' + # uses: ESCOMP/CDEPS/.github/actions/buildnetcdff@e06246b560d3132170bb1a5443fa3d65dfbd2040 + # with: + # netcdf_fortran_version: ${{ env.NETCDF_FORTRAN_VERSION }} + # install_prefix: $HOME/netcdf-fortran + # netcdf_c_path: /usr + - name: Build ParallelIO + if: steps.cache-PARALLELIO.outputs.cache-hit != 'true' + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@05173a6556ea8d80eb34e3881a5014ea8f4b7543 + with: + parallelio_version: ${{ env.ParallelIO_VERSION }} + enable_fortran: True + install_prefix: /home/runner/pio + + - name: Build ESMF + if: steps.cache-esmf.outputs.cache-hit != 'true' + uses: ESCOMP/CDEPS/.github/actions/buildesmf@e06246b560d3132170bb1a5443fa3d65dfbd2040 + with: + esmf_version: ${{ env.ESMF_VERSION }} + esmf_bopt: g + esmf_comm: openmpi + install_prefix: ~/ESMF + netcdf_c_path: /usr + netcdf_fortran_path: /usr + pnetcdf_path: /usr + parallelio_path: ~/pio - - name: scripts regression tests + + - name: PREP for scripts regression test run: | mkdir -p $HOME/cesm/scratch mkdir -p $HOME/cesm/inputdata - cd $HOME/work/CESM_share/CESM_share/scripts/tests - ls -l $HOME/work/CESM_share/CESM_share - export NETCDF=$HOME/netcdf-fortran - export PATH=$NETCDF/bin:$PATH - export LD_LIBRARY_PATH=$NETCDF/lib:$HOME/pnetcdf/lib:$LD_LIBRARY_PATH - ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest - + pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests + export CIME_TEST_PLATFORM=ubuntu-latest + export PIO_INCDIR=$HOME/pio/include + export PIO_LIBDIR=$HOME/pio/lib + export PIO_VERSION_MAJOR=2 + export PIO_TYPENAME_VALID_VALUES="netcdf,pnetcdf" + export NETCDF_PATH=/usr + export PNETCDF_PATH=/usr + export LD_LIBRARY_PATH=/usr/lib/libx86_64-linux-gnu/:$LD_LIBRARY_PATH + export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk + cat <> $GITHUB_WORKSPACE/cesm/ccs_config/machines/cmake_macros/ubuntu-latest.cmake + set(NetCDF_Fortran_INCLUDE_DIR /usr/include) + set(NetCDF_Fortran_LIBRARY /usr/lib/x86_64-gnu-Linux/libnetcdff.so) + EOF + printenv >> $GITHUB_ENV + popd + - name: scripts regression tests + run: | + pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests + ./scripts_regression_tests.py --no-fortran-run --compiler gnu --mpilib openmpi --machine ubuntu-latest + popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details # - name: Setup tmate session diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml new file mode 100644 index 000000000..a382ff1fd --- /dev/null +++ b/.pre-commit-config.yaml @@ -0,0 +1,24 @@ +exclude: ^utils/.*$ + +repos: + - repo: https://github.com/pre-commit/pre-commit-hooks + rev: v4.0.1 + hooks: + - id: check-xml + files: cime_config/ + - id: end-of-file-fixer + exclude: doc/ + - id: trailing-whitespace + exclude: doc/ + - repo: https://github.com/psf/black + rev: 22.3.0 + hooks: + - id: black + files: ./ + - repo: https://github.com/PyCQA/pylint + rev: v2.11.1 + hooks: + - id: pylint + args: + - --disable=I,C,R,logging-not-lazy,wildcard-import,unused-wildcard-import,fixme,broad-except,bare-except,eval-used,exec-used,global-statement,logging-format-interpolation,no-name-in-module,arguments-renamed,unspecified-encoding,protected-access,import-error,no-member + files: cime_config diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 1c5d3ca67..58b9d58a1 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -8,9 +8,8 @@ module Ensemble_driver !----------------------------------------------------------------------------- use shr_kind_mod , only : cl=>shr_kind_cl, cs=>shr_kind_cs - use shr_log_mod , only : shrlogunit=> shr_log_unit - use shr_file_mod , only : shr_file_setLogUnit - use esm_utils_mod , only : mastertask, logunit, chkerr + use shr_log_mod , only : shr_log_setLogUnit + use esm_utils_mod , only : maintask, logunit, chkerr implicit none private @@ -80,32 +79,30 @@ subroutine SetModelServices(ensemble_driver, rc) use ESMF , only : ESMF_CalendarSetDefault use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd - use NUOPC_Driver , only : NUOPC_DriverAddComp + use NUOPC_Driver , only : NUOPC_DriverAddComp, NUOPC_DriverGetComp use esm , only : ESMSetServices => SetServices, ReadAttributes use esm_time_mod , only : esm_time_clockInit - + use perf_mod , only : t_startf, t_stopf, t_initf ! input/output variables type(ESMF_GridComp) :: ensemble_driver integer, intent(out) :: rc ! local variables type(ESMF_VM) :: vm - type(ESMF_GridComp) :: driver, gridcomptmp + type(ESMF_GridComp) :: driver type(ESMF_Config) :: config - integer :: n, n1, stat + integer :: n integer, pointer :: petList(:) - character(len=20) :: model, prefix - integer :: petCount, i + integer :: petCount integer :: localPet - logical :: is_set character(len=512) :: diro character(len=512) :: logfile - integer :: global_comm logical :: read_restart character(len=CS) :: read_restart_string integer :: inst integer :: number_of_members integer :: ntasks_per_member + integer :: Global_Comm character(CL) :: start_type ! Type of startup character(len=7) :: drvrinst character(len=5) :: inst_suffix @@ -120,10 +117,21 @@ subroutine SetModelServices(ensemble_driver, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - call ESMF_GridCompGet(ensemble_driver, config=config, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=global_comm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (localPet == 0) then + maintask=.true. + else + maintask = .false. + end if + + call t_initf('drv_in', LogPrint=.true., LogUnit=logunit, mpicom=global_comm, mastertask=maintask) + call t_startf(subname) + !------------------------------------------- ! Initialize clocks !------------------------------------------- @@ -134,7 +142,7 @@ subroutine SetModelServices(ensemble_driver, rc) call ReadAttributes(ensemble_driver, config, "CLOCK_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(ensemble_driver, 'calendar', calendar, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, 'calendar', calendar, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (calendar == 'NO_LEAP') then call ESMF_CalendarSetDefault(ESMF_CALKIND_NOLEAP, rc=rc) @@ -204,8 +212,9 @@ subroutine SetModelServices(ensemble_driver, rc) !------------------------------------------- allocate(petList(ntasks_per_member)) - - do inst=1,number_of_members + ! We need to loop over instances + call t_startf('compute_drivers') + do inst = 1, number_of_members ! Determine pet list for driver instance petList(1) = (inst-1) * ntasks_per_member @@ -215,60 +224,68 @@ subroutine SetModelServices(ensemble_driver, rc) ! Add driver instance to ensemble driver write(drvrinst,'(a,i4.4)') "ESM",inst - call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=gridcomptmp, rc=rc) + call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + call t_stopf('compute_drivers') - if (localpet >= petlist(1) .and. localpet <= petlist(ntasks_per_member)) then - - driver = gridcomptmp - - if(number_of_members > 1) then - call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - write(inst_suffix,'(a,i4.4)') '_',inst - call NUOPC_CompAttributeSet(driver, name='inst_suffix', value=inst_suffix, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - inst_suffix = '' - endif + inst = localPet/ntasks_per_member + 1 + petList(1) = (inst-1) * ntasks_per_member + do n=2,ntasks_per_member + petList(n) = petList(n-1) + 1 + enddo + if (localpet >= petlist(1) .and. localpet <= petlist(ntasks_per_member)) then + write(drvrinst,'(a,i4.4)') "ESM",inst + call NUOPC_DriverGetComp(ensemble_driver, drvrinst, comp=driver, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Set the driver instance attributes - call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) + if(number_of_members > 1) then + call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(read_restart_string), rc=rc) + write(inst_suffix,'(a,i4.4)') '_',inst + call NUOPC_CompAttributeSet(driver, name='inst_suffix', value=inst_suffix, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + else + inst_suffix = '' + endif - call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Set the driver instance attributes + call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(read_restart_string), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(driver, config, "DRIVER_attributes::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call ReadAttributes(driver, config, "DRV_modelio::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + call ReadAttributes(driver, config, "DRIVER_attributes::", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Set the driver log to the driver task 0 - if (mod(localPet, ntasks_per_member) == 0) then - call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - open (newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - mastertask = .true. - else - logUnit = shrlogunit - mastertask = .false. - endif - call shr_file_setLogUnit (logunit) - - ! Create a clock for each driver instance - call esm_time_clockInit(ensemble_driver, driver, logunit, mastertask, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + call ReadAttributes(driver, config, "DRV_modelio::", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Set the driver log to the driver task 0 + if (mod(localPet, ntasks_per_member) == 0) then + call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + open (newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + maintask = .true. + else + logUnit = 6 + maintask = .false. endif - enddo + call shr_log_setLogUnit (logunit) + + ! Create a clock for each driver instance + call esm_time_clockInit(ensemble_driver, driver, logunit, maintask, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + endif deallocate(petList) + call t_stopf(subname) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index b6f39ad52..da2f6f6d3 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -8,9 +8,8 @@ module ESM use shr_sys_mod , only : shr_sys_abort use shr_mpi_mod , only : shr_mpi_bcast use shr_mem_mod , only : shr_mem_init - use shr_file_mod , only : shr_file_setLogunit - use esm_utils_mod, only : logunit, mastertask, dbug_flag, chkerr - use perf_mod , only : t_initf, t_setLogUnit + use shr_log_mod , only : shr_log_setLogunit + use esm_utils_mod, only : logunit, maintask, dbug_flag, chkerr implicit none private @@ -54,7 +53,6 @@ subroutine SetServices(driver, rc) integer, intent(out) :: rc ! local variables - type(ESMF_Config) :: runSeq character(len=*), parameter :: subname = "(esm.F90:SetServices)" !--------------------------------------- @@ -125,9 +123,7 @@ subroutine SetModelServices(driver, rc) ! local variables type(ESMF_VM) :: vm type(ESMF_Config) :: config - integer :: n, i, stat - character(len=20) :: model, prefix - integer :: localPet, medpet + integer :: localPet character(len=CL) :: meminitStr integer :: global_comm integer :: maxthreads @@ -141,10 +137,8 @@ subroutine SetModelServices(driver, rc) !------------------------------------------- ! Set the io logunit to the value defined in ensemble_driver - ! TODO: - is this statement still correct? - ! it may be corrected below if the med mastertask is not the driver mastertask !------------------------------------------- - call shr_file_setLogunit(logunit) + call shr_log_setLogunit(logunit) !------------------------------------------- ! Get the config and vm objects from the driver @@ -156,12 +150,10 @@ subroutine SetModelServices(driver, rc) call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=global_comm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return if (localPet == 0) then - mastertask=.true. + maintask=.true. else - mastertask = .false. + maintask = .false. end if !------------------------------------------- @@ -211,16 +203,11 @@ subroutine SetModelServices(driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Memory test - if (mastertask) then + if (maintask) then call shr_mem_init(strbuf=meminitstr) write(logunit,*) trim(meminitstr) end if - !------------------------------------------- - ! Timer initialization (has to be after pelayouts are determined) - !------------------------------------------- - call t_initf('drv_in', LogPrint=.true., LogUnit=logunit, mpicom=global_comm, mastertask=mastertask, MaxThreads=maxthreads) - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine SetModelServices @@ -243,7 +230,6 @@ subroutine SetRunSequence(driver, rc) integer, intent(out) :: rc ! local variables - integer :: localrc type(ESMF_Config) :: runSeq type(NUOPC_FreeFormat) :: runSeqFF character(len=*), parameter :: subname = "(esm.F90:SetRunSequence)" @@ -269,7 +255,7 @@ subroutine SetRunSequence(driver, rc) call NUOPC_DriverIngestRunSequence(driver, runSeqFF, autoAddConnectors=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - +#ifdef DEBUG ! Uncomment these to add debugging information for driver ! call NUOPC_DriverPrint(driver, orderflag=.true.) ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -277,9 +263,9 @@ subroutine SetRunSequence(driver, rc) ! file=__FILE__)) & ! return ! bail out - ! call pretty_print_nuopc_freeformat(runSeqFF, 'run sequence', rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - +! call pretty_print_nuopc_freeformat(runSeqFF, 'run sequence', rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +#endif call NUOPC_FreeFormatDestroy(runSeqFF, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -307,7 +293,7 @@ subroutine pretty_print_nuopc_freeformat(ffstuff, label, rc) rc = ESMF_SUCCESS - if (mastertask .or. dbug_flag > 3) then + if (maintask .or. dbug_flag > 3) then write(logunit, *) 'BEGIN: ', trim(label) call NUOPC_FreeFormatGet(ffstuff, linecount=linecnt, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -435,11 +421,7 @@ subroutine InitAttributes(driver, rc) type(ShrWVSatTableSpec) :: liquid_spec type(ShrWVSatTableSpec) :: ice_spec type(ShrWVSatTableSpec) :: mixed_spec - logical :: flag - integer :: i, it, n - integer :: unitn ! Namelist unit number to read integer :: localPet, rootpe_med - character(len=CL) :: msgstr integer , parameter :: ens1=1 ! use first instance of ensemble only integer , parameter :: fix1=1 ! temporary hard-coding to first ensemble, needs to be fixed real(R8) , parameter :: epsilo = shr_const_mwwv/shr_const_mwdair @@ -477,7 +459,7 @@ subroutine InitAttributes(driver, rc) call NUOPC_CompAttributeGet(driver, name="tfreeze_option", value=tfreeze_option, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_frz_freezetemp_init(tfreeze_option, mastertask) + call shr_frz_freezetemp_init(tfreeze_option, maintask) call NUOPC_CompAttributeGet(driver, name='cpl_rootpe', value=cvalue, rc=rc) read(cvalue, *) rootpe_med @@ -570,8 +552,6 @@ subroutine CheckAttributes( driver, rc ) integer , intent(out) :: rc !----- local ----- - character(len=CL) :: cvalue ! temporary - character(len=CL) :: start_type ! Type of startup character(len=CS) :: logFilePostFix ! postfix for output log files character(len=CL) :: outPathRoot ! root for output log files character(len=CS) :: cime_model @@ -629,12 +609,9 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n integer , intent(inout) :: rc ! local variables - integer :: n - integer :: stat integer :: inst_index character(len=CL) :: cvalue character(len=CS) :: attribute - integer :: componentCount character(len=*), parameter :: subname = "(esm.F90:AddAttributes)" !------------------------------------------- @@ -651,7 +628,7 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n if (chkerr(rc,__LINE__,u_FILE_u)) return !------ - ! Add driver restart flag a to gcomp attributes + ! Add driver restart flag to gcomp attributes !------ attribute = 'read_restart' call NUOPC_CompAttributeGet(driver, name=trim(attribute), value=cvalue, rc=rc) @@ -752,12 +729,12 @@ subroutine ReadAttributes(gcomp, config, label, relaxedflag, formatprint, rc) call NUOPC_CompAttributeIngest(gcomp, attrFF, addFlag=.true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! if (present (formatprint)) then - ! call pretty_print_nuopc_freeformat(attrFF, trim(label)//' attributes', rc=rc) - ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! end if - +#ifdef DEBUG +! if (present (formatprint)) then +! call pretty_print_nuopc_freeformat(attrFF, trim(label)//' attributes', rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return +! end if +#endif call NUOPC_FreeFormatDestroy(attrFF, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -872,11 +849,10 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) type(ESMF_VM) :: vm type(ESMF_Config) :: config type(ESMF_Info) :: info - integer :: componentcount integer :: PetCount - integer :: LocalPet + integer :: ComponentCount integer :: ntasks, rootpe, nthrds, stride - integer :: ntask, cnt + integer :: ntask integer :: i integer :: stat character(len=32), allocatable :: compLabels(:) @@ -1256,7 +1232,7 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - + scol_mesh_n = 0 ! obtain the single column lon and lat call NUOPC_CompAttributeGet(gcomp, name='scol_lon', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1535,7 +1511,7 @@ subroutine esm_finalize(driver, rc) rc = ESMF_SUCCESS - if (mastertask) then + if (maintask) then write(logunit,*)' SUCCESSFUL TERMINATION OF CESM' end if diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index 337b7bc56..0c8a6e86c 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -23,7 +23,7 @@ module esm_time_mod public :: esm_time_clockInit ! initialize driver clock (assumes default calendar) - private :: esm_time_timeInit +! private :: esm_time_timeInit private :: esm_time_alarmInit private :: esm_time_date2ymd @@ -52,12 +52,12 @@ module esm_time_mod contains !=============================================================================== - subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastertask, rc) + subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintask, rc) ! input/output variables type(ESMF_GridComp) :: ensemble_driver, instance_driver integer, intent(in) :: logunit - logical, intent(in) :: mastertask + logical, intent(in) :: maintask integer, intent(out) :: rc ! local variables @@ -87,15 +87,14 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert integer :: glc_cpl_dt ! Glc coupling interval integer :: rof_cpl_dt ! Runoff coupling interval integer :: wav_cpl_dt ! Wav coupling interval - integer :: esp_cpl_dt ! Esp coupling interval +! integer :: esp_cpl_dt ! Esp coupling interval character(CS) :: glc_avg_period ! Glc avering coupling period logical :: read_restart character(len=CL) :: restart_file character(len=CL) :: restart_pfile character(len=CL) :: cvalue integer :: dtime_drv ! time-step to use - integer :: yr, mon, day, sec ! Year, month, day, secs as integers - integer :: localPet ! local pet in esm domain + integer :: yr, mon, day ! Year, month, day as integers integer :: unitn ! unit number integer :: ierr ! Return code character(CL) :: tmpstr ! temporary @@ -143,7 +142,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert restart_pfile = trim(restart_file)//inst_suffix - if (mastertask) then + if (maintask) then call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) @@ -161,7 +160,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert return end if close(unitn) - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//" reading driver restart from file = "//trim(restart_file) end if call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) @@ -178,7 +177,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert else - if (mastertask) then + if (maintask) then write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' write(logunit,*) ' In this case the restarts are handled solely by the component being used and' write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' @@ -201,7 +200,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert call ESMF_TimeSet( StartTime, yy=yr, mm=mon, dd=day, s=start_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(mastertask) then + if(maintask) then write(tmpstr,'(i10)') start_ymd call ESMF_LogWrite(trim(subname)//': driver start_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO) write(logunit,*) trim(subname)//': driver start_ymd: '// trim(tmpstr) @@ -215,7 +214,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert call ESMF_TimeSet( CurrTime, yy=yr, mm=mon, dd=day, s=curr_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(mastertask) then + if(maintask) then write(tmpstr,'(i10)') curr_ymd call ESMF_LogWrite(trim(subname)//': driver curr_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO) write(logunit,*) trim(subname)//': driver curr_ymd: '// trim(tmpstr) @@ -268,7 +267,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert read(cvalue,*) glc_avg_period dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) - if(mastertask) then + if(maintask) then write(tmpstr,'(i10)') dtime_drv call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) @@ -315,7 +314,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, mastert stop_tod = 0 endif - if (mastertask) then + if (maintask) then write(tmpstr,'(i10)') stop_ymd call ESMF_LogWrite(trim(subname)//': driver stop_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO) write(logunit,*) trim(subname)//': driver stop_ymd: '// trim(tmpstr) @@ -392,7 +391,6 @@ subroutine esm_time_alarmInit( clock, alarm, option, & type(ESMF_Time) :: CurrTime ! Current Time type(ESMF_Time) :: NextAlarm ! Next restart alarm time type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval - integer :: sec character(len=*), parameter :: subname = '(med_time_alarmInit): ' !------------------------------------------------------------------------------- @@ -563,7 +561,7 @@ subroutine esm_time_alarmInit( clock, alarm, option, & end subroutine esm_time_alarmInit !=============================================================================== - +#ifdef UNUSEDFUNCTION subroutine esm_time_timeInit( Time, ymd, cal, tod, desc, logunit ) ! Create the ESMF_Time object corresponding to the given input time, given in @@ -607,7 +605,7 @@ subroutine esm_time_timeInit( Time, ymd, cal, tod, desc, logunit ) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine esm_time_timeInit - +#endif !=============================================================================== subroutine esm_time_date2ymd (date, year, month, day) diff --git a/cesm/driver/t_driver_timers_mod.F90 b/cesm/driver/t_driver_timers_mod.F90 index fd316e6de..c38946582 100644 --- a/cesm/driver/t_driver_timers_mod.F90 +++ b/cesm/driver/t_driver_timers_mod.F90 @@ -76,7 +76,6 @@ subroutine t_drvstopf(string,cplrun,cplcom,budget,hashint) logical,intent(in),optional :: cplcom logical,intent(in),optional :: budget integer, intent(in), optional :: hashint - character(len=128) :: strbar logical :: lcplrun,lcplcom,lbudget !------------------------------------------------------------------------------- diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index 9e74abf28..9ec558737 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -1445,7 +1445,8 @@ SUBROUTINE flux_atmOcn_diurnal & tSkin_night(:) = ts(:) cSkin_night(:) = 0.0_R8 endif - + u10n = 0.0_r8 + stable = 0.0_r8 DO n=1,nMax if (mask(n) /= 0) then diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 2584ab1dd..43d913c6d 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -2,7 +2,6 @@ module driver_pio_mod use pio use shr_pio_mod, only : io_compname, pio_comp_settings, iosystems, io_compid, shr_pio_getindex use shr_kind_mod, only : CS=>shr_kind_CS, shr_kind_cl, shr_kind_in - use shr_file_mod, only : shr_file_getunit, shr_file_freeunit use shr_log_mod, only : shr_log_unit use shr_mpi_mod, only : shr_mpi_bcast, shr_mpi_chkerr use shr_sys_mod, only : shr_sys_abort @@ -28,7 +27,7 @@ module driver_pio_mod logical, allocatable :: pio_async_interface(:) integer :: total_comps - logical :: mastertask + logical :: maintask #define DEBUGI 1 #ifdef DEBUGI @@ -73,7 +72,7 @@ subroutine driver_pio_init(driver, rc) call ESMF_VMGet(vm, localPet=localPet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - mastertask = (localPet == 0) + maintask = (localPet == 0) call NUOPC_CompAttributeGet(driver, name="pio_buffer_size_limit", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -81,7 +80,7 @@ subroutine driver_pio_init(driver, rc) ! 0 is a valid value of pio_buffer_size_limit if(pio_buffer_size_limit>=0) then - if(mastertask) write(shr_log_unit,*) 'Setting pio_buffer_size_limit : ',pio_buffer_size_limit + if(maintask) write(shr_log_unit,*) 'Setting pio_buffer_size_limit : ',pio_buffer_size_limit call pio_set_buffer_size_limit(pio_buffer_size_limit) endif @@ -90,7 +89,7 @@ subroutine driver_pio_init(driver, rc) read(cname, *) pio_blocksize if(pio_blocksize>0) then - if(mastertask) write(shr_log_unit,*) 'Setting pio_blocksize : ',pio_blocksize + if(maintask) write(shr_log_unit,*) 'Setting pio_blocksize : ',pio_blocksize call pio_set_blocksize(pio_blocksize) endif @@ -99,7 +98,7 @@ subroutine driver_pio_init(driver, rc) read(cname, *) pio_debug_level if(pio_debug_level > 0) then - if(mastertask) write(shr_log_unit,*) 'Setting pio_debug_level : ',pio_debug_level + if(maintask) write(shr_log_unit,*) 'Setting pio_debug_level : ',pio_debug_level ret = pio_set_log_level(pio_debug_level) endif @@ -146,7 +145,7 @@ subroutine driver_pio_init(driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cname, *) pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req - if(mastertask) then + if(maintask) then ! Log the rearranger options write(shr_log_unit, *) "PIO rearranger options:" write(shr_log_unit, *) " comm type = ", pio_rearr_opts%comm_type, " (",trim(pio_rearr_comm_type),")" diff --git a/cesm/nuopc_cap_share/esm_utils_mod.F90 b/cesm/nuopc_cap_share/esm_utils_mod.F90 index f6a4aeb40..7832e79d3 100644 --- a/cesm/nuopc_cap_share/esm_utils_mod.F90 +++ b/cesm/nuopc_cap_share/esm_utils_mod.F90 @@ -3,7 +3,7 @@ module esm_utils_mod implicit none public - logical :: mastertask + logical :: maintask integer :: logunit integer :: dbug_flag = 0 diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 1a6c43c24..3d50906d7 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -22,7 +22,7 @@ module nuopc_shr_methods use NUOPC_Model , only : NUOPC_ModelGet use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_sys_mod , only : shr_sys_abort - use shr_file_mod , only : shr_file_setlogunit, shr_file_getLogUnit + use shr_log_mod , only : shr_log_setLogUnit implicit none private @@ -75,12 +75,12 @@ module nuopc_shr_methods contains !=============================================================================== - subroutine memcheck(string, level, mastertask) + subroutine memcheck(string, level, maintask) ! input/output variables character(len=*) , intent(in) :: string integer , intent(in) :: level - logical , intent(in) :: mastertask + logical , intent(in) :: maintask ! local variables integer :: ierr @@ -90,7 +90,7 @@ subroutine memcheck(string, level, mastertask) !----------------------------------------------------------------------- #ifdef CESMCOUPLED - if ((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then + if ((maintask .and. memdebug_level > level) .or. memdebug_level > level+1) then ierr = GPTLprint_memusage(string) endif #endif @@ -131,11 +131,11 @@ end subroutine get_component_instance !=============================================================================== - subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) + subroutine set_component_logging(gcomp, maintask, logunit, shrlogunit, rc) use driver_pio_mod, only : driver_pio_log_comp_settings ! input/output variables type(ESMF_GridComp) :: gcomp - logical, intent(in) :: mastertask + logical, intent(in) :: maintask integer, intent(out) :: logunit integer, intent(out) :: shrlogunit integer, intent(out) :: rc @@ -145,11 +145,12 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) character(len=CL) :: logfile character(len=CL) :: inst_suffix integer :: inst_index ! not used here + integer :: n !----------------------------------------------------------------------- rc = ESMF_SUCCESS - if (mastertask) then + if (maintask) then call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) @@ -157,8 +158,9 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) call get_component_instance(gcomp, inst_suffix, inst_index, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Multiinstance logfile name needs a correction - if(logfile(4:4) == '_') then - logfile = logfile(1:3)//trim(inst_suffix)//logfile(9:) + if(len_trim(inst_suffix) > 0) then + n = index(logfile, '.') + logfile = logfile(1:n-1)//trim(inst_suffix)//logfile(n:) endif open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) @@ -170,7 +172,7 @@ subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) endif shrlogunit = logunit - call shr_file_setLogUnit (logunit) + call shr_log_setLogUnit (logunit) end subroutine set_component_logging diff --git a/cesm/nuopc_cap_share/shr_carma_mod.F90 b/cesm/nuopc_cap_share/shr_carma_mod.F90 index 3946b8878..6e596eb5b 100644 --- a/cesm/nuopc_cap_share/shr_carma_mod.F90 +++ b/cesm/nuopc_cap_share/shr_carma_mod.F90 @@ -7,7 +7,7 @@ module shr_carma_mod use shr_kind_mod , only : r8 => shr_kind_r8, CX => SHR_KIND_CX use shr_sys_mod , only : shr_sys_abort - use shr_log_mod , only : logunit => shr_log_Unit + use shr_log_mod , only : shr_log_getLogUnit use shr_nl_mod , only : shr_nl_find_group_name implicit none @@ -38,9 +38,11 @@ subroutine shr_carma_readnl( NLFileName, carma_fields) integer :: ierr ! error code logical :: exists ! if file exists or not integer :: i, tmp(1) + integer :: logunit character(*),parameter :: F00 = "('(shr_carma_readnl) ',2a)" namelist /carma_inparm/ carma_fields + call shr_log_getLogUnit(logunit) carma_fields = ' ' call ESMF_VMGetCurrent(vm, rc=rc) diff --git a/cesm/nuopc_cap_share/shr_drydep_mod.F90 b/cesm/nuopc_cap_share/shr_drydep_mod.F90 index 8b6464da4..7f3af4131 100644 --- a/cesm/nuopc_cap_share/shr_drydep_mod.F90 +++ b/cesm/nuopc_cap_share/shr_drydep_mod.F90 @@ -13,8 +13,7 @@ module shr_drydep_mod use shr_kind_mod , only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX use shr_const_mod , only : SHR_CONST_MWWV use shr_nl_mod , only : shr_nl_find_group_name - use shr_log_mod , only : s_logunit => shr_log_Unit - use shr_file_mod , only : shr_file_getLogUnit + use shr_log_mod , only : shr_log_getLogUnit use shr_infnan_mod , only : shr_infnan_posinf, assignment(=) use nuopc_shr_methods, only : chkerr @@ -254,6 +253,7 @@ subroutine shr_drydep_readnl(NLFilename, drydep_nflds) type(ESMF_VM) :: vm integer :: localPet integer :: mpicom + integer :: s_logunit integer :: rc character(*),parameter :: F00 = "('(shr_drydep_read) ',8a)" character(*),parameter :: FI1 = "('(shr_drydep_init) ',a,I2)" @@ -281,8 +281,8 @@ subroutine shr_drydep_readnl(NLFilename, drydep_nflds) call ESMF_VMGet(vm, localPet=localPet, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call shr_log_getLogUnit(s_logunit) if (localPet==0) then - call shr_file_getLogUnit(s_logunit) inquire( file=trim(NLFileName), exist=exists) if ( exists ) then open(newunit=unitn, file=trim(NLFilename), status='old' ) @@ -348,6 +348,7 @@ subroutine shr_drydep_init( ) integer :: mpicom integer :: bint(2) real(kind=r8), pointer :: dptr(:) + integer :: s_logunit integer :: rc logical, save :: drydep_initialized=.false. character(len=256) :: msg @@ -357,6 +358,7 @@ subroutine shr_drydep_init( ) character(*),parameter :: F00 = "('(shr_drydep_init) ',8a)" call ESMF_LogWrite(subname//' start', ESMF_LOGMSG_INFO) + call shr_log_getLogUnit(s_logunit) if (dep_data_file=='NONE' .or. len_trim(dep_data_file)==0) return @@ -615,7 +617,7 @@ subroutine set_hcoeff_vector( ncol, sfc_temp, heff ) real(r8) :: dk1s(ncol) ! DK Work array 1 real(r8) :: dk2s(ncol) ! DK Work array 2 real(r8) :: wrk(ncol) ! Work array - + integer :: s_logunit !----- formats ----- character(*),parameter :: subName = '(shr_drydep_set_hcoeff) ' character(*),parameter :: F00 = "('(shr_drydep_set_hcoeff) ',8a)" @@ -624,6 +626,7 @@ subroutine set_hcoeff_vector( ncol, sfc_temp, heff ) ! notes: !------------------------------------------------------------------------------- + call shr_log_getLogUnit(s_logunit) wrk(:) = (t0 - sfc_temp(:))/(t0*sfc_temp(:)) do m = 1,n_drydep l = mapping(m) diff --git a/cesm/nuopc_cap_share/shr_megan_mod.F90 b/cesm/nuopc_cap_share/shr_megan_mod.F90 index 4273217c0..d49411e84 100644 --- a/cesm/nuopc_cap_share/shr_megan_mod.F90 +++ b/cesm/nuopc_cap_share/shr_megan_mod.F90 @@ -16,7 +16,7 @@ module shr_megan_mod use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cx=>shr_kind_cx, cs=>shr_kind_cs use shr_sys_mod , only : shr_sys_abort - use shr_log_mod , only : logunit => shr_log_Unit + use shr_log_mod , only : shr_log_getLogUnit use shr_mpi_mod , only : shr_mpi_bcast use shr_nl_mod , only : shr_nl_find_group_name use shr_expr_parser_mod , only : shr_exp_parse, shr_exp_item_t, shr_exp_list_destroy @@ -126,6 +126,7 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) logical :: megan_mapped_emisfctrs = .false. character(len=CL) :: megan_factors_file = ' ' integer :: rc + integer :: logunit integer :: i, tmp(1) character(*), parameter :: F00 = "('(shr_megan_readnl) ',2a)" character(len=*), parameter :: subname='(shr_megan_readnl)' @@ -143,7 +144,7 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=mpicom, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - + call shr_log_getLogUnit(logunit) ! Note the following still needs to be called on all processors since the mpi_bcast is a collective ! call on all the pes of mpicom if (localPet==0) then diff --git a/cesm/nuopc_cap_share/shr_ndep_mod.F90 b/cesm/nuopc_cap_share/shr_ndep_mod.F90 index 6e0fcb91a..02219d9f3 100644 --- a/cesm/nuopc_cap_share/shr_ndep_mod.F90 +++ b/cesm/nuopc_cap_share/shr_ndep_mod.F90 @@ -9,7 +9,7 @@ module shr_ndep_mod use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS use shr_sys_mod , only : shr_sys_abort - use shr_log_mod , only : s_logunit => shr_log_Unit + use shr_log_mod , only : shr_log_getLogUnit use shr_kind_mod , only : r8 => shr_kind_r8 use shr_nl_mod , only : shr_nl_find_group_name use shr_mpi_mod , only : shr_mpi_bcast @@ -49,7 +49,7 @@ subroutine shr_ndep_readnl(NLFilename, ndep_nflds) character(len=32) :: ndep_list(maxspc) = '' ! List of ndep species integer :: localpet integer :: mpicom - + integer :: logunit character(*),parameter :: subName = '(shr_ndep_readnl) ' character(*),parameter :: F00 = "('(shr_ndep_readnl) ',8a)" ! ------------------------------------------------------------------ @@ -67,7 +67,7 @@ subroutine shr_ndep_readnl(NLFilename, ndep_nflds) if ( len_trim(NLFilename) == 0 ) then call shr_sys_abort( subName//'ERROR: nlfilename not set' ) end if - + call shr_log_getLogUnit(logunit) call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -80,7 +80,7 @@ subroutine shr_ndep_readnl(NLFilename, ndep_nflds) inquire( file=trim(NLFileName), exist=exists) if ( exists ) then open(newunit=unitn, file=trim(NLFilename), status='old' ) - write(s_logunit,F00) 'Read in ndep_inparm namelist from: ', trim(NLFilename) + write(logunit,F00) 'Read in ndep_inparm namelist from: ', trim(NLFilename) call shr_nl_find_group_name(unitn, 'ndep_inparm', ierr) if (ierr == 0) then ! Note that ierr /= 0, no namelist is present. diff --git a/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 b/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 index fbd601c3c..a0203395e 100644 --- a/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 +++ b/cesm/nuopc_cap_share/shr_ozone_coupling_mod.F90 @@ -7,7 +7,7 @@ module shr_ozone_coupling_mod use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS use shr_sys_mod , only : shr_sys_abort - use shr_log_mod , only : s_logunit => shr_log_Unit + use shr_log_mod , only : shr_log_getLogUnit use shr_nl_mod , only : shr_nl_find_group_name use shr_mpi_mod , only : shr_mpi_bcast @@ -52,7 +52,7 @@ subroutine shr_ozone_coupling_readnl(NLFilename, atm_ozone_frequency_val) integer :: rc integer :: localpet integer :: mpicom - + integer :: s_logunit character(len=*), parameter :: atm_ozone_frequency_not_present = 'NOT_PRESENT' character(len=*), parameter :: subname = '(shr_ozone_coupling_readnl) ' ! ------------------------------------------------------------------ @@ -65,7 +65,7 @@ subroutine shr_ozone_coupling_readnl(NLFilename, atm_ozone_frequency_val) if ( len_trim(NLFilename) == 0 ) then call shr_sys_abort( subname//'ERROR: nlfilename not set' ) end if - + call shr_log_getLogUnit(s_logunit) call ESMF_VMGetCurrent(vm, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return diff --git a/cime_config/buildnml b/cime_config/buildnml index fd5d73df0..32d6df1c0 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -17,259 +17,308 @@ from CIME.utils import expect from CIME.utils import get_model, get_time_in_seconds, get_timestamp from CIME.buildnml import create_namelist_infile, parse_input from CIME.XML.files import Files -#pylint: disable=undefined-variable + +# pylint: disable=undefined-variable logger = logging.getLogger(__name__) ############################################################################### def _create_drv_namelists(case, infile, confdir, nmlgen, files): -############################################################################### + ############################################################################### - #-------------------------------- + # -------------------------------- # Set up config dictionary - #-------------------------------- + # -------------------------------- config = {} cime_model = get_model() - config['cime_model'] = cime_model - config['iyear'] = case.get_value('COMPSET').split('_')[0] - config['BGC_MODE'] = case.get_value("CCSM_BGC") - config['CPL_I2O_PER_CAT'] = case.get_value('CPL_I2O_PER_CAT') - config['DRV_THREADING'] = case.get_value('DRV_THREADING') - config['CPL_ALBAV'] = case.get_value('CPL_ALBAV') - config['CPL_EPBAL'] = case.get_value('CPL_EPBAL') - config['FLDS_WISO'] = case.get_value('FLDS_WISO') - config['BUDGETS'] = case.get_value('BUDGETS') - config['MACH'] = case.get_value('MACH') - config['MPILIB'] = case.get_value('MPILIB') - config['OS'] = case.get_value('OS') - config['glc_nec'] = 0 if case.get_value('GLC_NEC') == 0 else case.get_value('GLC_NEC') - config['timer_level'] = 'pos' if case.get_value('TIMER_LEVEL') >= 1 else 'neg' - config['continue_run'] = '.true.' if case.get_value('CONTINUE_RUN') else '.false.' - config['flux_epbal'] = 'ocn' if case.get_value('CPL_EPBAL') == 'ocn' else 'off' - config['mask_grid'] = case.get_value('MASK_GRID') - config['rest_option'] = case.get_value('REST_OPTION') - config['comp_ocn'] = case.get_value('COMP_OCN') - - atm_grid = case.get_value('ATM_GRID') - lnd_grid = case.get_value('LND_GRID') - ice_grid = case.get_value('ICE_GRID') - ocn_grid = case.get_value('OCN_GRID') - rof_grid = case.get_value('ROF_GRID') - wav_grid = case.get_value('WAV_GRID') - #pylint: disable=unused-variable - glc_grid = case.get_value('GLC_GRID') - - config['atm_grid'] = atm_grid - config['lnd_grid'] = lnd_grid - config['ice_grid'] = ice_grid - config['ocn_grid'] = ocn_grid + config["cime_model"] = cime_model + config["iyear"] = case.get_value("COMPSET").split("_")[0] + config["BGC_MODE"] = case.get_value("CCSM_BGC") + config["CPL_I2O_PER_CAT"] = case.get_value("CPL_I2O_PER_CAT") + config["DRV_THREADING"] = case.get_value("DRV_THREADING") + config["CPL_ALBAV"] = case.get_value("CPL_ALBAV") + config["CPL_EPBAL"] = case.get_value("CPL_EPBAL") + config["FLDS_WISO"] = case.get_value("FLDS_WISO") + config["BUDGETS"] = case.get_value("BUDGETS") + config["MACH"] = case.get_value("MACH") + config["MPILIB"] = case.get_value("MPILIB") + config["OS"] = case.get_value("OS") + config["glc_nec"] = ( + 0 if case.get_value("GLC_NEC") == 0 else case.get_value("GLC_NEC") + ) + config["timer_level"] = "pos" if case.get_value("TIMER_LEVEL") >= 1 else "neg" + config["continue_run"] = ".true." if case.get_value("CONTINUE_RUN") else ".false." + config["flux_epbal"] = "ocn" if case.get_value("CPL_EPBAL") == "ocn" else "off" + config["mask_grid"] = case.get_value("MASK_GRID") + config["rest_option"] = case.get_value("REST_OPTION") + config["comp_ocn"] = case.get_value("COMP_OCN") + + atm_grid = case.get_value("ATM_GRID") + lnd_grid = case.get_value("LND_GRID") + ice_grid = case.get_value("ICE_GRID") + ocn_grid = case.get_value("OCN_GRID") + # pylint: disable=unused-variable + rof_grid = case.get_value("ROF_GRID") + # pylint: disable=unused-variable + wav_grid = case.get_value("WAV_GRID") + # pylint: disable=unused-variable + glc_grid = case.get_value("GLC_GRID") + + config["atm_grid"] = atm_grid + config["lnd_grid"] = lnd_grid + config["ice_grid"] = ice_grid + config["ocn_grid"] = ocn_grid atm_mesh = case.get_value("ATM_DOMAIN_MESH") lnd_mesh = case.get_value("LND_DOMAIN_MESH") rof_mesh = case.get_value("ROF_DOMAIN_MESH") - config['samegrid_atm_lnd'] = 'true' if atm_mesh == case.get_value("LND_DOMAIN_MESH") else 'false' - config['samegrid_atm_ocn'] = 'true' if atm_mesh == case.get_value("OCN_DOMAIN_MESH") else 'false' - config['samegrid_atm_ice'] = 'true' if atm_mesh == case.get_value("ICE_DOMAIN_MESH") else 'false' - config['samegrid_atm_wav'] = 'true' if atm_mesh == case.get_value("WAV_DOMAIN_MESH") else 'false' - config['samegrid_lnd_rof'] = 'true' if lnd_mesh == rof_mesh else 'false' + config["samegrid_atm_lnd"] = ( + "true" if atm_mesh == case.get_value("LND_DOMAIN_MESH") else "false" + ) + config["samegrid_atm_ocn"] = ( + "true" if atm_mesh == case.get_value("OCN_DOMAIN_MESH") else "false" + ) + config["samegrid_atm_ice"] = ( + "true" if atm_mesh == case.get_value("ICE_DOMAIN_MESH") else "false" + ) + config["samegrid_atm_wav"] = ( + "true" if atm_mesh == case.get_value("WAV_DOMAIN_MESH") else "false" + ) + config["samegrid_lnd_rof"] = "true" if lnd_mesh == rof_mesh else "false" # determine if need to set atm_domainfile - scol_lon = float(case.get_value('PTS_LON')) - scol_lat = float(case.get_value('PTS_LAT')) - if scol_lon > -999. and scol_lat > -999. and case.get_value("ATM_DOMAIN_FILE") != "UNSET": - config['single_column'] = 'true' + scol_lon = float(case.get_value("PTS_LON")) + scol_lat = float(case.get_value("PTS_LAT")) + if ( + scol_lon > -999.0 + and scol_lat > -999.0 + and case.get_value("ATM_DOMAIN_FILE") != "UNSET" + ): + config["single_column"] = "true" else: - config['single_column'] = 'false' + config["single_column"] = "false" # needed for determining the run sequence as well as glc_renormalize_smb - config['COMP_ATM'] = case.get_value("COMP_ATM") - config['COMP_ICE'] = case.get_value("COMP_ICE") - config['COMP_GLC'] = case.get_value("COMP_GLC") - config['COMP_LND'] = case.get_value("COMP_LND") - config['COMP_OCN'] = case.get_value("COMP_OCN") - config['COMP_ROF'] = case.get_value("COMP_ROF") - config['COMP_WAV'] = case.get_value("COMP_WAV") - - if ((case.get_value("COMP_ROF") == 'mosart' and case.get_value("MOSART_MODE") == 'NULL') or - (case.get_value("COMP_ROF") == 'rtm' and case.get_value("RTM_MODE") == 'NULL') or - (case.get_value("ROF_GRID") == 'null')): - config['ROF_MODE'] = 'null' - - if case.get_value('RUN_TYPE') == 'startup': - config['run_type'] = 'startup' - elif case.get_value('RUN_TYPE') == 'hybrid': - config['run_type'] = 'startup' - elif case.get_value('RUN_TYPE') == 'branch': - config['run_type'] = 'branch' - - #---------------------------------------------------- + config["COMP_ATM"] = case.get_value("COMP_ATM") + config["COMP_ICE"] = case.get_value("COMP_ICE") + config["COMP_GLC"] = case.get_value("COMP_GLC") + config["COMP_LND"] = case.get_value("COMP_LND") + config["COMP_OCN"] = case.get_value("COMP_OCN") + config["COMP_ROF"] = case.get_value("COMP_ROF") + config["COMP_WAV"] = case.get_value("COMP_WAV") + + if ( + ( + case.get_value("COMP_ROF") == "mosart" + and case.get_value("MOSART_MODE") == "NULL" + ) + or ( + case.get_value("COMP_ROF") == "rtm" and case.get_value("RTM_MODE") == "NULL" + ) + or (case.get_value("ROF_GRID") == "null") + ): + config["ROF_MODE"] = "null" + + if case.get_value("RUN_TYPE") == "startup": + config["run_type"] = "startup" + elif case.get_value("RUN_TYPE") == "hybrid": + config["run_type"] = "startup" + elif case.get_value("RUN_TYPE") == "branch": + config["run_type"] = "branch" + + # ---------------------------------------------------- # Initialize namelist defaults - #---------------------------------------------------- + # ---------------------------------------------------- nmlgen.init_defaults(infile, config, skip_default_for_groups=["modelio"]) - #-------------------------------- + # -------------------------------- # Set default wav-ice coupling (assumes cice6 as the ice component - #-------------------------------- - if (case.get_value("COMP_WAV") == 'ww3dev' and case.get_value("COMP_ICE") == 'cice'): - nmlgen.add_default('wavice_coupling', value='.true.') + # -------------------------------- + if case.get_value("COMP_WAV") == "ww3dev" and case.get_value("COMP_ICE") == "cice": + nmlgen.add_default("wavice_coupling", value=".true.") - #-------------------------------- + # -------------------------------- # Overwrite: set brnch_retain_casename - #-------------------------------- - start_type = nmlgen.get_value('start_type') - if start_type != 'startup': - if case.get_value('CASE') == case.get_value('RUN_REFCASE'): - nmlgen.set_value('brnch_retain_casename' , value='.true.') + # -------------------------------- + start_type = nmlgen.get_value("start_type") + if start_type != "startup": + if case.get_value("CASE") == case.get_value("RUN_REFCASE"): + nmlgen.set_value("brnch_retain_casename", value=".true.") # set aquaplanet if appropriate - if config['COMP_OCN'] == 'docn' and 'aqua' in case.get_value("DOCN_MODE"): - nmlgen.set_value('aqua_planet' , value='.true.') + if config["COMP_OCN"] == "docn" and "aqua" in case.get_value("DOCN_MODE"): + nmlgen.set_value("aqua_planet", value=".true.") - #-------------------------------- + # -------------------------------- # Overwrite: set component coupling frequencies - #-------------------------------- - ncpl_base_period = case.get_value('NCPL_BASE_PERIOD') - if ncpl_base_period == 'hour': + # -------------------------------- + ncpl_base_period = case.get_value("NCPL_BASE_PERIOD") + if ncpl_base_period == "hour": basedt = 3600 - elif ncpl_base_period == 'day': + elif ncpl_base_period == "day": basedt = 3600 * 24 - elif ncpl_base_period == 'year': - if case.get_value('CALENDAR') == 'NO_LEAP': + elif ncpl_base_period == "year": + if case.get_value("CALENDAR") == "NO_LEAP": basedt = 3600 * 24 * 365 else: - expect(False, "Invalid CALENDAR for NCPL_BASE_PERIOD %s " %ncpl_base_period) - elif ncpl_base_period == 'decade': - if case.get_value('CALENDAR') == 'NO_LEAP': + expect( + False, "Invalid CALENDAR for NCPL_BASE_PERIOD %s " % ncpl_base_period + ) + elif ncpl_base_period == "decade": + if case.get_value("CALENDAR") == "NO_LEAP": basedt = 3600 * 24 * 365 * 10 else: - expect(False, "invalid NCPL_BASE_PERIOD NCPL_BASE_PERIOD %s " %ncpl_base_period) + expect( + False, + "invalid NCPL_BASE_PERIOD NCPL_BASE_PERIOD %s " % ncpl_base_period, + ) else: - expect(False, "invalid NCPL_BASE_PERIOD NCPL_BASE_PERIOD %s " %ncpl_base_period) + expect( + False, "invalid NCPL_BASE_PERIOD NCPL_BASE_PERIOD %s " % ncpl_base_period + ) if basedt < 0: - expect(False, "basedt invalid overflow for NCPL_BASE_PERIOD %s " %ncpl_base_period) - + expect( + False, "basedt invalid overflow for NCPL_BASE_PERIOD %s " % ncpl_base_period + ) # determine coupling intervals comps = case.get_values("COMP_CLASSES") mindt = basedt coupling_times = {} for comp in comps: - ncpl = case.get_value(comp.upper() + '_NCPL') + ncpl = case.get_value(comp.upper() + "_NCPL") if ncpl is not None: cpl_dt = basedt // int(ncpl) totaldt = cpl_dt * int(ncpl) if totaldt != basedt: - expect(False, " %s ncpl doesn't divide base dt evenly" %comp) - nmlgen.add_default(comp.lower() + '_cpl_dt', value=cpl_dt) - coupling_times[comp.lower() + '_cpl_dt'] = cpl_dt + expect(False, " %s ncpl doesn't divide base dt evenly" % comp) + nmlgen.add_default(comp.lower() + "_cpl_dt", value=cpl_dt) + coupling_times[comp.lower() + "_cpl_dt"] = cpl_dt mindt = min(mindt, cpl_dt) # sanity check comp_atm = case.get_value("COMP_ATM") - if comp_atm is not None and comp_atm not in('datm', 'xatm', 'satm'): - atmdt = int(basedt / case.get_value('ATM_NCPL')) - expect(atmdt == mindt, 'Active atm should match shortest model timestep atmdt={} mindt={}' - .format(atmdt, mindt)) - - #-------------------------------- + if comp_atm is not None and comp_atm not in ("datm", "xatm", "satm"): + atmdt = int(basedt / case.get_value("ATM_NCPL")) + expect( + atmdt == mindt, + "Active atm should match shortest model timestep atmdt={} mindt={}".format( + atmdt, mindt + ), + ) + + # -------------------------------- # Overwrite: set start_ymd - #-------------------------------- - run_startdate = "".join(str(x) for x in case.get_value('RUN_STARTDATE').split('-')) - nmlgen.set_value('start_ymd', value=run_startdate) + # -------------------------------- + run_startdate = "".join(str(x) for x in case.get_value("RUN_STARTDATE").split("-")) + nmlgen.set_value("start_ymd", value=run_startdate) - #-------------------------------- + # -------------------------------- # Overwrite: set tprof_option and tprof_n - if tprof_total is > 0 - #-------------------------------- + # -------------------------------- # This would be better handled inside the alarm logic in the driver routines. # Here supporting only nday(s), nmonth(s), and nyear(s). - stop_option = case.get_value('STOP_OPTION') - if 'nyear' in stop_option: - tprofoption = 'ndays' + stop_option = case.get_value("STOP_OPTION") + if "nyear" in stop_option: + tprofoption = "ndays" tprofmult = 365 - elif 'nmonth' in stop_option: - tprofoption = 'ndays' + elif "nmonth" in stop_option: + tprofoption = "ndays" tprofmult = 30 - elif 'nday' in stop_option: - tprofoption = 'ndays' + elif "nday" in stop_option: + tprofoption = "ndays" tprofmult = 1 else: tprofmult = 1 - tprofoption = 'never' - - tprof_total = case.get_value('TPROF_TOTAL') - if ((tprof_total > 0) and (case.get_value('STOP_DATE') < 0) and ('ndays' in tprofoption)): - stop_n = case.get_value('STOP_N') + tprofoption = "never" + + tprof_total = case.get_value("TPROF_TOTAL") + if ( + (tprof_total > 0) + and (case.get_value("STOP_DATE") < 0) + and ("ndays" in tprofoption) + ): + stop_n = case.get_value("STOP_N") stopn = tprofmult * stop_n tprofn = int(stopn / tprof_total) if tprofn < 1: tprofn = 1 - nmlgen.set_value('tprof_option', value=tprofoption) - nmlgen.set_value('tprof_n' , value=tprofn) + nmlgen.set_value("tprof_option", value=tprofoption) + nmlgen.set_value("tprof_n", value=tprofn) # Set up the pause_component_list if pause is active - pauseo = case.get_value('PAUSE_OPTION') - if pauseo != 'never' and pauseo != 'none': - pausen = case.get_value('PAUSE_N') - pcl = nmlgen.get_default('pause_component_list') - nmlgen.add_default('pause_component_list', pcl) + pauseo = case.get_value("PAUSE_OPTION") + if pauseo != "never" and pauseo != "none": + pausen = case.get_value("PAUSE_N") + pcl = nmlgen.get_default("pause_component_list") + nmlgen.add_default("pause_component_list", pcl) # Check to make sure pause_component_list is valid - pcl = nmlgen.get_value('pause_component_list') - if pcl != 'none' and pcl != 'all': - pause_comps = pcl.split(':') + pcl = nmlgen.get_value("pause_component_list") + if pcl != "none" and pcl != "all": + pause_comps = pcl.split(":") comp_classes = case.get_values("COMP_CLASSES") for comp in pause_comps: - expect(comp == 'drv' or comp.upper() in comp_classes, - "Invalid PAUSE_COMPONENT_LIST, %s is not a valid component type"%comp) + expect( + comp == "drv" or comp.upper() in comp_classes, + "Invalid PAUSE_COMPONENT_LIST, %s is not a valid component type" + % comp, + ) # End for # End if # Set esp interval - if 'nstep' in pauseo: + if "nstep" in pauseo: esp_time = mindt else: esp_time = get_time_in_seconds(pausen, pauseo) - nmlgen.set_value('esp_cpl_dt', value=esp_time) + nmlgen.set_value("esp_cpl_dt", value=esp_time) # End if pause is active - #-------------------------------- + # -------------------------------- # Specify input data list file - #-------------------------------- - data_list_path = os.path.join(case.get_case_root(), "Buildconf", "cpl.input_data_list") + # -------------------------------- + data_list_path = os.path.join( + case.get_case_root(), "Buildconf", "cpl.input_data_list" + ) if os.path.exists(data_list_path): os.remove(data_list_path) - #-------------------------------- + # -------------------------------- # Write namelist file drv_in and initial input dataset list. - #-------------------------------- + # -------------------------------- namelist_file = os.path.join(confdir, "drv_in") drv_namelist_groups = ["papi_inparm", "prof_inparm", "debug_inparm"] - nmlgen.write_output_file(namelist_file, data_list_path=data_list_path, groups=drv_namelist_groups) + nmlgen.write_output_file( + namelist_file, data_list_path=data_list_path, groups=drv_namelist_groups + ) - #-------------------------------- + # -------------------------------- # Write nuopc.runconfig file and add to input dataset list. - #-------------------------------- - + # -------------------------------- # Determine valid components valid_comps = [] for item in case.get_values("COMP_CLASSES"): comp = case.get_value("COMP_" + item) valid = True - # stub comps - if comp == 's' + item.lower(): + if comp == "s" + item.lower(): + # stub comps valid = False - # xcpl_comps - elif comp == 'x' + item.lower(): - if item != 'ESP': #no esp xcpl component - if case.get_value(item + "_NX") == "0" and case.get_value(item + "_NY") == "0": + elif comp == "x" + item.lower(): + # xcpl_comps + if item != "ESP": # no esp xcpl component + if ( + case.get_value(item + "_NX") == "0" + and case.get_value(item + "_NY") == "0" + ): valid = False - # special case - mosart in NULL mode - elif (comp == 'mosart'): - if (case.get_value("MOSART_MODE") == 'NULL'): + elif comp == "mosart": + # special case - mosart in NULL mode + if case.get_value("MOSART_MODE") == "NULL": valid = False - # special case - rtm in NULL mode - elif (comp == 'rtm'): - if (case.get_value("RTM_MODE") == 'NULL'): + elif comp == "rtm": + # special case - rtm in NULL mode + if case.get_value("RTM_MODE") == "NULL": valid = False if valid: valid_comps.append(item) @@ -278,7 +327,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): datamodel_in_compset = False comp_classes = case.get_values("COMP_CLASSES") for comp in comp_classes: - dcompname = "d"+comp.lower() + dcompname = "d" + comp.lower() if dcompname in case.get_value("COMP_{}".format(comp)): datamodel_in_compset = True @@ -287,12 +336,14 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): if len(valid_comps) == 2 and not datamodel_in_compset: # skip the mediator if there is a prognostic component and all other components are stub valid_comps.remove("CPL") - nmlgen.set_value('mediator_present', value='.false.') + nmlgen.set_value("mediator_present", value=".false.") nmlgen.set_value("component_list", value=" ".join(valid_comps)) else: # do not skip mediator if there is a data component but all other components are stub valid_comps_string = " ".join(valid_comps) - nmlgen.set_value("component_list", value=valid_comps_string.replace("CPL","MED")) + nmlgen.set_value( + "component_list", value=valid_comps_string.replace("CPL", "MED") + ) # the driver restart pointer will look like a mediator is present even if it is not nmlgen.set_value("drv_restart_pointer", value="rpointer.cpl") @@ -304,53 +355,49 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): lid = os.environ["LID"] if "LID" in os.environ else get_timestamp("%y%m%d-%H%M%S") - #if we are in multi-coupler mode the number of instances of mediator will be the max + # if we are in multi-coupler mode the number of instances of mediator will be the max # of any NINST_* value maxinst = 1 - if case.get_value("MULTI_DRIVER"): - maxinst = case.get_value("NINST_MAX") - multi_driver = True - with open(nuopc_config_file, 'a', encoding="utf-8") as conffile: + + with open(nuopc_config_file, "a", encoding="utf-8") as conffile: nmlgen.write_nuopc_config_file(conffile, data_list_path=data_list_path) - for model in case.get_values("COMP_CLASSES") + ['DRV']: + for model in case.get_values("COMP_CLASSES") + ["DRV"]: model = model.lower() config = {} - config['component'] = model + config["component"] = model nmlgen.init_defaults([], config, skip_entry_loop=True) - if model == 'cpl': + if model == "cpl": newgroup = "MED_modelio" else: - newgroup = model.upper()+"_modelio" + newgroup = model.upper() + "_modelio" nmlgen.rename_group("modelio", newgroup) - if maxinst == 1 and model != 'cpl' and not multi_driver: - inst_count = case.get_value("NINST_" + model.upper()) - else: - inst_count = maxinst - if not model == 'drv': - for entry in ["pio_async_interface", - "pio_netcdf_format", - "pio_numiotasks", - "pio_rearranger", - "pio_root", - "pio_stride", - "pio_typename"]: + inst_count = maxinst + if not model == "drv": + for entry in [ + "pio_async_interface", + "pio_netcdf_format", + "pio_numiotasks", + "pio_rearranger", + "pio_root", + "pio_stride", + "pio_typename", + ]: nmlgen.add_default(entry) - inst_string = "" inst_index = 1 while inst_index <= inst_count: - # determine instance string + # determine instance string if inst_count > 1: - inst_string = '_{:04d}'.format(inst_index) + inst_string = "_{:04d}".format(inst_index) # Output the following to nuopc.runconfig - nmlgen.set_value("diro", case.get_value('RUNDIR')) - if model == 'cpl': - logfile = 'med' + inst_string + ".log." + str(lid) - elif model == 'drv': + nmlgen.set_value("diro", case.get_value("RUNDIR")) + if model == "cpl": + logfile = "med" + inst_string + ".log." + str(lid) + elif model == "drv": logfile = model + ".log." + str(lid) else: logfile = model + inst_string + ".log." + str(lid) @@ -358,24 +405,31 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): inst_index = inst_index + 1 nmlgen.write_nuopc_config_file(conffile) - #-------------------------------- + # -------------------------------- # Update nuopc.runconfig file if component needs it - #-------------------------------- + # -------------------------------- # Read nuopc.runconfig - with open(nuopc_config_file, 'r', encoding="utf-8") as f: + with open(nuopc_config_file, "r", encoding="utf-8") as f: lines_cpl = f.readlines() # Look for only active components except CPL lines_comp = [] for comp in comps: - if comp != 'CPL' and case.get_value("COMP_{}".format(comp)) != 'd'+comp.lower(): + if ( + comp != "CPL" + and case.get_value("COMP_{}".format(comp)) != "d" + comp.lower() + ): # Read *.configure file for component - caseroot = case.get_value('CASEROOT') - comp_config_file = os.path.join(caseroot,"Buildconf","{}conf".format(case.get_value("COMP_{}".format(comp))), - "{}.configure".format(case.get_value("COMP_{}".format(comp)))) + caseroot = case.get_value("CASEROOT") + comp_config_file = os.path.join( + caseroot, + "Buildconf", + "{}conf".format(case.get_value("COMP_{}".format(comp))), + "{}.configure".format(case.get_value("COMP_{}".format(comp))), + ) if os.path.isfile(comp_config_file): - with open(comp_config_file, 'r', encoding="utf-8") as f: + with open(comp_config_file, "r", encoding="utf-8") as f: lines_comp = f.readlines() if lines_comp: @@ -393,25 +447,25 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): lines_cpl_new.append(line_comp) # Write to a file - with open(nuopc_config_file, 'w', encoding="utf-8") as f: + with open(nuopc_config_file, "w", encoding="utf-8") as f: for line in lines_cpl_new: f.write(line) - #-------------------------------- + # -------------------------------- # Write nuopc.runseq - #-------------------------------- + # -------------------------------- _create_runseq(case, coupling_times, valid_comps) - #-------------------------------- + # -------------------------------- # Write drv_flds_in - #-------------------------------- + # -------------------------------- # In thte following, all values come simply from the infiles - no default values need to be added # FIXME - do want to add the possibility that will use a user definition file for drv_flds_in - caseroot = case.get_value('CASEROOT') + caseroot = case.get_value("CASEROOT") namelist_file = os.path.join(confdir, "drv_flds_in") - nmlgen.add_default('drv_flds_in_files') - drvflds_files = nmlgen.get_default('drv_flds_in_files') + nmlgen.add_default("drv_flds_in_files") + drvflds_files = nmlgen.get_default("drv_flds_in_files") infiles = [] for drvflds_file in drvflds_files: infile = os.path.join(caseroot, drvflds_file) @@ -427,31 +481,36 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): dict_ = {} with open(infile, "r", encoding="utf-8") as myfile: for line in myfile: - if "=" in line and '!' not in line: + if "=" in line and "!" not in line: name, var = line.partition("=")[::2] name = name.strip() var = var.strip() dict_[name] = var dicts[infile] = dict_ - for first,second in itertools.combinations(dicts.keys(),2): + for first, second in itertools.combinations(dicts.keys(), 2): compare_drv_flds_in(dicts[first], dicts[second], first, second) # Now create drv_flds_in config = {} - definition_dir = os.path.dirname(files.get_value("NAMELIST_DEFINITION_FILE", attribute={"component":"drv"})) - definition_file = [os.path.join(definition_dir, "namelist_definition_drv_flds.xml")] + definition_dir = os.path.dirname( + files.get_value("NAMELIST_DEFINITION_FILE", attribute={"component": "drv"}) + ) + definition_file = [ + os.path.join(definition_dir, "namelist_definition_drv_flds.xml") + ] nmlgen = NamelistGenerator(case, definition_file, files=files) skip_entry_loop = True nmlgen.init_defaults(infiles, config, skip_entry_loop=skip_entry_loop) drv_flds_in = os.path.join(caseroot, "CaseDocs", "drv_flds_in") nmlgen.write_output_file(drv_flds_in) + ############################################################################### def _create_runseq(case, coupling_times, valid_comps): -############################################################################### + ############################################################################### - caseroot = case.get_value("CASEROOT") + caseroot = case.get_value("CASEROOT") user_file = os.path.join(caseroot, "nuopc.runseq") rundir = case.get_value("RUNDIR") @@ -459,7 +518,7 @@ def _create_runseq(case, coupling_times, valid_comps): # Determine if there is a user run sequence file in CASEROOT, use it shutil.copy(user_file, rundir) - shutil.copy(user_file, os.path.join(caseroot,"CaseDocs")) + shutil.copy(user_file, os.path.join(caseroot, "CaseDocs")) logger.info("NUOPC run sequence: copying custom run sequence from case root") else: @@ -467,13 +526,17 @@ def _create_runseq(case, coupling_times, valid_comps): if len(valid_comps) == 1: # Create run sequence with no mediator - outfile = open(os.path.join(caseroot, "CaseDocs", "nuopc.runseq"), "w", encoding="utf-8") - dtime = coupling_times[valid_comps[0].lower() + '_cpl_dt'] - outfile.write ("runSeq:: \n") - outfile.write ("@" + str(dtime) + " \n") - outfile.write (" " + valid_comps[0] + " \n") - outfile.write ("@ \n") - outfile.write (":: \n") + outfile = open( + os.path.join(caseroot, "CaseDocs", "nuopc.runseq"), + "w", + encoding="utf-8", + ) + dtime = coupling_times[valid_comps[0].lower() + "_cpl_dt"] + outfile.write("runSeq:: \n") + outfile.write("@" + str(dtime) + " \n") + outfile.write(" " + valid_comps[0] + " \n") + outfile.write("@ \n") + outfile.write(":: \n") outfile.close() shutil.copy(os.path.join(caseroot, "CaseDocs", "nuopc.runseq"), rundir) @@ -488,9 +551,9 @@ def _create_runseq(case, coupling_times, valid_comps): sys.path.append(os.path.join(os.path.dirname(__file__), "runseq")) - if (comp_ice == "cice" and comp_atm == 'datm' and comp_ocn == "docn"): + if comp_ice == "cice" and comp_atm == "datm" and comp_ocn == "docn": from runseq_D import gen_runseq - elif (comp_lnd == 'dlnd' and comp_glc == "cism"): + elif comp_lnd == "dlnd" and comp_glc == "cism": from runseq_TG import gen_runseq else: from runseq_general import gen_runseq @@ -498,37 +561,52 @@ def _create_runseq(case, coupling_times, valid_comps): # create the run sequence gen_runseq(case, coupling_times) + ############################################################################### def compare_drv_flds_in(first, second, infile1, infile2): -############################################################################### + ############################################################################### sharedKeys = set(first.keys()).intersection(second.keys()) for key in sharedKeys: if first[key] != second[key]: - print('Key: {}, \n Value 1: {}, \n Value 2: {}'.format(key, first[key], second[key])) - expect(False, "incompatible settings in drv_flds_in from \n %s \n and \n %s" - % (infile1, infile2)) + print( + "Key: {}, \n Value 1: {}, \n Value 2: {}".format( + key, first[key], second[key] + ) + ) + expect( + False, + "incompatible settings in drv_flds_in from \n %s \n and \n %s" + % (infile1, infile2), + ) + ############################################################################### def buildnml(case, caseroot, component): -############################################################################### + ############################################################################### if component != "drv": raise AttributeError # Do a check here of ESMF VERSION, requires 8.1.0 or newer (8.2.0 or newer for esmf_aware_threading) esmf_aware_threading = case.get_value("ESMF_AWARE_THREADING") esmfmkfile = os.getenv("ESMFMKFILE") - expect(esmfmkfile and os.path.isfile(esmfmkfile),"ESMFMKFILE not found {}".format(esmfmkfile)) - with open(esmfmkfile, 'r', encoding="utf-8") as f: + expect( + esmfmkfile and os.path.isfile(esmfmkfile), + "ESMFMKFILE not found {}".format(esmfmkfile), + ) + with open(esmfmkfile, "r", encoding="utf-8") as f: major = None minor = None for line in f.readlines(): - if 'ESMF_VERSION' in line: - major = line[-2] if 'MAJOR' in line else major - minor = line[-2] if 'MINOR' in line else minor - logger.debug("ESMF version major {} minor {}".format(major,minor)) - expect(int(major) >=8,"ESMF version should be 8.1 or newer") + if "ESMF_VERSION" in line: + major = line[-2] if "MAJOR" in line else major + minor = line[-2] if "MINOR" in line else minor + logger.debug("ESMF version major {} minor {}".format(major, minor)) + expect(int(major) >= 8, "ESMF version should be 8.1 or newer") if esmf_aware_threading: - expect(int(minor) >= 2, "ESMF version should be 8.2.0 or newer when using ESMF_AWARE_THREADING") + expect( + int(minor) >= 2, + "ESMF version should be 8.2.0 or newer when using ESMF_AWARE_THREADING", + ) else: expect(int(minor) >= 1, "ESMF version should be 8.1.0 or newer") @@ -540,17 +618,22 @@ def buildnml(case, caseroot, component): # TODO: Append instead of replace? user_xml_dir = os.path.join(caseroot, "SourceMods", "src.drv") - expect (os.path.isdir(user_xml_dir), - "user_xml_dir %s does not exist " %user_xml_dir) + expect( + os.path.isdir(user_xml_dir), "user_xml_dir %s does not exist " % user_xml_dir + ) files = Files(comp_interface="nuopc") # TODO: to get the right attributes of COMP_ROOT_DIR_CPL in evaluating definition_file - need # to do the following first - this needs to be changed so that the following two lines are not needed! - comp_root_dir_cpl = files.get_value( "COMP_ROOT_DIR_CPL",{"component":"cpl"}, resolved=False) + comp_root_dir_cpl = files.get_value( + "COMP_ROOT_DIR_CPL", {"component": "cpl"}, resolved=False + ) files.set_value("COMP_ROOT_DIR_CPL", comp_root_dir_cpl) - definition_files = [files.get_value("NAMELIST_DEFINITION_FILE", {"component": "cpl"})] + definition_files = [ + files.get_value("NAMELIST_DEFINITION_FILE", {"component": "cpl"}) + ] user_drv_definition = os.path.join(user_xml_dir, "namelist_definition_drv.xml") if os.path.isfile(user_drv_definition): definition_files.append(user_drv_definition) @@ -574,8 +657,8 @@ def buildnml(case, caseroot, component): rundir = case.get_value("RUNDIR") # copy nuopc.runconfig to rundir - shutil.copy(os.path.join(confdir,"drv_in"), rundir) - shutil.copy(os.path.join(confdir,"nuopc.runconfig"), rundir) + shutil.copy(os.path.join(confdir, "drv_in"), rundir) + shutil.copy(os.path.join(confdir, "nuopc.runconfig"), rundir) # copy drv_flds_in to rundir drv_flds_in = os.path.join(caseroot, "CaseDocs", "drv_flds_in") @@ -591,9 +674,12 @@ def buildnml(case, caseroot, component): if os.path.isfile(user_yaml_file): filename = user_yaml_file else: - filename = os.path.join(os.path.dirname(__file__), os.pardir, "mediator", "fd_cesm.yaml") + filename = os.path.join( + os.path.dirname(__file__), os.pardir, "mediator", "fd_cesm.yaml" + ) shutil.copy(filename, os.path.join(rundir, "fd.yaml")) + ############################################################################### def _main_func(): caseroot = parse_input(sys.argv) @@ -601,5 +687,6 @@ def _main_func(): with Case(caseroot) as case: buildnml(case, caseroot, "drv") + if __name__ == "__main__": _main_func() diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 923e9afa8..c06f7a7f3 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -45,7 +45,7 @@ - + @@ -54,7 +54,7 @@ $CIMEROOT/config_files.xml case_def env_case.xml - master configuration file that specifies all relevant filenames + main configuration file that specifies all relevant filenames and directories to configure a case diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index cfcdc12ef..e2e6b44e1 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -92,7 +92,7 @@ env_run.xml Logical to archive all interim restart files, not just those at eor If TRUE, perform short term archiving on all interim restart files, - not just those at the end of the run. By default, this value is TRUE. + not just those at the end of the run. By default, this value is FALSE. The restart files are saved under the specific component directory ($DOUT_S_ROOT/$CASE/$COMPONENT/rest rather than the top-level $DOUT_S_ROOT/$CASE/rest directory). Interim restart files are created using the REST_N and REST_OPTION variables. diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index e35ff537d..ce1ae92ff 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -887,8 +887,8 @@ MED_attributes ogrid,agrid,xgrid - Grid for atm ocn flux calc (untested) - default: ocn + Grid for atm ocn flux calc + default: xgrid ogrid diff --git a/doc/source/addendum/req_attributes.rst b/doc/source/addendum/req_attributes.rst index d6b844282..410303632 100644 --- a/doc/source/addendum/req_attributes.rst +++ b/doc/source/addendum/req_attributes.rst @@ -34,7 +34,7 @@ Scalar attributes between the mediator and a component. Currently scalar values are put into a field bundle that only contains an undistributed dimension equal to the size of ``ScalarFieldCount`` and communicated - between the component and the mediator on the `master task` of each + between the component and the mediator on the `main task` of each component. **ScalarFieldName** (required) diff --git a/doc/source/conf.py b/doc/source/conf.py index 80334e199..8c53bb751 100644 --- a/doc/source/conf.py +++ b/doc/source/conf.py @@ -51,8 +51,8 @@ # source_suffix = ['.rst', '.md'] source_suffix = '.rst' -# The master toctree document. -master_doc = 'index' +# The main toctree document. +main_doc = 'index' # General information about the project. project = u'CMEPS' @@ -64,9 +64,9 @@ # built documents. # # The short X.Y version. -version = u'master' +version = u'main' # The full version, including alpha/beta/rc tags. -release = u'master' +release = u'main' # The language for content autogenerated by Sphinx. Refer to documentation # for a list of supported languages. @@ -143,7 +143,7 @@ # (source start file, target name, title, # author, documentclass [howto, manual, or own class]). latex_documents = [ - (master_doc, 'on.tex', u'on Documentation', + (main_doc, 'on.tex', u'on Documentation', u'Staff of the NCAR and NOAA/EMC', 'manual'), ] @@ -153,7 +153,7 @@ # One entry per manual page. List of tuples # (source start file, name, description, authors, manual section). man_pages = [ - (master_doc, 'on', u'on Documentation', + (main_doc, 'on', u'on Documentation', [author], 1) ] @@ -164,7 +164,7 @@ # (source start file, target name, title, author, # dir menu entry, description, category) texinfo_documents = [ - (master_doc, 'on', u'on Documentation', + (main_doc, 'on', u'on Documentation', author, 'on', 'One line description of project.', 'Miscellaneous'), ] @@ -172,7 +172,7 @@ # -- Options for pdf output ------------------------------------------------- pdf_documents = [ - (master_doc, + (main_doc, u'CMEPS_Users_Guide', u'CMEPS Users Guide (PDF)',) ] diff --git a/doc/source/index.rst b/doc/source/index.rst index c03f6276e..179198910 100644 --- a/doc/source/index.rst +++ b/doc/source/index.rst @@ -1,4 +1,4 @@ -.. on documentation master file, created by +.. on documentation main file, created by sphinx-quickstart on Mon May 18 11:50:23 2020. You can adapt this file completely to your liking, but it should at least contain the root `toctree` directive. diff --git a/mediator/CMakeLists.txt b/mediator/CMakeLists.txt index a851018ba..84f62675e 100644 --- a/mediator/CMakeLists.txt +++ b/mediator/CMakeLists.txt @@ -8,12 +8,12 @@ set(SRCFILES esmFldsExchange_cesm_mod.F90 med_fraction_mod.F90 esmFldsExchange_nems_mod.F90 med_io_mod.F90 med_phases_history_mod.F90 med_phases_prep_ocn_mod.F90 med_utils_mod.F90 esmFlds.F90 med_kind_mod.F90 - med_phases_ocnalb_mod.F90 med_phases_prep_rof_mod.F90 + med_phases_prep_rof_mod.F90 med_constants_mod.F90 med_map_mod.F90 med_phases_prep_atm_mod.F90 med_phases_prep_wav_mod.F90 med.F90 med_merge_mod.F90 med_phases_prep_glc_mod.F90 med_phases_profile_mod.F90 med_diag_mod.F90 - med_phases_post_ocn_mod.F90 + med_phases_post_ocn_mod.F90 med_phases_ocnalb_mod.F90 med_phases_post_atm_mod.F90 med_phases_post_ice_mod.F90 med_phases_post_lnd_mod.F90 med_phases_post_glc_mod.F90 med_phases_post_rof_mod.F90 med_phases_post_wav_mod.F90) diff --git a/mediator/esmFlds.F90 b/mediator/esmFlds.F90 index cb634f464..bcb3d5471 100644 --- a/mediator/esmFlds.F90 +++ b/mediator/esmFlds.F90 @@ -23,7 +23,7 @@ module esmflds public :: med_fldList_addfld_aoflux public :: med_fldList_addmap_aoflux - + private :: med_fldList_AddFld private :: med_fldList_AddMap private :: med_fldList_AddMrg @@ -93,7 +93,7 @@ subroutine med_fldlist_init1(ncomps) end subroutine med_fldlist_init1 !================================================================================ - + function med_fldList_GetaofluxFldList() result(fldList) ! Return a pointer to the aoflux fldlist type(med_fldList_type), pointer :: fldList @@ -129,7 +129,7 @@ function med_fldList_GetFldListTo(index) result(fldList) fldList => fldListTo(index) end function Med_FldList_GetFldListTo - + !================================================================================ subroutine med_fldList_addfld_from(index, stdname, shortname) @@ -139,7 +139,7 @@ subroutine med_fldList_addfld_from(index, stdname, shortname) character(len=*) , intent(in) , optional :: shortname call med_fldList_AddFld(FldListFr(index)%fields, stdname, shortname) - + end subroutine med_fldList_addfld_from !================================================================================ @@ -150,7 +150,7 @@ subroutine med_fldList_addfld_aoflux(stdname, shortname) character(len=*) , intent(in) , optional :: shortname call med_fldList_AddFld(fldlist_aoflux%fields, stdname, shortname) - + end subroutine med_fldList_addfld_aoflux !================================================================================ @@ -160,7 +160,7 @@ subroutine med_fldList_addfld_ocnalb(stdname, shortname) character(len=*) , intent(in) , optional :: shortname call med_fldList_AddFld(fldlist_ocnalb%fields, stdname, shortname) - + end subroutine med_fldList_addfld_ocnalb !================================================================================ @@ -171,7 +171,7 @@ subroutine med_fldList_addfld_to(index, stdname, shortname) character(len=*) , intent(in) , optional :: shortname call med_fldList_AddFld(FldListTo(index)%fields, stdname, shortname) - + end subroutine med_fldList_addfld_to !================================================================================ @@ -220,7 +220,7 @@ subroutine med_fldList_AddFld(fields, stdname, shortname) type(med_fldList_entry_type), pointer :: newfld character(len=*), parameter :: subname='(med_fldList_AddFld)' ! ---------------------------------------------- - + call med_fldList_findName(fields, stdname, found, newfld) ! create new entry if fldname is not in original list mapsize = size(fldListTo) @@ -293,13 +293,13 @@ subroutine med_fldList_AddMrg(flds, fldname, mrg_from, mrg_fld, mrg_type, mrg_fr character(len=*) , intent(in) :: mrg_fld character(len=*) , intent(in) :: mrg_type character(len=*) , intent(in), optional :: mrg_fracname - + ! local variables integer :: rc type(med_fldList_entry_type), pointer :: newfld character(len=*), parameter :: subname='(med_fldList_AddMrg)' ! ---------------------------------------------- - + newfld => med_fldList_GetFld(flds, fldname, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return newfld%merge_fields(mrg_from) = mrg_fld @@ -315,7 +315,7 @@ end subroutine med_fldList_AddMrg function med_fldList_GetFld(fields, fldname, rc) result(newfld) use ESMF, only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LOGMSG_INFO use ESMF, only : ESMF_FINALIZE, ESMF_END_ABORT - + type(med_fldList_entry_type) , intent(in), target :: fields character(len=*) , intent(in) :: fldname @@ -324,7 +324,7 @@ function med_fldList_GetFld(fields, fldname, rc) result(newfld) logical :: found integer :: rc character(len=*), parameter :: subname='(med_fldList_GetFld)' - + call med_fldList_findName(fields, fldname, found, newfld) @@ -339,7 +339,7 @@ function med_fldList_GetFld(fields, fldname, rc) result(newfld) call ESMF_LogWrite(subname // 'ERROR: fldname '// trim(fldname) // ' not found in input flds', ESMF_LOGMSG_ERROR) call ESMF_Finalize(endflag=ESMF_END_ABORT) endif - + end function med_fldList_GetFld !================================================================================ @@ -353,7 +353,7 @@ subroutine med_fldList_addmap_from(index, fldname, destcomp, maptype, mapnorm, m character(len=*), optional , intent(in) :: mapfile call med_fldList_AddMap(FldListFr(index)%fields, fldname, destcomp, maptype, mapnorm, mapfile) - + end subroutine med_fldList_addmap_from !================================================================================ @@ -366,7 +366,7 @@ subroutine med_fldList_addmap_aoflux(fldname, destcomp, maptype, mapnorm, mapfil character(len=*), optional , intent(in) :: mapfile call med_fldList_AddMap(fldlist_aoflux%fields, fldname, destcomp, maptype, mapnorm, mapfile) - + end subroutine med_fldList_addmap_aoflux !================================================================================ @@ -379,7 +379,7 @@ subroutine med_fldList_addmap_ocnalb(fldname, destcomp, maptype, mapnorm, mapfil character(len=*), optional , intent(in) :: mapfile call med_fldList_AddMap(fldlist_ocnalb%fields, fldname, destcomp, maptype, mapnorm, mapfile) - + end subroutine med_fldList_addmap_ocnalb !================================================================================ @@ -398,7 +398,8 @@ subroutine med_fldList_AddMap(fields, fldname, destcomp, maptype, mapnorm, mapfi ! local variables type(med_fldList_entry_type), pointer :: newfld - integer :: id, n, rc + integer :: rc + character(len=CX) :: lmapfile character(len=*),parameter :: subname='(med_fldList_AddMap)' ! ---------------------------------------------- @@ -458,7 +459,6 @@ subroutine med_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num integer :: n type(ESMF_Field) :: field character(CS) :: shortname - character(CS) :: stdname character(ESMF_MAXSTR) :: transferActionAttr type(ESMF_StateIntent_Flag) :: stateIntent character(ESMF_MAXSTR) :: transferAction @@ -701,7 +701,7 @@ subroutine med_fld_GetFldInfo(newfld, compsrc, stdname, shortname, mapindex, map character(len=*) , optional, intent(out) :: merge_type character(len=*) , optional, intent(out) :: merge_fracname integer , optional, intent(out) :: rc - + ! local variables integer :: lrc integer :: lcompsrc @@ -762,7 +762,7 @@ integer function med_fldList_GetNumFlds(fldList) type(med_fldList_type), intent(in), target :: fldList ! ---------------------------------------------- type(med_fldList_entry_type), pointer :: newfld - + newfld => fldList%fields med_fldList_GetNumFlds = 0 do while(associated(newfld)) @@ -771,7 +771,7 @@ integer function med_fldList_GetNumFlds(fldList) endif newfld => newfld%next end do - + end function med_fldList_GetNumFlds !================================================================================ @@ -817,20 +817,12 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) logical, intent(in) :: med_coupling_active(:,:) ! local variables - integer :: nsrc,ndst,nf,nm,n + integer :: nsrc,ndst integer :: mapindex character(len=CS) :: mapnorm character(len=CL) :: mapfile character(len=CS) :: fldname - character(len=CS) :: stdname - character(len=CX) :: merge_fields - character(len=CX) :: merge_field - character(len=CS) :: merge_type - character(len=CS) :: merge_fracname - character(len=CS) :: string - character(len=CL) :: mrgstr character(len=CL) :: cvalue - logical :: init_mrgstr type(med_fldList_entry_type), pointer :: newfld character(len=*),parameter :: subname = '(med_fldList_Document_Mapping)' !----------------------------------------------------------- @@ -883,7 +875,7 @@ subroutine med_fldList_Document_Mapping(logunit, med_coupling_active) if ( mapindex /= mapunset) then call med_fld_GetFldInfo(newfld, stdname=fldname, compsrc=ndst, mapnorm=mapnorm, mapfile=mapfile, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + if (trim(mapnorm) == 'unset') then cvalue = ' mapping '//trim(compname(nsrc))//'->'//trim(compname(ndst)) //' '//trim(fldname) // & ' via '// trim(mapnames(mapindex)) @@ -919,18 +911,16 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) logical, intent(in) :: med_coupling_active(:,:) ! local variables - integer :: nsrc,ndst,nf,n + integer :: nsrc,ndst character(len=CS) :: dst_comp character(len=CS) :: dst_field character(len=CS) :: src_comp - character(len=CS) :: src_field character(len=CS) :: merge_type character(len=CS) :: merge_field character(len=CS) :: merge_frac character(len=CS) :: prefix character(len=CS) :: string character(len=CL) :: mrgstr - logical :: init_mrgstr type(med_fldList_entry_type), pointer :: newfld character(len=*),parameter :: subname = '(med_fldList_Document_Merging)' !----------------------------------------------------------- @@ -947,7 +937,7 @@ subroutine med_fldList_Document_Merging(logunit, med_coupling_active) do while(associated(newfld)) call med_fld_GetFldInfo(newfld, stdname=dst_field, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - + ! Loop over all possible source components for destination component field mrgstr = ' ' do nsrc = 1,size(fldListFr) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index e69c092df..6ebd49e0f 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -20,7 +20,7 @@ module esmFldsExchange_cesm_mod !-------------------------------------- use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_internalstate_mod , only : logunit, mastertask + use med_internalstate_mod , only : logunit, maintask implicit none public @@ -71,12 +71,11 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_utils_mod , only : chkerr => med_utils_chkerr use med_methods_mod , only : fldchk => med_methods_FB_FldChk - use med_internalstate_mod , only : InternalState, logunit, mastertask + use med_internalstate_mod , only : InternalState, logunit, maintask use med_internalstate_mod , only : compmed, compatm, complnd, compocn use med_internalstate_mod , only : compice, comprof, compwav, compglc, ncomps use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch, mappatch_uv3d, mapbilnr_nstod use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf - use med_internalstate_mod , only : coupling_mode use med_internalstate_mod , only : map_glc2ocn_ice, map_glc2ocn_liq, map_rof2ocn_ice, map_rof2ocn_liq use esmFlds , only : addfld_ocnalb => med_fldList_addfld_ocnalb use esmFlds , only : addfld_aoflux => med_fldList_addfld_aoflux @@ -97,7 +96,6 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) type(InternalState) :: is_local integer :: n, ns character(len=CL) :: cvalue - character(len=CS) :: name logical :: wavice_coupling logical :: ocn2glc_coupling character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' @@ -126,71 +124,71 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! mapping to atm call NUOPC_CompAttributeGet(gcomp, name='ice2atm_map', value=ice2atm_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'ice2atm_map = '// trim(ice2atm_map) + if (maintask) write(logunit, '(a)') trim(subname)//'ice2atm_map = '// trim(ice2atm_map) call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_map', value=lnd2atm_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'lnd2atm_map = '// trim(lnd2atm_map) + if (maintask) write(logunit, '(a)') trim(subname)//'lnd2atm_map = '// trim(lnd2atm_map) call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_map', value=ocn2atm_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'ocn2atm_map = '// trim(ocn2atm_map) + if (maintask) write(logunit, '(a)') trim(subname)//'ocn2atm_map = '// trim(ocn2atm_map) ! mapping to lnd call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_map', value=atm2lnd_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'atm2lnd_map = '// trim(atm2lnd_map) + if (maintask) write(logunit, '(a)') trim(subname)//'atm2lnd_map = '// trim(atm2lnd_map) call NUOPC_CompAttributeGet(gcomp, name='rof2lnd_map', value=rof2lnd_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'rof2lnd_map = '// trim(rof2lnd_map) + if (maintask) write(logunit, '(a)') trim(subname)//'rof2lnd_map = '// trim(rof2lnd_map) ! mapping to ice call NUOPC_CompAttributeGet(gcomp, name='atm2ice_map', value=atm2ice_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'atm2ice_map = '// trim(atm2ice_map) + if (maintask) write(logunit, '(a)') trim(subname)//'atm2ice_map = '// trim(atm2ice_map) call NUOPC_CompAttributeGet(gcomp, name='glc2ice_rmapname', value=glc2ice_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'glc2ice_rmapname = '// trim(glc2ice_rmap) + if (maintask) write(logunit, '(a)') trim(subname)//'glc2ice_rmapname = '// trim(glc2ice_rmap) ! mapping to ocn call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_map', value=atm2ocn_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'atm2ocn_map = '// trim(atm2ocn_map) + if (maintask) write(logunit, '(a)') trim(subname)//'atm2ocn_map = '// trim(atm2ocn_map) call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_liq_rmapname', value=glc2ocn_liq_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'glc2ocn_liq_rmapname = '// trim(glc2ocn_liq_rmap) + if (maintask) write(logunit, '(a)') trim(subname)//'glc2ocn_liq_rmapname = '// trim(glc2ocn_liq_rmap) call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_ice_rmapname', value=glc2ocn_ice_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'glc2ocn_ice_rmapname = '// trim(glc2ocn_ice_rmap) + if (maintask) write(logunit, '(a)') trim(subname)//'glc2ocn_ice_rmapname = '// trim(glc2ocn_ice_rmap) call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', value=wav2ocn_smap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'wav2ocn_smapname = '// trim(wav2ocn_smap) + if (maintask) write(logunit, '(a)') trim(subname)//'wav2ocn_smapname = '// trim(wav2ocn_smap) call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_fmapname', value=rof2ocn_fmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'rof2ocn_fmapname = '// trim(rof2ocn_fmap) + if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_fmapname = '// trim(rof2ocn_fmap) call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_liq_rmapname', value=rof2ocn_liq_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'rof2ocn_liq_rmapname = '// trim(rof2ocn_liq_rmap) + if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_liq_rmapname = '// trim(rof2ocn_liq_rmap) call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_ice_rmapname', value=rof2ocn_ice_rmap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'rof2ocn_ice_rmapname = '// trim(rof2ocn_ice_rmap) + if (maintask) write(logunit, '(a)') trim(subname)//'rof2ocn_ice_rmapname = '// trim(rof2ocn_ice_rmap) ! mapping to rof call NUOPC_CompAttributeGet(gcomp, name='lnd2rof_map', value=lnd2rof_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit, '(a)') trim(subname)//'lnd2rof_map = '// trim(lnd2rof_map) + if (maintask) write(logunit, '(a)') trim(subname)//'lnd2rof_map = '// trim(lnd2rof_map) ! mapping to wav call NUOPC_CompAttributeGet(gcomp, name='atm2wav_map', value=atm2wav_map, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit,'(a)') trim(subname)//'atm2wav_map = '// trim(atm2wav_map) + if (maintask) write(logunit,'(a)') trim(subname)//'atm2wav_map = '// trim(atm2wav_map) call NUOPC_CompAttributeGet(gcomp, name='ice2wav_smapname', value=ice2wav_smap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit,'(a)') trim(subname)//'ice2wav_smapname = '// trim(ice2wav_smap) + if (maintask) write(logunit,'(a)') trim(subname)//'ice2wav_smapname = '// trim(ice2wav_smap) call NUOPC_CompAttributeGet(gcomp, name='ocn2wav_smapname', value=ocn2wav_smap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit,'(a)') trim(subname)//'ocn2wav_smapname = '// trim(ocn2wav_smap) + if (maintask) write(logunit,'(a)') trim(subname)//'ocn2wav_smapname = '// trim(ocn2wav_smap) ! uv cart3d mapping call NUOPC_CompAttributeGet(gcomp, name='mapuv_with_cart3d', value=cvalue, rc=rc) @@ -223,7 +221,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) read(cvalue,*) flds_r2l_stream_channel_depths ! write diagnostic output - if (mastertask) then + if (maintask) then write(logunit,'(a,l7)') trim(subname)//' flds_co2a = ',flds_co2a write(logunit,'(a,l7)') trim(subname)//' flds_co2b = ',flds_co2b write(logunit,'(a,l7)') trim(subname)//' flds_co2c = ',flds_co2c diff --git a/mediator/esmFldsExchange_hafs_mod.F90 b/mediator/esmFldsExchange_hafs_mod.F90 index 6aa71596d..1f645524e 100644 --- a/mediator/esmFldsExchange_hafs_mod.F90 +++ b/mediator/esmFldsExchange_hafs_mod.F90 @@ -95,16 +95,14 @@ subroutine esmFldsExchange_hafs_advt(gcomp, phase, rc) integer , intent(inout) :: rc ! local variables: - integer :: num, i, n + integer :: n logical :: isPresent character(len=CL) :: cvalue - character(len=CS) :: name, fldname + character(len=CS) :: fldname character(len=CS) :: fldname1, fldname2 type(gcomp_attr) :: hafs_attr - character(len=CS), allocatable :: flds(:) character(len=CS), allocatable :: S_flds(:) character(len=CS), allocatable :: F_flds(:,:) - character(len=CS), allocatable :: suffix(:) character(len=*) , parameter :: subname='(esmFldsExchange_hafs_advt)' !-------------------------------------- @@ -307,16 +305,12 @@ subroutine esmFldsExchange_hafs_init(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local - integer :: num, i, n - integer :: n1, n2, n3, n4 - character(len=CL) :: cvalue - character(len=CS) :: name, fldname + integer :: n + character(len=CS) :: fldname character(len=CS) :: fldname1, fldname2 type(gcomp_attr) :: hafs_attr - character(len=CS), allocatable :: flds(:) character(len=CS), allocatable :: S_flds(:) character(len=CS), allocatable :: F_flds(:,:) - character(len=CS), allocatable :: suffix(:) character(len=*) , parameter :: subname='(esmFldsExchange_hafs_init)' !-------------------------------------- diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index dcb4a9b2c..f93739618 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -26,7 +26,6 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use med_utils_mod , only : chkerr => med_utils_chkerr use med_methods_mod , only : fldchk => med_methods_FB_FldChk use med_internalstate_mod , only : InternalState - use med_internalstate_mod , only : mastertask, logunit use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, compwav, ncomps use med_internalstate_mod , only : mapbilnr, mapconsf, mapconsd, mappatch use med_internalstate_mod , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf @@ -40,8 +39,6 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use esmFlds , only : addfld_aoflux => med_fldList_addfld_aoflux use esmFlds , only : addmap_aoflux => med_fldList_addmap_aoflux - use med_internalstate_mod , only : InternalState, mastertask, logunit - ! input/output parameters: type(ESMF_GridComp) :: gcomp character(len=*) , intent(in) :: phase @@ -49,7 +46,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local - integer :: i, n, maptype + integer :: n, maptype character(len=CX) :: msgString character(len=CL) :: cvalue character(len=CS) :: fldname diff --git a/mediator/med.F90 b/mediator/med.F90 index 352cf0c4d..79a43a4c9 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -40,7 +40,7 @@ module MED use med_utils_mod , only : memcheck => med_memcheck use med_time_mod , only : med_time_alarmInit use med_internalstate_mod , only : InternalState, med_internalstate_init, med_internalstate_coupling - use med_internalstate_mod , only : med_internalstate_defaultmasks, logunit, mastertask + use med_internalstate_mod , only : med_internalstate_defaultmasks, logunit, maintask use med_internalstate_mod , only : ncomps, compname use med_internalstate_mod , only : compmed, compatm, compocn, compice, complnd, comprof, compwav, compglc use med_internalstate_mod , only : coupling_mode, aoflux_code, aoflux_ccpp_suite @@ -547,7 +547,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_AttributeGet, ESMF_AttributeSet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_CompAttributeGet - use med_internalstate_mod, only : mastertask, logunit, diagunit + use med_internalstate_mod, only : maintask, logunit, diagunit #ifdef CESMCOUPLED use nuopc_shr_methods, only : set_component_logging use shr_log_mod, only : shr_log_unit @@ -567,7 +567,6 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) character(len=CX) :: diro character(len=CX) :: logfile character(len=CX) :: diagfile - character(len=CX) :: do_budgets character(len=*),parameter :: subname=' (InitializeP0) ' !----------------------------------------------------------- @@ -577,11 +576,11 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=localPet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - mastertask = .false. - if (localPet == 0) mastertask=.true. + maintask = .false. + if (localPet == 0) maintask=.true. ! Determine mediator logunit - if (mastertask) then + if (maintask) then call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, isPresent=isPresent, isSet=isSet, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (.not. isPresent .and. .not. isSet) then @@ -593,7 +592,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) logfile = 'mediator.log' end if #ifdef CESMCOUPLED - call set_component_logging(gcomp, mastertask, logunit, shr_log_unit, rc) + call set_component_logging(gcomp, maintask, logunit, shr_log_unit, rc) #else open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) #endif @@ -614,7 +613,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) call ESMF_AttributeGet(gcomp, name="Verbosity", value=cvalue, defaultValue="max", & convention="NUOPC", purpose="Instance", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a)')trim(subname)//": Mediator verbosity is set to "//trim(cvalue) end if @@ -622,7 +621,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name="Profiling", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//": Mediator profiling is set to "//trim(cvalue) end if end if @@ -660,7 +659,6 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use esmFlds, only : med_fldlist_init1, med_fld_GetFldInfo, med_fldList_entry_type use med_phases_history_mod, only : med_phases_history_init - use med_internalstate_mod , only : atm_name ! input/output variables type(ESMF_GridComp) :: gcomp @@ -670,7 +668,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) ! local variables character(len=CS) :: stdname, shortname - integer :: n, n1, n2, ncomp, nflds, ns + integer :: ncomp, ns logical :: isPresent, isSet character(len=CS) :: transferOffer character(len=CS) :: cvalue @@ -772,7 +770,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) cvalue = 'cesm' end if aoflux_code = trim(cvalue) - if (mastertask) then + if (maintask) then write(logunit,*) '========================================================' write(logunit,'(a)')trim(subname)//' Mediator aoflux scheme is '//trim(aoflux_code) write(logunit,*) '========================================================' @@ -787,7 +785,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call ESMF_Finalize(endflag=ESMF_END_ABORT) end if aoflux_ccpp_suite = trim(cvalue) - if (mastertask) then + if (maintask) then write(logunit,*) '========================================================' write(logunit,'(a)')trim(subname)//' Mediator aoflux CCPP suite is '//trim(aoflux_ccpp_suite) write(logunit,*) '========================================================' @@ -801,7 +799,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='coupling_mode', value=coupling_mode, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite('coupling_mode = '// trim(coupling_mode), ESMF_LOGMSG_INFO) - if (mastertask) then + if (maintask) then write(logunit,*) '========================================================' write(logunit,'(a)')trim(subname)//' Mediator Coupling Mode is '//trim(coupling_mode) write(logunit,*) '========================================================' @@ -873,12 +871,12 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) do ncomp = 1,ncomps if (ncomp /= compmed) then - if (mastertask) write(logunit,*) + if (maintask) write(logunit,*) fldListFr => med_fldList_GetFldListFr(ncomp) fld => fldListFr%fields do while(associated(fld)) call med_fld_GetFldInfo(fld, stdname=stdname, shortname=shortname) - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//':Fr_'//trim(compname(ncomp))//': '//trim(shortname) end if if (trim(shortname) == is_local%wrap%flds_scalar_name) then @@ -893,12 +891,12 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(subname//':Fr_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) fld => fld%next end do - + fldListTo => med_fldList_GetFldListTo(ncomp) fld => fldListTo%fields do while(associated(fld)) call med_fld_GetFldInfo(fld, stdname=stdname, shortname=shortname, rc=rc) - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//':To_'//trim(compname(ncomp))//': '//trim(shortname) end if if (trim(shortname) == is_local%wrap%flds_scalar_name) then @@ -1003,7 +1001,7 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local - integer :: n1,n2 + integer :: n1 character(len=*),parameter :: subname=' (Modify Decomp of Mesh/Grid) ' !----------------------------------------------------------- @@ -1064,7 +1062,7 @@ subroutine realizeConnectedGrid(State,string,rc) integer :: dimCount, tileCount integer :: connectionCount integer :: fieldCount - integer :: i, j, n, n1, i1, i2 + integer :: n, n1, i1, i2 type(ESMF_GeomType_Flag) :: geomtype type(ESMF_FieldStatus_Flag) :: fieldStatus character(len=CX) :: msgString @@ -1331,7 +1329,7 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local - integer :: n1,n2 + integer :: n1 character(len=*),parameter :: subname=' (Realize Fields with Transfer Accept) ' !----------------------------------------------------------- @@ -1579,24 +1577,19 @@ subroutine DataInitialize(gcomp, rc) ! local variables type(InternalState) :: is_local - type(ESMF_VM) :: vm type(ESMF_Clock) :: clock type(ESMF_State) :: importState, exportState type(ESMF_Time) :: time type(ESMF_Field) :: field - type(ESMF_StateItem_Flag) :: itemType type(med_fldList_type), pointer :: fldListMed_ocnalb - logical :: atCorrectTime, connected - integer :: n1,n2,n,ns + logical :: atCorrectTime + integer :: n1,n2,n integer :: nsrc,ndst - integer :: cntn1, cntn2 integer :: fieldCount character(ESMF_MAXSTR),allocatable :: fieldNameList(:) character(CL), pointer :: fldnames(:) character(CL) :: cvalue - character(CL) :: start_type logical :: read_restart - logical :: isPresent, isSet logical :: allDone = .false. logical,save :: first_call = .true. real(r8) :: real_nx, real_ny @@ -1641,7 +1634,7 @@ subroutine DataInitialize(gcomp, rc) ! Create field bundles FBImp, FBExp !---------------------------------------------------------- - if (mastertask) then + if (maintask) then write(logunit,'(a)') 'Creating mediator field bundles ' end if @@ -1650,7 +1643,7 @@ subroutine DataInitialize(gcomp, rc) ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) .and. & ESMF_StateIsCreated(is_local%wrap%NStateExp(n1),rc=rc)) then - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initializing FBs for '//trim(compname(n1)) end if @@ -1669,7 +1662,7 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldCount == 0) then - if (mastertask) then + if (maintask) then write(logunit,*) trim(subname)//' '//trim(compname(n1))//' import FB field count is = ', fieldCount write(logunit,*) trim(subname)//' '//trim(compname(n1))//' trying to use export FB' call ESMF_FieldBundleGet(is_local%wrap%FBExp(n1), fieldCount=fieldCount, rc=rc) @@ -1692,7 +1685,7 @@ subroutine DataInitialize(gcomp, rc) ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) .and. & ESMF_StateIsCreated(is_local%wrap%NStateImp(n2),rc=rc)) then - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initializing FBs for '//& trim(compname(n1))//'_'//trim(compname(n2)) end if @@ -1740,13 +1733,13 @@ subroutine DataInitialize(gcomp, rc) call FB_init(is_local%wrap%FBMed_ocnalb_a, is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_ocnalb_a', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initializing FB FBMed_ocnalb_a' end if call FB_init(is_local%wrap%FBMed_ocnalb_o, is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames, name='FBMed_ocnalb_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initializing FB FBMed_ocnalb_o' end if deallocate(fldnames) @@ -1794,7 +1787,7 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (mastertask) then + if (maintask) then call med_fldList_Document_Mapping(logunit, is_local%wrap%med_coupling_active) call med_fldList_Document_Merging(logunit, is_local%wrap%med_coupling_active) end if @@ -1980,7 +1973,7 @@ subroutine DataInitialize(gcomp, rc) ! then dependency is not satisified - must return to atm call ESMF_LogWrite("MED - Initialize-Data-Dependency from ATM NOT YET SATISFIED!!!", & ESMF_LOGMSG_INFO) - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//"MED - Initialize-Data-Dependency from ATM NOT YET SATISFIED!!!" end if compDone(compatm) = .false. @@ -2039,7 +2032,7 @@ subroutine DataInitialize(gcomp, rc) if (.not. atCorrectTime) then allDone=.false. if (dbug_flag > 0) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//" MED - Initialize-Data-Dependency check not yet satisfied for "//& trim(compname(n1)) end if @@ -2062,12 +2055,12 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- if (allDone) then - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a)') trim(subname)//"Initialize-Data-Dependency allDone check Passed" end if do n1 = 1,ncomps - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a)') trim(subname)//" "//trim(compname(n1)) end if @@ -2087,13 +2080,13 @@ subroutine DataInitialize(gcomp, rc) is_local%wrap%nx(n1) = nint(real_nx) is_local%wrap%ny(n1) = nint(real_ny) write(msgString,'(2i8,2l4)') is_local%wrap%nx(n1), is_local%wrap%ny(n1) - if (mastertask) then + if (maintask) then write(logunit,'(a)') 'global nx,ny sizes for '//trim(compname(n1))//":"//trim(msgString) end if call ESMF_LogWrite(trim(subname)//":"//trim(compname(n1))//":"//trim(msgString), ESMF_LOGMSG_INFO) end if end do - if (mastertask) write(logunit,*) + if (maintask) write(logunit,*) !--------------------------------------- ! Initialize mediator IO @@ -2114,7 +2107,7 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- call NUOPC_CompAttributeGet(gcomp, name="read_restart", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a)') trim(subname)//' read_restart = '//trim(cvalue) end if @@ -2204,11 +2197,9 @@ subroutine SetRunClock(gcomp, rc) type(ESMF_TimeInterval) :: timeStep type(ESMF_Alarm) :: stop_alarm character(len=CL) :: cvalue - character(len=CL) :: name, stop_option + character(len=CL) :: stop_option integer :: stop_n, stop_ymd - logical :: first_time = .true. logical, save :: stopalarmcreated=.false. - integer :: alarmcount character(len=*),parameter :: subname=' (Set Run Clock) ' !----------------------------------------------------------- @@ -2506,8 +2497,8 @@ subroutine med_finalize(gcomp, rc) integer, intent(out) :: rc rc = ESMF_SUCCESS - call memcheck("med_finalize", 0, mastertask) - if (mastertask) then + call memcheck("med_finalize", 0, maintask) + if (maintask) then write(logunit,*)' SUCCESSFUL TERMINATION OF CMEPS' call med_phases_profile_finalize() end if diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 2792d0a26..802334f6f 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -27,7 +27,7 @@ module med_diag_mod use med_constants_mod , only : shr_const_rearth, shr_const_pi, shr_const_latice, shr_const_latvap use med_constants_mod , only : shr_const_ice_ref_sal, shr_const_ocn_ref_sal, shr_const_isspval use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_internalstate_mod , only : InternalState, logunit, mastertask, diagunit + use med_internalstate_mod , only : InternalState, logunit, maintask, diagunit use med_methods_mod , only : fldbun_getdata2d => med_methods_FB_getdata2d use med_methods_mod , only : fldbun_getdata1d => med_methods_FB_getdata1d use med_methods_mod , only : fldbun_fldChk => med_methods_FB_FldChk @@ -50,7 +50,7 @@ module med_diag_mod public :: med_phases_diag_ice_ice2med public :: med_phases_diag_ice_med2ice - private :: med_diag_sum_master + private :: med_diag_sum_main private :: med_diag_print_atm private :: med_diag_print_lnd_ice_ocn private :: med_diag_print_summary @@ -231,7 +231,7 @@ module med_diag_mod ! public data members ! --------------------------------- - ! note: call med_diag_sum_master then save budget_global and budget_counter on restart from/to root pe --- + ! note: call med_diag_sum_main then save budget_global and budget_counter on restart from/to root pe --- real(r8), allocatable :: budget_local (:,:,:) ! local sum, valid on all pes real(r8), allocatable :: budget_global (:,:,:) ! global sum, valid only on root pe @@ -263,7 +263,6 @@ subroutine med_diag_init(gcomp, rc) integer :: c_size ! number of component send/recvs integer :: f_size ! number of fields integer :: p_size ! number of period types - type(ESMF_Clock) :: mediatorClock character(CS) :: cvalue logical :: isPresent, isSet character(*), parameter :: subName = '(med_phases_diag_init) ' @@ -271,7 +270,7 @@ subroutine med_diag_init(gcomp, rc) rc = ESMF_SUCCESS - if(mastertask) then + if(maintask) then write(logunit,'(a)') ' Creating budget_diags%comps ' end if @@ -282,7 +281,7 @@ subroutine med_diag_init(gcomp, rc) else budget_table_version = 'v1' end if - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname) //' budget table version is '//trim(budget_table_version) end if @@ -575,7 +574,7 @@ subroutine med_phases_diag_accum(gcomp, rc) integer, intent(out) :: rc ! local variables - integer :: ip, ic + integer :: ip character(*), parameter :: subName = '(med_diag_accum) ' ! ------------------------------------------------------------------ @@ -590,7 +589,7 @@ subroutine med_phases_diag_accum(gcomp, rc) end subroutine med_phases_diag_accum !=============================================================================== - subroutine med_diag_sum_master(gcomp, rc) + subroutine med_diag_sum_main(gcomp, rc) ! ------------------------------------------------------------------ ! Sum local values to global on root @@ -606,7 +605,7 @@ subroutine med_diag_sum_master(gcomp, rc) integer :: c_size ! number of component send/recvs integer :: f_size ! number of fields integer :: p_size ! number of period types - character(*), parameter :: subName = '(med_diag_sum_master) ' + character(*), parameter :: subName = '(med_diag_sum_main) ' ! ------------------------------------------------------------------ call t_startf('MED:'//subname) @@ -630,7 +629,7 @@ subroutine med_diag_sum_master(gcomp, rc) call t_stopf('MED:'//subname) - end subroutine med_diag_sum_master + end subroutine med_diag_sum_main !=============================================================================== subroutine med_phases_diag_atm(gcomp, rc) @@ -647,14 +646,13 @@ subroutine med_phases_diag_atm(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: n,nf,ic,ip + integer :: n,nf,ip real(r8), pointer :: afrac(:) real(r8), pointer :: lfrac(:) real(r8), pointer :: ifrac(:) real(r8), pointer :: ofrac(:) real(r8), pointer :: areas(:) real(r8), pointer :: lats(:) - type(ESMF_Field) :: lfield character(*), parameter :: subName = '(med_phases_diag_atm) ' !------------------------------------------------------------------------------- @@ -790,7 +788,6 @@ subroutine diag_atm_recv(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -826,7 +823,6 @@ subroutine diag_atm_send(FB, fldname, nf, areas, lats, afrac, lfrac, ofrac, ifra integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -865,7 +861,6 @@ subroutine diag_atm_wiso_recv(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_Field) :: lfield real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -922,7 +917,6 @@ subroutine diag_atm_wiso_send(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_Field) :: lfield real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -979,7 +973,6 @@ subroutine med_phases_diag_lnd( gcomp, rc) real(r8), pointer :: lfrac(:) integer :: n,ip, ic real(r8), pointer :: areas(:) - type(ESMF_Field) :: lfield character(*), parameter :: subName = '(med_phases_diag_lnd) ' ! ------------------------------------------------------------------ @@ -1105,7 +1098,6 @@ subroutine diag_lnd(FB, fldname, nf, ic, areas, lfrac, budget, minus, rc) integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1139,7 +1131,6 @@ subroutine diag_lnd_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, lfrac, integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1177,7 +1168,7 @@ subroutine med_phases_diag_rof( gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: ic, ip, n + integer :: ic, ip real(r8), pointer :: areas(:) character(*), parameter :: subName = '(med_phases_diag_rof) ' ! ------------------------------------------------------------------ @@ -1266,7 +1257,6 @@ subroutine diag_rof(FB, fldname, nf, ic, areas, budget, minus, rc) ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1300,7 +1290,6 @@ subroutine diag_rof_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, budget, ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1386,7 +1375,6 @@ subroutine diag_glc(FB, fldname, nf, ic, areas, budget, minus, rc) integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1424,10 +1412,8 @@ subroutine med_phases_diag_ocn( gcomp, rc) real(r8), pointer :: ifrac(:) ! ice fraction in ocean grid cell real(r8), pointer :: ofrac(:) ! non-ice fraction nin ocean grid cell real(r8), pointer :: sfrac(:) ! sum of ifrac and ofrac - real(r8), pointer :: sfrac_x_ofrac(:) real(r8), pointer :: areas(:) real(r8), pointer :: data(:) - type(ESMF_field) :: lfield character(*), parameter :: subName = '(med_phases_diag_ocn) ' ! ------------------------------------------------------------------ @@ -1605,7 +1591,6 @@ subroutine diag_ocn(FB, fldname, nf, ic, areas, frac, budget, scale, rc) integer , intent(out) :: rc ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1639,7 +1624,6 @@ subroutine diag_ocn_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, ic, areas, frac, b ! local variables integer :: n, ip - type(ESMF_field) :: lfield real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1675,7 +1659,6 @@ subroutine med_phases_diag_ice_ice2med( gcomp, rc) real(r8), pointer :: ifrac(:) real(r8), pointer :: areas(:) real(r8), pointer :: lats(:) - type(ESMF_field) :: lfield character(*), parameter :: subName = '(med_phases_diag_ice_ice2med) ' ! ------------------------------------------------------------------ @@ -1779,7 +1762,6 @@ subroutine diag_ice_recv(FB, fldname, nf, areas, lats, ifrac, budget, minus, sca integer , intent(out) :: rc ! local variables integer :: n, ic, ip - type(ESMF_Field) :: lfield real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1825,7 +1807,6 @@ subroutine diag_ice_recv_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, integer , intent(out) :: rc ! local variables integer :: n, ic, ip - type(ESMF_Field) :: lfield real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -1875,7 +1856,6 @@ subroutine med_phases_diag_ice_med2ice( gcomp, rc) real(r8), pointer :: data(:) real(r8), pointer :: areas(:) real(r8), pointer :: lats(:) - type(ESMF_Field) :: lfield character(*), parameter :: subName = '(med_phases_diag_ice_med2ice) ' ! ------------------------------------------------------------------ @@ -1967,7 +1947,6 @@ subroutine diag_ice_send(FB, fldname, nf, areas, lats, ifrac, budget, rc) integer , intent(out) :: rc ! local variables integer :: n, ic, ip - type(ESMF_Field) :: lfield real(r8), pointer :: data(:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -2001,7 +1980,6 @@ subroutine diag_ice_send_wiso(FB, fldname, nf_16O, nf_18O, nf_HDO, areas, lats, ! local variables integer :: n, ic, ip - type(ESMF_Field) :: lfield real(r8), pointer :: data(:,:) ! ------------------------------------------------------------------ rc = ESMF_SUCCESS @@ -2044,14 +2022,15 @@ subroutine med_phases_diag_print(gcomp, rc) integer :: tod integer :: output_level ! print level logical :: sumdone ! has a sum been computed yet - character(CS) :: cvalue integer :: ip integer :: c_size ! number of component send/recvs integer :: f_size ! number of fields integer :: p_size ! number of period types real(r8), allocatable :: datagpr(:,:,:) - character(len=64) :: timestr logical, save :: firstcall = .true. +#ifdef DEBUG + character(len=CL) :: timestr +#endif character(*), parameter :: subName = '(med_phases_diag_print) ' ! ------------------------------------------------------------------ @@ -2076,7 +2055,7 @@ subroutine med_phases_diag_print(gcomp, rc) date = year*10000 + mon*100 + day #ifdef DEBUG - if(mastertask) then + if(maintask) then write(timestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') year,'-',mon,'-',day,'-',tod write(logunit,' (a)') trim(subname)//": time = "//trim(timestr) endif @@ -2124,13 +2103,13 @@ subroutine med_phases_diag_print(gcomp, rc) if (.not. sumdone) then ! Some budgets will be printed for this period type ! Determine sums if not already done - call med_diag_sum_master(gcomp, rc) + call med_diag_sum_main(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return sumdone = .true. end if - if (mastertask) then + if (maintask) then c_size = size(budget_diags%comps) f_size = size(budget_diags%fields) p_size = size(budget_diags%periods) @@ -2145,7 +2124,7 @@ subroutine med_phases_diag_print(gcomp, rc) end if datagpr(:,:,:) = datagpr(:,:,:)/budget_counter(:,:,:) - ! Write diagnostic tables to logunit (mastertask only) + ! Write diagnostic tables to logunit (maintask only) if (output_level >= 3) then ! detail atm budgets and breakdown into components --- call med_diag_print_atm(datagpr, ip, date, tod) @@ -2162,8 +2141,8 @@ subroutine med_phases_diag_print(gcomp, rc) deallocate(datagpr) - endif ! output_level > 0 and mastertask - end if ! if mastertask + endif ! output_level > 0 and maintask + end if ! if maintask enddo ! ip = 1, period_types !------------------------------------------------------------------------------- @@ -2195,6 +2174,12 @@ subroutine med_diag_print_atm(data, ip, date, tod) character(*), parameter:: subName = '(med_phases_diag_print_atm) ' ! ------------------------------------------------------------------ + ica = 0 + icl = 0 + icn = 0 + ics = 0 + ico = 0 + str = "" do ic = 1,2 if (ic == 1) then ! from atm to mediator ica = c_atm_recv ! total from atm @@ -2342,7 +2327,11 @@ subroutine med_diag_print_lnd_ice_ocn(data, ip, date, tod) character(len=40) :: str ! string character(*), parameter :: subName = '(med_diag_print_lnd_ice_ocn) ' ! ------------------------------------------------------------------ - + icar = 0 + icxs = 0 + icxr = 0 + icas = 0 + str = "" do ic = 1,4 if (ic == 1) then @@ -2498,10 +2487,10 @@ subroutine med_diag_print_summary(data, ip, date, tod) integer , intent(in) :: tod ! local variables - integer :: ic,nf,is ! data array indicies + integer :: nf,is ! data array indicies real(r8) :: atm_area, lnd_area, ocn_area real(r8) :: ice_area_nh, ice_area_sh - real(r8) :: sum_area, sum_area_tot + real(r8) :: sum_area real(r8) :: net_water_atm , sum_net_water_atm real(r8) :: net_water_lnd , sum_net_water_lnd real(r8) :: net_water_rof , sum_net_water_rof @@ -2526,7 +2515,6 @@ subroutine med_diag_print_summary(data, ip, date, tod) real(r8) :: net_salt_ice_nh , sum_net_salt_ice_nh real(r8) :: net_salt_ice_sh , sum_net_salt_ice_sh real(r8) :: net_salt_tot , sum_net_salt_tot - character(len=40) :: str character(*), parameter:: subName = '(med_diag_print_summary) ' ! ------------------------------------------------------------------ @@ -2772,7 +2760,7 @@ subroutine add_to_budget_diag(entries, index, name) ! create new entry if fldname is not in original list if (.not. found) then - if(mastertask) write(logunit,*) ' Add ',trim(name),' to budgets with index ',index + if(maintask) write(logunit,*) ' Add ',trim(name),' to budgets with index ',index ! 1) allocate newfld to be size (one element larger than input flds) allocate(new_entries(index)) diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 521ba0007..2fd83972a 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -152,7 +152,7 @@ subroutine med_fraction_init(gcomp, rc) use med_internalstate_mod , only : compatm, compocn, compice, complnd use med_internalstate_mod , only : comprof, compglc, compwav, compname use med_internalstate_mod , only : mapfcopy, mapconsd, mapnstod_consd - use med_internalstate_mod , only : InternalState, logunit, mastertask + use med_internalstate_mod , only : InternalState use med_map_mod , only : med_map_routehandles_init, med_map_rh_is_created use med_methods_mod , only : State_getNumFields => med_methods_State_getNumFields use perf_mod , only : t_startf, t_stopf @@ -165,7 +165,6 @@ subroutine med_fraction_init(gcomp, rc) type(InternalState) :: is_local type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst - type(ESMF_Field) :: lfield real(R8), pointer :: frac(:) real(R8), pointer :: ofrac(:) real(R8), pointer :: aofrac(:) @@ -178,7 +177,7 @@ subroutine med_fraction_init(gcomp, rc) real(R8), pointer :: Si_imask(:) real(R8), pointer :: So_omask(:) real(R8), pointer :: Sa_ofrac(:) - integer :: i,j,n,n1,ns + integer :: n,n1,ns integer :: maptype integer :: fieldCount logical, save :: first_call = .true. @@ -662,14 +661,12 @@ subroutine med_fraction_set(gcomp, rc) ! local variables type(InternalState) :: is_local - real(r8), pointer :: lfrac(:) real(r8), pointer :: ifrac(:) real(r8), pointer :: ofrac(:) real(r8), pointer :: aofrac(:) real(r8), pointer :: Si_ifrac(:) real(r8), pointer :: Si_imask(:) real(r8), pointer :: Sa_ofrac(:) - type(ESMF_Field) :: lfield type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst integer :: n diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index 99baa2fe1..c5497293f 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -18,8 +18,8 @@ module med_internalstate_mod public :: med_internalstate_defaultmasks integer, public :: logunit ! logunit for mediator log output - integer, public :: diagunit ! diagunit for budget output (med master only) - logical, public :: mastertask=.false. ! is this the mastertask + integer, public :: diagunit ! diagunit for budget output (med main only) + logical, public :: maintask=.false. ! is this the maintask integer, public :: med_id ! needed currently in med_io_mod and set in esm.F90 ! Components @@ -208,12 +208,9 @@ subroutine med_internalstate_init(gcomp, rc) ! local variables type(InternalState) :: is_local logical :: ispresent, isset - integer :: n, ns, n1, n2 - integer :: stat - logical :: glc_present + integer :: n, ns, n1 character(len=8) :: cnum character(len=CS) :: cvalue - character(len=CL) :: cname character(len=ESMF_MAXSTR) :: mesh_glc character(len=CX) :: msgString character(len=3) :: name @@ -242,7 +239,7 @@ subroutine med_internalstate_init(gcomp, rc) end do num_icesheets = num_icesheets + 1 endif - if (mastertask) then + if (maintask) then write(logunit,'(a,i8)') trim(subname)//' number of ice sheets is ',num_icesheets end if end if @@ -336,7 +333,7 @@ subroutine med_internalstate_init(gcomp, rc) compname(compglc(ns)) = 'glc' // trim(cnum) end do - if (mastertask) then + if (maintask) then ! Write out present flags write(logunit,*) do n1 = 1,ncomps @@ -407,7 +404,7 @@ subroutine med_internalstate_coupling(gcomp, rc) ! starts, but any coupling set to false will never be allowed. ! are allowed, just update the table below. - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname) // "Initializing active coupling flags" end if @@ -494,7 +491,7 @@ subroutine med_internalstate_coupling(gcomp, rc) ! - the columns are the source of coupling ! - So, the second column indicates which models the atm is coupled to. ! - And the second row indicates which models are coupled to the atm. - if (mastertask) then + if (maintask) then write(logunit,*) ' ' write(logunit,'(A)') trim(subname)//' Allowed coupling flags' write(logunit,'(2x,A10,20(A5))') '|from to -> ',(compname(n2),n2=1,ncomps) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 6d9b8d2f6..13ae0d3ec 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -13,7 +13,7 @@ module med_io_mod use NUOPC , only : NUOPC_FieldDictionaryGetEntry use NUOPC , only : NUOPC_FieldDictionaryHasEntry use pio , only : file_desc_t, iosystem_desc_t - use med_internalstate_mod , only : logunit, med_id + use med_internalstate_mod , only : logunit, med_id, maintask use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_methods_mod , only : FB_getFieldN => med_methods_FB_getFieldN use med_methods_mod , only : FB_getFldPtr => med_methods_FB_getFldPtr @@ -435,7 +435,7 @@ subroutine med_io_init(gcomp, rc) else pio_rearr_comm_enable_isend_comp2io = .false. end if - + ! pio_rearr_comm_max_pend_req_comp2io call NUOPC_CompAttributeGet(gcomp, name='pio_rearr_comm_max_pend_req_comp2io', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -576,7 +576,7 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) if(pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then nmode = ior(nmode,pio_ioformat) endif - + rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) if (iam==0) write(logunit,'(a)') trim(subname) //' creating file '// trim(filename) rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) @@ -753,10 +753,12 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & ! Write FB to netcdf file !--------------- + use ESMF, only : operator(==) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE, ESMF_END_ABORT use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundle, ESMF_Mesh, ESMF_DistGrid use ESMF , only : ESMF_FieldBundleGet, ESMF_FieldGet, ESMF_MeshGet, ESMF_DistGridGet use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_AttributeGet + use ESMF , only : ESMF_CoordSys_Flag, ESMF_COORDSYS_SPH_DEG, ESMF_COORDSYS_SPH_RAD, ESMF_COORDSYS_CART use pio , only : var_desc_t, io_desc_t, pio_offset_kind use pio , only : pio_def_dim, pio_inq_dimid, pio_real, pio_def_var, pio_put_att, pio_double use pio , only : pio_inq_varid, pio_setframe, pio_write_darray, pio_initdecomp, pio_freedecomp @@ -783,8 +785,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & type(ESMF_Field) :: field type(ESMF_Mesh) :: mesh type(ESMF_Distgrid) :: distgrid - type(ESMF_VM) :: VM - integer :: mpicom + type(ESMF_CoordSys_Flag) :: coordsys integer :: rcode integer :: nf,ns,ng integer :: k,n @@ -799,9 +800,10 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & character(CL) :: itemc ! string converted to char character(CL) :: name1 ! var name character(CL) :: cunit ! var units - character(CL) :: lname ! long name - character(CL) :: sname ! standard name character(CL) :: lpre ! local prefix + character(CS) :: coordvarnames(2) ! coordinate variable names + character(CS) :: coordnames(2) ! coordinate long names + character(CS) :: coordunits(2) ! coordinate units integer :: lnx,lny logical :: luse_float real(r8) :: lfillvalue @@ -819,7 +821,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & integer :: rank integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fields - logical :: isPresent logical :: atmtiles integer :: ntiles = 1 character(CL), allocatable :: fieldNameList(:) @@ -878,12 +879,25 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & if (chkerr(rc,__LINE__,u_FILE_u)) return ! Get mesh distgrid and number of elements - call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, coordSys=coordsys, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MeshGet(mesh, spatialDim=ndims, numOwnedElements=nelements, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return write(tmpstr,*) subname, 'ndims, nelements = ', ndims, nelements call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + ! Define coordinate attributes according to CoordSys + if (coordsys == ESMF_COORDSYS_CART) then + coordvarnames(1) = trim(lpre)//'_x' + coordvarnames(2) = trim(lpre)//'_y' + coordnames = (/'x-coordinate', 'y-coordinate'/) + coordunits = (/'unitless','unitless'/) + else + coordvarnames(1) = trim(lpre)//'_lon' + coordvarnames(2) = trim(lpre)//'_lat' + coordnames = (/'longitude', 'latitude '/) + if (coordsys == ESMF_COORDSYS_SPH_DEG) coordunits = (/'degrees_E', 'degrees_N'/) + if (coordsys == ESMF_COORDSYS_SPH_RAD) coordunits = (/'radians ', 'radians '/) + end if ! Set element coordinates if (.not. allocated(ownedElemCoords) .and. ndims > 0 .and. nelements > 0) then @@ -1039,25 +1053,16 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & end do ! Add coordinate information to file - name1 = trim(lpre)//'_lon' - if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) - else - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) - end if - rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", "longitude") - rcode = pio_put_att(io_file(lfile_ind), varid, "units", "degrees_east") - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", "longitude") - - name1 = trim(lpre)//'_lat' - if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) - else - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) - end if - rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", "latitude") - rcode = pio_put_att(io_file(lfile_ind), varid, "units", "degrees_north") - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", "latitude") + do n = 1,ndims + if (luse_float) then + rcode = pio_def_var(io_file(lfile_ind), trim(coordvarnames(n)), PIO_REAL, dimid, varid) + else + rcode = pio_def_var(io_file(lfile_ind), trim(coordvarnames(n)), PIO_DOUBLE, dimid, varid) + end if + rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", trim(coordnames(n))) + rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(coordunits(n))) + rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(coordnames(n))) + end do end if if (wdata) then @@ -1083,7 +1088,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & else itemc = trim(fieldNameList(k)) end if - + call FB_getFldPtr(FB, itemc, & fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -1124,19 +1129,19 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & end do ! end loop over fields in FB ! Fill coordinate variables - why is this being done each time? - name1 = trim(lpre)//'_lon' - rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) + rcode = pio_inq_varid(io_file(lfile_ind), trim(coordvarnames(1)), varid) call pio_setframe(io_file(lfile_ind),varid,frame) call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) - name1 = trim(lpre)//'_lat' - rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) + rcode = pio_inq_varid(io_file(lfile_ind), trim(coordvarnames(2)), varid) call pio_setframe(io_file(lfile_ind),varid,frame) call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) call pio_syncfile(io_file(lfile_ind)) call pio_freedecomp(io_file(lfile_ind), iodesc) endif + deallocate(fieldNameList) + deallocate(ownedElemCoords, ownedElemCoords_x, ownedElemCoords_y) if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -1216,8 +1221,6 @@ subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc integer :: dimid(1) type(var_desc_t) :: varid character(CL) :: cunit ! var units - character(CL) :: lname ! long name - character(CL) :: sname ! standard name integer :: lnx integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_int1d) ' @@ -1274,6 +1277,11 @@ subroutine med_io_write_r8(filename, rdata, dname, whead, wdata, file_ind, rc) rc = ESMF_SUCCESS + if(present(file_ind)) then + lfile_ind = file_ind + else + lfile_ind = 1 + endif if (whead) then rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,varid) if (rcode==PIO_NOERR) then @@ -1322,6 +1330,11 @@ subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) rc = ESMF_SUCCESS + if(present(file_ind)) then + lfile_ind = file_ind + else + lfile_ind = 1 + endif if (whead) then lnx = size(rdata) rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',lnx,dimid(1)) @@ -1365,8 +1378,6 @@ subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) integer :: dimid(1) type(var_desc_t) :: varid character(CL) :: cunit ! var units - character(CL) :: lname ! long name - character(CL) :: sname ! standard name integer :: lnx integer :: lfile_ind character(CL) :: charvar ! buffer for string read/write @@ -1374,7 +1385,11 @@ subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - + if(present(file_ind)) then + lfile_ind = file_ind + else + lfile_ind = 1 + endif if (whead) then lnx = len(charvar) rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_len',lnx,dimid(1)) @@ -1534,7 +1549,7 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) ! local variables type(ESMF_Field) :: lfield integer :: rcode - integer :: nf,ns,ng + integer :: nf integer :: k,n,l type(file_desc_t) :: pioid type(var_desc_t) :: varid @@ -1543,7 +1558,6 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) character(CL) :: name1 ! var name character(CL) :: lpre ! local prefix real(r8) :: lfillvalue - integer :: tmp(1) integer :: rank, lsize real(r8), pointer :: fldptr1(:), fldptr1_tmp(:) real(r8), pointer :: fldptr2(:,:) @@ -1740,17 +1754,15 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) type(ESMF_Distgrid) :: distgrid integer :: rcode integer :: ns,ng - integer :: n,ndims + integer :: ndims integer, pointer :: dimid(:) type(var_desc_t) :: varid integer :: lnx,lny - integer :: tmp(1) integer, pointer :: minIndexPTile(:,:) integer, pointer :: maxIndexPTile(:,:) integer :: dimCount, tileCount integer, pointer :: Dof(:) character(CL) :: tmpstr - integer :: rank character(*),parameter :: subName = '(med_io_read_init_iodesc) ' !------------------------------------------------------------------------------- @@ -1812,7 +1824,10 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) deallocate(dof) deallocate(minIndexPTile, maxIndexPTile) - + else + if(maintask) write(logunit,*) trim(subname),' ERROR: '//trim(name1)//' is not present, aborting ' + call ESMF_LogWrite(trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE end if ! end if rcode check end subroutine med_io_read_init_iodesc @@ -2079,7 +2094,7 @@ subroutine med_io_date2ymd_long (date,year,month,day) year =int(tdate/10000) if (date < 0) year = -year month = int( mod(tdate,10000_I8)/ 100) - day = mod(tdate, 100_I8) + day = int(mod(tdate, 100_I8)) end subroutine med_io_date2ymd_long !=============================================================================== diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 6a05fa4f2..18752dc2f 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -5,7 +5,7 @@ module med_map_mod use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_LOGMSG_INFO, ESMF_LogWrite use ESMF , only : ESMF_Field - use med_internalstate_mod , only : InternalState, logunit, mastertask + use med_internalstate_mod , only : InternalState, logunit, maintask use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr use perf_mod , only : t_startf, t_stopf @@ -85,7 +85,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun use med_constants_mod , only : czero => med_constants_czero use esmFlds , only : med_fldList_GetfldListFr, med_fldlist_type use esmFlds , only : med_fld_GetFldInfo, med_fldList_entry_type - use med_internalstate_mod , only : mapunset, compname, compocn, compatm + use med_internalstate_mod , only : mapunset, compname use med_internalstate_mod , only : ncomps, nmappers, compname, mapnames, mapfcopy ! input/output variables @@ -99,9 +99,8 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun type(ESMF_Field) :: fldsrc type(ESMF_Field) :: flddst integer :: n1,n2 - integer :: n,m,nf,id,nflds + integer :: nf integer :: fieldCount - character(len=CL) :: fieldname type(ESMF_Field), pointer :: fieldlist(:) type(ESMF_Field) :: field_src character(len=CX) :: mapfile @@ -132,7 +131,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun ! -------------------------------------------------------------- ! First loop over source and destination components components - if (mastertask) write(logunit,*) ' ' + if (maintask) write(logunit,*) ' ' do n1 = 1, ncomps do n2 = 1, ncomps if (n1 /= n2) then @@ -184,7 +183,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun fldptr => fldptr%next end do ! loop over fields - + end if ! if coupling active end if ! if n1 not equal to n2 end do ! loop over n2 @@ -195,7 +194,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun ! unity normalization up front ! -------------------------------------------------------------- - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a)') trim(subname)//"Initializing unity map normalizations" endif @@ -213,7 +212,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun call ESMF_FieldBundleGet(is_local%wrap%FBImp(n1,n1), fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldCount == 0) then - if (mastertask) then + if (maintask) then write(logunit,*) trim(subname)//' '//trim(compname(n1))//' import FB field count is = ', fieldCount write(logunit,*) trim(subname)//' '//trim(compname(n1))//' trying to use export FB' end if @@ -258,7 +257,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun call med_map_field(field_src=field_src, field_dst=is_local%wrap%field_NormOne(n1,n2,mapindex), & routehandles=is_local%wrap%RH(n1,n2,:), maptype=mapindex, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' created field_NormOne for '& //compname(n1)//'->'//compname(n2)//' with mapping '//trim(mapnames(mapindex)) end if @@ -348,7 +347,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, use med_internalstate_mod , only : mapunset, mapnames, nmappers use med_internalstate_mod , only : mapnstod, mapnstod_consd, mapnstod_consf, mapnstod_consd use med_internalstate_mod , only : mapfillv_bilnr, mapbilnr_nstod, mapconsf_aofrac - use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compwav, complnd, compname + use med_internalstate_mod , only : compocn, compwav, complnd, compname, compatm use med_internalstate_mod , only : coupling_mode, dststatus_print use med_internalstate_mod , only : defaultMasks use med_constants_mod , only : ispval_mask => med_constants_ispval_mask @@ -432,14 +431,14 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ! Create route handle if (mapindex == mapfcopy) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH redist for '//trim(string) end if call ESMF_FieldRedistStore(fldsrc, flddst, routehandle=routehandles(mapfcopy), & ignoreUnmatchedIndices = .true., rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else if (lmapfile /= 'unset') then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//& ' via input file '//trim(mapfile)//' for '//trim(string) end if @@ -449,7 +448,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, if (chkerr(rc,__LINE__,u_FILE_u)) return else if (mapindex == mapbilnr .or. mapindex == mapbilnr_uv3d) then if (.not. ESMF_RouteHandleIsCreated(routehandles(mapbilnr))) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapbilnr), & @@ -465,7 +464,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ldstprint = .true. end if else if (mapindex == mapfillv_bilnr) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapfillv_bilnr), & @@ -480,7 +479,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, if (chkerr(rc,__LINE__,u_FILE_u)) return ldstprint = .true. else if (mapindex == mapbilnr_nstod) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapbilnr_nstod), & @@ -496,7 +495,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, if (chkerr(rc,__LINE__,u_FILE_u)) return ldstprint = .true. else if (mapindex == mapconsf .or. mapindex == mapnstod_consf) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsf), & @@ -513,7 +512,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ldstprint = .true. else if (mapindex == mapconsf_aofrac) then if (.not. ESMF_RouteHandleIsCreated(routehandles(mapconsf))) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsf_aofrac), & @@ -530,14 +529,14 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ldstprint = .true. else ! Copy existing consf RH - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' copying RH(mapconsf) to '//trim(mapname)//' for '//trim(string) end if routehandles(mapconsf_aofrac) = ESMF_RouteHandleCreate(routehandles(mapconsf), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if else if (mapindex == mapconsd .or. mapindex == mapnstod_consd) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mapconsd), & @@ -554,7 +553,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ldstprint = .true. else if (mapindex == mappatch .or. mapindex == mappatch_uv3d) then if (.not. ESMF_RouteHandleIsCreated(routehandles(mappatch))) then - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' creating RH '//trim(mapname)//' for '//trim(string) end if call ESMF_FieldRegridStore(fldsrc, flddst, routehandle=routehandles(mappatch), & @@ -570,7 +569,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ldstprint = .true. end if else - if (mastertask) then + if (maintask) then write(logunit,'(A)') trim(subname)//' mapindex '//trim(mapname)//' not supported for '//trim(string) end if call ESMF_LogWrite(trim(subname)//' mapindex '//trim(mapname)//' not supported ', & @@ -630,7 +629,7 @@ subroutine med_map_routehandles_initfrom_field(n1, n2, fldsrc, flddst, mapindex, ! Output route handle to file if requested if (rhprint) then - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//trim(string)//": printing RH for "//trim(mapname) end if call ESMF_RouteHandlePrint(routehandles(mapindex), rc=rc) @@ -654,7 +653,6 @@ logical function med_map_RH_is_created_RH3d(RHs,n1,n2,mapindex,rc) integer , intent(out) :: rc ! local variables - integer :: rc1, rc2 character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH3d) ' !----------------------------------------------------------- @@ -686,7 +684,7 @@ logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) rc = ESMF_SUCCESS rc1 = ESMF_SUCCESS rc2 = ESMF_SUCCESS - + med_map_RH_is_created_RH1d = .false. mapexists = .false. if (mapindex == mapnstod_consd .and. & ESMF_RouteHandleIsCreated(RHs(mapnstod), rc=rc1) .and. & @@ -720,9 +718,8 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & use ESMF use esmFlds , only : med_fldList_entry_type, med_fldList_getNumFlds, med_fldList_type use esmFlds , only : med_fld_getFldInfo - use med_internalstate_mod , only : nmappers - use med_internalstate_mod , only : ncomps, compatm, compice, compocn, compname, mapnames - use med_internalstate_mod , only : packed_data_type + use med_internalstate_mod , only : compname, mapnames + use med_internalstate_mod , only : packed_data_type, nmappers ! input/output variables integer , intent(in) :: destcomp @@ -734,10 +731,9 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & integer , intent(out) :: rc ! local variables - integer :: nf, nu, ns + integer :: nf, nu integer, allocatable :: npacked(:) integer :: fieldcount - type(ESMF_Field) :: lfield integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields real(r8), pointer :: ptrsrc_packed(:,:) real(r8), pointer :: ptrdst_packed(:,:) @@ -746,7 +742,6 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & type(ESMF_Mesh) :: lmesh_src type(ESMF_Mesh) :: lmesh_dst integer :: mapindex - integer :: numFlds type(ESMF_Field), pointer :: fieldlist_src(:) type(ESMF_Field), pointer :: fieldlist_dst(:) type(med_fldlist_entry_type), pointer :: fldptr @@ -796,7 +791,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & ! ungridded dimensions and need to unwrap them into separate fields for the ! purposes of packing - if (mastertask) write(logunit,*) + if (maintask) write(logunit,*) ! Determine the normalization type for each packed_data mapping element ! Loop over mapping types @@ -878,7 +873,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & packed_data(mapindex)%fldindex(nf) = npacked(mapindex) end if - if (mastertask) then + if (maintask) then write(logunit,'(5(a,2x),2x,i4)') trim(subname)//& 'Packed field: destcomp,mapping,mapnorm,fldname,index: ', & trim(compname(destcomp)), & @@ -953,12 +948,9 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr2d(:,:) real(r8), pointer :: dataptr2d_packed(:,:) - type(ESMF_Field) :: lfield type(ESMF_Field) :: field_fracsrc type(ESMF_Field), pointer :: fieldlist_src(:) type(ESMF_Field), pointer :: fieldlist_dst(:) - type(ESMF_Field) :: usrc, vsrc ! only used for 3d mapping of u,v - type(ESMF_Field) :: udst, vdst ! only used for 3d mapping of u,v real(r8), pointer :: data_norm(:) real(r8), pointer :: data_dst(:,:) character(len=*), parameter :: subname=' (module_MED_map:med_map_field_packed) ' diff --git a/mediator/med_merge_mod.F90 b/mediator/med_merge_mod.F90 index 7139fffd9..f09c9311d 100644 --- a/mediator/med_merge_mod.F90 +++ b/mediator/med_merge_mod.F90 @@ -64,15 +64,13 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f ! local variables type(med_fldList_entry_type), pointer :: fldptr - integer :: nfld_out,nfld_in,nm + integer :: nfld_out,nm integer :: compsrc - integer :: num_merge_fields integer :: num_merge_colon_fields character(CL) :: merge_fields character(CL) :: merge_field character(CS) :: merge_type character(CS) :: merge_fracname - character(CS), pointer :: merge_field_names(:) logical :: error_check = .false. ! TODO: make this an input argument integer :: ungriddedUBound_out(1) ! size of ungridded dimension integer :: fieldcount @@ -124,7 +122,7 @@ subroutine med_merge_auto_multi_fldbuns(coupling_active, FBOut, FBfrac, FBImp, f else if (.not. coupling_active(compsrc)) then CYCLE end if - + ! Determine the merge information for the import field call med_fld_GetFldInfo(fldptr, compsrc=compsrc, merge_fields=merge_fields, merge_type=merge_type, merge_fracname=merge_fracname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -218,14 +216,12 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, ! local variables type(med_fldList_entry_type), pointer :: fldptr - integer :: nfld_out,nfld_in,nm - integer :: num_merge_fields + integer :: nfld_out,nm integer :: num_merge_colon_fields character(CL) :: merge_fields character(CL) :: merge_field character(CS) :: merge_type character(CS) :: merge_fracname - character(CS) :: merge_field_name integer :: ungriddedUBound_out(1) ! size of ungridded dimension integer :: fieldcount character(CL) , pointer :: fieldnamelist(:) @@ -273,7 +269,7 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, ! Determine merge field name from source field call merge_listGetName(merge_fields, nm, merge_field, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - + ! Initialize initial output field data to zero before doing merge if (zero_output) then if (ungriddedUBound_out(1) > 0) then @@ -287,12 +283,12 @@ subroutine med_merge_auto_single_fldbun(compsrc, FBOut, FBfrac, FBIn, fldListTo, end if zero_output = .false. end if - + ! Perform merge call med_merge_auto_field(trim(merge_type), fieldlist(nfld_out), ungriddedUBound_out, & FB=FBIn, FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - + end do ! end of nm loop end if ! end of check of merge_type and merge_field not unset end if ! end of check if stdname and fldname are the same @@ -337,7 +333,6 @@ subroutine med_merge_auto_field(merge_type, field_out, ungriddedUBound_out, & real(R8), pointer :: dpf1(:) real(R8), pointer :: dpf2(:,:) ! intput pointers to 1d and 2d fields real(R8), pointer :: dpw1(:) ! weight pointer - character(CL) :: name character(len=*),parameter :: subname=' (med_merge_mod: med_merge_auto_field)' !--------------------------------------- @@ -544,7 +539,7 @@ subroutine med_merge_field_1D(FBout, fnameout, & real(R8), pointer :: dataOut(:) real(R8), pointer :: dataPtr(:) real(R8), pointer :: wgt(:) - integer :: lb1,ub1,i,j,n + integer :: lb1,ub1,i,n logical :: wgtfound, FBinfound integer :: dbrc character(len=*),parameter :: subname='(med_merge_field_1D)' diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 203b1923d..bd5b60793 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -68,8 +68,9 @@ module med_methods_mod private med_methods_Mesh_Print private med_methods_Grid_Print private med_methods_Field_GetFldPtr +#ifdef DIAGNOSE private med_methods_Array_diagnose - +#endif !----------------------------------------------------------------------------- contains !----------------------------------------------------------------------------- @@ -242,13 +243,11 @@ subroutine med_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, S integer , intent(out) :: rc ! local variables - integer :: i,j,n,n1 + integer :: n,n1 integer :: fieldCount,fieldCountgeom - logical :: found character(ESMF_MAXSTR) :: lname type(ESMF_Field) :: field,lfield type(ESMF_Mesh) :: lmesh - type(ESMF_StaggerLoc) :: staggerloc type(ESMF_MeshLoc) :: meshloc integer :: ungriddedCount integer :: ungriddedCount_in @@ -658,7 +657,6 @@ subroutine med_methods_State_getNumFields(State, fieldnum, rc) integer , intent(out) :: rc ! local variables - integer :: n,itemCount type(ESMF_Field), pointer :: fieldList(:) character(len=*),parameter :: subname='(med_methods_State_getNumFields)' ! ---------------------------------------------- @@ -699,7 +697,7 @@ subroutine med_methods_FB_reset(FB, value, rc) integer , intent(out) :: rc ! local variables - integer :: i,j,n + integer :: n integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) real(R8) :: lvalue @@ -777,7 +775,7 @@ subroutine med_methods_State_reset(State, value, rc) integer , intent(out) :: rc ! local variables - integer :: i,j,n + integer :: n integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) real(R8) :: lvalue @@ -923,7 +921,7 @@ subroutine med_methods_FB_diagnose(FB, string, rc) integer , intent(out) :: rc ! local variables - integer :: i,j,n + integer :: n integer :: fieldCount, lrank character(ESMF_MAXSTR), pointer :: lfieldnamelist(:) character(len=CL) :: lstring @@ -993,7 +991,7 @@ subroutine med_methods_FB_diagnose(FB, string, rc) end subroutine med_methods_FB_diagnose !----------------------------------------------------------------------------- - +#ifdef DIAGNOSE subroutine med_methods_Array_diagnose(array, string, rc) ! ---------------------------------------------- @@ -1041,7 +1039,7 @@ subroutine med_methods_Array_diagnose(array, string, rc) endif end subroutine med_methods_Array_diagnose - +#endif !----------------------------------------------------------------------------- subroutine med_methods_State_diagnose(State, string, rc) @@ -1057,7 +1055,7 @@ subroutine med_methods_State_diagnose(State, string, rc) integer , intent(out) :: rc ! local variables - integer :: i,j,n + integer :: n integer :: fieldCount, lrank character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) character(len=CS) :: lstring @@ -1140,7 +1138,6 @@ subroutine med_methods_FB_Field_diagnose(FB, fieldname, string, rc) integer , intent(out) :: rc ! local variables - integer :: lrank character(len=CS) :: lstring real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) @@ -1738,7 +1735,6 @@ subroutine med_methods_State_GeomPrint(state, string, rc) type(ESMF_Field) :: lfield integer :: fieldcount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - character(ESMF_MAXSTR) :: name character(len=*),parameter :: subname='(med_methods_State_GeomPrint)' ! ---------------------------------------------- @@ -2061,7 +2057,7 @@ subroutine med_methods_Grid_Print(grid, string, rc) integer :: localDeCount integer :: DeCount integer :: dimCount, tileCount - integer :: staggerlocCount, arbdimCount, rank + integer :: rank type(ESMF_StaggerLoc) :: staggerloc type(ESMF_TypeKind_Flag) :: coordTypeKind character(len=32) :: staggerstr @@ -2265,7 +2261,7 @@ subroutine med_methods_State_GetScalar(state, scalar_id, scalar_value, flds_scal integer, intent(inout) :: rc ! local variables - integer :: mytask, ierr, len, icount + integer :: mytask, icount type(ESMF_VM) :: vm type(ESMF_Field) :: field real(R8), pointer :: farrayptr(:,:) diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index b3acbdeb4..0b3d10901 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -26,7 +26,7 @@ module med_phases_aofluxes_mod use ESMF , only : ESMF_Finalize, ESMF_LogFoundError use ESMF , only : ESMF_XGridGet, ESMF_MeshCreate, ESMF_MeshWrite, ESMF_KIND_R8 use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit use med_internalstate_mod , only : compatm, compocn, coupling_mode, aoflux_code, mapconsd, mapconsf, mapfcopy use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : memcheck => med_memcheck @@ -94,7 +94,6 @@ module med_phases_aofluxes_mod type(ESMF_RouteHandle) :: rh_agrid2xgrid ! atm->xgrid mapping type(ESMF_RouteHandle) :: rh_xgrid2ogrid ! xgrid->ocn mapping type(ESMF_RouteHandle) :: rh_xgrid2agrid ! xgrid->atm mapping - type(ESMF_RouteHandle) :: rh_ogrid2xgrid_2ndord ! ocn->xgrid mapping 2nd order conservative type(ESMF_RouteHandle) :: rh_agrid2xgrid_2ndord ! atm->xgrid mapping 2nd order conservative type(ESMF_RouteHandle) :: rh_agrid2xgrid_bilinr ! atm->xgrid mapping bilinear type(ESMF_RouteHandle) :: rh_agrid2xgrid_patch ! atm->xgrid mapping patch @@ -152,8 +151,6 @@ module med_phases_aofluxes_mod real(R8) , pointer :: ssq (:) => null() ! saved sq end type aoflux_out_type - character(len=CS) :: aoflux_grid - character(*), parameter :: u_FILE_u = & __FILE__ @@ -201,7 +198,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) call FB_init(is_local%wrap%FBMed_aoflux_a, is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames_aof_out, name='FBMed_aoflux_a', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a)') trim(subname)//' initialized FB FBMed_aoflux_a' end if @@ -210,7 +207,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) call FB_init(is_local%wrap%FBMed_aoflux_o, is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames_aof_out, name='FBMed_aoflux_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initialized FB FBMed_aoflux_o' write(logunit,'(a)') trim(subname)//' following are the fields in FBMed_aoflux_o and FBMed_aoflux_a' do n = 1,fieldcount @@ -223,7 +220,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) ! Create the field bundle is_local%wrap%FBImp(compatm,compocn) if needed if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compatm,compocn), rc=rc)) then - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' creating field bundle FBImp(compatm,compocn)' end if call FB_init(is_local%wrap%FBImp(compatm,compocn), is_local%wrap%flds_scalar_name, & @@ -231,14 +228,14 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) name='FBImp'//trim(compname(compatm))//'_'//trim(compname(compocn)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initializing FB for '// & trim(compname(compatm))//'_'//trim(compname(compocn)) end if ! Create the field bundle is_local%wrap%FBImp(compocn,compatm) if needed if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compatm), rc=rc)) then - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' creating field bundle FBImp(compocn,compatm)' end if call FB_init(is_local%wrap%FBImp(compocn,compatm), is_local%wrap%flds_scalar_name, & @@ -246,7 +243,7 @@ subroutine med_phases_aofluxes_init_fldbuns(gcomp, rc) name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compatm)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initializing FB for '// & trim(compname(compocn))//'_'//trim(compname(compatm)) end if @@ -312,7 +309,7 @@ subroutine med_phases_aofluxes_run(gcomp, rc) if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif - call memcheck(subname, 5, mastertask) + call memcheck(subname, 5, maintask) ! Calculate atm/ocn fluxes on the destination grid call med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) @@ -359,9 +356,7 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) ! local variables type(InternalState) :: is_local - integer :: n character(CL) :: cvalue - character(len=CX) :: tmpstr real(R8) :: flux_convergence ! convergence criteria for implicit flux computation integer :: flux_max_iteration ! maximum number of iterations for convergence logical :: coldair_outbreak_mod ! cold air outbreak adjustment (Mahrt & Sun 1995,MWR) @@ -373,7 +368,7 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS - call memcheck(subname, 5, mastertask) + call memcheck(subname, 5, maintask) call t_startf('MED:'//subname) @@ -401,7 +396,7 @@ subroutine med_aofluxes_init(gcomp, aoflux_in, aoflux_out, rc) ocn_surface_flux_scheme = 0 end if #ifdef CESMCOUPLED - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a)') trim(subname)//' ocn_surface_flux_scheme is '//trim(cvalue) end if @@ -504,7 +499,6 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) type(InternalState) :: is_local character(len=CX) :: tmpstr integer :: lsize - integer :: fieldcount type(ESMF_Field) :: lfield type(ESMF_Mesh) :: lmesh real(R8), pointer :: garea(:) => null() @@ -608,7 +602,6 @@ subroutine med_aofluxes_init_agrid(gcomp, aoflux_in, aoflux_out, rc) ! Local variables type(InternalState) :: is_local integer :: lsize,n - integer :: fieldcount type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst real(r8), pointer :: dataptr1d(:) @@ -764,7 +757,6 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) integer , intent(out) :: rc ! Local variables - integer :: n integer :: lsize type(InternalState) :: is_local type(ESMF_Field) :: field_a @@ -778,7 +770,6 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) integer :: fieldcount type(ESMF_CoordSys_Flag) :: coordSys real(ESMF_KIND_R8) ,allocatable :: garea(:) - character(ESMF_MAXSTR),allocatable :: fieldNameList(:) character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' !----------------------------------------------------------------------- @@ -974,12 +965,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) ! ! Local variables type(InternalState) :: is_local - type(ESMF_Field) :: field_src - type(ESMF_Field) :: field_dst - integer :: n,i,nf ! indices - real(r8), pointer :: data_normdst(:) - real(r8), pointer :: data_dst(:) - integer :: maptype + integer :: n ! indices real(r8), parameter :: qmin = 1.0e-8_r8 real(r8), parameter :: p0 = 100000.0_r8 ! reference pressure in Pa real(r8), parameter :: rcp = 0.286_r8 ! gas constant of air / specific heat capacity at a constant pressure @@ -1073,7 +1059,7 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) #else #ifdef UFS_AOFLUX if (trim(aoflux_code) == 'ccpp') then - call flux_atmocn_ccpp(gcomp=gcomp, mastertask=mastertask, logunit=logunit, & + call flux_atmocn_ccpp(gcomp=gcomp, maintask=maintask, logunit=logunit, & nMax=aoflux_in%lsize, psfc=aoflux_in%psfc, & pbot=aoflux_in%pbot, tbot=aoflux_in%tbot, qbot=aoflux_in%shum, lwdn=aoflux_in%lwdn, & zbot=aoflux_in%zbot, garea=aoflux_in%garea, ubot=aoflux_in%ubot, usfc=aoflux_in%usfc, vbot=aoflux_in%vbot, & @@ -1404,7 +1390,7 @@ subroutine med_aofluxes_map_xgrid2agrid_output(gcomp, rc) type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst type(ESMF_Field) :: lfield - integer :: n,i,nf ! indices + integer :: n,nf ! indices real(r8), pointer :: data_src(:) real(r8), pointer :: data_src_save(:) real(r8), pointer :: data_dst(:) @@ -1484,7 +1470,7 @@ subroutine med_aofluxes_map_xgrid2ogrid_output(gcomp, rc) ! ! Local variables type(InternalState) :: is_local - integer :: n,i,nf ! indices + integer :: nf ! indices type(ESMF_Field) :: field_src type(ESMF_Field) :: field_dst character(*),parameter :: subName = '(med_aofluxes_map_xgrid2ogrid_output) ' diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index f98ece233..2f7c9f062 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -20,7 +20,7 @@ module med_phases_history_mod use NUOPC_Model , only : NUOPC_ModelGet use med_utils_mod , only : chkerr => med_utils_ChkErr use med_internalstate_mod , only : ncomps, compname - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit use med_time_mod , only : med_time_alarmInit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf @@ -164,14 +164,12 @@ subroutine med_phases_history_write(gcomp, rc) logical :: isSet type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type - integer :: i,m,n ! indices - integer :: nx,ny ! global grid size + integer :: m,n ! indices character(CL) :: time_units ! units of time variable character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output logical :: write_now ! true => write to history type - real(r8) :: tbnds(2) ! CF1.0 time bounds type(ESMF_Time) :: starttime type(ESMF_Time) :: currtime type(ESMF_Time) :: nexttime @@ -232,7 +230,7 @@ subroutine med_phases_history_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write diagnostic info - if (mastertask) then + if (maintask) then write(logunit,'(a,2x,i8)') trim(subname) // " initialized history alarm "//& trim(alarmname)//" with option "//trim(hist_option_all_inst)//" and frequency ",hist_n_all_inst end if @@ -255,7 +253,7 @@ subroutine med_phases_history_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write diagnostic info if appropriate - if (mastertask .and. debug_alarms) then + if (maintask .and. debug_alarms) then call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeIntervalGet(ringInterval, s=ringinterval_length, rc=rc) @@ -273,7 +271,7 @@ subroutine med_phases_history_write(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a,i8)') trim(subname)//" : history alarmname "//trim(alarmname)//& ' is ringing, interval length is ', ringInterval_length @@ -388,8 +386,7 @@ subroutine med_phases_history_write_med(gcomp, rc) type(InternalState) :: is_local type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type - integer :: i,m,n ! indices - integer :: nx,ny ! global grid size + integer :: m ! indices character(CL) :: time_units ! units of time variable character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output @@ -540,10 +537,9 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) character(CL) :: time_units ! units of time variable real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output - character(len=CL) :: hist_str character(len=CL) :: hist_file integer :: m - logical :: isPresent, isSet + logical :: isPresent character(len=*), parameter :: subname='(med_phases_history_write_lnd2glc)' !--------------------------------------- @@ -672,14 +668,13 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) logical :: isSet type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type - integer :: i,m,n ! indices + integer :: m ! indices integer :: nx,ny ! global grid size character(CL) :: time_units ! units of time variable character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output logical :: write_now ! true => write to history type - real(r8) :: tbnds(2) ! CF1.0 time bounds character(len=*), parameter :: subname='(med_phases_history_write_inst_comp)' !--------------------------------------- @@ -830,14 +825,13 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) logical :: isSet type(ESMF_VM) :: vm type(ESMF_Calendar) :: calendar ! calendar type - integer :: i,m,n ! indices + integer :: m ! indices integer :: nx,ny ! global grid size character(CL) :: time_units ! units of time variable character(CL) :: hist_file ! history file name real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output logical :: write_now ! true => write to history type - real(r8) :: tbnds(2) ! CF1.0 time bounds character(CS) :: scalar_name character(len=*), parameter :: subname='(med_phases_history_write_comp_avg)' !--------------------------------------- @@ -1052,11 +1046,9 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) integer :: fieldCount logical :: found logical :: enable_auxfile - character(CS) :: timestr ! yr-mon-day-sec string character(CL) :: time_units ! units of time variable integer :: nx,ny ! global grid size logical :: write_now ! if true, write time sample to file - integer :: yr,mon,day,sec ! time units real(r8) :: time_val ! time coordinate output real(r8) :: time_bnds(2) ! time bounds output character(CS), allocatable :: fieldNameList(:) @@ -1150,7 +1142,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) end if ! end of if auxflds is set to 'all' - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a,i4,a)') trim(subname) // ' Writing the following fields to auxfile ',nfcnt,& ' for component '//trim(compname(compid)) @@ -1345,7 +1337,6 @@ subroutine get_auxflds(str, flds, rc) integer :: i,k,n ! generic indecies integer :: nflds ! allocatable size of flds integer :: count ! counts occurances of char - integer :: kFlds ! number of fields in list integer :: i0,i1 ! name = list(i0:i1) integer :: nChar ! temporary logical :: valid ! check if str is valid @@ -1365,7 +1356,7 @@ subroutine get_auxflds(str, flds, rc) valid = .false. end if if (.not. valid) then - if (mastertask) write(logunit,*) "ERROR: invalid list = ",trim(str) + if (maintask) write(logunit,*) "ERROR: invalid list = ",trim(str) call ESMF_LogWrite("ERROR: invalid list = "//trim(str), ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return @@ -1419,15 +1410,12 @@ subroutine med_phases_history_fldbun_accum(fldbun, fldbun_accum, count, rc) type(ESMF_Field) :: lfield_accum integer :: fieldCount_accum character(CL), pointer :: fieldnames_accum(:) - integer :: fieldCount - character(CL), pointer :: fieldnames(:) real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr2d(:,:) real(r8), pointer :: dataptr1d_accum(:) real(r8), pointer :: dataptr2d_accum(:,:) integer :: ungriddedUBound_accum(1) integer :: ungriddedUBound(1) - character(len=64) :: msg !--------------------------------------- rc = ESMF_SUCCESS @@ -1492,7 +1480,7 @@ subroutine med_phases_history_fldbun_average(fldbun_accum, count, rc) integer , intent(out) :: rc ! local variables - integer :: n,i + integer :: n type(ESMF_Field) :: lfield_accum integer :: fieldCount character(CL), pointer :: fieldnames(:) @@ -1557,7 +1545,6 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi ! local variables type(ESMF_Clock) :: mclock, dclock type(ESMF_Time) :: StartTime - type(ESMF_TimeInterval) :: htimestep type(ESMF_TimeInterval) :: mtimestep, dtimestep integer :: msec, dsec character(len=*), parameter :: subname='(med_phases_history_init_histclock) ' @@ -1578,7 +1565,7 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi call ESMF_TimeIntervalGet(dtimestep, s=dsec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a,2x,i8,2x,i8)') trim(subname) // " mediator, driver timesteps for " & //trim(alarmname),msec,dsec end if @@ -1593,7 +1580,7 @@ subroutine med_phases_history_init_histclock(gcomp, hclock, alarm, alarmname, hi reftime=StartTime, alarmname=trim(alarmname), advance_clock=.true., rc=rc) ! Write diagnostic info - if (mastertask) then + if (maintask) then write(logunit,'(a,2x,i8)') trim(subname) // " initialized history alarm "//& trim(alarmname)//" with option "//trim(hist_option)//" and frequency ",hist_n end if @@ -1647,7 +1634,7 @@ subroutine med_phases_history_query_ifwrite(gcomp, hclock, alarmname, write_now, ! Write diagnostic output if (write_now) then - if (mastertask .and. debug_alarms) then + if (maintask .and. debug_alarms) then ! output alarm info call ESMF_AlarmGet(alarm, ringInterval=ringInterval, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1665,7 +1652,7 @@ subroutine med_phases_history_query_ifwrite(gcomp, hclock, alarmname, write_now, if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a,i8)') trim(subname)//" : history alarmname "//trim(alarmname)//& ' is ringing, interval length is ', ringInterval_length @@ -1687,7 +1674,7 @@ subroutine med_phases_history_query_ifwrite(gcomp, hclock, alarmname, write_now, if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//" : mclock currtime = "//trim(currtimestr)//& " mclock nexttime = "//trim(nexttimestr) end if @@ -1735,7 +1722,6 @@ subroutine med_phases_history_set_timeinfo(gcomp, hclock, alarmname, & integer :: yr,mon,day,sec ! time units integer :: start_ymd ! Starting date YYYYMMDD logical :: isPresent - logical :: isSet character(len=*), parameter :: subname='(med_phases_history_set_timeinfo) ' !--------------------------------------- @@ -1814,7 +1800,7 @@ subroutine med_phases_history_set_timeinfo(gcomp, hclock, alarmname, & write(histfile, "(6a)") trim(case_name),'.cpl',trim(inst_tag),trim(hist_str),trim(nexttime_str),'.nc' end if - if (mastertask) then + if (maintask) then call ESMF_TimeGet(currtime, yy=yr, mm=mon, dd=day, s=sec, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtime_str,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 0fd6773c1..a5ef002c7 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -26,10 +26,11 @@ module med_phases_ocnalb_mod !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- - +#ifdef CESMCOUPLED private med_phases_ocnalb_init - private med_phases_ocnalb_orbital_init private med_phases_ocnalb_orbital_update + private med_phases_ocnalb_orbital_init +#endif !-------------------------------------------------------------------------- ! Private data @@ -49,14 +50,14 @@ module med_phases_ocnalb_mod ! Conversion from degrees to radians character(*),parameter :: u_FILE_u = & __FILE__ - +#ifdef CESMCOUPLED character(len=CL) :: orb_mode ! attribute - orbital mode integer :: orb_iyear ! attribute - orbital year integer :: orb_iyear_align ! attribute - associated with model year real(R8) :: orb_obliq ! attribute - obliquity in degrees real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude real(R8) :: orb_eccen ! attribute and update- orbital eccentricity - +#endif character(len=*) , parameter :: orb_fixed_year = 'fixed_year' character(len=*) , parameter :: orb_variable_year = 'variable_year' character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' @@ -64,7 +65,7 @@ module med_phases_ocnalb_mod !=============================================================================== contains !=============================================================================== - +#ifdef CESMCOUPLED subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) !----------------------------------------------------------------------- @@ -91,13 +92,11 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) type(ESMF_Mesh) :: lmesh integer :: n integer :: lsize - integer :: dimCount integer :: spatialDim integer :: numOwnedElements type(InternalState) :: is_local real(R8), pointer :: ownedElemCoords(:) character(len=CL) :: tempc1,tempc2 - logical :: mastertask integer :: fieldCount type(ESMF_Field), pointer :: fieldlist(:) character(*), parameter :: subname = '(med_phases_ocnalb_init) ' @@ -193,7 +192,7 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) call t_stopf('MED:'//subname) end subroutine med_phases_ocnalb_init - +#endif !=============================================================================== subroutine med_phases_ocnalb_run(gcomp, rc) @@ -216,7 +215,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - +#ifdef CESMCOUPLED ! local variables type(ocnalb_type), save :: ocnalb type(ESMF_VM) :: vm @@ -226,7 +225,6 @@ subroutine med_phases_ocnalb_run(gcomp, rc) type(InternalState) :: is_local type(ESMF_Clock) :: clock type(ESMF_Time) :: currTime - type(ESMF_Time) :: nextTime type(ESMF_TimeInterval) :: timeStep character(CL) :: cvalue character(CS) :: starttype ! config start type @@ -238,7 +236,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) real(R8), pointer :: ifrac(:) real(R8), pointer :: ifrad(:) integer :: lsize ! local size - integer :: n,i ! indices + integer :: n ! indices real(R8) :: rlat ! gridcell latitude in radians real(R8) :: rlon ! gridcell longitude in radians real(R8) :: cosz ! Cosine of solar zenith angle @@ -255,7 +253,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) logical :: first_call = .true. character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- - +#endif rc = ESMF_SUCCESS #ifndef CESMCOUPLED @@ -264,7 +262,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) #else - ! Determine master task + ! Determine main task call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=iam, rc=rc) @@ -443,8 +441,8 @@ subroutine med_phases_ocnalb_run(gcomp, rc) end subroutine med_phases_ocnalb_run !=============================================================================== - - subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, mastertask, rc) +#ifdef CESMCOUPLED + subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, maintask, rc) !---------------------------------------------------------- ! Obtain orbital related values @@ -458,10 +456,11 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, mastertask, rc) ! input/output variables type(ESMF_GridComp) :: gcomp integer , intent(in) :: logunit ! output logunit - logical , intent(in) :: mastertask + logical , intent(in) :: maintask integer , intent(out) :: rc ! output error ! local variables + character(len=CL) :: msgstr ! temporary character(len=CL) :: cvalue ! temporary character(len=*) , parameter :: subname = "(med_phases_ocnalb_orbital_init)" @@ -469,7 +468,6 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, mastertask, rc) rc = ESMF_SUCCESS -#ifdef CESMCOUPLED ! Determine orbital attributes from input call NUOPC_CompAttributeGet(gcomp, name="orb_mode", value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -539,13 +537,11 @@ subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, mastertask, rc) rc = ESMF_FAILURE return ! bail out endif -#endif - end subroutine med_phases_ocnalb_orbital_init !=============================================================================== - subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, obliqr, lambm0, mvelpp, rc) + subroutine med_phases_ocnalb_orbital_update(clock, logunit, maintask, eccen, obliqr, lambm0, mvelpp, rc) !---------------------------------------------------------- ! Update orbital settings @@ -557,7 +553,7 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, ! input/output variables type(ESMF_Clock) , intent(in) :: clock integer , intent(in) :: logunit - logical , intent(in) :: mastertask + logical , intent(in) :: maintask real(R8) , intent(inout) :: eccen ! orbital eccentricity real(R8) , intent(inout) :: obliqr ! Earths obliquity in rad real(R8) , intent(inout) :: lambm0 ! Mean long of perihelion at vernal equinox (radians) @@ -575,19 +571,18 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, !------------------------------------------- rc = ESMF_SUCCESS - -#ifdef CESMCOUPLED + lprint = .false. if (trim(orb_mode) == trim(orb_variable_year)) then call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(CurrTime, yy=year, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return orb_year = orb_iyear + (year - orb_iyear_align) - lprint = mastertask + lprint = maintask else orb_year = orb_iyear if (first_time) then - lprint = mastertask + lprint = maintask first_time = .false. else lprint = .false. @@ -604,9 +599,9 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, mastertask, eccen, call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return ! bail out endif -#endif end subroutine med_phases_ocnalb_orbital_update +#endif !=============================================================================== diff --git a/mediator/med_phases_post_atm_mod.F90 b/mediator/med_phases_post_atm_mod.F90 index 3cf2b64dd..9ed1b78d4 100644 --- a/mediator/med_phases_post_atm_mod.F90 +++ b/mediator/med_phases_post_atm_mod.F90 @@ -28,7 +28,7 @@ subroutine med_phases_post_atm(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState use med_phases_history_mod, only : med_phases_history_write_comp use med_map_mod , only : med_map_field_packed use med_constants_mod , only : dbug_flag => med_constants_dbug_flag diff --git a/mediator/med_phases_post_glc_mod.F90 b/mediator/med_phases_post_glc_mod.F90 index 891ee5ddb..ac32ae8b8 100644 --- a/mediator/med_phases_post_glc_mod.F90 +++ b/mediator/med_phases_post_glc_mod.F90 @@ -16,7 +16,7 @@ module med_phases_post_glc_mod use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated use med_internalstate_mod , only : compatm, compice, complnd, comprof, compocn, compname, compglc use med_internalstate_mod , only : mapbilnr, mapconsd, compname - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_fldchk => med_methods_FB_fldchk use med_methods_mod , only : fldbun_getmesh => med_methods_FB_getmesh @@ -90,10 +90,8 @@ subroutine med_phases_post_glc(gcomp, rc) ! local variables type(ESMF_Clock) :: dClock - type(ESMF_StateItem_Flag) :: itemType type(InternalState) :: is_local - integer :: n1,ncnt,ns - real(r8) :: nextsw_cday + integer :: ns logical :: first_call = .true. logical :: isPresent character(CL) :: cvalue @@ -134,7 +132,7 @@ subroutine med_phases_post_glc(gcomp, rc) exit end if end do - if (mastertask) then + if (maintask) then write(logunit,'(a,L1)') trim(subname) // 'glc2lnd_coupling is ',glc2lnd_coupling write(logunit,'(a,L1)') trim(subname) // 'glc2ocn_coupling is ',glc2ocn_coupling write(logunit,'(a,L1)') trim(subname) // 'glc2ice_coupling is ',glc2ice_coupling @@ -147,7 +145,7 @@ subroutine med_phases_post_glc(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name="cism_evolve", value=cvalue, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read (cvalue,*) cism_evolve - if (mastertask) then + if (maintask) then write(logunit,'(a,l7)') trim(subname)//' cism_evolve = ',cism_evolve end if end if @@ -242,9 +240,7 @@ subroutine map_glc2lnd_init(gcomp, rc) type(ESMF_Field) :: lfield_l type(ESMF_Mesh) :: mesh_l integer :: ungriddedUBound_output(1) - integer :: fieldCount - integer :: ns,n - type(ESMF_Field), pointer :: fieldlist(:) + integer :: ns character(len=*) , parameter :: subname='(map_glc2lnd_init)' !--------------------------------------- @@ -360,10 +356,7 @@ subroutine map_glc2lnd( gcomp, rc) ! local variables type(InternalState) :: is_local - type(ESMF_Field) :: lfield - type(ESMF_Field) :: lfield_src - type(ESMF_Field) :: lfield_dst - integer :: ec, l, g, ns, n + integer :: ec, l, ns real(r8) :: topo_virtual real(r8), pointer :: icemask_g(:) ! glc ice mask field on glc grid real(r8), pointer :: frac_g(:) ! total ice fraction in each glc cell @@ -374,9 +367,7 @@ subroutine map_glc2lnd( gcomp, rc) real(r8), pointer :: frac_x_icemask_g_ec(:,:) ! (glc fraction) x (icemask), on the glc grid real(r8), pointer :: frac_x_icemask_l_ec(:,:) real(r8), pointer :: topo_x_icemask_g_ec(:,:) - real(r8), pointer :: topo_x_icemask_l_ec(:,:) real(r8), pointer :: dataptr1d(:) - real(r8), pointer :: dataptr2d(:,:) real(r8), pointer :: frac_l_ec_sum(:,:) real(r8), pointer :: topo_l_ec_sum(:,:) real(r8), pointer :: dataptr1d_src(:) diff --git a/mediator/med_phases_post_ice_mod.F90 b/mediator/med_phases_post_ice_mod.F90 index d081448e4..739369525 100644 --- a/mediator/med_phases_post_ice_mod.F90 +++ b/mediator/med_phases_post_ice_mod.F90 @@ -28,9 +28,9 @@ subroutine med_phases_post_ice(gcomp, rc) use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_map_mod , only : med_map_field_packed use med_fraction_mod , only : med_fraction_set - use med_internalstate_mod , only : InternalState, mastertask + use med_internalstate_mod , only : InternalState use med_phases_history_mod, only : med_phases_history_write_comp - use med_internalstate_mod , only : compice, compatm, compocn, compwav + use med_internalstate_mod , only : compice, compocn, compwav use perf_mod , only : t_startf, t_stopf ! input/output variables diff --git a/mediator/med_phases_post_lnd_mod.F90 b/mediator/med_phases_post_lnd_mod.F90 index d057506af..589698fad 100644 --- a/mediator/med_phases_post_lnd_mod.F90 +++ b/mediator/med_phases_post_lnd_mod.F90 @@ -23,7 +23,7 @@ subroutine med_phases_post_lnd(gcomp, rc) use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, mastertask + use med_internalstate_mod , only : InternalState use med_phases_prep_rof_mod , only : med_phases_prep_rof_accum use med_phases_prep_glc_mod , only : med_phases_prep_glc_accum_lnd, med_phases_prep_glc_avg use med_phases_history_mod , only : med_phases_history_write_comp diff --git a/mediator/med_phases_post_ocn_mod.F90 b/mediator/med_phases_post_ocn_mod.F90 index abf766211..bfc234507 100644 --- a/mediator/med_phases_post_ocn_mod.F90 +++ b/mediator/med_phases_post_ocn_mod.F90 @@ -26,7 +26,7 @@ subroutine med_phases_post_ocn(gcomp, rc) use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, logunit, mastertask + use med_internalstate_mod , only : InternalState use med_internalstate_mod , only : compice, compocn, compwav use med_phases_history_mod , only : med_phases_history_write_comp use med_phases_prep_glc_mod , only : med_phases_prep_glc_accum_ocn diff --git a/mediator/med_phases_post_rof_mod.F90 b/mediator/med_phases_post_rof_mod.F90 index ea478b0cc..aafeec011 100644 --- a/mediator/med_phases_post_rof_mod.F90 +++ b/mediator/med_phases_post_rof_mod.F90 @@ -21,10 +21,10 @@ subroutine med_phases_post_rof(gcomp, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR, ESMF_SUCCESS, ESMF_FAILURE use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 - use med_internalstate_mod , only : complnd, compocn, compice, compatm, comprof, compname + use med_internalstate_mod , only : complnd, compocn, compice, comprof use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState use med_phases_history_mod, only : med_phases_history_write_comp use med_map_mod , only : med_map_field_packed use perf_mod , only : t_startf, t_stopf diff --git a/mediator/med_phases_post_wav_mod.F90 b/mediator/med_phases_post_wav_mod.F90 index 31abf004c..50592012c 100644 --- a/mediator/med_phases_post_wav_mod.F90 +++ b/mediator/med_phases_post_wav_mod.F90 @@ -23,7 +23,7 @@ subroutine med_phases_post_wav(gcomp, rc) use med_utils_mod , only : chkerr => med_utils_ChkErr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, mastertask + use med_internalstate_mod , only : InternalState use med_internalstate_mod , only : compwav, compatm, compocn, compice use med_phases_history_mod, only : med_phases_history_write_comp use perf_mod , only : t_startf, t_stopf diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 9448f6913..9bb2b059f 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -16,7 +16,7 @@ module med_phases_prep_atm_mod use med_methods_mod , only : FB_getfldptr=> med_methods_FB_GetFldPtr use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, mastertask + use med_internalstate_mod , only : InternalState, maintask use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode use esmFlds , only : med_fldlist_GetfldListTo, med_fldlist_type use perf_mod , only : t_startf, t_stopf @@ -46,13 +46,12 @@ subroutine med_phases_prep_atm(gcomp, rc) ! local variables type(ESMF_Field) :: lfield - character(len=64) :: timestr type(InternalState) :: is_local real(R8), pointer :: dataPtr1(:) real(R8), pointer :: dataPtr2(:) real(R8), pointer :: ifrac(:) real(R8), pointer :: ofrac(:) - integer :: i, j, n, n1, ncnt + integer :: n type(med_fldlist_type), pointer :: fldList character(len=*),parameter :: subname='(med_phases_prep_atm)' !------------------------------------------------------------------------------- @@ -63,7 +62,7 @@ subroutine med_phases_prep_atm(gcomp, rc) if (dbug_flag > 5) then call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) end if - call memcheck(subname, 3, mastertask) + call memcheck(subname, 3, maintask) !--------------------------------------- ! --- Get the internal state diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index d47bbf46c..311d91c8a 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -22,7 +22,7 @@ module med_phases_prep_glc_mod use ESMF , only : ESMF_DYNAMICMASK, ESMF_DynamicMaskSetR8R8R8, ESMF_DYNAMICMASKELEMENTR8R8R8 use ESMF , only : ESMF_FieldRegrid use med_internalstate_mod , only : complnd, compocn, mapbilnr, mapconsd, compname, compglc - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit use med_map_mod , only : med_map_routehandles_init, med_map_rh_is_created use med_map_mod , only : med_map_field_normalized, med_map_field use med_constants_mod , only : dbug_flag => med_constants_dbug_flag @@ -90,8 +90,6 @@ module med_phases_prep_glc_mod type(ESMF_Field) :: field_icemask_l type(ESMF_Field) :: field_frac_l type(ESMF_Field) :: field_frac_l_ec - type(ESMF_Field) :: field_lnd_icemask_l - real(r8) , pointer :: aream_l(:) ! cell areas on land grid, for mapping character(len=*), parameter :: qice_fieldname = 'Flgl_qice' ! Name of flux field giving surface mass balance character(len=*), parameter :: Sg_frac_fieldname = 'Sg_ice_covered' @@ -108,7 +106,6 @@ module med_phases_prep_glc_mod character(len=14) :: fldnames_fr_ocn(2) = (/'So_t_depth','So_s_depth'/) ! TODO: what else needs to be added here type(ESMF_DynamicMask) :: dynamicOcnMask integer, parameter :: num_ocndepths = 7 - logical :: ocn_sends_depths = .false. type(ESMF_Clock) :: prepglc_clock character(*), parameter :: u_FILE_u = & @@ -131,18 +128,10 @@ subroutine med_phases_prep_glc_init(gcomp, rc) ! local variables type(InternalState) :: is_local - type(ESMF_Clock) :: med_clock - type(ESMF_ALARM) :: glc_avg_alarm - character(len=CS) :: glc_avg_period - type(ESMF_Time) :: starttime - integer :: glc_cpl_dt - integer :: i,n,ns,nf + integer :: n,ns,nf type(ESMF_Mesh) :: mesh_l type(ESMF_Mesh) :: mesh_o type(ESMF_Field) :: lfield - character(len=CS) :: cvalue - real(r8), pointer :: data2d_in(:,:) - real(r8), pointer :: data2d_out(:,:) character(len=CS) :: glc_renormalize_smb logical :: glc_coupled_fluxes integer :: ungriddedUBound_output(1) ! currently the size must equal 1 for rank 2 fieldds @@ -269,7 +258,7 @@ subroutine med_phases_prep_glc_init(gcomp, rc) rc = ESMF_FAILURE return end select - if (mastertask) then + if (maintask) then write(logunit,'(a,l4)') trim(subname)//' smb_renormalize is ',smb_renormalize end if @@ -396,7 +385,6 @@ subroutine med_phases_prep_glc_accum_lnd(gcomp, rc) ! local variables type(InternalState) :: is_local - type(ESMF_Field) :: lfield integer :: i,n real(r8), pointer :: data2d_in(:,:) real(r8), pointer :: data2d_out(:,:) @@ -454,7 +442,6 @@ subroutine med_phases_prep_glc_accum_ocn(gcomp, rc) ! local variables type(InternalState) :: is_local - type(ESMF_Field) :: lfield integer :: i,n real(r8), pointer :: data2d_in(:,:) real(r8), pointer :: data2d_out(:,:) @@ -524,7 +511,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) integer :: yr_med, mon_med, day_med, sec_med integer :: yr_prepglc, mon_prepglc, day_prepglc, sec_prepglc type(ESMF_Alarm) :: alarm - integer :: i, n, ns + integer :: n, ns real(r8), pointer :: data2d(:,:) real(r8), pointer :: data2d_import(:,:) character(len=CS) :: cvalue @@ -559,7 +546,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) if (trim(glc_avg_period) == 'yearly') then call med_time_alarmInit(prepglc_clock, glc_avg_alarm, 'yearly', alarmname='alarm_glc_avg', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a,i10)') trim(subname)//& ' created alarm with averaging period for export to glc is yearly' end if @@ -569,7 +556,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) read(cvalue,*) glc_cpl_dt call med_time_alarmInit(prepglc_clock, glc_avg_alarm, 'nseconds', opt_n=glc_cpl_dt, alarmname='alarm_glc_avg', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a,i10)') trim(subname)//& ' created alarm with averaging period for export to glc (in seconds) ',glc_cpl_dt end if @@ -589,7 +576,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) ! Check time if (dbug_flag > 5) then - if (mastertask) then + if (maintask) then call NUOPC_ModelGet(gcomp, modelClock=med_clock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(med_clock, currtime=med_currtime, rc=rc) @@ -599,7 +586,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) call ESMF_ClockGet(prepglc_clock, currtime=prepglc_currtime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(prepglc_currtime,yy=yr_prepglc, mm=mon_prepglc, dd=day_prepglc, s=sec_prepglc, rc=rc) - if (mastertask) then + if (maintask) then write(logunit,'(a,4(i8,2x))') trim(subname)//'med clock yr, mon, day, sec = ',& yr_med,mon_med,day_med,sec_med write(logunit,'(a,4(i8,2x))') trim(subname)//'prep glc clock yr, mon, day, sec = ',& @@ -615,7 +602,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) do_avg = .true. call ESMF_LogWrite(trim(subname)//": glc_avg alarm is ringing - average input from lnd and ocn to glc", & ESMF_LOGMSG_INFO) - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//"glc_avg alarm is ringing - averaging input from lnd and ocn to glc" end if ! Turn off the alarm @@ -752,20 +739,16 @@ subroutine med_phases_prep_glc_map_lnd2glc(gcomp, rc) ! local variables type(InternalState) :: is_local real(r8), pointer :: topolnd_g_ec(:,:) ! topo in elevation classes - real(r8), pointer :: dataptr_g(:) ! temporary data pointer for one elevation class real(r8), pointer :: topoglc_g(:) ! ice topographic height on the glc grid extracted from glc import real(r8), pointer :: data_ice_covered_g(:) ! data for ice-covered regions on the GLC grid real(r8), pointer :: ice_covered_g(:) ! if points on the glc grid is ice-covered (1) or ice-free (0) integer , pointer :: elevclass_g(:) ! elevation classes glc grid real(r8), pointer :: dataexp_g(:) ! pointer into real(r8), pointer :: dataptr2d(:,:) - real(r8), pointer :: dataptr1d(:) real(r8) :: elev_l, elev_u ! lower and upper elevations in interpolation range real(r8) :: d_elev ! elev_u - elev_l integer :: nfld, ec - integer :: i,j,n,g,lsize_g,ns - integer :: ungriddedUBound_output(1) - type(ESMF_Field) :: lfield + integer :: n,lsize_g,ns type(ESMF_Field) :: field_lfrac_l integer :: fieldCount character(len=3) :: cnum @@ -1037,7 +1020,6 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) ! local variables type(InternalState) :: is_local type(ESMF_VM) :: vm - type(ESMF_Field) :: lfield real(r8) , pointer :: qice_g(:) ! SMB (Flgl_qice) on glc grid without elev classes real(r8) , pointer :: qice_l_ec(:,:) ! SMB (Flgl_qice) on land grid with elev classes real(r8) , pointer :: topo_g(:) ! ice topographic height on the glc grid cell @@ -1048,7 +1030,6 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) real(r8) , pointer :: icemask_l(:) ! icemask on land grid real(r8) , pointer :: lfrac(:) ! land fraction on land grid real(r8) , pointer :: dataptr1d(:) ! temporary 1d pointer - real(r8) , pointer :: dataptr2d(:,:) ! temporary 2d pointer integer :: ec ! loop index over elevation classes integer :: n @@ -1173,7 +1154,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) call ESMF_VMAllreduce(vm, senddata=local_ablat_lnd, recvdata=global_ablat_lnd, count=1, & reduceflag=ESMF_REDUCE_SUM, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a,d21.10)') trim(subname)//'global_accum_lnd = ', global_accum_lnd write(logunit,'(a,d21.10)') trim(subname)//'global_ablat_lnd = ', global_ablat_lnd endif @@ -1203,7 +1184,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) reduceflag=ESMF_REDUCE_SUM, rc=rc) call ESMF_VMAllreduce(vm, senddata=local_ablat_glc, recvdata=global_ablat_glc, count=1, & reduceflag=ESMF_REDUCE_SUM, rc=rc) - if (mastertask) then + if (maintask) then write(logunit,'(a,d21.10)') trim(subname)//'global_accum_glc = ', global_accum_glc write(logunit,'(a,d21.10)') trim(subname)//'global_ablat_glc = ', global_ablat_glc endif @@ -1219,7 +1200,7 @@ subroutine med_phases_prep_glc_renormalize_smb(gcomp, ns, rc) else ablat_renorm_factor = 0.0_r8 endif - if (mastertask) then + if (maintask) then write(logunit,'(a,d21.10)') trim(subname)//'accum_renorm_factor = ', accum_renorm_factor write(logunit,'(a,d21.10)') trim(subname)//'ablat_renorm_factor = ', ablat_renorm_factor endif diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 6b8f9c8a1..428f3afef 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -36,8 +36,8 @@ subroutine med_phases_prep_ice(gcomp, rc) use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_merge_mod , only : med_merge_auto - use med_internalstate_mod , only : InternalState, logunit, mastertask - use med_internalstate_mod , only : compatm, compice, compocn, comprof + use med_internalstate_mod , only : InternalState, logunit, maintask + use med_internalstate_mod , only : compatm, compice, compocn use med_internalstate_mod , only : coupling_mode use esmFlds , only : med_fldList_GetFldListTo use perf_mod , only : t_startf, t_stopf @@ -49,16 +49,13 @@ subroutine med_phases_prep_ice(gcomp, rc) ! local variables type(InternalState) :: is_local type(ESMF_Field) :: lfield - integer :: i,n + integer :: n real(R8), pointer :: dataptr(:) real(R8), pointer :: dataptr_scalar_ocn(:,:) real(R8) :: precip_fact(1) character(len=CS) :: cvalue character(len=64), allocatable :: fldnames(:) - real(r8) :: nextsw_cday integer :: scalar_id - real(r8) :: tmp(1) - logical :: first_precip_fact_call = .true. character(len=*),parameter :: subname='(med_phases_prep_ice)' !--------------------------------------- @@ -96,7 +93,7 @@ subroutine med_phases_prep_ice(gcomp, rc) ! is initialized to 0. ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, ! it is set to 0. - if (mastertask) then + if (maintask) then call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -133,7 +130,7 @@ subroutine med_phases_prep_ice(gcomp, rc) ! obtain nextsw_cday from atm if it is in the import state and send it to ice scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday - if (scalar_id > 0 .and. mastertask) then + if (scalar_id > 0 .and. maintask) then call ESMF_StateGet(is_local%wrap%NstateImp(compatm), & itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 20f953a64..0c0bad212 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -32,7 +32,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : complnd, compatm - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState, maintask use med_merge_mod , only : med_merge_auto use perf_mod , only : t_startf, t_stopf @@ -44,11 +44,8 @@ subroutine med_phases_prep_lnd(gcomp, rc) type(ESMF_StateItem_Flag) :: itemType type(InternalState) :: is_local type(ESMF_Field) :: lfield - integer :: ncnt,ns - real(r8) :: nextsw_cday + integer :: ncnt integer :: scalar_id - real(r8) :: tmp(1) - real(r8), pointer :: dataptr2d(:,:) logical :: first_call = .true. logical :: field_found type(med_fldlist_type), pointer :: fldList @@ -104,7 +101,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) ! obtain nextsw_cday from atm if it is in the import state and send it to lnd scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday - if (scalar_id > 0 .and. field_found .and. mastertask) then + if (scalar_id > 0 .and. field_found .and. maintask) then call ESMF_StateGet(is_local%wrap%NstateImp(compatm), & itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index b8b4f2fa6..58c9ebc8b 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -7,7 +7,7 @@ module med_phases_prep_ocn_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : czero =>med_constants_czero use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit use med_merge_mod , only : med_merge_auto, med_merge_field use med_map_mod , only : med_map_field_packed use med_utils_mod , only : memcheck => med_memcheck @@ -61,7 +61,7 @@ subroutine med_phases_prep_ocn_init(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initializing ocean export accumulation FB for ' end if call FB_init(is_local%wrap%FBExpAccumOcn, is_local%wrap%flds_scalar_name, & @@ -88,7 +88,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: n, ncnt + integer :: n real(r8) :: glob_area_inv real(r8), pointer :: tocn(:) real(r8), pointer :: rain(:), hrain(:) @@ -108,7 +108,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) end if rc = ESMF_SUCCESS - call memcheck(subname, 5, mastertask) + call memcheck(subname, 5, maintask) ! Get the internal state nullify(is_local%wrap) @@ -376,7 +376,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) if (dbug_flag > 20) then call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) end if - call memcheck(subname, 5, mastertask) + call memcheck(subname, 5, maintask) ! Get the internal state nullify(is_local%wrap) @@ -565,7 +565,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) ! is initialized to 0. ! In addition, in med.F90, if this attribute is not present as a mediator component attribute, ! it is set to 0. - if (mastertask) then + if (maintask) then call ESMF_StateGet(is_local%wrap%NstateImp(compocn), & itemName=trim(is_local%wrap%flds_scalar_name), field=lfield, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -624,10 +624,6 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) ! local variables type(InternalState) :: is_local - real(R8), pointer :: ocnwgt1(:) - real(R8), pointer :: icewgt1(:) - real(R8), pointer :: wgtp01(:) - real(R8), pointer :: wgtm01(:) real(R8), pointer :: customwgt(:) real(R8), pointer :: ifrac(:) real(R8), pointer :: ofrac(:) @@ -642,7 +638,7 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) if (dbug_flag > 20) then call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) end if - call memcheck(subname, 5, mastertask) + call memcheck(subname, 5, maintask) ! Get the internal state nullify(is_local%wrap) diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 0a8999231..5d603a141 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -13,7 +13,7 @@ module med_phases_prep_rof_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use ESMF , only : ESMF_FieldBundle, ESMF_Field use med_internalstate_mod , only : complnd, comprof, mapconsf, mapconsd, mapfcopy - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_constants_mod , only : czero => med_constants_czero use med_utils_mod , only : chkerr => med_utils_chkerr @@ -90,7 +90,7 @@ subroutine med_phases_prep_rof_init(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: n, n1, nflds + integer :: n, nflds type(ESMF_Mesh) :: mesh_l type(ESMF_Mesh) :: mesh_r type(ESMF_Field) :: lfield @@ -197,9 +197,7 @@ subroutine med_phases_prep_rof_accum(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: i,j,n,ncnt - integer :: fieldCount - integer :: ungriddedUBound(1) + integer :: n logical :: exists real(r8), pointer :: dataptr1d(:) real(r8), pointer :: dataptr1d_accum(:) @@ -277,18 +275,13 @@ subroutine med_phases_prep_rof(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: i,j,n,n1,ncnt + integer :: n integer :: count logical :: exists real(r8), pointer :: dataptr(:) real(r8), pointer :: dataptr1d(:) - type(ESMF_Field) :: field_irrig_flux type(ESMF_Field) :: lfield - type(ESMF_Field) :: lfield_src - type(ESMF_Field) :: lfield_dst - type(ESMF_Field) :: field_lfrac_lnd type(med_fldList_type), pointer :: fldList - character(CL), pointer :: lfieldnamelist(:) character(len=*),parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof)' !--------------------------------------- @@ -313,7 +306,7 @@ subroutine med_phases_prep_rof(gcomp, rc) count = lndAccum2rof_cnt if (count == 0) then - if (mastertask) then + if (maintask) then write(logunit,'(a)')trim(subname)//'accumulation count for land input averging to river is 0 '// & ' accumulation field is set to zero' end if @@ -455,10 +448,6 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) ! local variables integer :: r,l type(InternalState) :: is_local - integer :: fieldcount - type(ESMF_Field) :: field_import_rof - type(ESMF_Field) :: field_import_lnd - type(ESMF_Field) :: field_irrig_flux type(ESMF_Field) :: field_lfrac_lnd type(ESMF_Mesh) :: lmesh_lnd type(ESMF_Mesh) :: lmesh_rof diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 4fdd630ea..5fcb9ba7e 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -7,7 +7,7 @@ module med_phases_prep_wav_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : czero =>med_constants_czero use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_internalstate_mod , only : InternalState, mastertask, logunit + use med_internalstate_mod , only : InternalState, maintask, logunit use med_merge_mod , only : med_merge_auto, med_merge_field use med_map_mod , only : med_map_field_packed use med_utils_mod , only : memcheck => med_memcheck @@ -56,7 +56,7 @@ subroutine med_phases_prep_wav_init(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a)') trim(subname)//' initializing wave export accumulation FB for ' end if call FB_Init(is_local%wrap%FBExpAccumWav, is_local%wrap%flds_scalar_name, & @@ -81,7 +81,6 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) ! local variables type(InternalState) :: is_local - integer :: n, ncnt character(len=*), parameter :: subname='(med_phases_prep_wav_accum)' !--------------------------------------- @@ -90,7 +89,7 @@ subroutine med_phases_prep_wav_accum(gcomp, rc) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) end if rc = ESMF_SUCCESS - call memcheck(subname, 5, mastertask) + call memcheck(subname, 5, maintask) ! Get the internal state nullify(is_local%wrap) diff --git a/mediator/med_phases_profile_mod.F90 b/mediator/med_phases_profile_mod.F90 index 46d8f2a73..dadfb989c 100644 --- a/mediator/med_phases_profile_mod.F90 +++ b/mediator/med_phases_profile_mod.F90 @@ -7,7 +7,7 @@ module med_phases_profile_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag use med_utils_mod , only : med_utils_chkerr, med_memcheck - use med_internalstate_mod , only : mastertask, logunit + use med_internalstate_mod , only : maintask, logunit use med_utils_mod , only : chkerr => med_utils_ChkErr use med_time_mod , only : alarmInit => med_time_alarmInit use perf_mod , only : t_startf, t_stopf @@ -58,11 +58,13 @@ subroutine med_phases_profile(gcomp, rc) type(ESMF_Time), save :: prevTime type(ESMF_TimeInterval) :: ringInterval, timestep type(ESMF_Alarm) :: alarm - integer :: yr, mon, day, hr, min, sec logical :: ispresent logical :: alarmison=.false., stopalarmison=.false. real(R8) :: current_time, wallclockelapsed, ypd - real(r8) :: msize, mrss, ringdays + real(r8) :: ringdays +#ifdef CESMCOUPLED + real(r8) :: msize, mrss +#endif real(r8), save :: avgdt character(len=CL) :: walltimestr, nexttimestr character(len=*), parameter :: subname='(med_phases_profile)' @@ -142,7 +144,7 @@ subroutine med_phases_profile(gcomp, rc) endif endif - if ((stopalarmison .or. alarmIsOn .or. iterations==1) .and. mastertask) then + if ((stopalarmison .or. alarmIsOn .or. iterations==1) .and. maintask) then ! We need to get the next time for display call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) if (med_utils_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -185,6 +187,7 @@ subroutine med_phases_profile(gcomp, rc) call shr_mem_getusage(msize,mrss,.true.) write(logunit,105) ' memory_write: model date = ',trim(nexttimestr), & ' memory = ',msize,' MB (highwater) ',mrss,' MB (usage)' +105 format( 3A, f10.2, A, f10.2, A) #endif previous_time = current_time @@ -193,7 +196,6 @@ subroutine med_phases_profile(gcomp, rc) iterations = iterations + 1 101 format( 5A, F8.2, A, F8.2, A, F8.2, A) -105 format( 3A, f10.2, A, f10.2, A) !--------------------------------------- !--- clean up !--------------------------------------- diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 5affb149a..6bf5f3466 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -7,7 +7,7 @@ module med_phases_restart_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_internalstate_mod , only : mastertask, logunit, InternalState + use med_internalstate_mod , only : maintask, logunit, InternalState use med_internalstate_mod , only : ncomps, compname, compocn, complnd, compwav use perf_mod , only : t_startf, t_stopf use med_phases_prep_glc_mod , only : FBlndAccum2glc_l, lndAccum2glc_cnt @@ -58,8 +58,6 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) type(ESMF_Clock) :: mclock type(ESMF_TimeInterval) :: mtimestep type(ESMF_Time) :: mCurrTime - type(ESMF_Time) :: mStartTime - type(ESMF_TimeInterval) :: timestep integer :: timestep_length character(CL) :: cvalue ! attribute string character(CL) :: restart_option ! freq_option setting (ndays, nsteps, etc) @@ -108,7 +106,7 @@ subroutine med_phases_restart_alarm_init(gcomp, rc) end if ! Write mediator diagnostic output - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a,2x,i8)') trim(subname)//" restart clock timestep = ",timestep_length write(logunit,'(a,2x,i8)') trim(subname)//" set restart alarm with option "//& @@ -175,11 +173,8 @@ subroutine med_phases_restart_write(gcomp, rc) character(ESMF_MAXSTR) :: cpl_inst_tag ! instance tag character(ESMF_MAXSTR) :: restart_dir ! Optional restart directory name character(ESMF_MAXSTR) :: cvalue ! attribute string - character(ESMF_MAXSTR) :: freq_option ! freq_option setting (ndays, nsteps, etc) - integer :: freq_n ! freq_n setting relative to freq_option logical :: alarmIsOn ! generic alarm flag real(R8) :: tbnds(2) ! CF1.0 time bounds - character(ESMF_MAXSTR) :: tmpstr logical :: isPresent logical :: first_time = .true. character(len=*), parameter :: subname='(med_phases_restart_write)' @@ -267,7 +262,7 @@ subroutine med_phases_restart_write(gcomp, rc) if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO) endif - if (mastertask) then + if (maintask) then call ESMF_ClockPrint(clock, options="currTime", & preString="-------->"//trim(subname)//" mediating for: ", unit=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -303,8 +298,8 @@ subroutine med_phases_restart_write(gcomp, rc) write(restart_file,"(6a)") trim(restart_dir)//trim(case_name),'.cpl', trim(cpl_inst_tag),'.r.',& trim(nexttimestr),'.nc' - if (mastertask) then - restart_pfile = "rpointer.cpl"//cpl_inst_tag + if (maintask) then + restart_pfile = "rpointer.cpl"//trim(cpl_inst_tag) call ESMF_LogWrite(trim(subname)//" write rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED') write(unitn,'(a)') trim(restart_file) @@ -495,7 +490,7 @@ subroutine med_phases_restart_read(gcomp, rc) type(ESMF_Time) :: currtime character(len=CS) :: currtimestr type(InternalState) :: is_local - integer :: i,j,m,n + integer :: n integer :: ierr, unitn integer :: yr,mon,day,sec ! time units character(ESMF_MAXSTR) :: case_name ! case name @@ -537,14 +532,14 @@ subroutine med_phases_restart_read(gcomp, rc) if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO) endif - if (mastertask) then + if (maintask) then call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Get the restart file name from the pointer file - restart_pfile = "rpointer.cpl"//cpl_inst_tag - if (mastertask) then + restart_pfile = "rpointer.cpl"//trim(cpl_inst_tag) + if (maintask) then call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO) open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old', iostat=ierr) if (ierr < 0) then diff --git a/mediator/med_time_mod.F90 b/mediator/med_time_mod.F90 index 5ba7f30a7..8a05c3671 100644 --- a/mediator/med_time_mod.F90 +++ b/mediator/med_time_mod.F90 @@ -17,7 +17,7 @@ module med_time_mod use ESMF , only : operator(<=), operator(>), operator(==) use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : chkerr => med_utils_ChkErr - use med_internalstate_mod, only : mastertask, logunit + use med_internalstate_mod, only : maintask, logunit implicit none private ! default private @@ -86,7 +86,6 @@ subroutine med_time_alarmInit( clock, alarm, option, & type(ESMF_Time) :: CurrTime ! Current Time type(ESMF_Time) :: NextAlarm ! Next alarm time type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval - integer :: sec character(len=*), parameter :: subname = '(med_time_alarmInit): ' !------------------------------------------------------------------------------- @@ -255,7 +254,7 @@ subroutine med_time_alarmInit( clock, alarm, option, & enddo endif - if (mastertask) then + if (maintask) then write(logunit,*) write(logunit,'(a)') trim(subname) //' creating alarm '// trim(lalarmname) end if diff --git a/mediator/med_utils_mod.F90 b/mediator/med_utils_mod.F90 index 9e34d1d40..91286d651 100644 --- a/mediator/med_utils_mod.F90 +++ b/mediator/med_utils_mod.F90 @@ -17,14 +17,14 @@ module med_utils_mod contains !=============================================================================== - subroutine med_memcheck(string, level, mastertask) + subroutine med_memcheck(string, level, maintask) character(len=*), intent(in) :: string integer, intent(in) :: level - logical, intent(in) :: mastertask - integer :: ierr + logical, intent(in) :: maintask #ifdef CESMCOUPLED + integer :: ierr integer, external :: GPTLprint_memusage - if((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then + if((maintask .and. memdebug_level > level) .or. memdebug_level > level+1) then ierr = GPTLprint_memusage(string) endif #endif @@ -48,19 +48,21 @@ logical function med_utils_ChkErr(rc, line, file, mpierr) logical, optional, intent(in) :: mpierr #ifdef NO_MPI2 integer, parameter :: MPI_MAX_ERROR_STRING=80 +#else + integer :: ierr, len #endif character(MPI_MAX_ERROR_STRING) :: lstring - integer :: lrc, len, ierr + integer :: lrc med_utils_ChkErr = .false. lrc = rc if (present(mpierr)) then if(mpierr) then if (rc == MPI_SUCCESS) return -#ifdef USE_MPI2 - call MPI_ERROR_STRING(rc, lstring, len, ierr) -#else +#ifdef NO_MPI2 write(lstring,*) "ERROR in mct mpi-serial library rc=",rc +#else + call MPI_ERROR_STRING(rc, lstring, len, ierr) #endif call ESMF_LogWrite("ERROR: "//trim(lstring), ESMF_LOGMSG_INFO, line=line, file=file) lrc = ESMF_FAILURE diff --git a/ufs/flux_atmocn_ccpp_mod.F90 b/ufs/flux_atmocn_ccpp_mod.F90 index 9dafda8eb..84f1652bf 100644 --- a/ufs/flux_atmocn_ccpp_mod.F90 +++ b/ufs/flux_atmocn_ccpp_mod.F90 @@ -25,7 +25,7 @@ module flux_atmocn_ccpp_mod use med_kind_mod, only : CL=>SHR_KIND_CL use med_utils_mod, only : chkerr => med_utils_chkerr use med_internalstate_mod, only : aoflux_ccpp_suite, logunit - use med_internalstate_mod, only : InternalState, mastertask + use med_internalstate_mod, only : InternalState, maintask use med_constants_mod, only : dbug_flag => med_constants_dbug_flag implicit none @@ -52,7 +52,7 @@ module flux_atmocn_ccpp_mod contains !=============================================================================== - subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, & + subroutine flux_atmOcn_ccpp(gcomp, maintask, logunit, nMax, mask, psfc, pbot, & tbot, qbot, zbot, garea, ubot, usfc, vbot, vsfc, rbot, ts, lwdn, sen, lat, & lwup, evp, taux, tauy, tref, qref, duu10n, ustar_sv, re_sv, ssq_sv, missval) @@ -60,7 +60,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, !--- input arguments -------------------------------- type(ESMF_GridComp), intent(in) :: gcomp ! gridded component - logical , intent(in) :: mastertask ! master task + logical , intent(in) :: maintask ! main task integer , intent(in) :: logunit ! log file unit number integer , intent(in) :: nMax ! data vector length integer , intent(in) :: mask (nMax) ! ocn domain mask @@ -301,7 +301,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, if (trim(cvalue) .eq. '.true.' .or. trim(cvalue) .eq. 'true') ini_read = .true. end if - if (mastertask) then + if (maintask) then write(logunit,*) '========================================================' write(logunit,'(a,f5.2)') trim(subname)//' ccpp_phy_semis_water = ', semis_water write(logunit,'(a,l)') trim(subname)//' ccpp_phy_lseaspray = ', physics%model%lseaspray @@ -361,7 +361,7 @@ subroutine flux_atmOcn_ccpp(gcomp, mastertask, logunit, nMax, mask, psfc, pbot, ! set counter physics%model%kdt = ((currTime-StartTime)/timeStep)+1 - if (mastertask .and. dbug_flag > 5) then + if (maintask .and. dbug_flag > 5) then write(logunit,'(a,i5)') 'kdt = ', physics%model%kdt end if diff --git a/ufs/flux_atmocn_mod.F90 b/ufs/flux_atmocn_mod.F90 index ca0bc200c..3e5b58602 100644 --- a/ufs/flux_atmocn_mod.F90 +++ b/ufs/flux_atmocn_mod.F90 @@ -25,9 +25,9 @@ module flux_atmocn_mod real(R8) :: loc_karman = shr_const_karman real(R8) :: loc_g = shr_const_g real(R8) :: loc_latvap = shr_const_latvap - real(R8) :: loc_latice = shr_const_latice +! real(R8) :: loc_latice = shr_const_latice real(R8) :: loc_stebol = shr_const_stebol - real(R8) :: loc_tkfrz = shr_const_tkfrz +! real(R8) :: loc_tkfrz = shr_const_tkfrz ! These control convergence of the iterative flux calculation ! (For Large and Pond scheme only; not UA or COARE). @@ -144,10 +144,6 @@ subroutine flux_atmOcn(logunit, nMax,zbot ,ubot ,vbot ,thbot , & real(R8) :: cp ! specific heat of moist air real(R8) :: fac ! vertical interpolation factor real(R8) :: spval ! local missing value - !!++ COARE only - real(R8) :: zo,zot,zoq ! roughness lengths - real(R8) :: hsb,hlb ! sens & lat heat flxs at zbot - real(R8) :: trf,qrf,urf,vrf ! reference-height quantities !--- local functions -------------------------------- real(R8) :: qsat ! function: the saturation humididty of air (kg/m^3) diff --git a/ufs/glc_elevclass_mod.F90 b/ufs/glc_elevclass_mod.F90 index 3bcefc23c..6524f064f 100644 --- a/ufs/glc_elevclass_mod.F90 +++ b/ufs/glc_elevclass_mod.F90 @@ -29,7 +29,7 @@ module glc_elevclass_mod !----------------------------------------------------------------------- function glc_get_num_elevation_classes() result(num_elevation_classes) integer :: num_elevation_classes ! function result - integer :: rc + num_elevation_classes = 0 end function glc_get_num_elevation_classes !----------------------------------------------------------------------- @@ -52,6 +52,7 @@ function glc_mean_elevation_virtual(elevation_class, logunit) result(mean_elevat real(r8) :: mean_elevation ! function result integer, intent(in) :: elevation_class integer, optional, intent(in) :: logunit + mean_elevation = 0.0_r8 end function glc_mean_elevation_virtual !----------------------------------------------------------------------- diff --git a/ufs/ufs_io_mod.F90 b/ufs/ufs_io_mod.F90 index ee85fa183..8564be8e5 100644 --- a/ufs/ufs_io_mod.F90 +++ b/ufs/ufs_io_mod.F90 @@ -39,7 +39,7 @@ module ufs_io_mod use med_kind_mod, only : r8=>SHR_KIND_R8, cs=>SHR_KIND_CS, cl=>SHR_KIND_CL use med_utils_mod, only : chkerr => med_utils_chkerr use med_constants_mod, only : dbug_flag => med_constants_dbug_flag - use med_internalstate_mod, only : InternalState, mastertask, logunit + use med_internalstate_mod, only : InternalState, maintask, logunit use med_internalstate_mod, only : compatm, compocn, mapconsf use med_io_mod, only : med_io_date2yyyymmdd, med_io_sec2hms, med_io_ymd2date use ufs_const_mod, only : shr_const_cday @@ -173,7 +173,7 @@ subroutine read_initial(gcomp, ini_file, mosaic_file, input_dir, layout, rc) ! return pointer and fill variable call ESMF_FieldGet(field_dst, localDe=0, farrayPtr=ptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit,'(a)') 'Reading: '//trim(flds(n)) + if (maintask) write(logunit,'(a)') 'Reading: '//trim(flds(n)) if (trim(flds(n)) == 'zorl' ) physics%sfcprop%zorl(:) = ptr(:) if (trim(flds(n)) == 'uustar') physics%sfcprop%uustar(:)= ptr(:) nullify(ptr) @@ -246,7 +246,7 @@ subroutine read_restart(gcomp, rst_file, rc) ! Now read in the restart file !---------------------- - if (mastertask) then + if (maintask) then write(logunit,'(a)') 'Reading CCPP restart file: '//trim(rst_file) end if @@ -289,7 +289,7 @@ subroutine read_restart(gcomp, rst_file, rc) call FB_getfldptr(FBin, trim(flds(n)), ptr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) write(logunit,'(a)') 'Reading: '//trim(flds(n)) + if (maintask) write(logunit,'(a)') 'Reading: '//trim(flds(n)) if (trim(flds(n)) == 'zorl' ) physics%sfcprop%zorl(:) = ptr(:) if (trim(flds(n)) == 'uustar') physics%sfcprop%uustar(:)= ptr(:) if (trim(flds(n)) == 'qss' ) physics%sfcprop%qss(:) = ptr(:) @@ -873,7 +873,7 @@ subroutine write_restart(gcomp, restart_freq, rc) call ESMF_FieldBundleWrite(FBout, trim(rst_file), overwrite=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then + if (maintask) then write(logunit,'(a)') 'CCPP restart file is closed: '//trim(rst_file) end if From cef1277524497811017bdf2ccbcf6673269226ad Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sat, 25 Feb 2023 14:28:47 -0500 Subject: [PATCH 02/36] add back bilnr_nstod mapping --- mediator/esmFldsExchange_nems_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index f93739618..e62863a5d 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -306,7 +306,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sw_z0', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compwav,compwav), 'Sw_z0', rc=rc)) then - call addmap_from(compwav, 'Sw_z0', compatm, mapnstod_consf, 'one', 'unset') + call addmap_from(compwav, 'Sw_z0', compatm, mapbilnr_nstod, 'one', 'unset') call addmrg_to(compatm, 'Sw_z0', mrg_from=compwav, mrg_fld='Sw_z0', mrg_type='copy') end if end if @@ -698,7 +698,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap_from(compatm, trim(fldname), compwav, mapnstod_consf, 'one', 'unset') + call addmap_from(compatm, trim(fldname), compwav, mapbilnr_nstod, 'one', 'unset') call addmrg_to(compwav, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') end if end if From 18e5075201d10229c87234e48fa9875c1ddc9354 Mon Sep 17 00:00:00 2001 From: Jian Sun Date: Wed, 22 Mar 2023 21:56:04 -0600 Subject: [PATCH 03/36] Add Jim's changes for new GPU options based on his branch: https://github.com/jedwards4b/CMEPS/compare/ff8726f..79d6fa7 modified: cime_config/config_component.xml --- cime_config/config_component.xml | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 7f9bac96e..cadc8a433 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -784,6 +784,24 @@ If TRUE, the component libraries are always built with OpenMP capability. + + char + none, v100, a100, mi250 + none + build_def + env_build.xml + If set will compile and submit with this gpu type enabled + + + + char + none, openacc, openmp, combined + none + build_def + env_build.xml + If set will compile and submit with this gpu offload method enabled + + logical TRUE,FALSE From ebb0818566e23a99e14c3d59aff19cbaaf2e1f90 Mon Sep 17 00:00:00 2001 From: Jian Sun Date: Wed, 22 Mar 2023 22:03:18 -0600 Subject: [PATCH 04/36] Add MAX_CPUTASKS_PER_GPU_NODE XML variable Update nvhpc compiler for GPU settings Remove PGI compiler modified: cime_config/config_component.xml --- cime_config/config_component.xml | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index cadc8a433..abff72296 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -1897,12 +1897,22 @@ pes or cores per node for accounting purposes + + integer + 0 + + 1 + + mach_pes_last + env_mach_pes.xml + Number of CPU cores per GPU node used for simulation + + integer 0 - 1 - 1 + 1 mach_pes env_mach_pes.xml From 72c123099cc4a8f255af4c07eb0dc26984a02340 Mon Sep 17 00:00:00 2001 From: Jian Sun Date: Fri, 24 Mar 2023 14:44:22 -0600 Subject: [PATCH 05/36] Remove default_values and valid_values for GPU_TYPE and GPU_OFFLOAD so that they could assign multiple values to the config_machines.xml file modified: cime_config/config_component.xml --- cime_config/config_component.xml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index abff72296..48e86f88c 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -786,8 +786,8 @@ char - none, v100, a100, mi250 - none + + build_def env_build.xml If set will compile and submit with this gpu type enabled @@ -795,8 +795,8 @@ char - none, openacc, openmp, combined - none + + build_def env_build.xml If set will compile and submit with this gpu offload method enabled From 91bcb847e9e5cac48f1ed3676cfcb1764c45b51d Mon Sep 17 00:00:00 2001 From: RatkoVasic-NOAA <37597874+RatkoVasic-NOAA@users.noreply.github.com> Date: Fri, 31 Mar 2023 18:02:14 -0400 Subject: [PATCH 06/36] Modify CMEPS for ufsdev_ruclsm (#84) * Corrected type for 2-m dewpoint. * Corrected type of variables diag_flux and diag_log. * Match von_karman_constant name with Physcons. --------- Co-authored-by: tanyasmirnova --- ufs/ccpp/data/MED_typedefs.F90 | 17 ++++++++++-- ufs/ccpp/data/MED_typedefs.meta | 47 +++++++++++++++++++++++++++++++++ 2 files changed, 62 insertions(+), 2 deletions(-) diff --git a/ufs/ccpp/data/MED_typedefs.F90 b/ufs/ccpp/data/MED_typedefs.F90 index 1b2ce51c5..b9c46c807 100644 --- a/ufs/ccpp/data/MED_typedefs.F90 +++ b/ufs/ccpp/data/MED_typedefs.F90 @@ -4,9 +4,9 @@ module MED_typedefs !! \htmlinclude MED_typedefs.html !! use machine, only: kind_phys - use physcons, only: con_hvap, con_cp, con_rd, con_eps + use physcons, only: con_hvap, con_cp, con_rd, con_eps, con_rocp use physcons, only: con_epsm1, con_fvirt, con_g - use physcons, only: con_tice + use physcons, only: con_tice, karman implicit none @@ -189,6 +189,8 @@ module MED_typedefs integer :: lsoil !< number of soil layers integer :: kice !< vertical loop extent for ice levels, start at 1 integer :: lsm_ruc !< flag for RUC land surface model + logical :: diag_flux !< flag for flux method of 2-m diagnostics + logical :: diag_log !< flag for log 2-m diagnostics contains procedure :: init => control_initialize end type MED_control_type @@ -208,6 +210,8 @@ module MED_typedefs !! type MED_grid_type real(kind=kind_phys), pointer :: area(:) => null() !< area of the grid cell + real(kind=kind_phys), pointer :: xlat_d(:) => null() !< latitude in degrees + real(kind=kind_phys), pointer :: xlon_d(:) => null() !< longtitude in degrees contains procedure :: create => grid_create !< allocate array data end type MED_grid_type @@ -259,6 +263,7 @@ module MED_typedefs type MED_diag_type real(kind=kind_phys), pointer :: chh(:) => null() !< thermal exchange coefficient (kg m-2 s-1) real(kind=kind_phys), pointer :: cmm(:) => null() !< momentum exchange coefficient (m/s) + real(kind=kind_phys), pointer :: dpt2m(:) => null() !< 2-m dewpoint (K) contains procedure :: create => diag_create !< allocate array data end type MED_diag_type @@ -636,6 +641,8 @@ subroutine control_initialize(model) model%lsoil = 4 model%kice = 2 model%lsm_ruc = 3 + model%diag_flux = .false. + model%diag_log = .false. end subroutine control_initialize @@ -658,6 +665,10 @@ subroutine grid_create(grid, im) allocate(grid%area(im)) grid%area = clear_val + allocate(grid%xlat_d(im)) + grid%xlat_d = clear_val + allocate(grid%xlon_d(im)) + grid%xlon_d = clear_val end subroutine grid_create @@ -745,6 +756,8 @@ subroutine diag_create(diag, im) diag%chh = clear_val allocate(diag%cmm(im)) diag%cmm = clear_val + allocate(diag%dpt2m(im)) + diag%dpt2m = clear_val end subroutine diag_create diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index 8177ae5ca..9071b7d52 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -924,6 +924,18 @@ units = flag dimensions = () type = integer +[diag_flux] + standard_name = flag_for_flux_method_in_2m_diagnostics + long_name = flag for flux method in 2-m diagnostics + units = flag + dimensions = () + type = logical +[diag_log] + standard_name = flag_for_log_method_in_2m_diagnostics + long_name = flag for log method in 2-m diagnostics + units = flag + dimensions = () + type = logical ######################################################################## [ccpp-table-properties] @@ -964,6 +976,20 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[xlat_d] + standard_name = latitude_in_degree + long_name = latitude in degree north + units = degree_north + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[xlon_d] + standard_name = longitude_in_degree + long_name = longitude in degree east + units = degree_east + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys ######################################################################## [ccpp-table-properties] @@ -1228,6 +1254,13 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[dpt2m] + standard_name = dewpoint_temperature_at_2m + long_name = 2 meter dewpoint temperature + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys ######################################################################## [ccpp-table-properties] @@ -1343,3 +1376,17 @@ dimensions = () type = real kind = kind_phys +[con_rocp] + standard_name = ratio_of_gas_constant_dry_air_to_specific_heat_of_dry_air_at_constant_pressure + long_name = (rd/cp) + units = none + dimensions = () + type = real + kind = kind_phys +[karman] + standard_name = von_karman_constant + long_name = von karman constant + units = none + dimensions = () + type = real + From fe2c15820c27808260c313fa5caa0ae69e987dae Mon Sep 17 00:00:00 2001 From: "Samuel Trahan (NOAA contractor)" <39415369+SamuelTrahanNOAA@users.noreply.github.com> Date: Wed, 26 Apr 2023 11:59:59 -0400 Subject: [PATCH 07/36] new clm lake variables (#77) --- ufs/ccpp/data/MED_typedefs.F90 | 31 +++++++++++++++--- ufs/ccpp/data/MED_typedefs.meta | 58 +++++++++++++++++++++++++++++---- 2 files changed, 78 insertions(+), 11 deletions(-) diff --git a/ufs/ccpp/data/MED_typedefs.F90 b/ufs/ccpp/data/MED_typedefs.F90 index b9c46c807..e5e1b494f 100644 --- a/ufs/ccpp/data/MED_typedefs.F90 +++ b/ufs/ccpp/data/MED_typedefs.F90 @@ -68,7 +68,9 @@ module MED_typedefs real(kind=kind_phys), pointer :: fm10_water(:) => null() !< Monin-Obukhov similarity parameter for momentum at 10m over water real(kind=kind_phys), pointer :: prslki(:) => null() !< Exner function ratio bt midlayer and interface at 1st layer logical, pointer :: wet(:) => null() !< flag indicating presence of some ocean or lake surface area fraction - logical, pointer :: use_flake(:) => null() !< flag indicating lake points using flake model + integer, pointer :: use_lake_model(:)=>null() !< 0 for points that don't use a lake model, lkm for points that do + real (kind=kind_phys),pointer :: lake_t2m (:) => null() !< 2 meter temperature from CLM Lake model + real (kind=kind_phys),pointer :: lake_q2m (:) => null() !< 2 meter humidity from CLM Lake model real(kind=kind_phys), pointer :: wind(:) => null() !< wind speed at lowest model level (m/s) logical, pointer :: flag_iter(:) => null() !< flag for iteration real(kind=kind_phys), pointer :: qss_water(:) => null() !< surface air saturation specific humidity over water (kg/kg) @@ -172,7 +174,7 @@ module MED_typedefs integer :: sfc_z0_type !< surface roughness options over water logical :: thsfc_loc !< flag for reference pressure in theta calculation integer :: nstf_name(5) !< NSSTM flag: off/uncoupled/coupled=0/1/2 - integer :: lkm !< flag for flake model + integer :: lkm !< 0 = no lake model, 1 = lake model, 2 = lake & nsst on lake points logical :: first_time_step !< flag signaling first time step for time integration routine logical :: frac_grid !< flag for fractional grid logical :: cplwav2atm !< default no wav->atm coupling @@ -189,6 +191,14 @@ module MED_typedefs integer :: lsoil !< number of soil layers integer :: kice !< vertical loop extent for ice levels, start at 1 integer :: lsm_ruc !< flag for RUC land surface model + + ! Lake variables + logical :: frac_ice = .false. !< flag for fractional ice when fractional grid is not in use + logical :: use_lake2m = .false. !< use 2m T & Q calculated by the lake model + integer :: iopt_lake = 1 !< =1 flake, =2 clm lake + integer :: iopt_lake_flake = 1 + integer :: iopt_lake_clm = 2 + logical :: diag_flux !< flag for flux method of 2-m diagnostics logical :: diag_log !< flag for log 2-m diagnostics contains @@ -348,8 +358,12 @@ subroutine interstitial_create(interstitial, im) interstitial%prslki = clear_val allocate(interstitial%wet(im)) interstitial%wet = .false. - allocate(interstitial%use_flake(im)) - interstitial%use_flake = .false. + allocate(interstitial%use_lake_model(im)) + interstitial%use_lake_model = 0 + allocate(interstitial%lake_t2m(im)) + interstitial%lake_t2m=-9999 + allocate(interstitial%lake_q2m(im)) + interstitial%lake_q2m=-9999 allocate(interstitial%wind(im)) interstitial%wind = huge allocate(interstitial%flag_iter(im)) @@ -596,7 +610,9 @@ subroutine interstitial_phys_reset(interstitial) interstitial%tsurf_ice = huge interstitial%tsurf_land = huge interstitial%tsurf_water = huge - interstitial%use_flake = .false. + interstitial%use_lake_model = 0 + interstitial%lake_t2m = -9999 + interstitial%lake_q2m = -9999 interstitial%uustar_ice = huge interstitial%uustar_land = huge interstitial%uustar_water = huge @@ -641,6 +657,11 @@ subroutine control_initialize(model) model%lsoil = 4 model%kice = 2 model%lsm_ruc = 3 + model%frac_ice = .false. + model%use_lake2m = .false. + model%iopt_lake = 1 + model%iopt_lake_flake = 1 + model%iopt_lake_clm = 2 model%diag_flux = .false. model%diag_log = .false. diff --git a/ufs/ccpp/data/MED_typedefs.meta b/ufs/ccpp/data/MED_typedefs.meta index 9071b7d52..271110e9c 100644 --- a/ufs/ccpp/data/MED_typedefs.meta +++ b/ufs/ccpp/data/MED_typedefs.meta @@ -202,12 +202,28 @@ units = flag dimensions = (horizontal_loop_extent) type = logical -[use_flake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model +[lake_t2m] + standard_name = temperature_at_2m_from_clm_lake + long_name = temperature at 2m from clm lake + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_q2m] + standard_name = specific_humidity_at_2m_from_clm_lake + long_name = specific humidity at 2m from clm lake + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model units = flag dimensions = (horizontal_loop_extent) - type = logical + type = integer [wind] standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level @@ -817,9 +833,33 @@ units = flag dimensions = () type = integer +[iopt_lake] + standard_name = control_for_lake_model_selection + long_name = control for lake model selection + units = 1 + dimensions = () + type = integer +[iopt_lake_flake] + standard_name = flake_model_control_selection_value + long_name = value that indicates flake model in the control for lake model selection + units = 1 + dimensions = () + type = integer +[iopt_lake_clm] + standard_name = clm_lake_model_control_selection_value + long_name = value that indicates clm lake model in the control for lake model selection + units = 1 + dimensions = () + type = integer +[use_lake2m] + standard_name = use_2m_diagnostics_calculated_by_lake_model + long_name = model 2m diagnostics use the temperature and humidity calculated by the lake model + units = flag + dimensions = () + type = integer [lkm] - standard_name = control_for_lake_surface_scheme - long_name = flag for lake surface model + standard_name = control_for_lake_model_execution_method + long_name = control for lake model execution: 0=no lake, 1=lake, 2=lake+nsst units = flag dimensions = () type = integer @@ -835,6 +875,12 @@ units = flag dimensions = () type = logical +[frac_ice] + standard_name = flag_for_fractional_ice_when_fractional_landmask_is_disabled + long_name = flag for fractional ice when fractional landmask is disabled + units = flag + dimensions = () + type = logical [cplwav2atm] standard_name = flag_for_one_way_ocean_wave_coupling_to_atmosphere long_name = flag controlling ocean wave coupling to the atmosphere (default off) From ebc63bb70eaaf26273b60970a9bdbf3eb40ac7a5 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 12 May 2023 08:28:48 -0600 Subject: [PATCH 08/36] allow ufs to use check nan feature --- mediator/med_methods_mod.F90 | 28 ---------------------------- 1 file changed, 28 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index faecf47a6..1da8d6ac1 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -2530,11 +2530,6 @@ subroutine med_methods_FB_check_for_nans(FB, rc) ! ---------------------------------------------- rc = ESMF_SUCCESS -#ifndef CESMCOUPLED - ! For now only CESM uses shr_infnan_isnan - so until other models provide this - RETURN -#endif - call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2571,7 +2566,6 @@ subroutine med_methods_FB_check_for_nans(FB, rc) end subroutine med_methods_FB_check_for_nans !----------------------------------------------------------------------------- -#ifdef CESMCOUPLED subroutine med_methods_check_for_nans_1d(dataptr, nancount) use shr_infnan_mod, only: shr_infnan_isnan @@ -2607,26 +2601,4 @@ subroutine med_methods_check_for_nans_2d(dataptr, nancount) end do end subroutine med_methods_check_for_nans_2d -#else - - ! For now only CESM uses shr_infnan_isnan - so until other models provide this - ! nancount will just be set to zero - - subroutine med_methods_check_for_nans_1d(dataptr, nancount) - ! input/output variables - real(r8) , intent(in) :: dataptr(:) - integer , intent(out) :: nancount - - nancount = 0 - end subroutine med_methods_check_for_nans_1d - - subroutine med_methods_check_for_nans_2d(dataptr, nancount) - ! input/output variables - real(r8) , intent(in) :: dataptr(:,:) - integer , intent(out) :: nancount - - nancount = 0 - end subroutine med_methods_check_for_nans_2d -#endif - end module med_methods_mod From a25075d606421d5a33927771c5f5840d4581aea3 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 12 May 2023 08:37:19 -0600 Subject: [PATCH 09/36] fix comments --- mediator/med_phases_prep_glc_mod.F90 | 2 +- mediator/med_phases_prep_ice_mod.F90 | 2 +- mediator/med_phases_prep_ocn_mod.F90 | 2 +- mediator/med_phases_prep_rof_mod.F90 | 2 +- mediator/med_phases_prep_wav_mod.F90 | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 97049d5b9..e82dc9a4b 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -707,7 +707,7 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) endif end if - ! Check for nans in fields export to atm + ! Check for nans in fields export to glc do ns = 1,is_local%wrap%num_icesheets call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 1e0496b3d..e0c0ff3a7 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -150,7 +150,7 @@ subroutine med_phases_prep_ice(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - ! Check for nans in fields export to atm + ! Check for nans in fields export to ice call FB_check_for_nans(is_local%wrap%FBExp(compice), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index de989ac49..604d0ccea 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -296,7 +296,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compocn), is_local%wrap%FBExpAccumOcn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Check for nans in fields export to atm + ! Check for nans in fields export to ocn call FB_check_for_nans(is_local%wrap%FBExp(compocn), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index cf0ad0f4e..36c3ddbae 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -377,7 +377,7 @@ subroutine med_phases_prep_rof(gcomp, rc) FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=fldList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Check for nans in fields export to atm + ! Check for nans in fields export to rof call FB_check_for_nans(is_local%wrap%FBExp(comprof), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 3028303bc..9aad25417 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -177,7 +177,7 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compwav), is_local%wrap%FBExpAccumWav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! Check for nans in fields export to atm + ! Check for nans in fields export to wav call FB_check_for_nans(is_local%wrap%FBExp(compwav), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 6a642a6f92450d80c36ab92aeadb8733d60875ae Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 24 May 2023 07:35:58 -0400 Subject: [PATCH 10/36] get ufs to work w/ ocnalb * remove swnet to ocean from custom_nems * set optional use of nextswday * get med history working w/o aofluxes --- mediator/esmFldsExchange_nems_mod.F90 | 10 +++ mediator/med.F90 | 10 +-- mediator/med_map_mod.F90 | 3 +- mediator/med_phases_history_mod.F90 | 2 +- mediator/med_phases_ocnalb_mod.F90 | 107 +++++++++++++++++--------- mediator/med_phases_prep_ocn_mod.F90 | 65 ++++++++-------- 6 files changed, 122 insertions(+), 75 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index e62863a5d..d55f3d1b8 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -38,6 +38,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use esmFlds , only : addmap_from => med_fldList_addmap_from use esmFlds , only : addfld_aoflux => med_fldList_addfld_aoflux use esmFlds , only : addmap_aoflux => med_fldList_addmap_aoflux + use esmFlds , only : addfld_ocnalb => med_fldList_addfld_ocnalb + use esmFlds , only : addmap_ocnalb => med_fldList_addmap_ocnalb ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -172,6 +174,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call addfld_from(compice, 'mean_sw_pen_to_ocn') end if + ! Advertise the ocean albedos. These are not sent to the ATM in UFS. + if (phase == 'advertise') then + call addfld_ocnalb('So_avsdr') + call addfld_ocnalb('So_avsdf') + call addfld_ocnalb('So_anidr') + call addfld_ocnalb('So_anidf') + end if + !===================================================================== ! FIELDS TO ATMOSPHERE (compatm) !===================================================================== diff --git a/mediator/med.F90 b/mediator/med.F90 index e7c6da9d3..564c8b1dd 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1920,14 +1920,12 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------- - ! Initialize ocean albedos (this is needed for cesm and hafs) + ! Initialize ocean albedos !---------------------------------------------------------- - if (trim(coupling_mode(1:5)) /= 'nems_') then - if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compatm)) then - call med_phases_ocnalb_run(gcomp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compatm)) then + call med_phases_ocnalb_run(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if !--------------------------------------- diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 18752dc2f..6a0661643 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -259,7 +259,8 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) then write(logunit,'(a)') trim(subname)//' created field_NormOne for '& - //compname(n1)//'->'//compname(n2)//' with mapping '//trim(mapnames(mapindex)) + //trim(compname(n1))//'->'//trim(compname(n2))//' with mapping '& + //trim(mapnames(mapindex)) end if end if end do ! end of loop over map_indiex mappers diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 5f150a4b7..7d59a7fea 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -25,7 +25,7 @@ module med_phases_history_mod use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf use pio , only : file_desc_t - + implicit none private diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index a5ef002c7..2d2da421c 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -8,11 +8,9 @@ module med_phases_ocnalb_mod use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar use med_internalstate_mod , only : mapconsf, mapnames, compatm, compocn use perf_mod , only : t_startf, t_stopf -#ifdef CESMCOUPLED use shr_orb_mod , only : shr_orb_cosz, shr_orb_decl use shr_orb_mod , only : shr_orb_params, SHR_ORB_UNDEF_INT, SHR_ORB_UNDEF_REAL use shr_log_mod , only : shr_log_unit -#endif implicit none private @@ -26,11 +24,10 @@ module med_phases_ocnalb_mod !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- -#ifdef CESMCOUPLED + private med_phases_ocnalb_init private med_phases_ocnalb_orbital_update private med_phases_ocnalb_orbital_init -#endif !-------------------------------------------------------------------------- ! Private data @@ -47,17 +44,15 @@ module med_phases_ocnalb_mod logical :: created ! has memory been allocated here end type ocnalb_type - ! Conversion from degrees to radians character(*),parameter :: u_FILE_u = & __FILE__ -#ifdef CESMCOUPLED character(len=CL) :: orb_mode ! attribute - orbital mode integer :: orb_iyear ! attribute - orbital year integer :: orb_iyear_align ! attribute - associated with model year real(R8) :: orb_obliq ! attribute - obliquity in degrees real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude real(R8) :: orb_eccen ! attribute and update- orbital eccentricity -#endif + character(len=*) , parameter :: orb_fixed_year = 'fixed_year' character(len=*) , parameter :: orb_variable_year = 'variable_year' character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' @@ -65,7 +60,7 @@ module med_phases_ocnalb_mod !=============================================================================== contains !=============================================================================== -#ifdef CESMCOUPLED + subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) !----------------------------------------------------------------------- @@ -192,7 +187,7 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) call t_stopf('MED:'//subname) end subroutine med_phases_ocnalb_init -#endif + !=============================================================================== subroutine med_phases_ocnalb_run(gcomp, rc) @@ -201,8 +196,10 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! Compute ocean albedos (on the ocean grid) !----------------------------------------------------------------------- + use NUOPC_Mediator, only : NUOPC_MediatorGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_TimeInterval use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_Time, ESMF_TimeGet + use ESMF , only : ESMF_ClockIsCreated, ESMF_ClockGetNextTime use ESMF , only : ESMF_VM, ESMF_VMGet use ESMF , only : ESMF_LogWrite, ESMF_LogFoundError use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO @@ -211,11 +208,11 @@ subroutine med_phases_ocnalb_run(gcomp, rc) use ESMF , only : operator(+) use NUOPC , only : NUOPC_CompAttributeGet use med_constants_mod , only : shr_const_pi + use med_phases_history_mod, only : med_phases_history_write_med ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc -#ifdef CESMCOUPLED ! local variables type(ocnalb_type), save :: ocnalb type(ESMF_VM) :: vm @@ -224,7 +221,9 @@ subroutine med_phases_ocnalb_run(gcomp, rc) logical :: update_alb type(InternalState) :: is_local type(ESMF_Clock) :: clock + type(ESMF_Clock) :: dclock type(ESMF_Time) :: currTime + type(ESMF_Time) :: nextTime type(ESMF_TimeInterval) :: timeStep character(CL) :: cvalue character(CS) :: starttype ! config start type @@ -251,16 +250,11 @@ subroutine med_phases_ocnalb_run(gcomp, rc) real(R8), parameter :: const_deg2rad = shr_const_pi/180.0_R8 ! deg to rads character(CL) :: msg logical :: first_call = .true. + logical :: isPresent, isSet character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- -#endif - rc = ESMF_SUCCESS - -#ifndef CESMCOUPLED - RETURN ! the following code is not executed unless the model is CESM - -#else + rc = ESMF_SUCCESS ! Determine main task call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) @@ -273,10 +267,17 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! TODO: ? maybe somewhere else. Also need place to set ufs limit on albedo calc + !call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !if (isPresent .and. isSet) use_nextswcday = .true. + ! Determine if ocnalb data type will be initialized - and if not return if (first_call) then - if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & - ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then + !TODO: works? + if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .or. & + ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc) .or. & + ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then ocnalb%created = .true. else ocnalb%created = .false. @@ -331,6 +332,30 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) if (chkerr(rc,__LINE__,u_FILE_u)) return else + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + call State_GetScalar(& + state=is_local%wrap%NstateImp(compatm), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, & + scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & + scalar_value=nextsw_cday, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + first_call = .false. + + else + !TODO: ?set logical if nextsw is being done cesm way instead of attr get each time + ! Note that med_methods_State_GetScalar includes a broadcast to all other pets + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then call State_GetScalar(& state=is_local%wrap%NstateImp(compatm), & flds_scalar_name=is_local%wrap%flds_scalar_name, & @@ -338,21 +363,17 @@ subroutine med_phases_ocnalb_run(gcomp, rc) scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & scalar_value=nextsw_cday, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + else + ! TODO: Clock is advanced at end of run phase; use nextTime + call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !call ESMF_ClockGet( clock, currTime=currTime, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return + !call ESMF_TimeGet(currTime, dayOfYear_r8=nextsw_cday, rc=rc) + !if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - - first_call = .false. - - else - - ! Note that med_methods_State_GetScalar includes a broadcast to all other pets - call State_GetScalar(& - state=is_local%wrap%NstateImp(compatm), & - flds_scalar_name=is_local%wrap%flds_scalar_name, & - flds_scalar_num=is_local%wrap%flds_scalar_num, & - scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & - scalar_value=nextsw_cday, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, rc=rc) @@ -393,6 +414,8 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ocnalb%anidr(n) = (.026_r8/(cosz**1.7_r8 + 0.065_r8)) + & (.150_r8*(cosz - 0.100_r8 ) * & (cosz - 0.500_r8 ) * (cosz - 1.000_r8 ) ) + !TODO: make config---why does fv3atm use albdif here and not albdir ? + ocnalb%anidr(n) = max (ocnalb%anidr(n), albdif) ocnalb%avsdr(n) = ocnalb%anidr(n) ocnalb%anidf(n) = albdif ocnalb%avsdf(n) = albdif @@ -430,18 +453,29 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ofrad(:) = ofrac(:) endif + ! Write mediator ocnalb history if aofluxes are not active + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then + if ( .not. ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & + .not. ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + call med_phases_history_write_med(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + end if + if (dbug_flag > 1) then call FB_diagnose(is_local%wrap%FBMed_ocnalb_o, string=trim(subname)//' FBMed_ocnalb_o', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if call t_stopf('MED:'//subname) -#endif - end subroutine med_phases_ocnalb_run !=============================================================================== -#ifdef CESMCOUPLED + subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, maintask, rc) !---------------------------------------------------------- @@ -601,7 +635,6 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, maintask, eccen, ob endif end subroutine med_phases_ocnalb_orbital_update -#endif !=============================================================================== diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 604d0ccea..fcfae20fe 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -217,10 +217,12 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) end if ! custom merges to ocean - if (trim(coupling_mode) == 'cesm') then - call med_phases_prep_ocn_custom_cesm(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode(1:5)) == 'nems_') then + ! TODO: fix this + !if (trim(coupling_mode) == 'cesm') then + call med_phases_prep_ocn_custom_cesm(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + !else if (trim(coupling_mode(1:5)) == 'nems_') then + if (trim(coupling_mode(1:5)) == 'nems_') then call med_phases_prep_ocn_custom_nems(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -388,9 +390,10 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Check that the necessary export field is present - if ( .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then - return - end if + ! TODO: fix this + !if ( .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then + ! return + !end if call t_startf('MED:'//subname) @@ -479,8 +482,6 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrad' , ofracr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return if (FB_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', rc=rc)) then import_swpen_by_bands = .true. call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdr', Fioi_swpen_vdr, rc=rc) @@ -493,6 +494,8 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else import_swpen_by_bands = .false. + call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr',rc=rc)) then @@ -525,8 +528,10 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) ifracr_scaled = ifracr(n) / (frac_sum) ofracr_scaled = ofracr(n) / (frac_sum) endif - Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) - + !TODO: fix this + if (.not.import_swpen_by_bands) then + Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) + end if if (export_swnet_afracr) then Foxx_swnet_afracr(n) = ofracr_scaled*(fswabsv + fswabsi) end if @@ -688,25 +693,25 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_tauy', wgtB=customwgt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - - ! netsw_for_ocn = [downsw_from_atm*(1-ice_fraction)*(1-ocn_albedo)] + [pensw_from_ice*(ice_fraction)] - customwgt(:) = ofrac(:) * (1.0_R8 - 0.06_R8) - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdr' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdr', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdf' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdf', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndr' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idr', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndf' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idf', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! TODO: fix this + ! ! netsw_for_ocn = [downsw_from_atm*(1-ice_fraction)*(1-ocn_albedo)] + [pensw_from_ice*(ice_fraction)] + ! customwgt(:) = ofrac(:) * (1.0_R8 - 0.06_R8) + ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', & + ! FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdr' , wgtA=customwgt, & + ! FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdr', wgtB=ifrac, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', & + ! FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdf' , wgtA=customwgt, & + ! FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdf', wgtB=ifrac, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', & + ! FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndr' , wgtA=customwgt, & + ! FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idr', wgtB=ifrac, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', & + ! FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndf' , wgtA=customwgt, & + ! FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idf', wgtB=ifrac, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(customwgt) From d75d75ea4d0b52296d9b6ee527e3bf687158c761 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Fri, 26 May 2023 13:39:48 -0400 Subject: [PATCH 11/36] remove file accidentally committed --- mediator/runseq.cesm | 53 -------------------------------------------- 1 file changed, 53 deletions(-) delete mode 100644 mediator/runseq.cesm diff --git a/mediator/runseq.cesm b/mediator/runseq.cesm deleted file mode 100644 index 3d1e09b6b..000000000 --- a/mediator/runseq.cesm +++ /dev/null @@ -1,53 +0,0 @@ -runSeq:: -@86400 -@10800 -@3600 -@1800 - MED med_phases_aofluxes_run - MED med_phases_prep_ocn_accum - MED med_phases_ocnalb_run - MED med_phases_diag_ocn -@@3600 - MED med_phases_prep_ocn_avg - MED -> OCN :remapMethod=redist -@@ - MED med_phases_prep_lnd - MED -> LND :remapMethod=redist - MED med_phases_prep_ice - MED -> ICE :remapMethod=redist - ICE - LND - LND -> MED :remapMethod=redist - MED med_phases_post_lnd - MED med_phases_diag_lnd - MED med_phases_diag_rof - MED med_phases_diag_ice_ice2med - MED med_phases_diag_glc - ICE -> MED :remapMethod=redist - MED med_phases_post_ice - MED med_phases_prep_atm - MED -> ATM :remapMethod=redist - ATM - ATM -> MED :remapMethod=redist - MED med_phases_post_atm - MED med_phases_diag_atm - MED med_phases_diag_ice_med2ice - MED med_phases_diag_accum - MED med_phases_diag_print -@ - OCN - OCN -> MED :remapMethod=redist - MED med_phases_post_ocn -@ - MED med_phases_prep_rof - MED -> ROF :remapMethod=redist - ROF - ROF -> MED :remapMethod=redist - MED med_phases_post_rof - MED med_phases_history_write - MED med_phases_restart_write - MED med_phases_profile -@ - GLC -> MED :remapMethod=redist -@ -:: From a4d615e8b563656da11d3afd196a37be05a8710c Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Tue, 30 May 2023 22:01:06 +0000 Subject: [PATCH 12/36] add config variables for ufs use case --- mediator/med_phases_ocnalb_mod.F90 | 92 ++++++++++++++++++------------ 1 file changed, 56 insertions(+), 36 deletions(-) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 2d2da421c..47bbef6d5 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -57,6 +57,10 @@ module med_phases_ocnalb_mod character(len=*) , parameter :: orb_variable_year = 'variable_year' character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' + ! used, reused in module + logical :: use_min_albedo ! apply minimum value of albedo for direct vis, nir + logical :: use_nextswcday ! use the scalar field for next time (otherwise, will be set using clock) + !=============================================================================== contains !=============================================================================== @@ -69,11 +73,12 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) ! All input field bundles are ASSUMED to be on the ocean grid !----------------------------------------------------------------------- - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_Mesh, ESMF_MeshGet - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use ESMF , only : ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet - use ESMF , only : operator(==) + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_Mesh, ESMF_MeshGet + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet + use NUOPC , only : NUOPC_CompAttributeGet + use ESMF , only : operator(==) ! Arguments type(ESMF_GridComp) :: gcomp @@ -92,6 +97,8 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) type(InternalState) :: is_local real(R8), pointer :: ownedElemCoords(:) character(len=CL) :: tempc1,tempc2 + character(len=CS) :: cvalue + logical :: isPresent, isSet integer :: fieldCount type(ESMF_Field), pointer :: fieldlist(:) character(*), parameter :: subname = '(med_phases_ocnalb_init) ' @@ -181,6 +188,21 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) call med_phases_ocnalb_orbital_init(gcomp, logunit, iam==0, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Determine if direct albedos should have a minimum value + use_min_albedo = .false. + call NUOPC_CompAttributeGet(gcomp, name="limit_ocean_albedo", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + use_min_albedo=(trim(cvalue)=="true") + endif + ! Allow setting of albedo timestep using the clock instead of the atm's next timestep + use_nextswcday = .true. + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. isPresent ) then + use_nextswcday = .false. + endif + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif @@ -251,11 +273,17 @@ subroutine med_phases_ocnalb_run(gcomp, rc) character(CL) :: msg logical :: first_call = .true. logical :: isPresent, isSet + character(len=CL) :: logmsg character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- rc = ESMF_SUCCESS + write(logmsg,'(A,l)') trim(subname)//': use_min_albedo setting is ',use_min_albedo + call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + write(logmsg,'(A,l)') trim(subname)//': use_nextswcday setting is ',use_nextswcday + call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) + ! Determine main task call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -267,16 +295,10 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! TODO: ? maybe somewhere else. Also need place to set ufs limit on albedo calc - !call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !if (isPresent .and. isSet) use_nextswcday = .true. - ! Determine if ocnalb data type will be initialized - and if not return if (first_call) then - !TODO: works? - if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .or. & - ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc) .or. & + if ((ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & + ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) .or. & ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then ocnalb%created = .true. else @@ -332,9 +354,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) if (chkerr(rc,__LINE__,u_FILE_u)) return else - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then + if (use_nextswcday) then call State_GetScalar(& state=is_local%wrap%NstateImp(compatm), & flds_scalar_name=is_local%wrap%flds_scalar_name, & @@ -351,11 +371,8 @@ subroutine med_phases_ocnalb_run(gcomp, rc) first_call = .false. else - !TODO: ?set logical if nextsw is being done cesm way instead of attr get each time ! Note that med_methods_State_GetScalar includes a broadcast to all other pets - call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (isPresent .and. isSet) then + if (use_nextswcday) then call State_GetScalar(& state=is_local%wrap%NstateImp(compatm), & flds_scalar_name=is_local%wrap%flds_scalar_name, & @@ -365,17 +382,19 @@ subroutine med_phases_ocnalb_run(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else ! TODO: Clock is advanced at end of run phase; use nextTime - call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call ESMF_ClockGet( clock, currTime=currTime, rc=rc) + !call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call ESMF_TimeGet(currTime, dayOfYear_r8=nextsw_cday, rc=rc) + !call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday, rc=rc) !if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! TODO: albedos are used only for ocean sw net calculation at this Advance, use currTime + call ESMF_ClockGet( clock, currTime=currTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(currTime, dayOfYear_r8=nextsw_cday, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end if + !TODO: is there a reason to get this each time instead of at init? call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flux_albav @@ -414,8 +433,10 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ocnalb%anidr(n) = (.026_r8/(cosz**1.7_r8 + 0.065_r8)) + & (.150_r8*(cosz - 0.100_r8 ) * & (cosz - 0.500_r8 ) * (cosz - 1.000_r8 ) ) - !TODO: make config---why does fv3atm use albdif here and not albdir ? - ocnalb%anidr(n) = max (ocnalb%anidr(n), albdif) + if (use_min_albedo) then + !TODO: why does fv3atm use albdif here and not albdir ? + ocnalb%anidr(n) = max (ocnalb%anidr(n), albdif) + end if ocnalb%avsdr(n) = ocnalb%anidr(n) ocnalb%anidf(n) = albdif ocnalb%avsdf(n) = albdif @@ -454,15 +475,14 @@ subroutine med_phases_ocnalb_run(gcomp, rc) endif ! Write mediator ocnalb history if aofluxes are not active - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then - if ( .not. ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & - .not. ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then - call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc) .and. & + .not. ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & + .not. ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + call med_phases_history_write_med(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (ESMF_ClockIsCreated(dclock)) then - call med_phases_history_write_med(gcomp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if end if end if From b6fd22cf2abc9240708f9a7be26fc88b35c65925 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 12 Jun 2023 15:47:02 -0400 Subject: [PATCH 13/36] add configuration options for albedo calcs * flux_albav moved to _init * use_nextswcday for using clock instead of scalar field * min_albedo for setting min albedo used max(min_albedo,....) * giving a min_albedo value sets logical use_min_albedo, otherwise false and min_albedo=0 * set mean albdif and albdir via config. If not present, defaults to current values --- mediator/med_phases_ocnalb_mod.F90 | 86 ++++++++++++++++++---------- mediator/med_phases_prep_ocn_mod.F90 | 34 ++--------- 2 files changed, 63 insertions(+), 57 deletions(-) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 47bbef6d5..cd242bb7e 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -6,7 +6,7 @@ module med_phases_ocnalb_mod use med_utils_mod , only : chkerr => med_utils_chkerr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar - use med_internalstate_mod , only : mapconsf, mapnames, compatm, compocn + use med_internalstate_mod , only : mapconsf, mapnames, compatm, compocn, maintask use perf_mod , only : t_startf, t_stopf use shr_orb_mod , only : shr_orb_cosz, shr_orb_decl use shr_orb_mod , only : shr_orb_params, SHR_ORB_UNDEF_INT, SHR_ORB_UNDEF_REAL @@ -58,9 +58,12 @@ module med_phases_ocnalb_mod character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' ! used, reused in module - logical :: use_min_albedo ! apply minimum value of albedo for direct vis, nir - logical :: use_nextswcday ! use the scalar field for next time (otherwise, will be set using clock) - + logical :: flux_albav ! use average dif and dir albedos + logical :: use_nextswcday ! use the scalar field for next time (otherwise, will be set using clock) + logical :: use_min_albedo ! apply minimum value of albedo for direct vis, nir + real(R8) :: min_albedo ! minimum value of albedo for direct vis, nir + real(R8) :: albdif ! 60 deg reference albedo, diffuse + real(R8) :: albdir ! 60 deg reference albedo, direct !=============================================================================== contains !=============================================================================== @@ -98,8 +101,10 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) real(R8), pointer :: ownedElemCoords(:) character(len=CL) :: tempc1,tempc2 character(len=CS) :: cvalue + logical :: use_min_ocnalb logical :: isPresent, isSet integer :: fieldCount + character(CL) :: msg type(ESMF_Field), pointer :: fieldlist(:) character(*), parameter :: subname = '(med_phases_ocnalb_init) ' !----------------------------------------------------------------------- @@ -188,12 +193,37 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) call med_phases_ocnalb_orbital_init(gcomp, logunit, iam==0, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Determine if direct albedos should have a minimum value - use_min_albedo = .false. - call NUOPC_CompAttributeGet(gcomp, name="limit_ocean_albedo", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + ! Determine if reference albedos are used + flux_albav = .false. + call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flux_albav + end if + ! Set reference albedo values + call NUOPC_CompAttributeGet(gcomp, name="albdif", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then - use_min_albedo=(trim(cvalue)=="true") + read(cvalue,*) albdif + else + albdif = 0.06_r8 + end if + call NUOPC_CompAttributeGet(gcomp, name="albdir", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) albdir + else + albdir = 0.07_r8 + end if + ! Determine if direct albedo should have a minimum value + call NUOPC_CompAttributeGet(gcomp, name="ocean_albedo_limit", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) min_albedo + use_min_albedo = .true. + else + min_albedo = 0.0_R8 + use_min_ocnalb = .false. endif ! Allow setting of albedo timestep using the clock instead of the atm's next timestep use_nextswcday = .true. @@ -203,6 +233,18 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) use_nextswcday = .false. endif + if (flux_albav) then + write(msg,'(2(A,f8.2))') trim(subname)//': mean albedos set: albdif = ',albdif,', albdir = ',albdir + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + else + if (use_min_albedo) then + write(msg,'(A,f8.2)') trim(subname)//': min_albedo setting = ',min_albedo + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + end if + end if + write(msg,'(A,l)') trim(subname)//': use_nextswcday setting is ',use_nextswcday + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif @@ -250,7 +292,6 @@ subroutine med_phases_ocnalb_run(gcomp, rc) character(CL) :: cvalue character(CS) :: starttype ! config start type character(CL) :: runtype ! initial, continue, hybrid, branch - logical :: flux_albav ! flux avg option real(R8) :: nextsw_cday ! calendar day of next atm shortwave real(R8), pointer :: ofrac(:) real(R8), pointer :: ofrad(:) @@ -267,23 +308,14 @@ subroutine med_phases_ocnalb_run(gcomp, rc) real(R8) :: obliqr ! Earth orbit real(R8) :: delta ! Solar declination angle in radians real(R8) :: eccf ! Earth orbit eccentricity factor - real(R8), parameter :: albdif = 0.06_r8 ! 60 deg reference albedo, diffuse - real(R8), parameter :: albdir = 0.07_r8 ! 60 deg reference albedo, direct real(R8), parameter :: const_deg2rad = shr_const_pi/180.0_R8 ! deg to rads character(CL) :: msg logical :: first_call = .true. - logical :: isPresent, isSet - character(len=CL) :: logmsg character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- rc = ESMF_SUCCESS - write(logmsg,'(A,l)') trim(subname)//': use_min_albedo setting is ',use_min_albedo - call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) - write(logmsg,'(A,l)') trim(subname)//': use_nextswcday setting is ',use_nextswcday - call ESMF_LogWrite(trim(logmsg), ESMF_LOGMSG_INFO) - ! Determine main task call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -354,6 +386,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) if (chkerr(rc,__LINE__,u_FILE_u)) return else + ! obtain nextsw_cday from atm if it is in the import state if (use_nextswcday) then call State_GetScalar(& state=is_local%wrap%NstateImp(compatm), & @@ -382,22 +415,17 @@ subroutine med_phases_ocnalb_run(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else ! TODO: Clock is advanced at end of run phase; use nextTime - !call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - !call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday, rc=rc) - !if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! TODO: albedos are used only for ocean sw net calculation at this Advance, use currTime - call ESMF_ClockGet( clock, currTime=currTime, rc=rc) + call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(currTime, dayOfYear_r8=nextsw_cday, rc=rc) + call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end if !TODO: is there a reason to get this each time instead of at init? - call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flux_albav + !call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, rc=rc) + !if (chkerr(rc,__LINE__,u_FILE_u)) return + !read(cvalue,*) flux_albav ! Get orbital values call med_phases_ocnalb_orbital_update(clock, logunit, iam==0, eccen, obliqr, lambm0, mvelpp, rc) @@ -435,7 +463,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) (cosz - 0.500_r8 ) * (cosz - 1.000_r8 ) ) if (use_min_albedo) then !TODO: why does fv3atm use albdif here and not albdir ? - ocnalb%anidr(n) = max (ocnalb%anidr(n), albdif) + ocnalb%anidr(n) = max (ocnalb%anidr(n), min_albedo) end if ocnalb%avsdr(n) = ocnalb%anidr(n) ocnalb%anidf(n) = albdif diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 2c63751ae..bc87fdeb8 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -31,7 +31,7 @@ module med_phases_prep_ocn_mod public :: med_phases_prep_ocn_accum ! called from run sequence public :: med_phases_prep_ocn_avg ! called from run sequence - private :: med_phases_prep_ocn_custom_cesm + private :: med_phases_prep_ocn_custom private :: med_phases_prep_ocn_custom_nems character(*), parameter :: u_FILE_u = & @@ -217,11 +217,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) end if ! custom merges to ocean - ! TODO: fix this - !if (trim(coupling_mode) == 'cesm') then - call med_phases_prep_ocn_custom_cesm(gcomp, rc) + call med_phases_prep_ocn_custom(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !else if (trim(coupling_mode(1:5)) == 'nems_') then if (trim(coupling_mode(1:5)) == 'nems_') then call med_phases_prep_ocn_custom_nems(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -317,7 +314,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) end subroutine med_phases_prep_ocn_avg !----------------------------------------------------------------------------- - subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) + subroutine med_phases_prep_ocn_custom(gcomp, rc) !--------------------------------------- ! custom calculations for cesm @@ -374,7 +371,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) integer :: lsize real(R8) :: c1,c2,c3,c4 character(len=64), allocatable :: fldnames(:) - character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_cesm)' + character(len=*), parameter :: subname='(med_phases_prep_ocn_custom)' !--------------------------------------- rc = ESMF_SUCCESS @@ -531,7 +528,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) ifracr_scaled = ifracr(n) / (frac_sum) ofracr_scaled = ofracr(n) / (frac_sum) endif - !TODO: fix this + !TODO: ? fix this if (.not.import_swpen_by_bands) then Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) end if @@ -624,7 +621,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) end if call t_stopf('MED:'//subname) - end subroutine med_phases_prep_ocn_custom_cesm + end subroutine med_phases_prep_ocn_custom !----------------------------------------------------------------------------- subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) @@ -696,25 +693,6 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_tauy', wgtB=customwgt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! TODO: fix this - ! ! netsw_for_ocn = [downsw_from_atm*(1-ice_fraction)*(1-ocn_albedo)] + [pensw_from_ice*(ice_fraction)] - ! customwgt(:) = ofrac(:) * (1.0_R8 - 0.06_R8) - ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', & - ! FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdr' , wgtA=customwgt, & - ! FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdr', wgtB=ifrac, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', & - ! FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdf' , wgtA=customwgt, & - ! FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdf', wgtB=ifrac, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', & - ! FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndr' , wgtA=customwgt, & - ! FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idr', wgtB=ifrac, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', & - ! FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndf' , wgtA=customwgt, & - ! FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idf', wgtB=ifrac, rc=rc) - ! if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(customwgt) From cec8db8d09fa0a0b016d197a68edc67cbd100d97 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 14 Jun 2023 15:36:32 -0400 Subject: [PATCH 14/36] Update CMEPS (#88) --- .github/pull_request_template.md | 37 +- .github/workflows/extbuild.yml | 39 +- cesm/driver/ensemble_driver.F90 | 303 ++++++++++--- cesm/driver/esm.F90 | 52 ++- cesm/driver/esm_time_mod.F90 | 261 ++++++------ cesm/nuopc_cap_share/driver_pio_mod.F90 | 397 +++++++++++++----- cesm/nuopc_cap_share/nuopc_shr_methods.F90 | 22 +- cesm/nuopc_cap_share/shr_expr_parser_mod.F90 | 166 ++++---- .../shr_lightning_coupling_mod.F90 | 112 +++++ cesm/nuopc_cap_share/shr_megan_mod.F90 | 37 +- cime_config/buildexe | 4 + cime_config/buildnml | 36 +- cime_config/config_component.xml | 105 ++--- cime_config/config_component_cesm.xml | 39 +- cime_config/namelist_definition_drv.xml | 219 +++++++--- cime_config/namelist_definition_drv_flds.xml | 15 +- cime_config/runseq/driver_config.py | 3 +- cime_config/runseq/runseq_general.py | 12 +- cime_config/testdefs/testlist_drv.xml | 34 +- .../drv/asyncio1node/shell_commands | 17 + .../drv/asyncio1pernode/shell_commands | 22 + mediator/esmFldsExchange_cesm_mod.F90 | 44 +- mediator/fd_cesm.yaml | 21 +- mediator/med.F90 | 77 ++-- mediator/med_diag_mod.F90 | 8 +- mediator/med_io_mod.F90 | 367 ++++++---------- mediator/med_methods_mod.F90 | 107 ++++- mediator/med_phases_aofluxes_mod.F90 | 46 +- mediator/med_phases_history_mod.F90 | 122 +++--- mediator/med_phases_prep_atm_mod.F90 | 7 +- mediator/med_phases_prep_glc_mod.F90 | 7 + mediator/med_phases_prep_ice_mod.F90 | 5 + mediator/med_phases_prep_lnd_mod.F90 | 7 +- mediator/med_phases_prep_ocn_mod.F90 | 17 +- mediator/med_phases_prep_rof_mod.F90 | 5 + mediator/med_phases_prep_wav_mod.F90 | 5 + mediator/med_phases_restart_mod.F90 | 54 +-- 37 files changed, 1831 insertions(+), 1000 deletions(-) create mode 100644 cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 create mode 100644 cime_config/testdefs/testmods_dirs/drv/asyncio1node/shell_commands create mode 100644 cime_config/testdefs/testmods_dirs/drv/asyncio1pernode/shell_commands diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index 438a2f450..f3d2d933a 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -11,39 +11,6 @@ Are changes expected to change answers? (specify if bfb, different at roundoff, Any User Interface Changes (namelist or namelist defaults changes)? ### Testing performed +Please describe the tests along with the target model and machine(s) +If possible, please also added hashes that were used in the testing -Testing performed if application target is CESM: -- [ ] (recommended) CIME_DRIVER=nuopc scripts_regression_tests.py - - machines: - - details (e.g. failed tests): -- [ ] (recommended) CESM testlist_drv.xml - - machines and compilers: - - details (e.g. failed tests): -- [ ] (optional) CESM prealpha test - - machines and compilers - - details (e.g. failed tests): -- [ ] (other) please described in detail - - machines and compilers - - details (e.g. failed tests): - -Testing performed if application target is UFS-coupled: -- [ ] (recommended) UFS-coupled testing - - description: - - details (e.g. failed tests): - -Testing performed if application target is UFS-HAFS: -- [ ] (recommended) UFS-HAFS testing - - description: - - details (e.g. failed tests): - -### Hashes used for testing: - -- [ ] CESM: - - repository to check out: https://github.com/ESCOMP/CESM.git - - branch/hash: -- [ ] UFS-coupled, then umbrella repostiory to check out and associated hash: - - repository to check out: - - branch/hash: -- [ ] UFS-HAFS, then umbrella repostiory to check out and associated hash: - - repository to check out: - - branch/hash: diff --git a/.github/workflows/extbuild.yml b/.github/workflows/extbuild.yml index fafc46f46..6e26b40a5 100644 --- a/.github/workflows/extbuild.yml +++ b/.github/workflows/extbuild.yml @@ -18,11 +18,13 @@ jobs: FC: mpifort CXX: mpicxx CPPFLAGS: "-I/usr/include -I/usr/local/include" + # Versions of all dependencies can be updated here - ESMF_VERSION: v8.4.0 + ESMF_VERSION: v8.4.2 PNETCDF_VERSION: checkpoint.1.12.3 NETCDF_FORTRAN_VERSION: v4.6.0 - PIO_VERSION: pio2_5_10 + PIO_VERSION: pio2_6_0 + CDEPS_VERSION: cdeps1.0.15 steps: - uses: actions/checkout@v3 # Build the ESMF library, if the cache contains a previous build @@ -50,14 +52,14 @@ jobs: key: ${{ runner.os }}-${{ env.PIO_VERSION }}.pio - name: Build ParallelIO if: steps.cache-ParallelIO.outputs.cache-hit != 'true' - uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@9390e30e29d4ebbfbef0fc72162cacd9e8f25e4e + uses: NCAR/ParallelIO/.github/actions/parallelio_cmake@pio2_6_0 with: parallelio_version: ${{ env.ParallelIO_VERSION }} enable_fortran: True install_prefix: $HOME/pio - name: Build ESMF if: steps.cache-esmf.outputs.cache-hit != 'true' - uses: ESCOMP/CDEPS/.github/actions/buildesmf@e06246b560d3132170bb1a5443fa3d65dfbd2040 + uses: ESCOMP/CDEPS/.github/actions/buildesmf@cdeps1.0.15 with: esmf_version: ${{ env.ESMF_VERSION }} esmf_bopt: g @@ -67,12 +69,39 @@ jobs: netcdf_fortran_path: /usr pnetcdf_path: /usr parallelio_path: $HOME/pio + - name: Cache CDEPS + id: cache-cdeps + uses: actions/cache@v3 + with: + path: $HOME/cdeps + key: ${{ runner.os }}-${{ env.CDEPS_VERSION }}.cdeps + + - name: checkout CDEPS + uses: actions/checkout@v3 + with: + repository: ESCOMP/CDEPS + path: cdeps-src + ref: ${{ env.CDEPS_VERSION }} + - name: Build CDEPS + if: steps.cache-cdeps.outputs.cache-hit != 'true' + uses: ESCOMP/CDEPS/.github/actions/buildcdeps@cdeps1.0.15 + with: + esmfmkfile: $HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk + pio_path: $HOME/pio + src_root: ${GITHUB_WORKSPACE}/cdeps-src + cmake_flags: " -Wno-dev -DCMAKE_BUILD_TYPE=DEBUG -DWERROR=ON -DCMAKE_Fortran_FLAGS=\"-DCPRGNU -g -Wall \ + -ffree-form -ffree-line-length-none -fallow-argument-mismatch \"" + - name: Build CMEPS run: | export ESMFMKFILE=$HOME/ESMF/lib/libg/Linux.gfortran.64.openmpi.default/esmf.mk export PIO=$HOME/pio mkdir build-cmeps pushd build-cmeps - cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Wall -Werror -ffree-form -ffree-line-length-none -Wno-unused-dummy-argument" ../ + cmake -DCMAKE_BUILD_TYPE=DEBUG -DCMAKE_Fortran_FLAGS="-g -Wall -Werror -ffree-form -ffree-line-length-none -Wno-unused-dummy-argument -I /home/runner/work/CMEPS/CMEPS/build-cdeps/share" ../ make VERBOSE=1 popd + + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 diff --git a/cesm/driver/ensemble_driver.F90 b/cesm/driver/ensemble_driver.F90 index 58b9d58a1..2656f10fc 100644 --- a/cesm/driver/ensemble_driver.F90 +++ b/cesm/driver/ensemble_driver.F90 @@ -7,7 +7,7 @@ module Ensemble_driver ! esm driver and its components layed out concurently across mpi tasks. !----------------------------------------------------------------------------- - use shr_kind_mod , only : cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_kind_mod , only : cl=>shr_kind_cl, cs=>shr_kind_cs, cx=>shr_kind_cx use shr_log_mod , only : shr_log_setLogUnit use esm_utils_mod , only : maintask, logunit, chkerr @@ -16,7 +16,13 @@ module Ensemble_driver public :: SetServices private :: SetModelServices + private :: ensemble_finalize + integer, allocatable :: asyncio_petlist(:) + logical :: asyncio_task=.false. + logical :: asyncIO_available=.false. + integer :: number_of_members + integer :: inst ! ensemble instance containing this task character(*),parameter :: u_FILE_u = & __FILE__ @@ -26,9 +32,12 @@ module Ensemble_driver subroutine SetServices(ensemble_driver, rc) - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSpecialize, NUOPC_CompAttributeSet + use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Driver , only : driver_routine_SS => SetServices use NUOPC_Driver , only : ensemble_label_SetModelServices => label_SetModelServices + use NUOPC_Driver , only : ensemble_label_PostChildrenAdvertise => label_PostChildrenAdvertise + use NUOPC_Driver , only : label_Finalize use ESMF , only : ESMF_GridComp, ESMF_GridCompSet use ESMF , only : ESMF_Config, ESMF_ConfigCreate, ESMF_ConfigLoadFile use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO @@ -38,6 +47,7 @@ subroutine SetServices(ensemble_driver, rc) ! local variables type(ESMF_Config) :: config + logical :: isPresent character(len=*), parameter :: subname = "(ensemble_driver.F90:SetServices)" !--------------------------------------- @@ -53,6 +63,14 @@ subroutine SetServices(ensemble_driver, rc) specRoutine=SetModelServices, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! PostChildrenAdvertise is a NUOPC specialization which happens after Advertize but before Realize + ! We have overloaded this specialization location to initilize IO. + ! So after all components have called Advertise but before any component calls Realize + ! IO will be initialized and any async IO tasks will be split off to the PIO async IO driver. + call NUOPC_CompSpecialize(ensemble_driver, specLabel=ensemble_label_PostChildrenAdvertise, & + specRoutine=InitializeIO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Create, open and set the config config = ESMF_ConfigCreate(rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -63,6 +81,26 @@ subroutine SetServices(ensemble_driver, rc) call ESMF_GridCompSet(ensemble_driver, config=config, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! NUOPC component drivers end the initialization process with an internal call to InitializeDataResolution. + ! The ensemble_driver does not need to InitializeDataResolution and doing so will cause a hang + ! if asyncronous IO is used. This attribute is available after ESMF8.4.0b03 to toggle that control. + ! Cannot use asyncIO with older ESMF versions. + call NUOPC_CompAttributeGet(ensemble_driver, name="InitializeDataResolution", & + isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if(isPresent) then + call ESMF_LogWrite(trim(subname)//": setting InitializeDataResolution false", ESMF_LOGMSG_INFO) + call NUOPC_CompAttributeSet(ensemble_driver, name="InitializeDataResolution", value="false", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + asyncIO_available = .true. + call ESMF_LogWrite(trim(subname)//": asyncio is available", ESMF_LOGMSG_INFO) + endif + ! Set a finalize method, it calls pio_finalize + call NUOPC_CompSpecialize(ensemble_driver, specLabel=label_Finalize, & + specRoutine=ensemble_finalize, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine SetServices @@ -99,14 +137,18 @@ subroutine SetModelServices(ensemble_driver, rc) character(len=512) :: logfile logical :: read_restart character(len=CS) :: read_restart_string - integer :: inst - integer :: number_of_members integer :: ntasks_per_member + integer :: iopetcnt + integer :: petcnt + logical :: comp_task + integer :: pio_asyncio_ntasks + integer :: pio_asyncio_stride + integer :: pio_asyncio_rootpe integer :: Global_Comm - character(CL) :: start_type ! Type of startup + character(len=CL) :: start_type ! Type of startup character(len=7) :: drvrinst character(len=5) :: inst_suffix - character(len=CL) :: msgstr + character(len=CX) :: msgstr character(len=CL) :: cvalue character(len=CL) :: calendar character(len=*) , parameter :: start_type_start = "startup" @@ -196,13 +238,25 @@ subroutine SetModelServices(ensemble_driver, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) number_of_members + call NUOPC_CompAttributeGet(ensemble_driver, name="pio_asyncio_ntasks", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) pio_asyncio_ntasks + + call NUOPC_CompAttributeGet(ensemble_driver, name="pio_asyncio_stride", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) pio_asyncio_stride + + call NUOPC_CompAttributeGet(ensemble_driver, name="pio_asyncio_rootpe", value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) pio_asyncio_rootpe + call ESMF_VMGet(vm, localPet=localPet, PetCount=PetCount, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ntasks_per_member = PetCount/number_of_members - if(ntasks_per_member*number_of_members .ne. PetCount) then + ntasks_per_member = PetCount/number_of_members - pio_asyncio_ntasks + if(modulo(PetCount-pio_asyncio_ntasks*number_of_members, number_of_members) .ne. 0) then write (msgstr,'(a,i5,a,i3,a,i3,a)') & - "PetCount (",PetCount,") must be evenly divisable by number of members (",number_of_members,")" + "PetCount (",PetCount,") - Async IOtasks (",pio_asyncio_ntasks*number_of_members,") must be evenly divisable by number of members (",number_of_members,")" call ESMF_LogSetError(ESMF_RC_ARG_BAD, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -212,77 +266,123 @@ subroutine SetModelServices(ensemble_driver, rc) !------------------------------------------- allocate(petList(ntasks_per_member)) - ! We need to loop over instances - call t_startf('compute_drivers') - do inst = 1, number_of_members - + allocate(asyncio_petlist(pio_asyncio_ntasks)) + ! + ! Logic for asyncio variables is handled in cmeps buildnml. + ! here we assume that pio_asyncio_stride and pio_asyncio_ntasks are only set + ! if asyncio is enabled. + ! + logunit = 6 + do inst=1,number_of_members + petcnt=1 + iopetcnt = 1 + comp_task = .false. + asyncio_task = .false. ! Determine pet list for driver instance - petList(1) = (inst-1) * ntasks_per_member - do n=2,ntasks_per_member - petList(n) = petList(n-1) + 1 + if(pio_asyncio_ntasks > 0) then + do n=pio_asyncio_rootpe,pio_asyncio_rootpe+pio_asyncio_stride*(pio_asyncio_ntasks-1),pio_asyncio_stride + asyncio_petlist(iopetcnt) = (inst-1)*(ntasks_per_member+pio_asyncio_ntasks) + n + if(asyncio_petlist(iopetcnt) == localPet) asyncio_task = .true. + iopetcnt = iopetcnt+1 + enddo + iopetcnt = 1 + endif + do n=0,ntasks_per_member+pio_asyncio_ntasks-1 + if(pio_asyncio_ntasks > 0) then + if( asyncio_petlist(iopetcnt)==(inst-1)*(ntasks_per_member+pio_asyncio_ntasks) + n) then + ! Here if asyncio is true and this is an io task + iopetcnt = iopetcnt+1 + else if(petcnt <= ntasks_per_member) then + ! Here if this is a compute task + petList(petcnt) = n + (inst-1)*(ntasks_per_member + pio_asyncio_ntasks) + if (petList(petcnt) == localPet) then + comp_task=.true. + endif + petcnt = petcnt+1 + else + msgstr = "ERROR task cannot be neither a compute task nor an asyncio task" + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + else + ! Here if asyncio is false + petList(petcnt) = (inst-1)*ntasks_per_member + n + if (petList(petcnt) == localPet) comp_task=.true. + petcnt = petcnt+1 + endif enddo - + if(inst == localPet/(ntasks_per_member+pio_asyncio_ntasks) + 1) then + if(comp_task .and. asyncio_task) then + write(msgstr,*) "ERROR task cannot be both a compute task and an asyncio task", inst, petlist + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + elseif (.not. comp_task .and. .not. asyncio_task) then + write(msgstr,*) "ERROR task is nether a compute task nor an asyncio task", inst, petlist + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return ! bail out + endif + endif ! Add driver instance to ensemble driver write(drvrinst,'(a,i4.4)') "ESM",inst - call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - enddo - call t_stopf('compute_drivers') - - inst = localPet/ntasks_per_member + 1 - petList(1) = (inst-1) * ntasks_per_member - do n=2,ntasks_per_member - petList(n) = petList(n-1) + 1 - enddo - if (localpet >= petlist(1) .and. localpet <= petlist(ntasks_per_member)) then - write(drvrinst,'(a,i4.4)') "ESM",inst - call NUOPC_DriverGetComp(ensemble_driver, drvrinst, comp=driver, rc=rc) + + call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=driver, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - if(number_of_members > 1) then - call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) + write(msgstr, *) ": driver added on PETS ",petlist(1),' to ',petlist(petcnt-1), comp_task, asyncio_task + call ESMF_LogWrite(trim(subname)//msgstr) + ! Set the driver log to the driver task 0 + if (comp_task) then + if(number_of_members > 1) then + call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(inst_suffix,'(a,i4.4)') '_',inst + call NUOPC_CompAttributeSet(driver, name='inst_suffix', value=inst_suffix, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + inst_suffix = '' + endif + ! CESM does not use this ESMF feature and at large processor counts it can be expensive to have it on. + call NUOPC_CompAttributeSet(driver, name="HierarchyProtocol", value="off", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(inst_suffix,'(a,i4.4)') '_',inst - call NUOPC_CompAttributeSet(driver, name='inst_suffix', value=inst_suffix, rc=rc) + + ! Set the driver instance attributes + call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - else - inst_suffix = '' - endif - - ! Set the driver instance attributes - call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(read_restart_string), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ReadAttributes(driver, config, "DRIVER_attributes::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ReadAttributes(driver, config, "DRV_modelio::", rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Set the driver log to the driver task 0 - if (mod(localPet, ntasks_per_member) == 0) then - call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) + call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(read_restart_string), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) + + call ReadAttributes(driver, config, "DRIVER_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - open (newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - maintask = .true. - else - logUnit = 6 - maintask = .false. + + call ReadAttributes(driver, config, "DRV_modelio::", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(msgStr, *) trim(subname), ' instance = ',inst, 'attributes read' + call ESMF_LogWrite(msgStr) + if (localPet == petList(1)) then + call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Multiinstance logfile name needs a correction + if(len_trim(inst_suffix) > 0) then + n = index(logfile, '.') + logfile = logfile(1:n-1)//trim(inst_suffix)//logfile(n:) + endif + open (newunit=logunit,file=trim(diro)//"/"//trim(logfile)) + maintask = .true. + endif + endif call shr_log_setLogUnit (logunit) - ! Create a clock for each driver instance - call esm_time_clockInit(ensemble_driver, driver, logunit, maintask, rc) + + call esm_time_clockInit(ensemble_driver, driver, logunit, localpet==petList(1), rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - endif + enddo + inst = localPet/(ntasks_per_member+pio_asyncio_ntasks) + 1 deallocate(petList) call t_stopf(subname) @@ -291,4 +391,75 @@ subroutine SetModelServices(ensemble_driver, rc) end subroutine SetModelServices + subroutine InitializeIO(ensemble_driver, rc) + use ESMF, only: ESMF_GridComp, ESMF_LOGMSG_INFO, ESMF_LogWrite + use ESMF, only: ESMF_SUCCESS, ESMF_VM, ESMF_GridCompGet, ESMF_VMGet + use ESMF, only: ESMF_CONFIG, ESMF_GridCompIsPetLocal, ESMF_State, ESMF_Clock + use NUOPC, only: NUOPC_CompAttributeGet, NUOPC_CompGet + use NUOPC_DRIVER, only: NUOPC_DriverGetComp + use driver_pio_mod , only: driver_pio_init, driver_pio_component_init +#ifndef NO_MPI2 + use MPI, only : MPI_Comm_split, MPI_UNDEFINED +#endif + type(ESMF_GridComp) :: ensemble_driver + type(ESMF_VM) :: ensemble_vm + integer, intent(out) :: rc + character(len=*), parameter :: subname = '('//__FILE__//':InitializeIO)' + type(ESMF_GridComp), pointer :: dcomp(:) + integer :: iam + integer :: Global_Comm, Instance_Comm + integer :: drv + integer :: PetCount + integer :: key, color, i + type(ESMF_GridComp) :: driver + character(len=7) :: drvrinst + character(len=8) :: compname + + rc = ESMF_SUCCESS + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + call shr_log_setLogUnit (logunit) + + call ESMF_GridCompGet(ensemble_driver, vm=ensemble_vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(ensemble_vm, localpet=iam, mpiCommunicator=Global_Comm, PetCount=PetCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if(number_of_members > 1) then + color = inst + key = modulo(iam, PetCount/number_of_members) +#ifndef NO_MPI2 + call MPI_Comm_split(Global_Comm, color, key, Instance_Comm, rc) +#endif + do i=1,size(asyncio_petlist) + asyncio_petList(i) = modulo(asyncio_petList(i), PetCount/number_of_members) + enddo + else + Instance_Comm = Global_Comm + endif + write(drvrinst,'(a,i4.4)') "ESM",inst + call NUOPC_DriverGetComp(ensemble_driver, drvrinst, comp=driver, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": call driver_pio_init "//compname, ESMF_LOGMSG_INFO) + call driver_pio_init(driver, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": call driver_pio_component_init "//compname, ESMF_LOGMSG_INFO) + call driver_pio_component_init(driver, Instance_Comm, asyncio_petlist, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": driver_pio_component_init done "//compname, ESMF_LOGMSG_INFO) + + deallocate(asyncio_petlist) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end subroutine InitializeIO + + subroutine ensemble_finalize(ensemble_driver, rc) + use ESMF, only : ESMF_GridComp, ESMF_SUCCESS + use driver_pio_mod, only: driver_pio_finalize + type(ESMF_GridComp) :: Ensemble_driver + integer, intent(out) :: rc + rc = ESMF_SUCCESS + call shr_log_setLogUnit (logunit) + call driver_pio_finalize() + + end subroutine ensemble_finalize end module Ensemble_driver diff --git a/cesm/driver/esm.F90 b/cesm/driver/esm.F90 index da2f6f6d3..b5207955a 100644 --- a/cesm/driver/esm.F90 +++ b/cesm/driver/esm.F90 @@ -237,6 +237,7 @@ subroutine SetRunSequence(driver, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + call shr_log_setLogunit(logunit) !-------- ! Run Sequence and Connectors @@ -335,6 +336,7 @@ recursive subroutine ModifyCplLists(driver, importState, exportState, clock, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + call shr_log_setLogunit(logunit) call ESMF_LogWrite("Driver is in ModifyCplLists()", ESMF_LOGMSG_INFO, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -430,6 +432,7 @@ subroutine InitAttributes(driver, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + call shr_log_setLogunit(logunit) !---------------------------------------------------------- ! Initialize options for reproducible sums @@ -607,16 +610,17 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n character(len=*) , intent(in) :: inst_suffix integer , intent(in) :: nthrds integer , intent(inout) :: rc - ! local variables integer :: inst_index + logical :: computetask character(len=CL) :: cvalue character(len=CS) :: attribute character(len=*), parameter :: subname = "(esm.F90:AddAttributes)" !------------------------------------------- - + computetask = .false. rc = ESMF_Success call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + call shr_log_setLogunit(logunit) !------ ! Add compid to gcomp attributes @@ -631,6 +635,10 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n ! Add driver restart flag to gcomp attributes !------ attribute = 'read_restart' + call NUOPC_CompAttributeGet(driver, name=trim(attribute), isPresent=computetask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if(.not. computetask) return + call NUOPC_CompAttributeGet(driver, name=trim(attribute), value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeAdd(gcomp, (/trim(attribute)/), rc=rc) @@ -645,6 +653,9 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, n if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(gcomp, config, "ALLCOMP_attributes::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_LogWrite(trim(subname)//": call Readattributes for"//trim(compname), ESMF_LOGMSG_INFO) + call ReadAttributes(gcomp, config, trim(compname)//"_modelio::", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) then print *,__FILE__,__LINE__,"ERROR reading ",trim(compname)," modelio from runconfig" @@ -718,6 +729,7 @@ subroutine ReadAttributes(gcomp, config, label, relaxedflag, formatprint, rc) !------------------------------------------- rc = ESMF_SUCCESS + call shr_log_setLogunit(logunit) if (present(relaxedflag)) then attrFF = NUOPC_FreeFormatCreate(config, label=trim(label), relaxedflag=.true., rc=rc) @@ -784,8 +796,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) #ifndef NO_MPI2 use mpi , only : MPI_COMM_NULL, mpi_comm_size #endif - use mct_mod , only : mct_world_init - use driver_pio_mod , only : driver_pio_init, driver_pio_component_init + use m_MCTWorld , only : mct_world_init => init #ifdef MED_PRESENT use med_internalstate_mod , only : med_id @@ -870,6 +881,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) integer :: rank, nprocs, ierr character(len=*), parameter :: subname = "(esm_pelayout.F90:esm_init_pelayout)" !--------------------------------------- + call shr_log_setLogunit(logunit) rc = ESMF_SUCCESS call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -908,11 +920,6 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) inst_suffix = "" endif - ! Initialize PIO - ! This reads in the pio parameters that are independent of component - call driver_pio_init(driver, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(comms(componentCount+1), comps(componentCount+1)) comps(1) = 1 comms = MPI_COMM_NULL @@ -937,7 +944,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) read(cvalue,*) ntasks if (ntasks < 0 .or. ntasks > PetCount) then - write (msgstr, *) "Invalid NTASKS value specified for component: ",namestr, ' ntasks: ',ntasks + write (msgstr, *) "Invalid NTASKS value specified for component: ",namestr, ' ntasks: ',ntasks, petcount call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return endif @@ -1156,12 +1163,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - ! Read in component dependent PIO parameters and initialize - ! IO systems - call driver_pio_component_init(driver, size(comps), rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Initialize MCT (this is needed for data models and cice prescribed capability) call mct_world_init(componentCount+1, GLOBAL_COMM, comms, comps) @@ -1232,7 +1234,9 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS + call shr_log_setLogunit(logunit) scol_mesh_n = 0 + ! obtain the single column lon and lat call NUOPC_CompAttributeGet(gcomp, name='scol_lon', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1392,11 +1396,12 @@ subroutine esm_set_single_column_attributes(compname, gcomp, rc) allocate(lonMesh(lsize), latMesh(lsize)) call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) if (ChkErr(rc,__LINE__,u_FILE_u)) return + + scol_mesh_n = 0 do n = 1,lsize lonMesh(n) = ownedElemCoords(2*n-1) latMesh(n) = ownedElemCoords(2*n) if (abs(lonMesh(n) - scol_lon) < 1.e-4 .and. abs(latMesh(n) - scol_lat) < 1.e-4) then - scol_mesh_n = n scol_mesh_n = n exit end if @@ -1493,7 +1498,7 @@ end subroutine esm_set_single_column_attributes subroutine esm_finalize(driver, rc) use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM, ESMF_VMGet - use ESMF , only : ESMF_SUCCESS + use ESMF , only : ESMF_SUCCESS, ESMF_LOGMSG_INFO, ESMF_LOGWRITE use NUOPC , only : NUOPC_CompAttributeGet use perf_mod , only : t_prf, t_finalizef @@ -1507,14 +1512,12 @@ subroutine esm_finalize(driver, rc) logical :: isPresent type(ESMF_VM) :: vm integer :: mpicomm + character(len=*), parameter :: subname = '(esm_finalize) ' !--------------------------------------- + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS - - if (maintask) then - write(logunit,*)' SUCCESSFUL TERMINATION OF CESM' - end if - + call shr_log_setLogunit(logunit) call ESMF_GridCompGet(driver, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, mpiCommunicator=mpicomm, rc=rc) @@ -1533,6 +1536,11 @@ subroutine esm_finalize(driver, rc) endif call t_prf(trim(timing_dir)//'/model_timing'//trim(inst_suffix), mpicom=mpicomm) + if (maintask) then + write(logunit,*)' SUCCESSFUL TERMINATION OF CESM' + end if + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + call t_finalizef() end subroutine esm_finalize diff --git a/cesm/driver/esm_time_mod.F90 b/cesm/driver/esm_time_mod.F90 index 0c8a6e86c..fc57eaf11 100644 --- a/cesm/driver/esm_time_mod.F90 +++ b/cesm/driver/esm_time_mod.F90 @@ -11,7 +11,8 @@ module esm_time_mod use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_LOGMSG_ERROR use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast - use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE + use ESMF , only : ESMF_VMAllReduce, ESMF_REDUCE_MAX + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_GridCompIsPetLocal use ESMF , only : operator(<), operator(/=), operator(+) use ESMF , only : operator(-), operator(*) , operator(>=) use ESMF , only : operator(<=), operator(>), operator(==) @@ -62,7 +63,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas ! local variables type(ESMF_Clock) :: clock - type(ESMF_VM) :: vm + type(ESMF_VM) :: vm, envm type(ESMF_Time) :: StartTime ! Start time type(ESMF_Time) :: RefTime ! Reference time type(ESMF_Time) :: CurrTime ! Current time @@ -100,99 +101,151 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas character(CL) :: tmpstr ! temporary character(CS) :: inst_suffix integer :: tmp(4) ! Array for Broadcast + integer :: myid, bcastID(2) logical :: isPresent - character(len=*), parameter :: subname = '(esm_time_clockInit): ' + logical :: inDriver + logical, save :: firsttime=.true. + character(len=*), parameter :: subname = '('//__FILE__//':esm_time_clockInit) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - - call ESMF_GridCompGet(instance_driver, vm=vm, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) !--------------------------------------------------------------------------- ! Determine start time, reference time and current time !--------------------------------------------------------------------------- - call NUOPC_CompAttributeGet(instance_driver, name="start_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="start_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) start_ymd - call NUOPC_CompAttributeGet(instance_driver, name="start_tod", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="start_tod", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) start_tod - call NUOPC_CompAttributeGet(instance_driver, name='read_restart', value=cvalue, rc=rc) + !--------------------------------------------------------------------------- + ! Determine driver clock timestep + !--------------------------------------------------------------------------- + + call NUOPC_CompAttributeGet(ensemble_driver, name="atm_cpl_dt", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) read_restart + read(cvalue,*) atm_cpl_dt - if (read_restart) then + call NUOPC_CompAttributeGet(ensemble_driver, name="lnd_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) lnd_cpl_dt - call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_file, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(ensemble_driver, name="ice_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ice_cpl_dt - if (trim(restart_file) /= 'none') then + call NUOPC_CompAttributeGet(ensemble_driver, name="ocn_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ocn_cpl_dt - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - if(isPresent) then - call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", value=inst_suffix, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else - inst_suffix = "" - endif + call NUOPC_CompAttributeGet(ensemble_driver, name="glc_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) glc_cpl_dt - restart_pfile = trim(restart_file)//inst_suffix - - if (maintask) then - call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & - ESMF_LOGMSG_INFO) - open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) - if (ierr < 0) then - rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//' ERROR rpointer file open returns error', & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) - return - end if - read(unitn,'(a)', iostat=ierr) restart_file - if (ierr < 0) then - rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//' ERROR rpointer file read returns error', & - ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) - return - end if - close(unitn) - if (maintask) then - write(logunit,'(a)') trim(subname)//" reading driver restart from file = "//trim(restart_file) - end if - call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(ensemble_driver, name="rof_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) rof_cpl_dt - tmp(1) = start_ymd ; tmp(2) = start_tod - tmp(3) = curr_ymd ; tmp(4) = curr_tod - endif + call NUOPC_CompAttributeGet(ensemble_driver, name="wav_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) wav_cpl_dt - call ESMF_VMBroadcast(vm, tmp, 4, 0, rc=rc) + dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) + if(maintask) then + write(tmpstr,'(i10)') dtime_drv + call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) + endif + call ESMF_GridCompGet(ensemble_driver, vm=envm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(envm, localPet=myid, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + indriver = ESMF_GridCompIsPetLocal(instance_driver, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if(indriver) then + call ESMF_GridCompGet(instance_driver, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(instance_driver, name='read_restart', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) read_restart + + if (read_restart) then + + call NUOPC_CompAttributeGet(instance_driver, name='drv_restart_pointer', value=restart_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - start_ymd = tmp(1) ; start_tod = tmp(2) - curr_ymd = tmp(3) ; curr_tod = tmp(4) - else + if (trim(restart_file) /= 'none') then - if (maintask) then - write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' - write(logunit,*) ' In this case the restarts are handled solely by the component being used and' - write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' - end if - curr_ymd = start_ymd - curr_tod = start_tod + call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if(isPresent) then + call NUOPC_CompAttributeGet(instance_driver, name="inst_suffix", value=inst_suffix, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + inst_suffix = "" + endif - end if + restart_pfile = trim(restart_file)//inst_suffix + if (maintask) then + call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & + ESMF_LOGMSG_INFO) + open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) + if (ierr < 0) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file open returns error', & + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) + return + end if + read(unitn,'(a)', iostat=ierr) restart_file + if (ierr < 0) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file read returns error', & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) + return + end if + close(unitn) + if (maintask) then + write(logunit,'(a)') trim(subname)//" reading driver restart from file = "//trim(restart_file) + end if + call esm_time_read_restart(restart_file, start_ymd, start_tod, curr_ymd, curr_tod, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + else + if(maintask) then + write(logunit,*) ' NOTE: the current compset has no mediator - which provides the clock restart information' + write(logunit,*) ' In this case the restarts are handled solely by the component being used and' + write(logunit,*) ' and the driver clock will always be starting from the initial date on restart' + end if + curr_ymd = start_ymd + curr_tod = start_tod + endif + else + curr_ymd = start_ymd + curr_tod = start_tod + end if ! end if read_restart + endif + if(maintask) then + bcastID(1) = myid + tmp(1) = start_ymd ; tmp(2) = start_tod + tmp(3) = curr_ymd ; tmp(4) = curr_tod else + bcastID(1) = 0 + tmp = 0 + endif + call ESMF_VMAllReduce(envm, bcastID(1:1), bcastID(2:2), 1, ESMF_REDUCE_MAX,rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - curr_ymd = start_ymd - curr_tod = start_tod - - end if ! end if read_restart + call ESMF_VMBroadcast(envm, tmp, 4, bcastID(2), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + start_ymd = tmp(1) ; start_tod = tmp(2) + curr_ymd = tmp(3) ; curr_tod = tmp(4) ! Determine start time (THE FOLLOWING ASSUMES THAT THE DEFAULT CALENDAR IS SET in the driver) @@ -222,7 +275,6 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas call ESMF_LogWrite(trim(subname)//': driver curr_tod: '// trim(tmpstr), ESMF_LOGMSG_INFO) write(logunit,*) trim(subname)//': driver curr_tod: '// trim(tmpstr) endif - ! Set reference time - HARD-CODED TO START TIME ref_ymd = start_ymd ref_tod = start_tod @@ -230,48 +282,7 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - !--------------------------------------------------------------------------- - ! Determine driver clock timestep - !--------------------------------------------------------------------------- - - call NUOPC_CompAttributeGet(instance_driver, name="atm_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) atm_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="lnd_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) lnd_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="ice_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ice_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="ocn_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ocn_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="glc_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="rof_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) rof_cpl_dt - - call NUOPC_CompAttributeGet(instance_driver, name="wav_cpl_dt", value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) wav_cpl_dt - call NUOPC_CompAttributeGet(instance_driver, name="glc_avg_period", value=glc_avg_period, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_avg_period - - dtime_drv = minval((/atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt/)) - if(maintask) then - write(tmpstr,'(i10)') dtime_drv - call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) - endif call ESMF_TimeIntervalSet( TimeStep, s=dtime_drv, rc=rc ) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -293,20 +304,22 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas if (ChkErr(rc,__LINE__,u_FILE_u)) return end do - ! Set the ensemble driver gridded component clock to the created clock - call ESMF_GridCompSet(instance_driver, clock=clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Set the driver gridded component clock to the created clock + if (indriver) then + call ESMF_GridCompSet(instance_driver, clock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif ! Set driver clock stop time - call NUOPC_CompAttributeGet(instance_driver, name="stop_option", value=stop_option, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="stop_option", value=stop_option, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(instance_driver, name="stop_n", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="stop_n", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_n - call NUOPC_CompAttributeGet(instance_driver, name="stop_ymd", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="stop_ymd", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_ymd - call NUOPC_CompAttributeGet(instance_driver, name="stop_tod", value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(ensemble_driver, name="stop_tod", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stop_tod if ( stop_ymd < 0) then @@ -341,17 +354,17 @@ subroutine esm_time_clockInit(ensemble_driver, instance_driver, logunit, maintas !--------------------------------------------------------------------------- ! Create the ensemble driver clock - ! TODO: this is done repeatedly - but only needs to be done the first time this is called !--------------------------------------------------------------------------- + if(firsttime) then + TimeStep = StopTime - ClockTime + clock = ESMF_ClockCreate(TimeStep, ClockTime, StopTime=StopTime, & + refTime=RefTime, name='ESMF ensemble Driver Clock', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - TimeStep = StopTime - ClockTime - clock = ESMF_ClockCreate(TimeStep, ClockTime, StopTime=StopTime, & - refTime=RefTime, name='ESMF ensemble Driver Clock', rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_GridCompSet(ensemble_driver, clock=clock, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - + call ESMF_GridCompSet(ensemble_driver, clock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + firsttime = .false. + endif end subroutine esm_time_clockInit !=============================================================================== diff --git a/cesm/nuopc_cap_share/driver_pio_mod.F90 b/cesm/nuopc_cap_share/driver_pio_mod.F90 index 43d913c6d..710373ed9 100644 --- a/cesm/nuopc_cap_share/driver_pio_mod.F90 +++ b/cesm/nuopc_cap_share/driver_pio_mod.F90 @@ -1,9 +1,12 @@ module driver_pio_mod - use pio + use pio , only : pio_offset_kind, pio_rearr_opt_t, PIO_REARR_COMM_UNLIMITED_PEND_REQ + use pio , only : pio_iotype_netcdf, pio_iotype_pnetcdf, pio_iotype_netcdf4c, pio_iotype_netcdf4p + use pio , only : iosystem_desc_t, PIO_64BIT_DATA, PIO_64BIT_OFFSET, PIO_REARR_COMM_COLL + use pio , only : PIO_REARR_COMM_P2P, pio_init, pio_set_log_level + use pio , only : pio_set_blocksize, pio_set_buffer_size_limit, pio_finalize use shr_pio_mod, only : io_compname, pio_comp_settings, iosystems, io_compid, shr_pio_getindex use shr_kind_mod, only : CS=>shr_kind_CS, shr_kind_cl, shr_kind_in - use shr_log_mod, only : shr_log_unit - use shr_mpi_mod, only : shr_mpi_bcast, shr_mpi_chkerr + use shr_log_mod, only : shr_log_getLogUnit use shr_sys_mod, only : shr_sys_abort #ifndef NO_MPI2 use mpi, only : mpi_comm_null, mpi_comm_world, mpi_finalize @@ -17,14 +20,14 @@ module driver_pio_mod public :: driver_pio_init public :: driver_pio_component_init public :: driver_pio_finalize - public :: driver_pio_log_comp_settings + private :: driver_pio_log_comp_settings integer :: io_comm integer :: pio_debug_level=0, pio_blocksize=0 integer(kind=pio_offset_kind) :: pio_buffer_size_limit=-1 type(pio_rearr_opt_t) :: pio_rearr_opts - logical, allocatable :: pio_async_interface(:) + logical :: pio_async_interface integer :: total_comps logical :: maintask @@ -62,11 +65,13 @@ subroutine driver_pio_init(driver, rc) character(len=shr_kind_cl) :: nlfilename, cname integer :: ret integer :: localPet + integer :: logunit character(len=CS) :: pio_rearr_comm_type, pio_rearr_comm_fcd character(CS) :: msgstr character(*), parameter :: subName = '(driver_pio_init) ' - + + call shr_log_getLogUnit(logunit) call ESMF_GridCompGet(driver, vm=vm, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -80,7 +85,7 @@ subroutine driver_pio_init(driver, rc) ! 0 is a valid value of pio_buffer_size_limit if(pio_buffer_size_limit>=0) then - if(maintask) write(shr_log_unit,*) 'Setting pio_buffer_size_limit : ',pio_buffer_size_limit + if(maintask) write(logunit,*) 'Setting pio_buffer_size_limit : ',pio_buffer_size_limit call pio_set_buffer_size_limit(pio_buffer_size_limit) endif @@ -89,7 +94,7 @@ subroutine driver_pio_init(driver, rc) read(cname, *) pio_blocksize if(pio_blocksize>0) then - if(maintask) write(shr_log_unit,*) 'Setting pio_blocksize : ',pio_blocksize + if(maintask) write(logunit,*) 'Setting pio_blocksize : ',pio_blocksize call pio_set_blocksize(pio_blocksize) endif @@ -98,7 +103,7 @@ subroutine driver_pio_init(driver, rc) read(cname, *) pio_debug_level if(pio_debug_level > 0) then - if(maintask) write(shr_log_unit,*) 'Setting pio_debug_level : ',pio_debug_level + if(maintask) write(logunit,*) 'Setting pio_debug_level : ',pio_debug_level ret = pio_set_log_level(pio_debug_level) endif @@ -120,22 +125,22 @@ subroutine driver_pio_init(driver, rc) call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_hs_comp2io", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_rearr_opts%comm_fc_opts_comp2io%enable_hs = (trim(cname) .eq. '.true.') + pio_rearr_opts%comm_fc_opts_comp2io%enable_hs = logical((trim(cname) .eq. '.true.'), kind=1) call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_hs_io2comp", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_rearr_opts%comm_fc_opts_io2comp%enable_hs = (trim(cname) .eq. '.true.') + pio_rearr_opts%comm_fc_opts_io2comp%enable_hs = logical((trim(cname) .eq. '.true.'), kind=1) call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_isend_comp2io", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_rearr_opts%comm_fc_opts_comp2io%enable_isend = (trim(cname) .eq. '.true.') + pio_rearr_opts%comm_fc_opts_comp2io%enable_isend = logical((trim(cname) .eq. '.true.'), kind=1) call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_enable_isend_io2comp", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_rearr_opts%comm_fc_opts_io2comp%enable_isend = (trim(cname) .eq. '.true.') + pio_rearr_opts%comm_fc_opts_io2comp%enable_isend = logical((trim(cname) .eq. '.true.'), kind=1) call NUOPC_CompAttributeGet(driver, name="pio_rearr_comm_max_pend_req_comp2io", value=cname, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -147,98 +152,169 @@ subroutine driver_pio_init(driver, rc) if(maintask) then ! Log the rearranger options - write(shr_log_unit, *) "PIO rearranger options:" - write(shr_log_unit, *) " comm type = ", pio_rearr_opts%comm_type, " (",trim(pio_rearr_comm_type),")" - write(shr_log_unit, *) " comm fcd = ", pio_rearr_opts%fcd, " (",trim(pio_rearr_comm_fcd),")" + write(logunit, *) "PIO rearranger options:" + write(logunit, *) " comm type = ", pio_rearr_opts%comm_type, " (",trim(pio_rearr_comm_type),")" + write(logunit, *) " comm fcd = ", pio_rearr_opts%fcd, " (",trim(pio_rearr_comm_fcd),")" if(pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then - write(shr_log_unit, *) " max pend req (comp2io) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" + write(logunit, *) " max pend req (comp2io) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" else - write(shr_log_unit, *) " max pend req (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req + write(logunit, *) " max pend req (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req end if - write(shr_log_unit, *) " enable_hs (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%enable_hs - write(shr_log_unit, *) " enable_isend (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%enable_isend + write(logunit, *) " enable_hs (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%enable_hs + write(logunit, *) " enable_isend (comp2io) = ", pio_rearr_opts%comm_fc_opts_comp2io%enable_isend if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req == PIO_REARR_COMM_UNLIMITED_PEND_REQ) then - write(shr_log_unit, *) " max pend req (io2comp) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" + write(logunit, *) " max pend req (io2comp) = PIO_REARR_COMM_UNLIMITED_PEND_REQ (-1)" else - write(shr_log_unit, *) " max pend req (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req + write(logunit, *) " max pend req (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req end if - write(shr_log_unit, *) " enable_hs (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%enable_hs - write(shr_log_unit, *) " enable_isend (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%enable_isend + write(logunit, *) " enable_hs (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%enable_hs + write(logunit, *) " enable_isend (io2comp) = ", pio_rearr_opts%comm_fc_opts_io2comp%enable_isend end if end subroutine driver_pio_init - subroutine driver_pio_component_init(driver, ncomps, rc) + subroutine driver_pio_component_init(driver, inst_comm, asyncio_petlist, rc) use ESMF, only : ESMF_GridComp, ESMF_LogSetError, ESMF_RC_NOT_VALID, ESMF_GridCompIsCreated, ESMF_VM, ESMF_VMGet - use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated + use ESMF, only : ESMF_GridCompGet, ESMF_GridCompIsPetLocal, ESMF_VMIsCreated, ESMF_Finalize, ESMF_PtrInt1D + use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGWRITE use NUOPC, only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use NUOPC_Driver, only : NUOPC_DriverGetComp + use mpi, only : MPI_INTEGER, MPI_MAX, MPI_IN_PLACE, MPI_LOR, MPI_LOGICAL type(ESMF_GridComp) :: driver - type(ESMF_VM) :: vm - integer, intent(in) :: ncomps + integer, intent(in) :: asyncio_petlist(:) + integer, intent(in) :: Inst_comm ! The communicator associated with the driver integer, intent(out) :: rc + type(ESMF_VM) :: vm integer :: i, npets, default_stride - integer :: j + integer :: j, myid + integer :: k integer :: comp_comm, comp_rank + integer, allocatable :: procs_per_comp(:), async_procs_per_comp(:) + integer, allocatable :: io_proc_list(:), asyncio_tasks(:), comp_proc_list(:,:) + type(ESMF_GridComp), pointer :: gcomp(:) + character(CS) :: cval character(CS) :: msgstr integer :: do_async_init + integer :: totalpes + integer :: asyncio_ntasks + integer :: asyncio_stride + integer :: pecnt + integer :: ierr + integer :: iocomm + integer :: pp + integer :: async_rearr + integer :: maxprocspercomp, driver_myid + integer, allocatable :: driverpetlist(:) + integer, allocatable :: asyncio_comp_comm(:) + integer :: logunit + integer :: ioproc + integer :: n + logical :: asyncio_task + logical, allocatable :: petlocal(:) + type(ESMF_PtrInt1D), pointer :: petLists(:) type(iosystem_desc_t), allocatable :: async_iosystems(:) + character(len=*), parameter :: subname = '('//__FILE__//':shr_pio_component_init)' + + asyncio_ntasks = size(asyncio_petlist) - allocate(pio_comp_settings(ncomps)) - allocate(gcomp(ncomps)) + call shr_log_getLogUnit(logunit) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - allocate(io_compid(ncomps)) - allocate(io_compname(ncomps)) - allocate(iosystems(ncomps)) + call MPI_Comm_rank(Inst_comm, myid, rc) + call MPI_Comm_size(Inst_comm, totalpes, rc) - allocate(pio_async_interface(ncomps)) + asyncio_task=.false. + do i=1,asyncio_ntasks + ! asyncio_petlist is in + if(asyncio_petlist(i) == myid) then + asyncio_task = .true. + exit + endif + enddo + write(msgstr,*) 'asyncio_task = ', asyncio_task, myid, asyncio_petlist + call ESMF_LogWrite(trim(subname)//msgstr, ESMF_LOGMSG_INFO, rc=rc) nullify(gcomp) - do_async_init = 0 + nullify(petLists) + if (.not. asyncio_task) then + call ESMF_GridCompGet(gridcomp=driver, vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, localPet=driver_myid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_DriverGetComp(driver, compList=gcomp, petLists=petLists, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + if(associated(gcomp)) then + total_comps = size(gcomp) + else + total_comps = 0 + endif - call NUOPC_DriverGetComp(driver, compList=gcomp, rc=rc) + call ESMF_LogWrite(trim(subname)//": share total_comps and driverpecount", ESMF_LOGMSG_INFO) if (chkerr(rc,__LINE__,u_FILE_u)) return + if(totalpes > 1) then + call MPI_AllReduce(MPI_IN_PLACE, total_comps, 1, MPI_INTEGER, & + MPI_MAX, Inst_comm, rc) + endif + + allocate(pio_comp_settings(total_comps)) + allocate(procs_per_comp(total_comps)) + allocate(io_compid(total_comps)) + allocate(io_compname(total_comps)) + allocate(iosystems(total_comps)) + allocate(petlocal(total_comps)) + do_async_init = 0 + procs_per_comp = 0 - total_comps = size(gcomp) - do i=1,total_comps - io_compid(i) = i+1 + if(associated(gcomp)) then + petlocal(i) = ESMF_GridCompIsPetLocal(gcomp(i), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - if (ESMF_GridCompIsPetLocal(gcomp(i), rc=rc)) then - call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) + call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + pio_comp_settings(i)%pio_async_interface = (trim(cval) == '.true.') - io_compname(i) = trim(cval) - + call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cval, *) pio_comp_settings(i)%pio_rearranger + else + petlocal(i) = .false. + endif + pio_comp_settings(i)%pio_async_interface = .false. + io_compid(i) = i+1 + + if (petlocal(i)) then call NUOPC_CompAttributeAdd(gcomp(i), attrList=(/'MCTID'/), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - write(cval, *) io_compid(i) call NUOPC_CompAttributeSet(gcomp(i), name="MCTID", value=trim(cval), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, mpiCommunicator=comp_comm, rc=rc) + + call ESMF_GridCompGet(gcomp(i), vm=vm, name=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": initialize component: "//trim(cval), ESMF_LOGMSG_INFO) + io_compname(i) = trim(cval) - if(comp_comm .ne. MPI_COMM_NULL) then - call ESMF_VMGet(vm, petCount=npets, localPet=comp_rank, ssiLocalPetCount=default_stride, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_VMGet(vm, mpiCommunicator=comp_comm, localPet=comp_rank, petCount=npets, & + ssiLocalPetCount=default_stride, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + procs_per_comp(i) = npets + + if(.not. pio_comp_settings(i)%pio_async_interface) then call NUOPC_CompAttributeGet(gcomp(i), name="pio_stride", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cval, *) pio_comp_settings(i)%pio_stride if(pio_comp_settings(i)%pio_stride <= 0 .or. pio_comp_settings(i)%pio_stride > npets) then pio_comp_settings(i)%pio_stride = min(npets, default_stride) endif - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_rearranger", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cval, *) pio_comp_settings(i)%pio_rearranger - + call NUOPC_CompAttributeGet(gcomp(i), name="pio_numiotasks", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cval, *) pio_comp_settings(i)%pio_numiotasks @@ -247,84 +323,167 @@ subroutine driver_pio_component_init(driver, ncomps, rc) pio_comp_settings(i)%pio_numiotasks = max(1,npets/pio_comp_settings(i)%pio_stride) endif + call NUOPC_CompAttributeGet(gcomp(i), name="pio_root", value=cval, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cval, *) pio_comp_settings(i)%pio_root - + if(pio_comp_settings(i)%pio_root < 0 .or. pio_comp_settings(i)%pio_root > npets) then pio_comp_settings(i)%pio_root = 0 endif + endif + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_typename", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeGet(gcomp(i), name="pio_typename", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - select case (trim(cval)) - case ('pnetcdf') - pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_PNETCDF - case ('netcdf') - pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF - case ('netcdf4p') - pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF4P - case ('netcdf4c') - pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF4C - case DEFAULT - write (msgstr, *) "Invalid PIO_TYPENAME Setting for component ", trim(cval) - call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) - return - end select - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_async_interface", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - pio_async_interface(i) = (trim(cval) == '.true.') - - call NUOPC_CompAttributeGet(gcomp(i), name="pio_netcdf_format", value=cval, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call driver_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) - - if (pio_async_interface(i)) then - do_async_init = do_async_init + 1 - else - if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then - pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req = pio_comp_settings(i)%pio_numiotasks - endif - if(pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then - pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req = pio_comp_settings(i)%pio_numiotasks - endif - call pio_init(comp_rank ,comp_comm ,pio_comp_settings(i)%pio_numiotasks, 0, pio_comp_settings(i)%pio_stride, & - pio_comp_settings(i)%pio_rearranger, iosystems(i), pio_comp_settings(i)%pio_root, & - pio_rearr_opts) + select case (trim(cval)) + case ('pnetcdf') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_PNETCDF + case ('netcdf') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF + case ('netcdf4p') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF4P + case ('netcdf4c') + pio_comp_settings(i)%pio_iotype = PIO_IOTYPE_NETCDF4C + case DEFAULT + write (msgstr, *) "Invalid PIO_TYPENAME Setting for component ", trim(cval) + call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) + return + end select + + call NUOPC_CompAttributeGet(gcomp(i), name="pio_netcdf_format", value=cval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call driver_pio_getioformatfromname(cval, pio_comp_settings(i)%pio_netcdf_ioformat, PIO_64BIT_DATA) + + if (.not. pio_comp_settings(i)%pio_async_interface) then + if(pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + pio_rearr_opts%comm_fc_opts_io2comp%max_pend_req = pio_comp_settings(i)%pio_numiotasks + endif + if(pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req < PIO_REARR_COMM_UNLIMITED_PEND_REQ) then + pio_rearr_opts%comm_fc_opts_comp2io%max_pend_req = pio_comp_settings(i)%pio_numiotasks endif + + call pio_init(comp_rank ,comp_comm ,pio_comp_settings(i)%pio_numiotasks, 0, pio_comp_settings(i)%pio_stride, & + pio_comp_settings(i)%pio_rearranger, iosystems(i), pio_comp_settings(i)%pio_root, & + pio_rearr_opts) endif + ! Write the PIO settings to the beggining of each component log + if(comp_rank == 0) call driver_pio_log_comp_settings(gcomp(i), rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif enddo + + call ESMF_LogWrite(trim(subname)//": check for async", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do i=1,total_comps + call MPI_AllReduce(MPI_IN_PLACE, pio_comp_settings(i)%pio_async_interface, 1, MPI_LOGICAL, & + MPI_LOR, Inst_comm, rc) + if(pio_comp_settings(i)%pio_async_interface) then + do_async_init = do_async_init + 1 + endif + enddo + +! +! Get the PET list for each component using async IO +! + + call MPI_Allreduce(MPI_IN_PLACE, do_async_init, 1, MPI_INTEGER, MPI_MAX, Inst_comm, ierr) + call MPI_Allreduce(MPI_IN_PLACE, procs_per_comp, total_comps, MPI_INTEGER, MPI_MAX, Inst_comm, ierr) if (do_async_init > 0) then + maxprocspercomp = 0 + do i=1,total_comps + if(procs_per_comp(i) > maxprocspercomp) maxprocspercomp = procs_per_comp(i) + enddo + call MPI_AllReduce(MPI_IN_PLACE, maxprocspercomp, 1, MPI_INTEGER, & + MPI_MAX, Inst_comm, rc) + + allocate(asyncio_comp_comm(do_async_init)) + allocate(comp_proc_list(maxprocspercomp, do_async_init)) + j = 1 + k = 1 + comp_proc_list = -1 + if(.not. asyncio_task) then + do i=1,total_comps + if(pio_comp_settings(i)%pio_async_interface) then + comp_proc_list(1:procs_per_comp(i), j) = petLists(i)%ptr + ! IO tasks are not in the driver comp so we need to correct the comp_proc_list + do k=1,size(asyncio_petlist) + ioproc = asyncio_petlist(k) + do n=1,procs_per_comp(i) + if(petLists(i)%ptr(n) >= (ioproc-k+1)) comp_proc_list(n,j) = comp_proc_list(n,j) + 1 + enddo + enddo + j = j+1 + endif +! deallocate(petLists(i)%ptr) + enddo + endif + ! Copy comp_proc_list to io tasks + do i=1,do_async_init + call MPI_AllReduce(MPI_IN_PLACE, comp_proc_list(:,i), maxprocspercomp, MPI_INTEGER, MPI_MAX, Inst_comm, ierr) + enddo + if(asyncio_ntasks == 0) then + call shr_sys_abort(subname//' ERROR: ASYNC IO Requested but no IO PES assigned') + endif + allocate(async_iosystems(do_async_init)) + allocate(async_procs_per_comp(do_async_init)) j=1 + async_rearr = 0 do i=1,total_comps - if(pio_async_interface(i)) then - iosystems(i) = async_iosystems(j) + if(pio_comp_settings(i)%pio_async_interface) then + async_procs_per_comp(j) = procs_per_comp(i) j = j+1 + if(.not.asyncio_task) then + if(async_rearr == 0) then + async_rearr = pio_comp_settings(i)%pio_rearranger + elseif(async_rearr .ne. pio_comp_settings(i)%pio_rearranger .and. pio_comp_settings(i)%pio_rearranger > 0) then + write(msgstr,*) i,async_rearr,pio_comp_settings(i)%pio_rearranger + call shr_sys_abort(subname//' ERROR: all async component rearrangers must match '//msgstr) + endif + endif endif enddo + ! IO tasks should not return until the run is completed + !ierr = pio_set_log_level(1) + call ESMF_LogWrite(trim(subname)//": call async pio_init", ESMF_LOGMSG_INFO) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call MPI_AllReduce(MPI_IN_PLACE, async_rearr, 1, MPI_INTEGER, & + MPI_MAX, Inst_comm, rc) + call pio_init(async_iosystems, Inst_comm, async_procs_per_comp, & + comp_proc_list, asyncio_petlist, & + async_rearr, asyncio_comp_comm, io_comm) + if(.not. asyncio_task) then + j=1 + do i=1,total_comps + if(pio_comp_settings(i)%pio_async_interface) then + iosystems(i) = async_iosystems(j) + j = j+1 + endif + enddo + endif endif - - deallocate(gcomp) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + if(associated(petLists)) deallocate(petLists) + if(associated(gcomp)) deallocate(gcomp) end subroutine driver_pio_component_init - subroutine driver_pio_log_comp_settings(gcomp, logunit) - use ESMF, only : ESMF_GridComp, ESMF_GridCompGet + subroutine driver_pio_log_comp_settings(gcomp, rc) + use ESMF, only : ESMF_GridComp, ESMF_GridCompGet, ESMF_SUCCESS use NUOPC, only: NUOPC_CompAttributeGet - + use, intrinsic :: iso_fortran_env, only: output_unit + type(ESMF_GridComp) :: gcomp - integer, intent(in) :: logunit - + integer, intent(out) :: rc integer :: compid character(len=CS) :: name, cval integer :: i - integer :: rc + integer :: logunit logical :: isPresent + rc = ESMF_SUCCESS call ESMF_GridCompGet(gcomp, name=name, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -335,21 +494,29 @@ subroutine driver_pio_log_comp_settings(gcomp, logunit) read(cval, *) compid i = shr_pio_getindex(compid) endif - write(logunit,*) trim(name),': PIO numiotasks=', pio_comp_settings(i)%pio_numiotasks - - write(logunit, *) trim(name), ': PIO stride=',pio_comp_settings(i)%pio_stride - - write(logunit, *) trim(name),': PIO rearranger=',pio_comp_settings(i)%pio_rearranger - write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root - + logunit = 6 + call NUOPC_CompAttributeGet(gcomp, name="logunit", value=logunit, isPresent=ispresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if(.not. isPresent) then + logunit = output_unit + if(maintask) write(logunit,*) 'Attribute logunit not set for ',trim(name) + endif + if(pio_comp_settings(i)%pio_async_interface) then + write(logunit,*) trim(name),': using ASYNC IO interface' + else + write(logunit,*) trim(name),': PIO numiotasks=', pio_comp_settings(i)%pio_numiotasks + write(logunit, *) trim(name), ': PIO stride=',pio_comp_settings(i)%pio_stride + write(logunit, *) trim(name),': PIO rearranger=',pio_comp_settings(i)%pio_rearranger + write(logunit, *) trim(name),': PIO root=',pio_comp_settings(i)%pio_root + endif end subroutine driver_pio_log_comp_settings !=============================================================================== subroutine driver_pio_finalize( ) integer :: ierr integer :: i - do i=1,total_comps + do i=1,size(iosystems) call pio_finalize(iosystems(i), ierr) end do @@ -383,6 +550,10 @@ subroutine driver_pio_getiotypefromname(typename, iotype, defaulttype) integer, intent(out) :: iotype integer, intent(in) :: defaulttype + integer :: logunit + + call shr_log_getLogUnit(logunit) + typename = shr_string_toupper(typename) if ( typename .eq. 'NETCDF' ) then iotype = pio_iotype_netcdf @@ -397,7 +568,7 @@ subroutine driver_pio_getiotypefromname(typename, iotype, defaulttype) else if ( typename .eq. 'DEFAULT') then iotype = defaulttype else - write(shr_log_unit,*) 'driver_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' + write(logunit,*) 'driver_pio_mod: WARNING Bad io_type argument - using iotype_netcdf' iotype=pio_iotype_netcdf end if diff --git a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 index 3d50906d7..9062b27f1 100644 --- a/cesm/nuopc_cap_share/nuopc_shr_methods.F90 +++ b/cesm/nuopc_cap_share/nuopc_shr_methods.F90 @@ -130,9 +130,8 @@ subroutine get_component_instance(gcomp, inst_suffix, inst_index, rc) end subroutine get_component_instance !=============================================================================== - subroutine set_component_logging(gcomp, maintask, logunit, shrlogunit, rc) - use driver_pio_mod, only : driver_pio_log_comp_settings + use NUOPC, only: NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd ! input/output variables type(ESMF_GridComp) :: gcomp logical, intent(in) :: maintask @@ -144,8 +143,10 @@ subroutine set_component_logging(gcomp, maintask, logunit, shrlogunit, rc) character(len=CL) :: diro character(len=CL) :: logfile character(len=CL) :: inst_suffix - integer :: inst_index ! not used here + integer :: inst_index ! Not used here integer :: n + character(len=CL) :: name + character(len=*), parameter :: subname = "("//__FILE__//": set_component_logging)" !----------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -164,16 +165,23 @@ subroutine set_component_logging(gcomp, maintask, logunit, shrlogunit, rc) endif open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) - ! Write the PIO settings to the beggining of each component log - call driver_pio_log_comp_settings(gcomp, logunit) else logUnit = 6 endif - shrlogunit = logunit + + call ESMF_GridCompGet(gcomp, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": setting logunit for component: "//trim(name), ESMF_LOGMSG_INFO) + call NUOPC_CompAttributeAdd(gcomp, (/"logunit"/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, "logunit", logunit, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_log_setLogUnit (logunit) - + ! Still need to set this return value + shrlogunit = logunit + call ESMF_LogWrite(trim(subname)//": done for component "//trim(name), ESMF_LOGMSG_INFO) end subroutine set_component_logging !=============================================================================== diff --git a/cesm/nuopc_cap_share/shr_expr_parser_mod.F90 b/cesm/nuopc_cap_share/shr_expr_parser_mod.F90 index f37a4ac3c..4cf748a35 100644 --- a/cesm/nuopc_cap_share/shr_expr_parser_mod.F90 +++ b/cesm/nuopc_cap_share/shr_expr_parser_mod.F90 @@ -1,12 +1,12 @@ !============================================================================= ! expression parser utility -- ! for parsing simple linear mathematical expressions of the form -! X = a*Y + b*Z + ... +! X = a*R + b*S + c*(X + Y + Z) ... ! !============================================================================= module shr_expr_parser_mod use shr_kind_mod,only : r8 => shr_kind_r8 - use shr_kind_mod,only : cx => shr_kind_cx + use shr_kind_mod,only : CXX => shr_kind_cxx implicit none private @@ -35,82 +35,122 @@ function shr_exp_parse( exp_array, nitems ) result(exp_items_list) integer, optional, intent(out) :: nitems ! number of expressions parsed type(shr_exp_item_t), pointer :: exp_items_list ! linked list of items returned - integer :: i,j, jj, nmax, nterms, n_exp_items - character(len=cx) :: tmp_str + integer :: i,j, n_exp_items type(shr_exp_item_t), pointer :: exp_item, list_item + integer :: ndxs(512) + integer :: nelem, j1,j2,k + character(len=CXX) :: tmp_str, tmp_name + character(len=8) :: xchr ! multipler + real(r8) :: xdbl + real(r8) :: coeff0 + logical :: more_to_come + character(len=CXX), allocatable :: sums_grps(:) + character(len=CXX) :: sum_string + + allocate(sums_grps(size(exp_array))) nullify( exp_items_list ) nullify( exp_item ) nullify( list_item ) - n_exp_items = 0 - nmax = size( exp_array ) + sums_grps(:) = ' ' - do i = 1,nmax - if (len_trim(exp_array(i))>0) then + ! combine lines that have a trailing "+" with the next line + i=1 + j=1 + loop1: do while( len_trim(exp_array(i)) > 0 ) - j = scan( exp_array(i), '=' ) + k = scan(exp_array(i), '+', back=.true. ) + more_to_come = k == len_trim(exp_array(i)) ! line ends with "+" - if ( j>0 ) then + if ( more_to_come ) then + sums_grps(j) = trim(sums_grps(j)) // trim(adjustl(exp_array(i))) + else + sums_grps(j) = trim(sums_grps(j)) // trim(adjustl(exp_array(i))) + j = j+1 + endif + + i = i+1 + if ( i > size(exp_array) ) exit loop1 - n_exp_items = n_exp_items + 1 + end do loop1 - allocate( exp_item ) - exp_item%n_terms = 0 - exp_item%name = trim(adjustl(exp_array(i)(:j-1))) + n_exp_items = j-1 - tmp_str = trim(adjustl(exp_array(i)(j+1:))) + ! a group is a summation of terms - nterms = 1 - jj = scan( tmp_str, '+' ) - do while(jj>0) - nterms = nterms + 1 - tmp_str = tmp_str(jj+1:) - jj = scan( tmp_str, '+' ) - enddo + ! parse the individual sum strings... and form the groupings + has_grps: if (n_exp_items>0) then - allocate( exp_item%vars(nterms) ) - allocate( exp_item%coeffs(nterms) ) + ! from shr_megan_mod ... should be generalized and shared... + grploop: do i = 1,n_exp_items - tmp_str = trim(adjustl(exp_array(i)(j+1:))) + ! parse out the term names + ! from first parsing out the terms in the summation equation ("+" separates the terms) + sum_string = sums_grps(i) + j = scan( sum_string, '=' ) + nelem = 1 + ndxs(nelem) = j ! ndxs stores the index of each term of the equation + + ! find indices of all the terms in the equation + tmp_str = trim( sum_string(j+1:) ) + j = scan( tmp_str, '+' ) + do while(j>0) + nelem = nelem+1 + ndxs(nelem) = ndxs(nelem-1) + j + tmp_str = tmp_str(j+1:) j = scan( tmp_str, '+' ) + enddo + ndxs(nelem+1) = len(sum_string)+1 - if (j>0) then - call set_coefvar( tmp_str(:j-1), exp_item ) - tmp_str = tmp_str(j-1:) - else - call set_coefvar( tmp_str, exp_item ) - endif + allocate( exp_item ) - else + exp_item%n_terms = nelem ! number of terms - tmp_str = trim(adjustl(exp_array(i))) ! assumed to begin with '+' + exp_item%name = trim(adjustl( sum_string(:ndxs(1)-1))) ! thing to the left of the "=" is used as the name of the group - endif + ! now that we have the number of terms in the summation allocate memory for the terms + allocate( exp_item%vars(nelem) ) + allocate( exp_item%coeffs(nelem) ) - ! at this point tmp_str begins with '+' - j = scan( tmp_str, '+' ) + coeff0 = 1._r8 ! default multiplier - if (j>0) then + ! now parse out the multiplier from the terms + elmloop: do k = 1,nelem - ! remove the leading + ... - tmp_str = tmp_str(j+1:) - j = scan( tmp_str, '+' ) + exp_item%coeffs(k) = coeff0 - do while(j>0) + ! get the term name which follows the '*' operator if the is one + tmp_name = adjustl(sum_string(ndxs(k)+1:ndxs(k+1)-1)) - call set_coefvar( tmp_str(:j-1), exp_item ) + j = scan( tmp_name, '*' ) + if (j>0) then - tmp_str = tmp_str(j+1:) - j = scan( tmp_str, '+' ) + xchr = tmp_name(1:j-1) ! get the multipler (left of the '*') + read( xchr, * ) xdbl ! convert the string to a real + exp_item%coeffs(k) = xdbl ! store the multiplier - enddo + j1 = scan( tmp_name, '(' ) + if (j1>0) then + coeff0 = xdbl + tmp_name = trim(adjustl(tmp_name(j1+1:))) ! get the term name (right of the '*') + else + coeff0 = 1._r8 + tmp_name = trim(adjustl(tmp_name(j+1:))) ! get the term name (right of the '*') + endif - call set_coefvar( tmp_str, exp_item ) + endif - endif + j2 = scan( tmp_name, ')' ) + if (j2>0) then + coeff0 = 1._r8 + tmp_name = tmp_name(1:j2-1) + endif + exp_item%vars(k) = trim(tmp_name) + + enddo elmloop if (associated(exp_item)) then if (associated(exp_items_list)) then @@ -124,13 +164,16 @@ function shr_exp_parse( exp_array, nitems ) result(exp_items_list) endif endif - endif - enddo + + enddo grploop + endif has_grps if ( present(nitems) ) then nitems = n_exp_items endif + deallocate(sums_grps) + end function shr_exp_parse ! ----------------------------------------------------------------- @@ -157,29 +200,4 @@ subroutine shr_exp_list_destroy( list ) end subroutine shr_exp_list_destroy - !========================== - ! Private Methods - - ! ----------------------------------------------------------------- - ! ----------------------------------------------------------------- - subroutine set_coefvar( term, item ) - character(len=*), intent(in) :: term - type(shr_exp_item_t) , intent(inout) :: item - - integer :: k, n - - item%n_terms = item%n_terms + 1 - n = item%n_terms - - k = scan( term, '*' ) - if (k>0) then - item%vars(n) = trim(adjustl(term(k+1:))) - read( term(:k-1), *) item%coeffs(n) - else - item%vars(n) = trim(adjustl(term)) - item%coeffs(n) = 1.0_r8 - endif - - end subroutine set_coefvar - end module shr_expr_parser_mod diff --git a/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 new file mode 100644 index 000000000..3b4e260d8 --- /dev/null +++ b/cesm/nuopc_cap_share/shr_lightning_coupling_mod.F90 @@ -0,0 +1,112 @@ +module shr_lightning_coupling_mod + + !======================================================================== + ! Module for handling namelist variables related to lightning coupling + !======================================================================== + + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet + use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS + use ESMF , only : ESMF_VMBroadCast, ESMF_Logical, assignment(=) + use shr_sys_mod , only : shr_sys_abort + use shr_log_mod , only : shr_log_getLogUnit + use shr_nl_mod , only : shr_nl_find_group_name + use nuopc_shr_methods, only : chkerr + + implicit none + private + + ! !PUBLIC MEMBER FUNCTIONS + public shr_lightning_coupling_readnl ! Read namelist + + character(len=*), parameter :: & + u_FILE_u=__FILE__ + + !==================================================================================== +CONTAINS + !==================================================================================== + + subroutine shr_lightning_coupling_readnl(NLFilename, atm_provides_lightning_out) + + !======================================================================== + ! reads lightning_coupling_nl namelist and returns a variable specifying + ! if atmosphere model provides lightning flash frequency field to mediator + !======================================================================== + + ! input/output variables + character(len=*), intent(in) :: NLFilename ! Namelist filename + logical, intent(out) :: atm_provides_lightning_out ! if TRUE atm will provide lightning flash frequency + + !----- local ----- + logical :: atm_provides_lightning + type(ESMF_VM) :: vm + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + type(ESMF_Logical):: ltmp(1) + integer :: rc + integer :: localpet + integer :: mpicom + integer :: s_logunit + character(len=*), parameter :: atm_ozone_frequency_not_present = 'NOT_PRESENT' + character(len=*), parameter :: subname = '(shr_lightning_coupling_readnl) ' + ! ------------------------------------------------------------------ + + namelist /lightning_coupling_nl/ atm_provides_lightning + + rc = ESMF_SUCCESS + + atm_provides_lightning_out = .false. + ltmp(1) = .false. + + !--- Open and read namelist --- + if ( len_trim(NLFilename) == 0 ) then + call shr_sys_abort( subname//'ERROR: nlfilename not set' ) + end if + call shr_log_getLogUnit(s_logunit) + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=localpet, mpiCommunicator=mpicom, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (localpet==0) then + ! ------------------------------------------------------------------------ + ! Set default values in case namelist file doesn't exist, lightning_coupling_nl group + ! doesn't exist within the file, or a given variable isn't present in the namelist + ! group in the file. + ! ------------------------------------------------------------------------ + atm_provides_lightning = .false. + + ! ------------------------------------------------------------------------ + ! Read namelist file + ! ------------------------------------------------------------------------ + inquire( file=trim(NLFileName), exist=exists) + if ( exists ) then + open(newunit=unitn, file=trim(NLFilename), status='old' ) + write(s_logunit,'(a)') subname,'Read in lightning_coupling_nl namelist from: ', trim(NLFilename) + call shr_nl_find_group_name(unitn, 'lightning_coupling_nl', ierr) + if (ierr == 0) then + ! Note that ierr /= 0 means no namelist is present. + read(unitn, lightning_coupling_nl, iostat=ierr) + if (ierr > 0) then + call shr_sys_abort(subname//'problem reading lightning_coupling_nl') + end if + end if + close( unitn ) + end if + + ltmp(1) = atm_provides_lightning + + end if + + ! ------------------------------------------------------------------------ + ! Broadcast values to all tasks + ! ------------------------------------------------------------------------ + call ESMF_VMBroadcast(vm, ltmp, count=1, rootPet=0, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + atm_provides_lightning_out = ltmp(1) + + end subroutine shr_lightning_coupling_readnl + +end module shr_lightning_coupling_mod diff --git a/cesm/nuopc_cap_share/shr_megan_mod.F90 b/cesm/nuopc_cap_share/shr_megan_mod.F90 index d49411e84..57a218dd7 100644 --- a/cesm/nuopc_cap_share/shr_megan_mod.F90 +++ b/cesm/nuopc_cap_share/shr_megan_mod.F90 @@ -5,22 +5,22 @@ module shr_megan_mod ! MEGAN = Model of Emissions of Gases and Aerosols from Nature ! ! This reads the megan_emis_nl namelist in drv_flds_in and makes the relavent - ! information available to CAM, CLM, and driver. - ! - The driver sets up CLM to CAM communication for the VOC flux fields. - ! - CLM needs to know what specific VOC fluxes need to be passed to the coupler + ! information available to CAM, CLM, and driver. + ! - The driver sets up CLM to CAM communication for the VOC flux fields. + ! - CLM needs to know what specific VOC fluxes need to be passed to the coupler ! and how to assemble the fluxes. ! - CAM needs to know what specific VOC fluxes to expect from CLM. !================================================================================ use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet - use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS - use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cx=>shr_kind_cx, cs=>shr_kind_cs + use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cx=>shr_kind_cx use shr_sys_mod , only : shr_sys_abort use shr_log_mod , only : shr_log_getLogUnit use shr_mpi_mod , only : shr_mpi_bcast use shr_nl_mod , only : shr_nl_find_group_name use shr_expr_parser_mod , only : shr_exp_parse, shr_exp_item_t, shr_exp_list_destroy - + implicit none private @@ -68,6 +68,9 @@ module shr_megan_mod ! switch to use mapped emission factors logical :: shr_megan_mapped_emisfctrs = .false. + integer :: localPet = -huge(1) + integer :: logunit = -huge(1) + !-------------------------------------------------------- contains !-------------------------------------------------------- @@ -100,7 +103,8 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) ! Example: ! &megan_emis_nl ! megan_specifier = 'ISOP = isoprene', - ! 'C10H16 = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + ...', + ! 'C10H16 = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + ', + ! ' thujene_a + bornene + 0.5*(terpineol_4 + terpineol_a + terpinyl_ACT_a + myrtenal) + ...', ! 'CH3OH = methanol', ! 'C2H5OH = ethanol', ! 'CH2O = formaldehyde', @@ -109,25 +113,22 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) ! megan_factors_file = '$datapath/megan_emis_factors.nc' ! / !------------------------------------------------------------------------- - + ! input/output variables character(len=*), intent(in) :: NLFileName integer, intent(out) :: megan_nflds ! local variables type(ESMF_VM) :: vm - integer :: localPet integer :: mpicom integer :: unitn ! namelist unit number integer :: ierr ! error code logical :: exists ! if file exists or not - integer, parameter :: maxspc = 100 - character(len=2*CX) :: megan_specifier(maxspc) = ' ' + integer, parameter :: maxspc = 200 + character(len=CX) :: megan_specifier(maxspc) = ' ' logical :: megan_mapped_emisfctrs = .false. character(len=CL) :: megan_factors_file = ' ' integer :: rc - integer :: logunit - integer :: i, tmp(1) character(*), parameter :: F00 = "('(shr_megan_readnl) ',2a)" character(len=*), parameter :: subname='(shr_megan_readnl)' !-------------------------------------------------------------- @@ -140,12 +141,12 @@ subroutine shr_megan_readnl( NLFileName, megan_nflds) end if call ESMF_VMGetCurrent(vm, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call ESMF_VMGet(vm, localPet=localPet, mpiCommunicator=mpicom, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return call shr_log_getLogUnit(logunit) - ! Note the following still needs to be called on all processors since the mpi_bcast is a collective + ! Note the following still needs to be called on all processors since the mpi_bcast is a collective ! call on all the pes of mpicom if (localPet==0) then inquire( file=trim(NLFileName), exist=exists) @@ -204,6 +205,8 @@ subroutine shr_megan_init( specifier) allocate(shr_megan_mechcomps(n_entries)) shr_megan_mechcomps(:)%n_megan_comps = 0 + if (localPet==0) write(logunit,*) 'MEGAN entries:' + item => items_list i = 1 do while(associated(item)) @@ -221,7 +224,9 @@ subroutine shr_megan_init( specifier) shr_megan_mechcomps(i)%n_megan_comps = item%n_terms allocate(shr_megan_mechcomps(i)%megan_comps(item%n_terms)) + if (localPet==0) write(logunit,*) ' species : ', item%name do j = 1,item%n_terms + if (localPet==0) write(logunit,'(f12.4,a,a)') item%coeffs(j),' * ', item%vars(j) shr_megan_mechcomps(i)%megan_comps(j)%ptr => add_megan_comp( item%vars(j), item%coeffs(j) ) enddo shr_megan_mechcomps_n = shr_megan_mechcomps_n+1 diff --git a/cime_config/buildexe b/cime_config/buildexe index 406f660a3..1d7366718 100755 --- a/cime_config/buildexe +++ b/cime_config/buildexe @@ -38,6 +38,7 @@ def _main_func(): num_esp = case.get_value("NUM_COMP_INST_ESP") ocn_model = case.get_value("COMP_OCN") gmake_args = get_standard_makefile_args(case) + link_libs = case.get_value("CAM_LINKED_LIBS", subgroup="build_component_cam") esmf_aware_threading = case.get_value("ESMF_AWARE_THREADING") # Determine valid components @@ -65,6 +66,9 @@ def _main_func(): if ocn_model == 'mom': gmake_args += "USE_FMS=TRUE" + if link_libs is not None: + gmake_args += 'USER_SLIBS="{}"'.format(link_libs) + comp_classes = case.get_values("COMP_CLASSES") for comp in comp_classes: model = case.get_value("COMP_{}".format(comp)) diff --git a/cime_config/buildnml b/cime_config/buildnml index 32d6df1c0..32be8ead4 100755 --- a/cime_config/buildnml +++ b/cime_config/buildnml @@ -125,17 +125,13 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): elif case.get_value("RUN_TYPE") == "branch": config["run_type"] = "branch" + config['wav_ice_coupling'] = config['COMP_WAV'] == 'ww3dev' and config['COMP_ICE'] == 'cice' + # ---------------------------------------------------- # Initialize namelist defaults # ---------------------------------------------------- nmlgen.init_defaults(infile, config, skip_default_for_groups=["modelio"]) - # -------------------------------- - # Set default wav-ice coupling (assumes cice6 as the ice component - # -------------------------------- - if case.get_value("COMP_WAV") == "ww3dev" and case.get_value("COMP_ICE") == "cice": - nmlgen.add_default("wavice_coupling", value=".true.") - # -------------------------------- # Overwrite: set brnch_retain_casename # -------------------------------- @@ -298,8 +294,13 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): # -------------------------------- # Determine valid components valid_comps = [] + asyncio = False + for item in case.get_values("COMP_CLASSES"): comp = case.get_value("COMP_" + item) + if case.get_value(f"PIO_ASYNC_INTERFACE", {"compclass":item}): + asyncio = True + valid = True if comp == "s" + item.lower(): # stub comps @@ -322,6 +323,20 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): valid = False if valid: valid_comps.append(item) + asyncio_ntasks = case.get_value("PIO_ASYNCIO_NTASKS") + asyncio_stride = case.get_value("PIO_ASYNCIO_STRIDE") + # If asyncio is enabled make sure that the aysncio values are set + # if not enabled then do not pass xml settings to namelists. + if asyncio: + expect(asyncio_ntasks > 0 and asyncio_stride > 0, + "ASYNCIO is enabled but PIO_ASYNCIO_NTASKS={} and PIO_ASYNCIO_STRIDE = {}". + format(asyncio_ntasks, asyncio_stride)) + else: + if asyncio_ntasks > 0 or asyncio_stride > 0: + logger.warning("ASYNCIO is disabled, ignoring settings for PIO_ASYNCIO_NTASKS={} and PIO_ASYNCIO_STRIDE = {}". + format(asyncio_ntasks, asyncio_stride)) + nmlgen.set_value("pio_asyncio_ntasks", 0) + nmlgen.set_value("pio_asyncio_stride", 0) # Determine if there are any data components in the compset datamodel_in_compset = False @@ -601,14 +616,7 @@ def buildnml(case, caseroot, component): major = line[-2] if "MAJOR" in line else major minor = line[-2] if "MINOR" in line else minor logger.debug("ESMF version major {} minor {}".format(major, minor)) - expect(int(major) >= 8, "ESMF version should be 8.1 or newer") - if esmf_aware_threading: - expect( - int(minor) >= 2, - "ESMF version should be 8.2.0 or newer when using ESMF_AWARE_THREADING", - ) - else: - expect(int(minor) >= 1, "ESMF version should be 8.1.0 or newer") + expect(int(major) >= 8 and int(minor) >=4, "ESMF version should be 8.4.1 or newer") confdir = os.path.join(case.get_value("CASEBUILD"), "cplconf") if not os.path.isdir(confdir): diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index c06f7a7f3..f986cfad2 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -1361,87 +1361,6 @@ - - - - char - idmap - run_domain - env_run.xml - atm2ocn flux mapping file - - - - char - idmap - run_domain - env_run.xml - atm2ocn state mapping file - - - - char - idmap - run_domain - env_run.xml - atm2ocn vector mapping file - - - - char - idmap - run_domain - env_run.xml - atm2lnd flux mapping file - - - - char - idmap - run_domain - env_run.xml - atm2lnd state mapping file - - - - char - idmap - run_domain - env_run.xml - atm2wav state mapping file - - - - char - idmap - run_domain - env_run.xml - ocn2atm flux mapping file - - - - char - idmap - run_domain - env_run.xml - ocn2atm state mapping file - - - - char - idmap - run_domain - env_run.xml - lnd2atm flux mapping file - - - - char - idmap - run_domain - env_run.xml - lnd2atm state mapping file - char @@ -2023,6 +1942,30 @@ pio blocksize for box decompositions + + integer + 0 + run_pio + env_mach_pes.xml + Task count for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True + + + + integer + 0 + run_pio + env_mach_pes.xml + Stride of tasks for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True + + + + integer + 1 + run_pio + env_mach_pes.xml + RootPE of tasks for asyncronous IO, only valid if PIO_ASYNC_INTERFACE is True + + integer -1 diff --git a/cime_config/config_component_cesm.xml b/cime_config/config_component_cesm.xml index e2e6b44e1..dbf3b11e3 100644 --- a/cime_config/config_component_cesm.xml +++ b/cime_config/config_component_cesm.xml @@ -108,12 +108,15 @@ CO2A none CO2A + CO2A CO2A CO2A CO2A CO2A CO2C CO2C + CO2A + CO2A run_coupling env_run.xml @@ -232,6 +235,11 @@ 1 + + + + 24 + 48 run_coupling env_run.xml @@ -466,37 +474,6 @@ - - char - none,never,nsteps,nseconds,nminutes,nhours,ndays,nmonths,nyears,date,end - never - - nmonths - - med_history - env_run.xml - Sets mediator average history file frequency (like REST_OPTION) - - - char - - -999 - - 1 - - med_history - env_run.xml - Sets mediator average history file frequency (like REST_N) - - - integer - - -999 - med_history - env_run.xml - yyyymmdd format, sets mediator average history date (like REST_DATE) - - logical TRUE,FALSE diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index ce1ae92ff..d9001cfb7 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -36,6 +36,42 @@ + + integer + pio + PELAYOUT_attributes + + IO tasks FOR ASYNC IO, only valid if ASYNCIO is true. + + + $PIO_ASYNCIO_NTASKS + + + + + integer + pio + PELAYOUT_attributes + + IO task stride FOR ASYNC IO, only valid if ASYNCIO is true. + + + $PIO_ASYNCIO_STRIDE + + + + + integer + pio + PELAYOUT_attributes + + IO rootpe task FOR ASYNC IO, only valid if ASYNCIO is true. + + + $PIO_ASYNCIO_ROOTPE + + + char expdef @@ -680,6 +716,17 @@ $ESMF_VERBOSITY_LEVEL + + logical + performance + MED_attributes + + Check for NaN values in fields returned from mediator to components. This has a small performance impact. + + + .true. + + integer control @@ -888,10 +935,10 @@ ogrid,agrid,xgrid Grid for atm ocn flux calc - default: xgrid + default: ogrid - ogrid + xgrid @@ -1199,7 +1246,7 @@ - + logical aux_hist @@ -1228,10 +1275,10 @@ - char + integer aux_hist MED_attributes - history option type + history option span 1 @@ -1258,13 +1305,13 @@ integer aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 24 - + logical aux_hist @@ -1293,10 +1340,10 @@ - char + integer aux_hist MED_attributes - history option type + history option span 1 @@ -1311,10 +1358,10 @@ - char + integer aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 24 @@ -1329,7 +1376,7 @@ - + logical aux_hist @@ -1345,7 +1392,7 @@ char aux_hist MED_attributes - Auxiliary mediator atm2med precipitation history output every 3 hours + Auxiliary mediator atm2med precipitation fields history output every 3 hours Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl @@ -1360,10 +1407,10 @@ - char + integer aux_hist MED_attributes - history option type + history option span 3 @@ -1378,10 +1425,10 @@ - char + integer aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 8 @@ -1396,13 +1443,13 @@ - + logical aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x dynamic, radiation, and precipitation history output every 3 hours .false. @@ -1413,7 +1460,7 @@ aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x dynamic, radiation, and precipitation fields history output every 3 hours Sa_z:Sa_topo:Sa_u:Sa_v:Sa_tbot:Sa_ptem:Sa_shum:Sa_dens:Sa_pbot:Sa_pslv:Faxa_lwdn:Faxa_rainc:Faxa_rainl:Faxa_snowc:Faxa_snowl:Faxa_swndr:Faxa_swvdr:Faxa_swndf:Faxa_swvdf:Sa_co2diag:Sa_co2prog @@ -1429,10 +1476,10 @@ - char + integer aux_hist MED_attributes - history option type + history option span 3 @@ -1447,10 +1494,10 @@ - char + integer aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 8 @@ -1465,12 +1512,12 @@ - + logical aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x aerosol and ghg history output daily or endofrun .false. @@ -1479,7 +1526,7 @@ char aux_hist MED_attributes - Auxiliary mediator a2x precipitation history output every 3 hours + Auxiliary mediator a2x aerosol and ghg history output daily or endofrun Faxa_bcph:Faxa_ocph:Faxa_dstwet:Faxa_dstdry:Sa_co2prog:Sa_co2diag @@ -1490,16 +1537,16 @@ MED_attributes history option type - ndays + nhours - char + integer aux_hist MED_attributes - history option type + history option span - 1 + 3 @@ -1512,12 +1559,12 @@ - char + integer aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. - 1 + 2 @@ -1712,7 +1759,7 @@ - char + integer aux_hist MED_attributes history option type @@ -1730,10 +1777,10 @@ - char + integer aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. 1 @@ -1765,6 +1812,71 @@ + + + logical + aux_hist + MED_attributes + Auxiliary mediator ocn2med average history output every day. + + .false. + + + + char + aux_hist + MED_attributes + Auxiliary mediator ocn2med average history output every day. + + So_bldepth:So_t:So_u:So_v + + + + char + aux_hist + MED_attributes + history option type + + ndays + + + + integer + aux_hist + MED_attributes + history option type + + 1 + + + + logical + aux_hist + MED_attributes + If true, use time average for aux file output. + + .true. + + + + char + aux_hist + MED_attributes + Auxiliary name identifier in history name + + ocn.24h.avg + + + + integer + aux_hist + MED_attributes + Number of time samples per file. + + 30 + + + char time @@ -1877,7 +1989,7 @@ char aux_hist MED_attributes - Auxiliary mediator rof2med precipitation history output. + Auxiliary mediator rof2med precipitation fields history output. all @@ -1888,16 +2000,16 @@ MED_attributes history option type - ndays + nhours - char + integer aux_hist MED_attributes - history option type + history option span - 1 + 3 @@ -1910,12 +2022,12 @@ - char + integer aux_hist MED_attributes - Number of time sames per file. + Number of time samples per file. - 1 + 2 @@ -2055,25 +2167,25 @@ idmap - + char mapping abs MED_attributes - lnd to rof mapping, 'unset' or 'idmap' are normal possible values + lnd to rof mapping, 'unset' or 'idmap' are normal possible values (mapping file given for mizuRoute grids) - unset + $LND2ROF_FMAPNAME idmap - + char mapping abs MED_attributes - rof to lnd mapping, 'unset' or 'idmap' are normal possible values + rof to lnd mapping, 'unset' or 'idmap' are normal possible values (mapping file given for mizuRoute grids) - unset + $ROF2LND_FMAPNAME idmap @@ -2270,6 +2382,7 @@ 4 + 4 0 @@ -3798,7 +3911,7 @@ - + logical expdef ALLCOMP_attributes @@ -3807,6 +3920,8 @@ .false. + + diff --git a/cime_config/namelist_definition_drv_flds.xml b/cime_config/namelist_definition_drv_flds.xml index b8d96bcd6..03b6b7c6d 100644 --- a/cime_config/namelist_definition_drv_flds.xml +++ b/cime_config/namelist_definition_drv_flds.xml @@ -142,7 +142,7 @@ - + @@ -157,4 +157,17 @@ + + + + + + logical + lightning_coupling + lightning_coupling_nl + + If TRUE atmosphere model will provide prognosed lightning flash frequency (flashes per minute). + + + diff --git a/cime_config/runseq/driver_config.py b/cime_config/runseq/driver_config.py index e5fe2715d..9694c7503 100644 --- a/cime_config/runseq/driver_config.py +++ b/cime_config/runseq/driver_config.py @@ -132,7 +132,8 @@ def __compute_ocn(self, case, coupling_times): # TODO: check of data model prognostic flag is on - this is a new xml variable # If the prognostic flag is on, then should set med_to_wav to True docn_mode = case.get_value("DOCN_MODE") - med_to_ocn = ('som' in docn_mode or 'interannual' in docn_mode) + docn_import_fields = case.get_value("DOCN_IMPORT_FIELDS") + med_to_ocn = ('som' in docn_mode or 'interannual' in docn_mode or docn_import_fields != 'none') return (run_ocn, med_to_ocn, coupling_times["ocn_cpl_dt"]) diff --git a/cime_config/runseq/runseq_general.py b/cime_config/runseq/runseq_general.py index 2b7f0cc0a..ddbfca598 100644 --- a/cime_config/runseq/runseq_general.py +++ b/cime_config/runseq/runseq_general.py @@ -94,7 +94,7 @@ def gen_runseq(case, coupling_times): runseq.add_action("MED med_phases_aofluxes_run" , run_ocn and run_atm and (med_to_ocn or med_to_atm)) runseq.add_action("MED med_phases_prep_ocn_accum" , med_to_ocn) runseq.add_action("MED med_phases_ocnalb_run" , (run_ocn and run_atm and (med_to_ocn or med_to_atm)) and not xcompset) - runseq.add_action("MED med_phases_diag_ocn" , run_ocn and diag_mode) + runseq.add_action("MED med_phases_diag_ocn" , run_ocn and diag_mode) if (cpl_seq_option == 'OPTION1'): if ocn_cpl_time != atm_cpl_time: @@ -104,11 +104,17 @@ def gen_runseq(case, coupling_times): if ocn_cpl_time != atm_cpl_time: runseq.leave_time_loop(inner_loop, addextra_atsign=True) + if (cpl_seq_option == 'TIGHT'): + runseq.add_action("MED med_phases_aofluxes_run" , med_to_ocn) + runseq.add_action("MED med_phases_prep_ocn_accum" , med_to_ocn) + runseq.add_action("MED med_phases_prep_ocn_avg" , med_to_ocn and ocn_outer_loop) + runseq.add_action("MED -> OCN :remapMethod=redist", med_to_ocn and ocn_outer_loop) + runseq.add_action("MED med_phases_prep_lnd" , med_to_lnd) runseq.add_action("MED -> LND :remapMethod=redist" , med_to_lnd) - runseq.add_action("MED med_phases_prep_ice" , med_to_ice) - runseq.add_action("MED -> ICE :remapMethod=redist" , med_to_ice) + runseq.add_action("MED med_phases_prep_ice" , med_to_ice) + runseq.add_action("MED -> ICE :remapMethod=redist" , med_to_ice) runseq.add_action("MED med_phases_prep_wav_accum" , med_to_wav) runseq.add_action("MED med_phases_prep_wav_avg" , med_to_wav) diff --git a/cime_config/testdefs/testlist_drv.xml b/cime_config/testdefs/testlist_drv.xml index 7368a1fd2..985bd6ce9 100644 --- a/cime_config/testdefs/testlist_drv.xml +++ b/cime_config/testdefs/testlist_drv.xml @@ -189,7 +189,7 @@ - + @@ -260,4 +260,36 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/cime_config/testdefs/testmods_dirs/drv/asyncio1node/shell_commands b/cime_config/testdefs/testmods_dirs/drv/asyncio1node/shell_commands new file mode 100644 index 000000000..70ec80d0e --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/asyncio1node/shell_commands @@ -0,0 +1,17 @@ +# This will add 4 asyncio tasks on the first node +./xmlchange PIO_ASYNCIO_ROOTPE=0 +./xmlchange PIO_ASYNCIO_STRIDE=1 +./xmlchange PIO_ASYNCIO_NTASKS=4 +./xmlchange PIO_REARRANGER=2 +./xmlchange PIO_ASYNC_INTERFACE=TRUE +for comp in ATM OCN LND ICE CPL GLC ROF +do + rootpe=`./xmlquery --value ROOTPE_$comp` + let newrootpe=rootpe+4 + ./xmlchange ROOTPE_$comp=$newrootpe +done +comp_ocn=`./xmlquery --value COMP_OCN` +# MOM ocn has no pio interface +if [[ "$comp_ocn" == "mom" ]]; then + ./xmlchange PIO_ASYNC_INTERFACE_OCN=FALSE; +fi diff --git a/cime_config/testdefs/testmods_dirs/drv/asyncio1pernode/shell_commands b/cime_config/testdefs/testmods_dirs/drv/asyncio1pernode/shell_commands new file mode 100644 index 000000000..05077453c --- /dev/null +++ b/cime_config/testdefs/testmods_dirs/drv/asyncio1pernode/shell_commands @@ -0,0 +1,22 @@ +# This will add one async pio task per node to a test +# does not work for all cases +max2() { printf '%d' $(( $1 > $2 ? $1 : $2 )); } +let totaltasks=0 +./xmlchange --force --force PIO_ASYNC_INTERFACE=TRUE +for comp in ATM OCN LND ICE CPL GLC ROF +do + ntasks=`./xmlquery --value NTASKS_$comp` + rootpe=`./xmlquery --value ROOTPE_$comp` + let maxpe=ntasks+rootpe + totaltasks=$(( $totaltasks > $maxpe ? $totaltasks : $maxpe )) +done +echo "totaltasks is $totaltasks" +tpn=`./xmlquery --value MAX_MPITASKS_PER_NODE` +./xmlchange --force --force PIO_ASYNCIO_STRIDE=$tpn +let piontasks=totaltasks/tpn +echo "piontasks=$piontasks" +./xmlchange --force --force PIO_ASYNCIO_NTASKS=$piontasks +let newntasks=totaltasks-piontasks +echo "newntasks=$newntasks" +./xmlchange --force --force NTASKS=$newntasks +./xmlchange --force --force PIO_REARRANGER=2 diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 6ebd49e0f..13811aec9 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -96,16 +96,16 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) type(InternalState) :: is_local integer :: n, ns character(len=CL) :: cvalue - logical :: wavice_coupling + logical :: wav_coupling_to_cice logical :: ocn2glc_coupling character(len=*) , parameter :: subname=' (esmFldsExchange_cesm) ' !-------------------------------------- rc = ESMF_SUCCESS - call NUOPC_CompAttributeGet(gcomp, name='wavice_coupling', value=cvalue, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='wav_coupling_to_cice', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) wavice_coupling + read(cvalue,*) wav_coupling_to_cice call NUOPC_CompAttributeGet(gcomp, name='ocn2glc_coupling', value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -399,6 +399,19 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if ! --------------------------------------------------------------------- + ! to lnd: cld to grnd lightning flash freq + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_from(compatm, 'Sa_lightning') + call addfld_to(complnd, 'Sa_lightning') + else + if ( fldchk(is_local%wrap%FBexp(complnd) , 'Sa_lightning', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), 'Sa_lightning', rc=rc)) then + call addmap_from(compatm, 'Sa_lightning', complnd, mapbilnr, 'one', atm2lnd_map) + call addmrg_to(complnd, 'Sa_lightning', mrg_from=compatm, mrg_fld='Sa_lightning', mrg_type='copy') + end if + end if + ! --------------------------------------------------------------------- ! to lnd: temperature at the lowest model level from atm ! --------------------------------------------------------------------- if (phase == 'advertise') then @@ -1960,6 +1973,17 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) mrg_from=compatm, mrg_fld='Faxa_dstdry', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if + if (phase == 'advertise') then + call addfld_to(compocn, 'Faxa_ndep') + call addfld_from(compatm, 'Faxa_ndep') + else + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_ndep', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_ndep', rc=rc)) then + call addmap_from(compatm, 'Faxa_ndep', compocn, mapconsf, 'one', atm2ocn_map) + call addmrg_to(compocn, 'Faxa_ndep', & + mrg_from=compatm, mrg_fld='Faxa_ndep', mrg_type='copy') + end if + end if ! --------------------------------------------------------------------- ! to ocn: enthalpy from atm rain, snow, evaporation @@ -2807,7 +2831,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ice: wave elevation spectrum (field with ungridded dimensions) ! --------------------------------------------------------------------- - if (wavice_coupling) then + if (wav_coupling_to_cice) then if (phase == 'advertise') then call addfld_from(compwav, 'Sw_elevation_spectrum') call addfld_to(compice, 'Sw_elevation_spectrum') @@ -2842,7 +2866,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !---------------------------------------------------------- ! to wav: ice thickness from ice !---------------------------------------------------------- - if (wavice_coupling) then + if (wav_coupling_to_cice) then if (phase == 'advertise') then call addfld_from(compice, 'Si_thick') call addfld_to(compwav, 'Si_thick') @@ -2857,7 +2881,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) !---------------------------------------------------------- ! to wav: ice floe diameter from ice !---------------------------------------------------------- - if (wavice_coupling) then + if (wav_coupling_to_cice) then if (phase == 'advertise') then call addfld_from(compice, 'Si_floediam') call addfld_to(compwav, 'Si_floediam') @@ -2962,6 +2986,14 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) end if end if + ! --------------------------------------------------------------------- + ! to wav: zonal and meridional wind stress + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld_to(compwav , 'Fwxx_taux') + call addfld_to(compwav , 'Fwxx_tauy') + end if + !===================================================================== ! FIELDS TO RIVER (comprof) !===================================================================== diff --git a/mediator/fd_cesm.yaml b/mediator/fd_cesm.yaml index 648a4fed2..c09a63c58 100644 --- a/mediator/fd_cesm.yaml +++ b/mediator/fd_cesm.yaml @@ -325,6 +325,10 @@ canonical_units: mol/mol description: atmosphere export - O3 in the lowest model layer (prognosed or prescribed) # + - standard_name: Sa_lightning + canonical_units: /min + description: atmosphere export - lightning flash freqency + # - standard_name: Sa_topo alias: inst_surface_height canonical_units: m @@ -745,7 +749,7 @@ description: sea-ice export - ice thickness # - standard_name: Si_floediam - canonical_units: m + canonical_units: m description: sea-ice export - ice floe diameter # #----------------------------------- @@ -1172,6 +1176,21 @@ canonical_units: m2/s description: wave elevation spectrum + # + #----------------------------------- + # section: wave import + #----------------------------------- + # + - standard_name: Fwxx_taux + alias: mean_zonal_moment_flx + canonical_units: N m-2 + description: wave import - zonal surface stress + # + - standard_name: Fwxx_tauy + alias: mean_merid_moment_flx + canonical_units: N m-2 + description: wave import - meridional surface stress + #----------------------------------- # mediator fields #----------------------------------- diff --git a/mediator/med.F90 b/mediator/med.F90 index 79a43a4c9..56fcb7621 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -59,10 +59,10 @@ module MED public SetServices public SetVM private InitializeP0 - private InitializeIPDv03p1 ! advertise fields - private InitializeIPDv03p3 ! realize connected Fields with transfer action "provide" - private InitializeIPDv03p4 ! optionally modify the decomp/distr of transferred Grid/Mesh - private InitializeIPDv03p5 ! realize all Fields with transfer action "accept" + private AdvertiseFields ! advertise fields + private RealizeFieldsWithTransferProvided ! realize connected Fields with transfer action "provide" + private ModifyDecompofMesh ! optionally modify the decomp/distr of transferred Grid/Mesh + private RealizeFieldsWithTransferAccept ! realize all Fields with transfer action "accept" private DataInitialize ! finish initialization and resolve data dependencies private SetRunClock private med_meshinfo_create @@ -129,7 +129,7 @@ subroutine SetServices(gcomp, rc) integer, intent(out) :: rc ! local variables - character(len=*),parameter :: subname=' (SetServices) ' + character(len=*), parameter :: subname = '('//__FILE__//':SetServices)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -161,7 +161,7 @@ subroutine SetServices(gcomp, rc) ! The valid values are: [will provide, can provide, cannot provide] call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeIPDv03p1, rc=rc) + phaseLabelList=(/"IPDv03p1"/), userRoutine=AdvertiseFields, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -169,7 +169,7 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeIPDv03p3, rc=rc) + phaseLabelList=(/"IPDv03p3"/), userRoutine=RealizeFieldsWithTransferProvided, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -177,7 +177,7 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p4"/), userRoutine=InitializeIPDv03p4, rc=rc) + phaseLabelList=(/"IPDv03p4"/), userRoutine=ModifyDecompofMesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -185,7 +185,7 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & - phaseLabelList=(/"IPDv03p5"/), userRoutine=InitializeIPDv03p5, rc=rc) + phaseLabelList=(/"IPDv03p5"/), userRoutine=RealizeFieldsWithTransferAccept, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ @@ -567,10 +567,12 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) character(len=CX) :: diro character(len=CX) :: logfile character(len=CX) :: diagfile - character(len=*),parameter :: subname=' (InitializeP0) ' + character(len=*), parameter :: subname = '('//__FILE__//':InitializeP0)' !----------------------------------------------------------- rc = ESMF_SUCCESS + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + if (profile_memory) call ESMF_VMLogMemInfo("Entering "//trim(subname)) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -646,7 +648,7 @@ end subroutine InitializeP0 !----------------------------------------------------------------------- - subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) + subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) ! Mediator advertises its import and export Fields and sets the ! TransferOfferGeomObject Attribute. @@ -659,6 +661,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use esmFlds, only : med_fldlist_init1, med_fld_GetFldInfo, med_fldList_entry_type use med_phases_history_mod, only : med_phases_history_init + use med_methods_mod , only : mediator_checkfornans ! input/output variables type(ESMF_GridComp) :: gcomp @@ -677,7 +680,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) type(med_fldlist_type), pointer :: fldListFr, fldListTo type(med_fldList_entry_type), pointer :: fld integer :: stat - character(len=*),parameter :: subname=' (Advertise Fields) ' + character(len=*), parameter :: subname = '('//__FILE__//':AdvertiseFields)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -914,14 +917,32 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) end if end do ! end of ncomps loop + ! Should mediator check for NaNs? + call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if(isPresent .and. isSet) then + read(cvalue, *) mediator_checkfornans + else + mediator_checkfornans = .false. + endif + if(maintask) then + write(logunit,*) ' check_for_nans is ',mediator_checkfornans + if(mediator_checkfornans) then + write(logunit,*) ' Fields will be checked for NaN values when passed from mediator to component' + else + write(logunit,*) ' Fields will NOT be checked for NaN values when passed from mediator to component' + endif + endif + + if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - end subroutine InitializeIPDv03p1 + end subroutine AdvertiseFields !----------------------------------------------------------------------------- - subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) + subroutine RealizeFieldsWithTransferProvided(gcomp, importState, exportState, clock, rc) ! Realize connected Fields with transfer action "provide" @@ -941,7 +962,7 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) type(InternalState) :: is_local type(ESMF_VM) :: vm integer :: n - character(len=*),parameter :: subname=' (Realize Fields with Transfer Provide) ' + character(len=*), parameter :: subname = '('//__FILE__//':RealizeFieldsWithTransferProvided)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -981,11 +1002,11 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - end subroutine InitializeIPDv03p3 + end subroutine RealizeFieldsWithTransferProvided !----------------------------------------------------------------------------- - subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) + subroutine ModifyDecompofMesh(gcomp, importState, exportState, clock, rc) ! Optionally modify the decomp/distr of transferred Grid/Mesh @@ -1002,7 +1023,8 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local integer :: n1 - character(len=*),parameter :: subname=' (Modify Decomp of Mesh/Grid) ' + character(len=*), parameter :: subname = '('//__FILE__//':ModifyDecompofMesh)' + !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1301,11 +1323,11 @@ subroutine realizeConnectedGrid(State,string,rc) end subroutine realizeConnectedGrid - end subroutine InitializeIPDv03p4 + end subroutine ModifyDecompofMesh !----------------------------------------------------------------------------- - subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) + subroutine RealizeFieldsWithTransferAccept(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_LogWrite use ESMF , only : ESMF_SUCCESS, ESMF_LOGMSG_INFO, ESMF_StateIsCreated @@ -1330,7 +1352,8 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local integer :: n1 - character(len=*),parameter :: subname=' (Realize Fields with Transfer Accept) ' + character(len=*), parameter :: subname = '('//__FILE__//':RealizeFieldsWithTransferAccept)' + !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1402,7 +1425,7 @@ subroutine completeFieldInitialization(State,rc) integer, allocatable :: ungriddedLBound(:), ungriddedUBound(:) logical :: isPresent logical :: meshcreated - character(len=*),parameter :: subname=' (Complete Field Initialization) ' + character(len=*), parameter :: subname = '('//__FILE__//':completeFieldInitialization)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -1512,7 +1535,7 @@ subroutine completeFieldInitialization(State,rc) end subroutine completeFieldInitialization - end subroutine InitializeIPDv03p5 + end subroutine RealizeFieldsWithTransferAccept !----------------------------------------------------------------------------- @@ -1594,7 +1617,7 @@ subroutine DataInitialize(gcomp, rc) logical,save :: first_call = .true. real(r8) :: real_nx, real_ny character(len=CX) :: msgString - character(len=*), parameter :: subname=' (Data Initialization) ' + character(len=*), parameter :: subname = '('//__FILE__//':DataInitialize)' !----------------------------------------------------------- call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) @@ -2200,8 +2223,8 @@ subroutine SetRunClock(gcomp, rc) character(len=CL) :: stop_option integer :: stop_n, stop_ymd logical, save :: stopalarmcreated=.false. + character(len=*), parameter :: subname = '('//__FILE__//':SetRunClock)' - character(len=*),parameter :: subname=' (Set Run Clock) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -2286,7 +2309,7 @@ subroutine med_meshinfo_create(FB, mesh_info, FBArea, rc) real(r8), allocatable :: ownedElemCoords(:) real(r8), pointer :: dataptr(:) integer :: n, dimcount, fieldcount - character(len=*),parameter :: subname=' (module_MED:med_meshinfo_create) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_meshinfo_create)' !------------------------------------------------------------------------------- rc= ESMF_SUCCESS @@ -2359,7 +2382,7 @@ subroutine med_grid_write(grid, fileName, rc) type(ESMF_ArrayBundle) :: arrayBundle integer :: tileCount logical :: isPresent - character(len=*), parameter :: subname=' (Grid Write) ' + character(len=*), parameter :: subname = '('//__FILE__//':med_grid_write)' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_diag_mod.F90 b/mediator/med_diag_mod.F90 index 802334f6f..8ea6651ea 100644 --- a/mediator/med_diag_mod.F90 +++ b/mediator/med_diag_mod.F90 @@ -95,6 +95,8 @@ module med_diag_mod character(*), parameter :: FA1 = "(' ',a12,6f15.8)" character(*), parameter :: FA0r = "(' ',12x,8(6x,a8,1x))" character(*), parameter :: FA1r = "(' ',a12,8f15.8)" + character(*), parameter :: FA0s = "(' ',12x,8(7x,a8,2x))" + character(*), parameter :: FA1s = "(' ',a12,8g18.8)" ! --------------------------------- ! C for component @@ -2683,7 +2685,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) write(diagunit,*) ' ' write(diagunit,FAH) subname,'NET SALT BUDGET (kg/m2s): period = ',& trim(budget_diags%periods(ip)%name), ': date = ',date,tod - write(diagunit,FA0r) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' + write(diagunit,FA0s) ' atm',' lnd',' rof',' ocn',' ice nh',' ice sh',' glc',' *SUM* ' do nf = f_salt_beg, f_salt_end net_salt_atm = data(nf, c_atm_recv, ip) + data(nf, c_atm_send, ip) net_salt_lnd = data(nf, c_lnd_recv, ip) + data(nf, c_lnd_send, ip) @@ -2695,7 +2697,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) net_salt_tot = net_salt_atm + net_salt_lnd + net_salt_rof + net_salt_ocn + & net_salt_ice_nh + net_salt_ice_sh + net_salt_glc - write(diagunit,FA1r) budget_diags%fields(nf)%name,& + write(diagunit,FA1s) budget_diags%fields(nf)%name,& net_salt_atm, net_salt_lnd, net_salt_rof, net_salt_ocn, & net_salt_ice_nh, net_salt_ice_sh, net_salt_glc, net_salt_tot enddo @@ -2718,7 +2720,7 @@ subroutine med_diag_print_summary(data, ip, date, tod) sum_net_salt_tot = sum_net_salt_atm + sum_net_salt_lnd + sum_net_salt_rof + sum_net_salt_ocn + & sum_net_salt_ice_nh + sum_net_salt_ice_sh + sum_net_salt_glc - write(diagunit,FA1r)' *SUM*',& + write(diagunit,FA1s)' *SUM*',& sum_net_salt_atm, sum_net_salt_lnd, sum_net_salt_rof, sum_net_salt_ocn, & sum_net_salt_ice_nh, sum_net_salt_ice_sh, sum_net_salt_glc, sum_net_salt_tot end if diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 13ae0d3ec..82e0b04d0 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -7,7 +7,7 @@ module med_io_mod use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, I8=>SHR_KIND_I8, R8=>SHR_KIND_R8 use med_kind_mod , only : R4=>SHR_KIND_R4 use med_constants_mod , only : fillvalue => SHR_CONST_SPVAL - use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError + use ESMF , only : ESMF_VM, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError, ESMF_LOGMSG_ERROR use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_END_ABORT, ESMF_LOGERR_PASSTHRU use ESMF , only : ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadCast, ESMF_Finalize use NUOPC , only : NUOPC_FieldDictionaryGetEntry @@ -75,10 +75,7 @@ module med_io_mod character(*),parameter :: prefix = "med_io_" character(*),parameter :: modName = "(med_io_mod) " character(*),parameter :: version = "cmeps0" - integer , parameter :: number_strlen = 8 - integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now - character(CL) :: wfilename(0:file_desc_t_cnt) = '' - type(file_desc_t) :: io_file(0:file_desc_t_cnt) + integer :: pio_iotype integer :: pio_ioformat type(iosystem_desc_t), pointer :: io_subsystem @@ -198,7 +195,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. '64BIT_DATA') then pio_ioformat = PIO_64BIT_DATA else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_ioformat (CLASSIC|64BIT_OFFSET|64BIT_DATA)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_ioformat (CLASSIC|64BIT_OFFSET|64BIT_DATA)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -223,7 +220,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'NETCDF4P') then pio_iotype = PIO_IOTYPE_NETCDF4P else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_typename (NETCDF|PNETCDF|NETCDF4C|NETCDF4P)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_typename (NETCDF|PNETCDF|NETCDF4C|NETCDF4P)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -334,13 +331,13 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'SUBSET') then pio_rearranger = PIO_REARR_SUBSET else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearranger (BOX|SUBSET)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearranger (BOX|SUBSET)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if else - cvalue = 'BOX' - pio_rearranger = PIO_REARR_BOX + cvalue = 'SUBSET' + pio_rearranger = PIO_REARR_SUBSET end if if (localPet == 0) write(logunit,*) trim(subname), ' : pio_rearranger = ', trim(cvalue), pio_rearranger @@ -357,7 +354,7 @@ subroutine med_io_init(gcomp, rc) if (isPresent .and. isSet) then read(cvalue,*) pio_debug_level if (pio_debug_level < 0 .or. pio_debug_level > 6) then - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_debug_level (0-6)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_debug_level (0-6)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -381,7 +378,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. 'COLL') then pio_rearr_comm_type = PIO_REARR_COMM_COLL else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_type (P2P|COLL)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_type (P2P|COLL)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -406,7 +403,7 @@ subroutine med_io_init(gcomp, rc) else if (trim(cvalue) .eq. '2DDISABLE') then pio_rearr_comm_fcd = PIO_REARR_COMM_FC_2D_DISABLE else - call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_fcd (2DENABLE|IO2COMP|COMP2IO|2DDISABLE)', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//': need to provide valid option for pio_rearr_comm_fcd (2DENABLE|IO2COMP|COMP2IO|2DDISABLE)', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return end if @@ -498,7 +495,7 @@ subroutine med_io_init(gcomp, rc) end subroutine med_io_init !=============================================================================== - subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) + subroutine med_io_wopen(filename, io_file, vm, rc, clobber, file_ind, model_doi_url) !--------------- ! open netcdf file @@ -511,17 +508,17 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) ! input/output arguments character(*), intent(in) :: filename + type(file_desc_t), intent(inout) :: io_file type(ESMF_VM) :: vm + integer, intent(out) :: rc logical, optional, intent(in) :: clobber integer, optional, intent(in) :: file_ind character(CL), optional, intent(in) :: model_doi_url - ! local variables logical :: lclobber integer :: rcode integer :: nmode integer :: lfile_ind - integer :: rc integer :: iam character(CL) :: lversion character(CL) :: lmodel_doi_url @@ -539,13 +536,11 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind - if (.not. pio_file_is_open(io_file(lfile_ind))) then + call ESMF_VMGet(vm, localPet=iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! filename not open - wfilename(lfile_ind) = trim(filename) + if (.not. pio_file_is_open(io_file)) then if (med_io_file_exists(vm, filename)) then if (lclobber) then @@ -554,20 +549,20 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) if(pio_iotype == PIO_IOTYPE_NETCDF .or. pio_iotype == PIO_IOTYPE_PNETCDF) then nmode = ior(nmode,pio_ioformat) endif - rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) + rcode = pio_createfile(io_subsystem, io_file, pio_iotype, trim(filename), nmode) if(iam==0) write(logunit,'(a)') trim(subname)//' creating file '//trim(filename) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) + rcode = pio_put_att(io_file,pio_global,"file_version",version) + rcode = pio_put_att(io_file,pio_global,"model_doi_url",lmodel_doi_url) else - rcode = pio_openfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), pio_write) + rcode = pio_openfile(io_subsystem, io_file, pio_iotype, trim(filename), pio_write) if (iam==0) write(logunit,'(a)') trim(subname)//' opening file '//trim(filename) - call pio_seterrorhandling(io_file(lfile_ind),PIO_BCAST_ERROR) - rcode = pio_get_att(io_file(lfile_ind),pio_global,"file_version",lversion) - call pio_seterrorhandling(io_file(lfile_ind),PIO_INTERNAL_ERROR) + call pio_seterrorhandling(io_file,PIO_BCAST_ERROR) + rcode = pio_get_att(io_file,pio_global,"file_version",lversion) + call pio_seterrorhandling(io_file,PIO_INTERNAL_ERROR) if (trim(lversion) /= trim(version)) then - rcode = pio_redef(io_file(lfile_ind)) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) - rcode = pio_enddef(io_file(lfile_ind)) + rcode = pio_redef(io_file) + rcode = pio_put_att(io_file,pio_global,"file_version",version) + rcode = pio_enddef(io_file) endif endif else @@ -577,22 +572,12 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) nmode = ior(nmode,pio_ioformat) endif - rcode = pio_createfile(io_subsystem, io_file(lfile_ind), pio_iotype, trim(filename), nmode) + rcode = pio_createfile(io_subsystem, io_file, pio_iotype, trim(filename), nmode) if (iam==0) write(logunit,'(a)') trim(subname) //' creating file '// trim(filename) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"file_version",version) - rcode = pio_put_att(io_file(lfile_ind),pio_global,"model_doi_url",lmodel_doi_url) + rcode = pio_put_att(io_file,pio_global,"file_version",version) + rcode = pio_put_att(io_file,pio_global,"model_doi_url",lmodel_doi_url) endif - elseif (trim(wfilename(lfile_ind)) /= trim(filename)) then - ! filename is open, better match open filename - if (iam==0) then - write(logunit,'(a)') trim(subname)//' different filename currently open '//trim(filename) - write(logunit,'(a)') trim(subname)//' different wfilename currently open '//trim(wfilename(lfile_ind)) - end if - call ESMF_LogWrite(trim(subname)//'different file currently open '//trim(filename), ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - return - else ! filename is already open, just return endif @@ -600,7 +585,7 @@ subroutine med_io_wopen(filename, vm, clobber, file_ind, model_doi_url) end subroutine med_io_wopen !=============================================================================== - subroutine med_io_close(filename, vm, file_ind, rc) + subroutine med_io_close(io_file, rc) !--------------- ! close netcdf file @@ -609,85 +594,51 @@ subroutine med_io_close(filename, vm, file_ind, rc) use pio, only: pio_file_is_open, pio_closefile ! input/output variables - character(*) , intent(in) :: filename - type(ESMF_VM) , intent(in) :: vm - integer,optional , intent(in) :: file_ind + type(file_desc_t) :: io_file integer , intent(out) :: rc ! local variables - integer :: lfile_ind - integer :: iam + character(*),parameter :: subName = '(med_io_close) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - - if (.not. pio_file_is_open(io_file(lfile_ind))) then - ! filename not open, just return - elseif (trim(wfilename(lfile_ind)) == trim(filename)) then - ! filename matches, close it - call pio_closefile(io_file(lfile_ind)) - !wfilename(lfile_ind) = '' - else - call ESMF_VMGet(vm, localPet=iam, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! different filename is open, abort - if (iam==0) then - write(logunit,*) subname,' different wfilename and filename currently open, aborting ' - write(logunit,'(a)') 'filename = ',trim(filename) - write(logunit,'(a)') 'wfilename = ',trim(wfilename(lfile_ind)) - write(logunit,'(i6)')'lfile_ind = ',lfile_ind - end if - call ESMF_LogWrite(subname//'different file currently open, aborting '//trim(filename), ESMF_LOGMSG_INFO) - rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then - call ESMF_Finalize(endflag=ESMF_END_ABORT) - end if + if (pio_file_is_open(io_file)) then + call pio_closefile(io_file) endif end subroutine med_io_close !=============================================================================== - subroutine med_io_redef(filename,file_ind) + subroutine med_io_redef(io_file) use pio, only : pio_redef ! input/output variables - character(len=*), intent(in) :: filename - integer,optional,intent(in):: file_ind - + type(file_desc_t) :: io_file ! local variables - integer :: lfile_ind integer :: rcode !------------------------------------------------------------------------------- - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - rcode = pio_redef(io_file(lfile_ind)) + rcode = pio_redef(io_file) end subroutine med_io_redef !=============================================================================== - subroutine med_io_enddef(filename,file_ind) + subroutine med_io_enddef(io_file) use pio, only : pio_enddef ! input/output variables - character(len=*) , intent(in) :: filename - integer,optional , intent(in) :: file_ind + type(file_desc_t) :: io_file ! local variables - integer :: lfile_ind + integer :: rcode !------------------------------------------------------------------------------- - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - rcode = pio_enddef(io_file(lfile_ind)) + rcode = pio_enddef(io_file) end subroutine med_io_enddef @@ -746,8 +697,8 @@ character(len=8) function med_io_sec2hms (seconds, rc) end function med_io_sec2hms !=============================================================================== - subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & - fillval, pre, flds, tavg, use_float, file_ind, tilesize, rc) + subroutine med_io_write_FB(io_file, FB, whead, wdata, nx, ny, nt, & + fillval, pre, flds, tavg, use_float, tilesize, rc) !--------------- ! Write FB to netcdf file @@ -765,7 +716,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & use pio , only : pio_syncfile ! input/output variables - character(len=*) , intent(in) :: filename ! file + type(file_desc_t) :: io_file type(ESMF_FieldBundle) , intent(in) :: FB ! data to be written logical , intent(in) :: whead ! write header logical , intent(in) :: wdata ! write data @@ -777,7 +728,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & character(len=*), optional , intent(in) :: flds(:) ! specific fields to write out logical, optional , intent(in) :: tavg ! is this a tavg logical, optional , intent(in) :: use_float ! write output as float rather than double - integer, optional , intent(in) :: file_ind integer, optional , intent(in) :: tilesize ! if non-zero, write atm component on tiles integer , intent(out):: rc @@ -811,7 +761,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & integer, pointer :: maxIndexPTile(:,:) integer :: dimCount, tileCount integer, pointer :: Dof(:) - integer :: lfile_ind real(r8), pointer :: fldptr1(:) real(r8), pointer :: fldptr2(:,:) real(r8), allocatable :: ownedElemCoords(:), ownedElemCoords_x(:), ownedElemCoords_y(:) @@ -835,8 +784,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & if (present(pre)) lpre = trim(pre) luse_float = .false. if (present(use_float)) luse_float = use_float - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind + atmtiles = .false. if (present(tilesize)) then if (tilesize > 0) atmtiles = .true. @@ -848,7 +796,6 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif - rc = ESMF_Success return endif @@ -954,22 +901,22 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & ! Write header if (whead) then if (atmtiles) then - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_nx', lnx, dimid3(1)) - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ny', lny, dimid3(2)) - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ntiles', ntiles, dimid3(3)) + rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid3(1)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid3(2)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ntiles', ntiles, dimid3(3)) if (present(nt)) then dimid4(1:3) = dimid3 - rcode = pio_inq_dimid(io_file(lfile_ind), 'time', dimid4(4)) + rcode = pio_inq_dimid(io_file, 'time', dimid4(4)) dimid => dimid4 else dimid => dimid3 endif else - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_nx', lnx, dimid2(1)) - rcode = pio_def_dim(io_file(lfile_ind), trim(lpre)//'_ny', lny, dimid2(2)) + rcode = pio_def_dim(io_file, trim(lpre)//'_nx', lnx, dimid2(1)) + rcode = pio_def_dim(io_file, trim(lpre)//'_ny', lny, dimid2(2)) if (present(nt)) then dimid3(1:2) = dimid2 - rcode = pio_inq_dimid(io_file(lfile_ind), 'time', dimid3(3)) + rcode = pio_inq_dimid(io_file, 'time', dimid3(3)) dimid => dimid3 else dimid => dimid2 @@ -1008,21 +955,21 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) call ESMF_LogWrite(trim(subname)//': defining '//trim(name1), ESMF_LOGMSG_INFO) if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid,"_FillValue",real(lfillvalue,r4)) + rcode = pio_def_var(io_file, trim(name1), PIO_REAL, dimid, varid) + rcode = pio_put_att(io_file, varid,"_FillValue",real(lfillvalue,r4)) else - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"_FillValue",lfillvalue) + rcode = pio_def_var(io_file, trim(name1), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file,varid,"_FillValue",lfillvalue) end if if (NUOPC_FieldDictionaryHasEntry(trim(itemc))) then call NUOPC_FieldDictionaryGetEntry(itemc, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind), varid, "units" , trim(cunit)) + rcode = pio_put_att(io_file, varid, "units" , trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) + rcode = pio_put_att(io_file, varid, "standard_name", trim(name1)) if (present(tavg)) then if (tavg) then - rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + rcode = pio_put_att(io_file, varid, "cell_methods", "time: mean") endif endif end if @@ -1031,21 +978,21 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & name1 = trim(lpre)//'_'//trim(itemc) call ESMF_LogWrite(trim(subname)//':'//trim(itemc)//':'//trim(name1),ESMF_LOGMSG_INFO) if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_REAL, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, "_FillValue", real(lfillvalue, r4)) + rcode = pio_def_var(io_file, trim(name1), PIO_REAL, dimid, varid) + rcode = pio_put_att(io_file, varid, "_FillValue", real(lfillvalue, r4)) else - rcode = pio_def_var(io_file(lfile_ind), trim(name1), PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, "_FillValue", lfillvalue) + rcode = pio_def_var(io_file, trim(name1), PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file, varid, "_FillValue", lfillvalue) end if if (NUOPC_FieldDictionaryHasEntry(trim(itemc))) then call NUOPC_FieldDictionaryGetEntry(itemc, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(cunit)) + rcode = pio_put_att(io_file, varid, "units", trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(name1)) + rcode = pio_put_att(io_file, varid, "standard_name", trim(name1)) if (present(tavg)) then if (tavg) then - rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + rcode = pio_put_att(io_file, varid, "cell_methods", "time: mean") endif end if end if @@ -1055,13 +1002,13 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & ! Add coordinate information to file do n = 1,ndims if (luse_float) then - rcode = pio_def_var(io_file(lfile_ind), trim(coordvarnames(n)), PIO_REAL, dimid, varid) + rcode = pio_def_var(io_file, trim(coordvarnames(n)), PIO_REAL, dimid, varid) else - rcode = pio_def_var(io_file(lfile_ind), trim(coordvarnames(n)), PIO_DOUBLE, dimid, varid) + rcode = pio_def_var(io_file, trim(coordvarnames(n)), PIO_DOUBLE, dimid, varid) end if - rcode = pio_put_att(io_file(lfile_ind), varid, "long_name", trim(coordnames(n))) - rcode = pio_put_att(io_file(lfile_ind), varid, "units", trim(coordunits(n))) - rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(coordnames(n))) + rcode = pio_put_att(io_file, varid, "long_name", trim(coordnames(n))) + rcode = pio_put_att(io_file, varid, "units", trim(coordunits(n))) + rcode = pio_put_att(io_file, varid, "standard_name", trim(coordnames(n))) end do end if @@ -1107,40 +1054,39 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & do n = 1,ungriddedUBound(1) write(cnumber,'(i0)') n name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) - rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) + rcode = pio_inq_varid(io_file, trim(name1), varid) + call pio_setframe(io_file,varid,frame) if (gridToFieldMap(1) == 1) then - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue) + call pio_write_darray(io_file, varid, iodesc, fldptr2(:,n), rcode, fillval=lfillvalue) else if (gridToFieldMap(1) == 2) then - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) + call pio_write_darray(io_file, varid, iodesc, fldptr2(n,:), rcode, fillval=lfillvalue) end if end do else if (rank == 1 .or. rank == 0) then name1 = trim(lpre)//'_'//trim(itemc) - rcode = pio_inq_varid(io_file(lfile_ind), trim(name1), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) + rcode = pio_inq_varid(io_file, trim(name1), varid) + call pio_setframe(io_file,varid,frame) ! fix for writing data on exchange grid, which has no data in some PETs if (rank == 0) nullify(fldptr1) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr1, rcode, fillval=lfillvalue) + call pio_write_darray(io_file, varid, iodesc, fldptr1, rcode, fillval=lfillvalue) end if ! end if rank is 2 or 1 or 0 end if ! end if not "hgt" end do ! end loop over fields in FB ! Fill coordinate variables - why is this being done each time? - rcode = pio_inq_varid(io_file(lfile_ind), trim(coordvarnames(1)), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) + rcode = pio_inq_varid(io_file, trim(coordvarnames(1)), varid) + call pio_setframe(io_file,varid,frame) + call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_x, rcode, fillval=lfillvalue) - rcode = pio_inq_varid(io_file(lfile_ind), trim(coordvarnames(2)), varid) - call pio_setframe(io_file(lfile_ind),varid,frame) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) + rcode = pio_inq_varid(io_file, trim(coordvarnames(2)), varid) + call pio_setframe(io_file,varid,frame) + call pio_write_darray(io_file, varid, iodesc, ownedElemCoords_y, rcode, fillval=lfillvalue) - call pio_syncfile(io_file(lfile_ind)) - call pio_freedecomp(io_file(lfile_ind), iodesc) + call pio_syncfile(io_file) + call pio_freedecomp(io_file, iodesc) endif - deallocate(fieldNameList) deallocate(ownedElemCoords, ownedElemCoords_x, ownedElemCoords_y) if (dbug_flag > 5) then @@ -1150,7 +1096,7 @@ subroutine med_io_write_FB(filename, FB, whead, wdata, nx, ny, nt, & end subroutine med_io_write_FB !=============================================================================== - subroutine med_io_write_int(filename, idata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_int(io_file, idata, dname, whead, wdata, rc) use pio, only : var_desc_t, pio_def_var, pio_put_att, pio_int, pio_inq_varid, pio_put_var @@ -1159,45 +1105,40 @@ subroutine med_io_write_int(filename, idata, dname, whead, wdata, file_ind, rc) !--------------- ! intput/output variables - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file integer ,intent(in) :: idata ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables integer :: rcode type(var_desc_t) :: varid character(CL) :: cunit ! var units - integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_int) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - if (whead) then if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_def_var(io_file,trim(dname),PIO_INT,varid) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) endif if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,idata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,idata) endif end subroutine med_io_write_int !=============================================================================== - subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_int1d(io_file, idata, dname, whead, wdata, file_ind, rc) !--------------- ! Write 1d integer array to netcdf file @@ -1208,7 +1149,7 @@ subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc use pio , only : pio_int, pio_def_var ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file integer ,intent(in) :: idata(:) ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header @@ -1235,21 +1176,21 @@ subroutine med_io_write_int1d(filename, idata, dname, whead, wdata, file_ind, rc if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if lnx = size(idata) - rcode = pio_def_dim(io_file(lfile_ind),trim(dname),lnx,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_INT,dimid,varid) - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_def_dim(io_file,trim(dname),lnx,dimid(1)) + rcode = pio_def_var(io_file,trim(dname),PIO_INT,dimid,varid) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) else if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,idata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,idata) endif end subroutine med_io_write_int1d !=============================================================================== - subroutine med_io_write_r8(filename, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_r8(io_file, rdata, dname, whead, wdata, rc) !--------------- ! Write scalar double to netcdf file @@ -1259,48 +1200,41 @@ subroutine med_io_write_r8(filename, rdata, dname, whead, wdata, file_ind, rc) use pio , only : pio_double, pio_noerr, pio_inq_varid, pio_put_var ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + type(file_desc_T) :: io_file real(r8) ,intent(in) :: rdata ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables integer :: rcode type(var_desc_t) :: varid character(CL) :: cunit ! var units - integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_r8) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if(present(file_ind)) then - lfile_ind = file_ind - else - lfile_ind = 1 - endif if (whead) then - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,varid) + rcode = pio_def_var(io_file,trim(dname),PIO_DOUBLE,varid) if (rcode==PIO_NOERR) then if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) end if else if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,rdata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,rdata) endif end subroutine med_io_write_r8 !=============================================================================== - subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_r81d(io_file, rdata, dname, whead, wdata, rc) !--------------- ! Write 1d double array to netcdf file @@ -1310,12 +1244,11 @@ subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) use pio , only : pio_inq_varid, pio_put_var, pio_double, pio_put_att ! !INPUT/OUTPUT PARAMETERS: - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file real(r8) ,intent(in) :: rdata(:) ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables @@ -1324,38 +1257,32 @@ subroutine med_io_write_r81d(filename, rdata, dname, whead, wdata, file_ind, rc) type(var_desc_t) :: varid character(CL) :: cunit ! var units integer :: lnx - integer :: lfile_ind character(*),parameter :: subName = '(med_io_write_r81d) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if(present(file_ind)) then - lfile_ind = file_ind - else - lfile_ind = 1 - endif if (whead) then lnx = size(rdata) - rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_nx',lnx,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_DOUBLE,dimid,varid) + rcode = pio_def_dim(io_file,trim(dname)//'_nx',lnx,dimid(1)) + rcode = pio_def_var(io_file,trim(dname),PIO_DOUBLE,dimid,varid) if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) + rcode = pio_put_att(io_file,varid,"units",trim(cunit)) end if - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) endif if (wdata) then - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,rdata) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,rdata) endif end subroutine med_io_write_r81d !=============================================================================== - subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) + subroutine med_io_write_char(io_file, rdata, dname, whead, wdata, rc) !--------------- ! Write char string to netcdf file @@ -1365,12 +1292,11 @@ subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) use pio , only : pio_char, pio_put_var ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + type(file_desc_t) :: io_file character(len=*) ,intent(in) :: rdata ! data to be written character(len=*) ,intent(in) :: dname ! name of data logical ,intent(in) :: whead ! write header logical ,intent(in) :: wdata ! write data - integer,optional ,intent(in) :: file_ind integer ,intent(out):: rc ! local variables @@ -1379,37 +1305,32 @@ subroutine med_io_write_char(filename, rdata, dname, whead, wdata, file_ind, rc) type(var_desc_t) :: varid character(CL) :: cunit ! var units integer :: lnx - integer :: lfile_ind character(CL) :: charvar ! buffer for string read/write character(*),parameter :: subName = '(med_io_write_char) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if(present(file_ind)) then - lfile_ind = file_ind - else - lfile_ind = 1 - endif + if (whead) then lnx = len(charvar) - rcode = pio_def_dim(io_file(lfile_ind),trim(dname)//'_len',lnx,dimid(1)) - rcode = pio_def_var(io_file(lfile_ind),trim(dname),PIO_CHAR,dimid,varid) + rcode = pio_def_dim(io_file,trim(dname)//'_len',lnx,dimid(1)) + rcode = pio_def_var(io_file,trim(dname),PIO_CHAR,dimid,varid) if (NUOPC_FieldDictionaryHasEntry(trim(dname))) then call NUOPC_FieldDictionaryGetEntry(dname, canonicalUnits=cunit, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(dname)) + rcode = pio_put_att(io_file,varid,"standard_name",trim(dname)) else if (wdata) then charvar = '' charvar = trim(rdata) - rcode = pio_inq_varid(io_file(lfile_ind),trim(dname),varid) - rcode = pio_put_var(io_file(lfile_ind),varid,charvar) + rcode = pio_inq_varid(io_file,trim(dname),varid) + rcode = pio_put_var(io_file,varid,charvar) endif end subroutine med_io_write_char !=============================================================================== - subroutine med_io_define_time(time_units, calendar, file_ind, rc) + subroutine med_io_define_time(io_file, time_units, calendar, rc) use ESMF, only : operator(==), operator(/=) use ESMF, only : ESMF_Calendar, ESMF_CalendarIsCreated @@ -1422,9 +1343,9 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) use pio , only : pio_inq_varid, pio_put_var ! input/output variables + type(file_desc_t) :: io_file character(len=*) , intent(in) :: time_units ! units of time type(ESMF_Calendar) , intent(in) :: calendar ! calendar - integer, optional , intent(in) :: file_ind integer , intent(out):: rc ! local variables @@ -1432,16 +1353,12 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) integer :: dimid(1) integer :: dimid2(2) type(var_desc_t) :: varid - integer :: lfile_ind character(CL) :: calname ! calendar name character(*),parameter :: subName = '(med_io_define_time) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - if (.not. ESMF_CalendarIsCreated(calendar)) then call ESMF_LogWrite(trim(subname)//' ERROR: calendar is not created ', & ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) @@ -1450,9 +1367,9 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) end if ! define time and add calendar attribute - rcode = pio_def_dim(io_file(lfile_ind), 'time', PIO_UNLIMITED, dimid(1)) - rcode = pio_def_var(io_file(lfile_ind), 'time', PIO_DOUBLE, dimid, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, 'units', trim(time_units)) + rcode = pio_def_dim(io_file, 'time', PIO_UNLIMITED, dimid(1)) + rcode = pio_def_var(io_file, 'time', PIO_DOUBLE, dimid, varid) + rcode = pio_put_att(io_file, varid, 'units', trim(time_units)) if (calendar == ESMF_CALKIND_360DAY) then calname = '360_day' else if (calendar == ESMF_CALKIND_GREGORIAN) then @@ -1468,18 +1385,18 @@ subroutine med_io_define_time(time_units, calendar, file_ind, rc) else if (calendar == ESMF_CALKIND_NOLEAP) then calname = 'noleap' end if - rcode = pio_put_att(io_file(lfile_ind), varid, 'calendar', trim(calname)) + rcode = pio_put_att(io_file, varid, 'calendar', trim(calname)) ! define time bounds dimid2(2) = dimid(1) - rcode = pio_def_dim(io_file(lfile_ind), 'ntb', 2, dimid2(1)) - rcode = pio_def_var(io_file(lfile_ind), 'time_bnds', PIO_DOUBLE, dimid2, varid) - rcode = pio_put_att(io_file(lfile_ind), varid, 'bounds', 'time_bnds') + rcode = pio_def_dim(io_file, 'ntb', 2, dimid2(1)) + rcode = pio_def_var(io_file, 'time_bnds', PIO_DOUBLE, dimid2, varid) + rcode = pio_put_att(io_file, varid, 'bounds', 'time_bnds') end subroutine med_io_define_time !=============================================================================== - subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) + subroutine med_io_write_time(io_file, time_val, tbnds, nt, rc) !--------------- ! Write time variable to netcdf file @@ -1488,15 +1405,14 @@ subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) use pio, only : pio_put_att, pio_inq_varid, pio_put_var ! input/output variables + type(file_desc_t) :: io_file real(r8) , intent(in) :: time_val ! data to be written real(r8) , intent(in) :: tbnds(2) ! time bounds integer , intent(in) :: nt - integer , optional, intent(in) :: file_ind integer , intent(out):: rc ! local variables integer :: rcode - integer :: lfile_ind integer :: varid integer :: start(2),count(2) character(*),parameter :: subName = '(med_io_write_time) ' @@ -1504,19 +1420,16 @@ subroutine med_io_write_time(time_val, tbnds, nt, file_ind, rc) rc = ESMF_SUCCESS - lfile_ind = 0 - if (present(file_ind)) lfile_ind=file_ind - ! write time count = 1; start = nt - rcode = pio_inq_varid(io_file(lfile_ind), 'time', varid) - rcode = pio_put_var(io_file(lfile_ind), varid, start(1:1), count(1:1), (/time_val/)) + rcode = pio_inq_varid(io_file, 'time', varid) + rcode = pio_put_var(io_file, varid, start(1:1), count(1:1), (/time_val/)) ! write time bounds - rcode = pio_inq_varid(io_file(lfile_ind), 'time_bnds', varid) + rcode = pio_inq_varid(io_file, 'time_bnds', varid) start(1) = 1; start(2) = nt count(1) = 2; count(2) = 1 - rcode = pio_put_var(io_file(lfile_ind), varid, start(1:2), count(1:2), tbnds) + rcode = pio_put_var(io_file, varid, start(1:2), count(1:2), tbnds) end subroutine med_io_write_time @@ -1539,7 +1452,7 @@ subroutine med_io_read_FB(filename, vm, FB, pre, frame, rc) use pio , only : pio_read_darray, pio_offset_kind, pio_setframe ! input/output arguments - character(len=*) ,intent(in) :: filename ! file + character(len=*) ,intent(in) :: filename type(ESMF_VM) ,intent(in) :: vm type(ESMF_FieldBundle) ,intent(in) :: FB ! data to be read character(len=*) ,optional ,intent(in) :: pre ! prefix to variable name diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index bd5b60793..54fe20ec1 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -24,8 +24,13 @@ module med_methods_mod med_methods_FieldPtr_compare2 end interface - ! used/reused in module + interface med_methods_check_for_nans + module procedure med_methods_check_for_nans_1d + module procedure med_methods_check_for_nans_2d + end interface med_methods_check_for_nans + ! used/reused in module + logical, public :: mediator_checkfornans ! set in med.F90 AdvertiseFields logical :: isPresent character(len=1024) :: msgString type(ESMF_FieldStatus_Flag) :: status @@ -49,6 +54,7 @@ module med_methods_mod public med_methods_FB_getdata2d public med_methods_FB_getdata1d public med_methods_FB_getmesh + public med_methods_FB_check_for_nans public med_methods_State_reset public med_methods_State_diagnose @@ -71,6 +77,8 @@ module med_methods_mod #ifdef DIAGNOSE private med_methods_Array_diagnose #endif + private med_methods_check_for_nans + !----------------------------------------------------------------------------- contains !----------------------------------------------------------------------------- @@ -2497,4 +2505,101 @@ subroutine med_methods_FB_getmesh(FB, mesh, rc) end subroutine med_methods_FB_getmesh + !----------------------------------------------------------------------------- + subroutine med_methods_FB_check_for_nans(FB, maintask, logunit, rc) + use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet, ESMF_FieldGet + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + logical , intent(in) :: maintask + integer , intent(in) :: logunit + integer , intent(inout) :: rc + + ! local variables + type(ESMF_Field) :: field + integer :: index + integer :: fieldcount + integer :: fieldrank + character(len=CL) :: fieldname + real(r8) , pointer :: dataptr1d(:) + real(r8) , pointer :: dataptr2d(:,:) + integer :: nancount + character(len=CS) :: nancount_char + character(len=CL) :: msg_error + logical :: nanfound + character(len=*), parameter :: subname='(med_methods_FB_check_for_nans)' + ! ---------------------------------------------- + rc = ESMF_SUCCESS + + if(.not. mediator_checkfornans) return + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + nanfound = .false. + do index=1,fieldCount + call med_methods_FB_getNameN(FB, index, fieldname, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(FB, fieldName=fieldname, field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, rank=fieldrank, name=fieldname, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (fieldrank == 1) then + call ESMF_FieldGet(field, farrayPtr=dataptr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_check_for_nans(dataptr1d, nancount) + else + call ESMF_FieldGet(field, farrayPtr=dataptr2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call med_methods_check_for_nans(dataptr2d, nancount) + end if + if (nancount > 0) then + write(nancount_char, '(i0)') nancount + msg_error = "ERROR: " // trim(nancount_char) //" nans found in "//trim(fieldname) + call ESMF_LogWrite(trim(msg_error), ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + nanfound = .true. + end if + end do + if (nanfound) then + call ESMF_LogWrite('ABORTING JOB', ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + end if + + end subroutine med_methods_FB_check_for_nans + + !----------------------------------------------------------------------------- + subroutine med_methods_check_for_nans_1d(dataptr, nancount) + use shr_infnan_mod, only: shr_infnan_isnan + ! input/output variables + real(r8) , intent(in) :: dataptr(:) + integer , intent(out) :: nancount + ! local variables + integer :: n + + nancount = 0 + do n = 1,size(dataptr) + if (shr_infnan_isnan(dataptr(n))) then + nancount = nancount + 1 + end if + end do + end subroutine med_methods_check_for_nans_1d + + subroutine med_methods_check_for_nans_2d(dataptr, nancount) + use shr_infnan_mod, only: shr_infnan_isnan + ! input/output variables + real(r8) , intent(in) :: dataptr(:,:) + integer , intent(out) :: nancount + ! local variables + integer :: n,k + + nancount = 0 + do k = 1,size(dataptr, dim=1) + do n = 1,size(dataptr, dim=2) + if (shr_infnan_isnan(dataptr(k,n))) then + nancount = nancount + 1 + end if + end do + end do + end subroutine med_methods_check_for_nans_2d + end module med_methods_mod diff --git a/mediator/med_phases_aofluxes_mod.F90 b/mediator/med_phases_aofluxes_mod.F90 index 0b3d10901..48055e92e 100644 --- a/mediator/med_phases_aofluxes_mod.F90 +++ b/mediator/med_phases_aofluxes_mod.F90 @@ -27,7 +27,7 @@ module med_phases_aofluxes_mod use ESMF , only : ESMF_XGridGet, ESMF_MeshCreate, ESMF_MeshWrite, ESMF_KIND_R8 use med_kind_mod , only : CX=>SHR_KIND_CX, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL, R8=>SHR_KIND_R8 use med_internalstate_mod , only : InternalState, maintask, logunit - use med_internalstate_mod , only : compatm, compocn, coupling_mode, aoflux_code, mapconsd, mapconsf, mapfcopy + use med_internalstate_mod , only : compatm, compocn, compwav, coupling_mode, aoflux_code, mapconsd, mapconsf, mapfcopy use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_utils_mod , only : memcheck => med_memcheck use med_utils_mod , only : chkerr => med_utils_chkerr @@ -487,6 +487,7 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) use esmFlds , only : med_fldlist_GetaofluxfldList use esmFlds , only : med_fldList_type use med_map_mod , only : med_map_packed_field_create + use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk ! Arguments type(ESMF_GridComp) , intent(inout) :: gcomp @@ -565,7 +566,6 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) if (is_local%wrap%aoflux_grid == 'ogrid') then if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o) .and. & ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a)) then - call med_map_packed_field_create(destcomp=compatm, & flds_scalar_name=is_local%wrap%flds_scalar_name, & fieldsSrc=fldListMed_aoflux, & @@ -573,7 +573,6 @@ subroutine med_aofluxes_init_ogrid(gcomp, aoflux_in, aoflux_out, rc) FBDst=is_local%wrap%FBMed_aoflux_a, & packed_data=is_local%wrap%packed_data_aoflux_o2a(:), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if end if @@ -768,6 +767,7 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) type(ESMF_Mesh) :: xch_mesh real(r8), pointer :: dataptr(:) integer :: fieldcount + integer :: stp ! srcTermProcessing is declared inout and must have variable not constant type(ESMF_CoordSys_Flag) :: coordSys real(ESMF_KIND_R8) ,allocatable :: garea(:) character(len=*),parameter :: subname=' (med_aofluxes_init_xgrid) ' @@ -870,11 +870,12 @@ subroutine med_aofluxes_init_xgrid(gcomp, aoflux_in, aoflux_out, rc) regridmethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (trim(coupling_mode) == 'cesm') then + stp = 1 call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_bilinr, & - regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), rc=rc) + regridmethod=ESMF_REGRIDMETHOD_BILINEAR, dstMaskValues=(/0/), srcTermProcessing=stp, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRegridStore(field_a, field_x, routehandle=rh_agrid2xgrid_patch, & - regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), rc=rc) + regridmethod=ESMF_REGRIDMETHOD_PATCH, dstMaskValues=(/0/), srcTermProcessing=stp, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -948,6 +949,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) use ESMF , only : ESMF_GridComp use ESMF , only : ESMF_LogWrite, ESMF_LogMsg_Info, ESMF_SUCCESS use med_map_mod , only : med_map_field_packed, med_map_rh_is_created + use med_map_mod , only : med_map_routehandles_init + use med_methods_mod, only : FB_fldchk => med_methods_FB_fldchk + use med_methods_mod, only : FB_diagnose => med_methods_FB_diagnose #ifdef CESMCOUPLED use shr_flux_mod , only : flux_atmocn #else @@ -970,6 +974,9 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) real(r8), parameter :: p0 = 100000.0_r8 ! reference pressure in Pa real(r8), parameter :: rcp = 0.286_r8 ! gas constant of air / specific heat capacity at a constant pressure real(r8), parameter :: rdair = 287.058_r8 ! dry air gas constant in J/K/kg + integer :: maptype + type(ESMF_Field) :: field_src + type(ESMF_Field) :: field_dst character(*),parameter :: subName = '(med_aofluxes_update) ' !----------------------------------------------------------------------- @@ -1115,6 +1122,35 @@ subroutine med_aofluxes_update(gcomp, aoflux_in, aoflux_out, rc) end if + ! map taux and tauy from ocean to wave grid if stresses are needed on the wave grid + if ( FB_fldchk(is_local%wrap%FBExp(compwav), 'Fwxx_taux', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compwav), 'Fwxx_tauy', rc=rc)) then + maptype = mapconsf + if (.not. med_map_RH_is_created(is_local%wrap%RH(compocn,compwav,:), maptype, rc=rc)) then + call med_map_routehandles_init( compocn, compwav, & + FBSrc=is_local%wrap%FBImp(compocn,compocn), & + FBDst=is_local%wrap%FBImp(compwav,compwav), & + mapindex=maptype, RouteHandle=is_local%wrap%RH, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_o, 'Faox_taux', field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compwav), 'Fwxx_taux', field=field_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegrid(field_src, field_dst, & + routehandle=is_local%wrap%RH(compocn, compwav, maptype), & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBMed_aoflux_o, 'Faox_tauy', field=field_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(is_local%wrap%FBExp(compwav), 'Fwxx_tauy', field=field_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldRegrid(field_src, field_dst, & + routehandle=is_local%wrap%RH(compocn, compwav, maptype), & + termorderflag=ESMF_TERMORDER_SRCSEQ, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call t_stopf('MED:'//subname) end subroutine med_aofluxes_update diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 2f7c9f062..5f150a4b7 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -24,7 +24,8 @@ module med_phases_history_mod use med_time_mod , only : med_time_alarmInit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf - + use pio , only : file_desc_t + implicit none private @@ -59,6 +60,7 @@ module med_phases_history_mod ! Instantaneous history files datatypes/variables per component ! ---------------------------- type, public :: instfile_type + type(file_desc_t):: io_file logical :: write_inst character(CS) :: hist_option integer :: hist_n @@ -74,6 +76,7 @@ module med_phases_history_mod ! Time averaging history files ! ---------------------------- type, public :: avgfile_type + type(file_desc_t) :: io_file logical :: write_avg type(ESMF_FieldBundle) :: FBaccum_import ! field bundle for time averaging integer :: accumcnt_import ! field bundle accumulation counter @@ -93,6 +96,7 @@ module med_phases_history_mod ! Auxiliary history files ! ---------------------------- type, public :: auxfile_type + type(file_desc_t) :: io_file character(CS), allocatable :: flds(:) ! array of aux field names character(CS) :: auxname ! name for history file creation character(CL) :: histfile = '' ! current history file name @@ -155,6 +159,7 @@ subroutine med_phases_history_write(gcomp, rc) integer, intent(out) :: rc ! local variables + type(file_desc_t) :: io_file type(InternalState) :: is_local type(ESMF_Clock) :: mclock type(ESMF_Alarm) :: alarm @@ -292,22 +297,23 @@ subroutine med_phases_history_write(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, io_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Loop over whead/wdata phases do m = 1,2 if (m == 2) then - call med_io_enddef(hist_file) + call med_io_enddef(io_file) end if ! Write time values if (whead(m)) then call ESMF_ClockGet(mclock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_write_time(io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -315,49 +321,49 @@ subroutine med_phases_history_write(gcomp, rc) ! Write import and export field bundles if (is_local%wrap%comp_present(n)) then if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBexp(n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBexp(n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif end if ! Write mediator fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(n),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBFrac(n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBFrac(n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='Med_frac_'//trim(compname(n)), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write component mediator area field bundles - call med_io_write(hist_file, is_local%wrap%FBArea(n), whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBArea(n), whead(m), wdata(m), & is_local%wrap%nx(n), is_local%wrap%ny(n), nt=1, pre='MED_'//trim(compname(n)), rc=rc) end do ! Write atm/ocn fluxes and ocean albedoes if field bundles are created if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_alb_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_aoflux_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & + call med_io_write(io_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) end if end do ! end of loop over whead/wdata m index phases ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! end of write_now if-block @@ -463,43 +469,44 @@ subroutine med_phases_history_write_med(gcomp, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, instfiles(compmed)%io_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then call ESMF_ClockGet(instfiles(compmed)%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(instfiles(compmed)%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(instfiles(compmed)%io_file) + call med_io_write_time(instfiles(compmed)%io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write aoflux fields computed in mediator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_aoflux_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_aoflux_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_aoflux_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_aoflux_atm', rc=rc) end if ! If appropriate - write ocn albedos computed in mediator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), & is_local%wrap%nx(compocn), is_local%wrap%ny(compocn), nt=1, pre='Med_alb_ocn', rc=rc) end if if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_a,rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & + call med_io_write(instfiles(compmed)%io_file, is_local%wrap%FBMed_ocnalb_a, whead(m), wdata(m), & is_local%wrap%nx(compatm), is_local%wrap%ny(compatm), nt=1, pre='Med_alb_atm', rc=rc) end if end do ! end of loop over m ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(instfiles(compmed)%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! end of if-write_now block @@ -523,6 +530,7 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) integer , intent(out) :: rc ! local variables + type(file_desc_t) :: io_file type(InternalState) :: is_local type(ESMF_VM) :: vm type(ESMF_Clock) :: clock @@ -596,27 +604,28 @@ subroutine med_phases_history_write_lnd2glc(gcomp, fldbun, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, io_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data to history file do m = 1,2 if (whead(m)) then call ESMF_ClockGet(clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(io_file) + call med_io_write_time(io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call med_io_write(hist_file, fldbun, whead(m), wdata(m), is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & + call med_io_write(io_file, fldbun, whead(m), wdata(m), is_local%wrap%nx(complnd), is_local%wrap%ny(complnd), & nt=1, pre=trim(compname(complnd))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end do ! end of loop over m ! Close history file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine med_phases_history_write_lnd2glc @@ -749,17 +758,18 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, instfile%io_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then call ESMF_ClockGet(instfile%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(instfile%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(instfile%io_file) + call med_io_write_time(instfile%io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -767,19 +777,19 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) ny = is_local%wrap%ny(compid) ! Define/write import field bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBimp(compid,compid), whead(m), wdata(m), nx, ny, & + call med_io_write(instfile%io_file, is_local%wrap%FBimp(compid,compid), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/write import export bundle if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBexp(compid), whead(m), wdata(m), nx, ny, & + call med_io_write(instfile%io_file, is_local%wrap%FBexp(compid), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Define/Write mediator fractions if (ESMF_FieldBundleIsCreated(is_local%wrap%FBFrac(compid),rc=rc)) then - call med_io_write(hist_file, is_local%wrap%FBFrac(compid), whead(m), wdata(m), nx, ny, & + call med_io_write(instfile%io_file, is_local%wrap%FBFrac(compid), whead(m), wdata(m), nx, ny, & nt=1, pre='Med_frac_'//trim(compname(compid)), tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -787,7 +797,7 @@ subroutine med_phases_history_write_comp_inst(gcomp, compid, instfile, rc) end do ! end of loop over m ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(instfile%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -953,17 +963,18 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) ! Create history file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(hist_file, vm, clobber=.true.) + call med_io_wopen(hist_file, avgfile%io_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 ! Write time values if (whead(m)) then call ESMF_ClockGet(avgfile%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(avgfile%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_enddef(hist_file) - call med_io_write_time(time_val, time_bnds, nt=1, rc=rc) + call med_io_enddef(avgfile%io_file) + call med_io_write_time(avgfile%io_file, time_val, time_bnds, nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -972,7 +983,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) nx = is_local%wrap%nx(compid) ny = is_local%wrap%ny(compid) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(compid,compid),rc=rc)) then - call med_io_write(hist_file, avgfile%FBaccum_import, whead(m), wdata(m), nx, ny, & + call med_io_write(avgfile%io_file, avgfile%FBaccum_import, whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Imp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then @@ -981,7 +992,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) end if endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(compid),rc=rc)) then - call med_io_write(hist_file, avgfile%FBaccum_export, whead(m), wdata(m), nx, ny, & + call med_io_write(avgfile%io_file, avgfile%FBaccum_export, whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(compid))//'Exp', tilesize=hist_tilesize, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (wdata(m)) then @@ -993,7 +1004,7 @@ subroutine med_phases_history_write_comp_avg(gcomp, compid, avgfile, rc) end do ! end of loop over m ! Close file - call med_io_close(hist_file, vm, rc=rc) + call med_io_close(avgfile%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! end of write_now if-block @@ -1276,39 +1287,40 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) ! open file call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(auxcomp%files(nf)%histfile, vm, file_ind=nf, clobber=.true.) + call med_io_wopen(auxcomp%files(nf)%histfile, auxcomp%files(nf)%io_file, vm, rc, file_ind=nf, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define time variables call ESMF_ClockGet(auxcomp%files(nf)%clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, file_ind=nf, rc=rc) + call med_io_define_time(auxcomp%files(nf)%io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! define data variables with a time dimension (include the nt argument below) - call med_io_write(auxcomp%files(nf)%histfile, is_local%wrap%FBimp(compid,compid), & + call med_io_write(auxcomp%files(nf)%io_file, is_local%wrap%FBimp(compid,compid), & whead(1), wdata(1), nx, ny, nt=auxcomp%files(nf)%nt, & pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, & - file_ind=nf, use_float=.true., rc=rc) + use_float=.true., rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! end definition phase - call med_io_enddef(auxcomp%files(nf)%histfile, file_ind=nf) + call med_io_enddef(auxcomp%files(nf)%io_file) end if ! Write time variables for time nt - call med_io_write_time(time_val, time_bnds, nt=auxcomp%files(nf)%nt, file_ind=nf, rc=rc) + call med_io_write_time(auxcomp%files(nf)%io_file, time_val, time_bnds, nt=auxcomp%files(nf)%nt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Write data variables for time nt if (auxcomp%files(nf)%doavg) then - call med_io_write(auxcomp%files(nf)%histfile, auxcomp%files(nf)%FBaccum, whead(2), wdata(2), nx, ny, & - nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, file_ind=nf, rc=rc) + call med_io_write(auxcomp%files(nf)%io_file, auxcomp%files(nf)%FBaccum, whead(2), wdata(2), nx, ny, & + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_methods_FB_reset(auxcomp%files(nf)%FBaccum, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write(auxcomp%files(nf)%histfile, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, & - nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, file_ind=nf, rc=rc) + call med_io_write(auxcomp%files(nf)%io_file, is_local%wrap%FBimp(compid,compid), whead(2), wdata(2), nx, ny, & + nt=auxcomp%files(nf)%nt, pre=trim(compname(compid))//'Imp', flds=auxcomp%files(nf)%flds, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -1316,7 +1328,7 @@ subroutine med_phases_history_write_comp_aux(gcomp, compid, auxcomp, rc) if (auxcomp%files(nf)%nt == auxcomp%files(nf)%ntperfile) then call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_close(auxcomp%files(nf)%histfile, vm, file_ind=nf, rc=rc) + call med_io_close(auxcomp%files(nf)%io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return auxcomp%files(nf)%nt = 0 end if diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 9bb2b059f..98728a8a6 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -14,9 +14,10 @@ module med_phases_prep_atm_mod use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk use med_methods_mod , only : FB_getfldptr=> med_methods_FB_GetFldPtr + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_field_packed - use med_internalstate_mod , only : InternalState, maintask + use med_internalstate_mod , only : InternalState, maintask, logunit use med_internalstate_mod , only : compatm, compocn, compice, compname, coupling_mode use esmFlds , only : med_fldlist_GetfldListTo, med_fldlist_type use perf_mod , only : t_startf, t_stopf @@ -243,6 +244,10 @@ subroutine med_phases_prep_atm(gcomp, rc) end do end if + ! Check for nans in fields export to atm + call FB_check_for_nans(is_local%wrap%FBExp(compatm), maintask, logunit, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_prep_glc_mod.F90 b/mediator/med_phases_prep_glc_mod.F90 index 311d91c8a..920fb415e 100644 --- a/mediator/med_phases_prep_glc_mod.F90 +++ b/mediator/med_phases_prep_glc_mod.F90 @@ -34,6 +34,7 @@ module med_phases_prep_glc_mod use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_init => med_methods_FB_init + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_methods_mod , only : field_getdata2d => med_methods_Field_getdata2d use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d use med_utils_mod , only : chkerr => med_utils_ChkErr @@ -706,6 +707,12 @@ subroutine med_phases_prep_glc_avg(gcomp, rc) endif end if + ! Check for nans in fields export to glc + do ns = 1,is_local%wrap%num_icesheets + call FB_check_for_nans(is_local%wrap%FBExp(compglc(ns)), maintask, logunit, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif diff --git a/mediator/med_phases_prep_ice_mod.F90 b/mediator/med_phases_prep_ice_mod.F90 index 428f3afef..524313622 100644 --- a/mediator/med_phases_prep_ice_mod.F90 +++ b/mediator/med_phases_prep_ice_mod.F90 @@ -34,6 +34,7 @@ subroutine med_phases_prep_ice(gcomp, rc) use med_methods_mod , only : FB_fldchk => med_methods_FB_FldChk use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : FB_GetFldPtr => med_methods_FB_GetFldPtr + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_merge_mod , only : med_merge_auto use med_internalstate_mod , only : InternalState, logunit, maintask @@ -149,6 +150,10 @@ subroutine med_phases_prep_ice(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if + ! Check for nans in fields export to ice + call FB_check_for_nans(is_local%wrap%FBExp(compice), maintask, logunit, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif diff --git a/mediator/med_phases_prep_lnd_mod.F90 b/mediator/med_phases_prep_lnd_mod.F90 index 0c0bad212..4be8bb402 100644 --- a/mediator/med_phases_prep_lnd_mod.F90 +++ b/mediator/med_phases_prep_lnd_mod.F90 @@ -29,10 +29,11 @@ subroutine med_phases_prep_lnd(gcomp, rc) use ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND use esmFlds , only : med_fldList_GetFldListTo, med_fldList_type use med_methods_mod , only : fldbun_diagnose => med_methods_FB_diagnose + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use med_utils_mod , only : chkerr => med_utils_ChkErr use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : complnd, compatm - use med_internalstate_mod , only : InternalState, maintask + use med_internalstate_mod , only : InternalState, maintask, logunit use med_merge_mod , only : med_merge_auto use perf_mod , only : t_startf, t_stopf @@ -127,6 +128,10 @@ subroutine med_phases_prep_lnd(gcomp, rc) ! Set first call logical to false first_call = .false. + ! Check for nans in fields export to lnd + call FB_check_for_nans(is_local%wrap%FBExp(complnd), maintask, logunit, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end if diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 58c9ebc8b..373d92469 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -19,6 +19,7 @@ module med_phases_prep_ocn_mod use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use esmFlds , only : med_fldList_GetfldListTo, med_fldlist_type use med_internalstate_mod , only : compocn, compatm, compice, coupling_mode use perf_mod , only : t_startf, t_stopf @@ -295,6 +296,10 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compocn), is_local%wrap%FBExpAccumOcn, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check for nans in fields export to ocn + call FB_check_for_nans(is_local%wrap%FBExp(compocn), maintask, logunit, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! zero accumulator is_local%wrap%ExpAccumOcnCnt = 0 call FB_reset(is_local%wrap%FBExpAccumOcn, value=czero, rc=rc) @@ -372,7 +377,6 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) rc = ESMF_SUCCESS - call t_startf('MED:'//subname) if (dbug_flag > 20) then call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) end if @@ -383,6 +387,17 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check that the necessary export field is present + if ( .not. FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc) .and. & + .not. (FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', rc=rc) .and. & + FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', rc=rc))) then + return + end if + + call t_startf('MED:'//subname) + !--------------------------------------- ! Compute netsw for ocean !--------------------------------------- diff --git a/mediator/med_phases_prep_rof_mod.F90 b/mediator/med_phases_prep_rof_mod.F90 index 5d603a141..55b2dae82 100644 --- a/mediator/med_phases_prep_rof_mod.F90 +++ b/mediator/med_phases_prep_rof_mod.F90 @@ -23,6 +23,7 @@ module med_phases_prep_rof_mod use med_methods_mod , only : fldbun_reset => med_methods_FB_reset use med_methods_mod , only : fldbun_average => med_methods_FB_average use med_methods_mod , only : field_getdata1d => med_methods_Field_getdata1d + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use perf_mod , only : t_startf, t_stopf implicit none @@ -376,6 +377,10 @@ subroutine med_phases_prep_rof(gcomp, rc) FBfrac=is_local%wrap%FBFrac(comprof), FBin=FBlndAccum2rof_r, fldListTo=fldList, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Check for nans in fields export to rof + call FB_check_for_nans(is_local%wrap%FBExp(comprof), maintask, logunit, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then call fldbun_diagnose(is_local%wrap%FBExp(comprof), & string=trim(subname)//' FBexp(comprof) ', rc=rc) diff --git a/mediator/med_phases_prep_wav_mod.F90 b/mediator/med_phases_prep_wav_mod.F90 index 5fcb9ba7e..c690aa522 100644 --- a/mediator/med_phases_prep_wav_mod.F90 +++ b/mediator/med_phases_prep_wav_mod.F90 @@ -17,6 +17,7 @@ module med_phases_prep_wav_mod use med_methods_mod , only : FB_average => med_methods_FB_average use med_methods_mod , only : FB_copy => med_methods_FB_copy use med_methods_mod , only : FB_reset => med_methods_FB_reset + use med_methods_mod , only : FB_check_for_nans => med_methods_FB_check_for_nans use esmFlds , only : med_fldList_GetfldListTo use med_internalstate_mod , only : compwav use perf_mod , only : t_startf, t_stopf @@ -176,6 +177,10 @@ subroutine med_phases_prep_wav_avg(gcomp, rc) call FB_copy(is_local%wrap%FBExp(compwav), is_local%wrap%FBExpAccumWav, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! Check for nans in fields export to wav + call FB_check_for_nans(is_local%wrap%FBExp(compwav), maintask, logunit, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! zero accumulator is_local%wrap%ExpAccumWavCnt = 0 call FB_reset(is_local%wrap%FBExpAccumWav, value=czero, rc=rc) diff --git a/mediator/med_phases_restart_mod.F90 b/mediator/med_phases_restart_mod.F90 index 6bf5f3466..a225ff97c 100644 --- a/mediator/med_phases_restart_mod.F90 +++ b/mediator/med_phases_restart_mod.F90 @@ -13,7 +13,7 @@ module med_phases_restart_mod use med_phases_prep_glc_mod , only : FBlndAccum2glc_l, lndAccum2glc_cnt use med_phases_prep_glc_mod , only : FBocnAccum2glc_o, ocnAccum2glc_cnt use med_phases_prep_rof_mod , only : FBlndAccum2rof_l, lndAccum2rof_cnt - + use pio , only : file_desc_t implicit none private @@ -143,6 +143,7 @@ subroutine med_phases_restart_write(gcomp, rc) integer, intent(out) :: rc ! local variables + type(file_desc_t) :: io_file type(ESMF_VM) :: vm type(ESMF_Clock) :: clock type(ESMF_Time) :: starttime @@ -309,11 +310,12 @@ subroutine med_phases_restart_write(gcomp, rc) call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_wopen(restart_file, vm, clobber=.true.) + call med_io_wopen(restart_file, io_file, vm, rc, clobber=.true.) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do m = 1,2 if (m == 2) then - call med_io_enddef(restart_file) + call med_io_enddef(io_file) end if tbnds = days_since @@ -321,23 +323,23 @@ subroutine med_phases_restart_write(gcomp, rc) if (whead(m)) then call ESMF_ClockGet(clock, calendar=calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_define_time(time_units, calendar, rc=rc) + call med_io_define_time(io_file, time_units, calendar, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else - call med_io_write_time(days_since, tbnds=(/days_since,days_since/), nt=1, rc=rc) + call med_io_write_time(io_file, days_since, tbnds=(/days_since,days_since/), nt=1, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Write out next ymd/tod in place of curr ymd/tod because the ! restart represents the time at end of the current timestep ! and that is where we want to start the next run. - call med_io_write(restart_file, start_ymd, 'start_ymd', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, start_ymd, 'start_ymd', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, start_tod, 'start_tod', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, start_tod, 'start_tod', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, next_ymd , 'curr_ymd' , whead(m), wdata(m), rc=rc) + call med_io_write(io_file, next_ymd , 'curr_ymd' , whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, next_tod , 'curr_tod' , whead(m), wdata(m), rc=rc) + call med_io_write(io_file, next_tod , 'curr_tod' , whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps @@ -346,19 +348,19 @@ subroutine med_phases_restart_write(gcomp, rc) ny = is_local%wrap%ny(n) ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_io_write(restart_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBimp(n,n), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(n))//'Imp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Write export field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - call med_io_write(restart_file, is_local%wrap%FBexp(n), whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBexp(n), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(n))//'Exp', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Write fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then - call med_io_write(restart_file, is_local%wrap%FBfrac(n), whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBfrac(n), whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(n))//'Frac', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -369,10 +371,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumOcn)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, is_local%wrap%FBExpAccumOcn, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBExpAccumOcn, whead(m), wdata(m), nx, ny, & nt=1, pre='ocnExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, is_local%wrap%ExpAccumOcnCnt, 'ocnExpAccum_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -380,10 +382,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccumWav)) then nx = is_local%wrap%nx(compwav) ny = is_local%wrap%ny(compwav) - call med_io_write(restart_file, is_local%wrap%FBExpAccumWav, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBExpAccumWav, whead(m), wdata(m), nx, ny, & nt=1, pre='wavExpAccum', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, is_local%wrap%ExpAccumWavCnt, 'wavExpAccum_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, is_local%wrap%ExpAccumWavCnt, 'wavExpAccum_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -391,10 +393,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBlndAccum2rof_l)) then nx = is_local%wrap%nx(complnd) ny = is_local%wrap%ny(complnd) - call med_io_write(restart_file, FBlndAccum2rof_l, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, FBlndAccum2rof_l, whead(m), wdata(m), nx, ny, & nt=1, pre='lndImpAccum2rof', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, lndAccum2rof_cnt, 'lndImpAccum2rof_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, lndAccum2rof_cnt, 'lndImpAccum2rof_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -402,10 +404,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBlndAccum2glc_l)) then nx = is_local%wrap%nx(complnd) ny = is_local%wrap%ny(complnd) - call med_io_write(restart_file, FBlndAccum2glc_l, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, FBlndAccum2glc_l, whead(m), wdata(m), nx, ny, & nt=1, pre='lndImpAccum2glc', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, lndAccum2glc_cnt, 'lndImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, lndAccum2glc_cnt, 'lndImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -413,10 +415,10 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(FBocnAccum2glc_o)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, FBocnAccum2glc_o, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, FBocnAccum2glc_o, whead(m), wdata(m), nx, ny, & nt=1, pre='ocnImpAccum2glc_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) + call med_io_write(io_file, ocnAccum2glc_cnt, 'ocnImpAccum2glc_cnt', whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -424,7 +426,7 @@ subroutine med_phases_restart_write(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then nx = is_local%wrap%nx(compocn) ny = is_local%wrap%ny(compocn) - call med_io_write(restart_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), nx, ny, & + call med_io_write(io_file, is_local%wrap%FBMed_ocnalb_o, whead(m), wdata(m), nx, ny, & nt=1, pre='MedOcnAlb_o', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -437,11 +439,11 @@ subroutine med_phases_restart_write(gcomp, rc) if (auxcomp(nc)%files(nf)%doavg .and. auxcomp(nc)%files(nf)%accumcnt > 0) then nx = is_local%wrap%nx(nc) ny = is_local%wrap%ny(nc) - call med_io_write(restart_file, auxcomp(nc)%files(nf)%FBaccum, & + call med_io_write(io_file, auxcomp(nc)%files(nf)%FBaccum, & whead(m), wdata(m), nx, ny, & nt=1, pre=trim(compname(nc))//trim(auxcomp(nc)%files(nf)%auxname), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_io_write(restart_file, auxcomp(nc)%files(nf)%accumcnt, & + call med_io_write(io_file, auxcomp(nc)%files(nf)%accumcnt, & trim(compname(nc))//trim(auxcomp(nc)%files(nf)%auxname)//'_accumcnt', & whead(m), wdata(m), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -452,7 +454,7 @@ subroutine med_phases_restart_write(gcomp, rc) enddo ! end of whead/wdata loop ! Close file - call med_io_close(restart_file, vm, rc=rc) + call med_io_close(io_file, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif From 5f27114bdd2808c281c7b884fa084977a098d81b Mon Sep 17 00:00:00 2001 From: James Edwards Date: Fri, 23 Jun 2023 15:27:58 -0600 Subject: [PATCH 15/36] both =0 is not an error --- mediator/med_methods_mod.F90 | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 54fe20ec1..649c9c511 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -1354,7 +1354,10 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) call med_methods_Field_GetFldPtr(lfield, fldptr1=dataptro1, fldptr2=dataptro2, rank=lranko, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (lranki == 1 .and. lranko == 1) then + if (lranki == 0 .and. lranko == 0) then + ! do nothing + call ESMF_LogWrite(trim(subname)//": Both ranki and ranko are 0", ESMF_LOGMSG_INFO) + elseif (lranki == 1 .and. lranko == 1) then if (.not.med_methods_FieldPtr_Compare(dataPtro1, dataPtri1, subname, rc)) then call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", ESMF_LOGMSG_ERROR) @@ -1397,7 +1400,7 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) else write(msgString,'(a,2i8)') trim(subname)//": ranki, ranko = ",lranki,lranko - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_ERROR) call ESMF_LogWrite(trim(subname)//": ERROR ranki ranko not supported "//trim(lfieldnamelist(n)), & ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE From 9923d6d17700daf502d9a016138bf8eb8aad7f09 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 7 Jul 2023 12:06:18 -0400 Subject: [PATCH 16/36] use evap from atm (#96) * atm sends evap directly --- mediator/esmFldsExchange_nems_mod.F90 | 6 +++--- mediator/med_phases_prep_ocn_mod.F90 | 5 ++--- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index e62863a5d..bbdf41568 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -453,13 +453,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: evaporation water flux (custom merge in med_phases_prep_ocn) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compatm, 'Faxa_lat') + call addfld_from(compatm, 'Faxa_evap') call addfld_to(compocn, 'Faxa_evap') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_evap', rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lat' , rc=rc)) then - call addmap_from(compatm, 'Faxa_lat', compocn, mapconsf_aofrac, 'aofrac', 'unset') + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_evap' , rc=rc)) then + call addmap_from(compatm, 'Faxa_evap', compocn, mapconsf_aofrac, 'aofrac', 'unset') end if end if else if (trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux') then diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 373d92469..27e1d55ef 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -643,7 +643,6 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) real(R8), pointer :: ifrac(:) real(R8), pointer :: ofrac(:) integer :: lsize - real(R8) , parameter :: const_lhvap = 2.501e6_R8 ! latent heat of evaporation ~ J/kg character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_nems)' !--------------------------------------- @@ -672,9 +671,9 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) if (trim(coupling_mode) == 'nems_orig' .or. & trim(coupling_mode) == 'nems_frac' .or. & trim(coupling_mode) == 'nems_frac_aoflux_sbs') then - customwgt(:) = -ofrac(:) / const_lhvap + customwgt(:) = -ofrac(:) call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_evap', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_lat' , wgtA=customwgt, rc=rc) + FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_evap' , wgtA=customwgt, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return customwgt(:) = -ofrac(:) From 6ef50f318bf0cbb559ebecc6f26731f02a58057e Mon Sep 17 00:00:00 2001 From: James Edwards Date: Mon, 24 Jul 2023 14:27:13 -0600 Subject: [PATCH 17/36] add surface flux rollover --- cesm/flux_atmocn/shr_flux_mod.F90 | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/cesm/flux_atmocn/shr_flux_mod.F90 b/cesm/flux_atmocn/shr_flux_mod.F90 index 9ec558737..741447d93 100644 --- a/cesm/flux_atmocn/shr_flux_mod.F90 +++ b/cesm/flux_atmocn/shr_flux_mod.F90 @@ -259,7 +259,17 @@ SUBROUTINE flux_atmOcn(logunit, nMax ,zbot ,ubot ,vbot ,thbot , & qsat(Tk) = 640380.0_R8 / exp(5107.4_R8/Tk) - cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + + ! Large and Yeager 2009 + cdn(Umps) = 0.0027_R8 / min(33.0000_R8,Umps) + 0.000142_R8 + & + 0.0000764_R8 * min(33.0000_R8,Umps) - 3.14807e-13_r8 * min(33.0000_R8,Umps)**6 + ! Capped Large and Pond by wind + ! cdn(Umps) = 0.0027_R8 / min(30.0_R8,Umps) + 0.000142_R8 + 0.0000764_R8 * min(30.0_R8,Umps) + ! Capped Large and Pond by Cd + ! cdn(Umps) = min(0.0025_R8, (0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps )) + ! Large and Pond + ! cdn(Umps) = 0.0027_R8 / Umps + 0.000142_R8 + 0.0000764_R8 * Umps + psimhu(xd) = log((1.0_R8+xd*(2.0_R8+xd))*(1.0_R8+xd*xd)/8.0_R8) - 2.0_R8*atan(xd) + 1.571_R8 psixhu(xd) = 2.0_R8 * log((1.0_R8 + xd*xd)/2.0_R8) From 7b7d232bb7cd28a0cef8ed57c252c5d02e0b7f44 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 27 Jul 2023 10:21:28 -0400 Subject: [PATCH 18/36] remove TODOs --- mediator/med_phases_ocnalb_mod.F90 | 7 ------- 1 file changed, 7 deletions(-) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index cd242bb7e..636ce16e6 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -414,7 +414,6 @@ subroutine med_phases_ocnalb_run(gcomp, rc) scalar_value=nextsw_cday, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else - ! TODO: Clock is advanced at end of run phase; use nextTime call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday, rc=rc) @@ -422,11 +421,6 @@ subroutine med_phases_ocnalb_run(gcomp, rc) end if end if - !TODO: is there a reason to get this each time instead of at init? - !call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, rc=rc) - !if (chkerr(rc,__LINE__,u_FILE_u)) return - !read(cvalue,*) flux_albav - ! Get orbital values call med_phases_ocnalb_orbital_update(clock, logunit, iam==0, eccen, obliqr, lambm0, mvelpp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -462,7 +456,6 @@ subroutine med_phases_ocnalb_run(gcomp, rc) (.150_r8*(cosz - 0.100_r8 ) * & (cosz - 0.500_r8 ) * (cosz - 1.000_r8 ) ) if (use_min_albedo) then - !TODO: why does fv3atm use albdif here and not albdir ? ocnalb%anidr(n) = max (ocnalb%anidr(n), min_albedo) end if ocnalb%avsdr(n) = ocnalb%anidr(n) From 4e09c3a8af0bf6af4fd69997b4f2ad16ed61a253 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 27 Jul 2023 11:39:06 -0400 Subject: [PATCH 19/36] use log_error, not log_info --- mediator/med_io_mod.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 82e0b04d0..49c1f3d37 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -75,7 +75,7 @@ module med_io_mod character(*),parameter :: prefix = "med_io_" character(*),parameter :: modName = "(med_io_mod) " character(*),parameter :: version = "cmeps0" - + integer :: pio_iotype integer :: pio_ioformat type(iosystem_desc_t), pointer :: io_subsystem @@ -1739,7 +1739,7 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) deallocate(minIndexPTile, maxIndexPTile) else if(maintask) write(logunit,*) trim(subname),' ERROR: '//trim(name1)//' is not present, aborting ' - call ESMF_LogWrite(trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ', ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE end if ! end if rcode check From 9bcf425b42a369f31257e50335caec3640db3338 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Thu, 27 Jul 2023 13:06:12 -0600 Subject: [PATCH 20/36] remove TODO --- mediator/med_phases_prep_ocn_mod.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index e46763499..8cae24f3e 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -528,7 +528,6 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) ifracr_scaled = ifracr(n) / (frac_sum) ofracr_scaled = ofracr(n) / (frac_sum) endif - !TODO: ? fix this if (.not.import_swpen_by_bands) then Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) end if From 0dbe67ed6f32066d1929f751c1e92dcbc7c2aed5 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Fri, 28 Jul 2023 09:43:13 -0600 Subject: [PATCH 21/36] fix the x case --- mediator/med_internalstate_mod.F90 | 1 - mediator/med_map_mod.F90 | 22 +++++++++++----------- 2 files changed, 11 insertions(+), 12 deletions(-) diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index c5497293f..66e2eb1db 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -262,7 +262,6 @@ subroutine med_internalstate_init(gcomp, rc) end do end if is_local%wrap%num_icesheets = num_icesheets - call NUOPC_CompAttributeGet(gcomp, name='mediator_present', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 18752dc2f..9f514a4cb 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -111,7 +111,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun type(ESMF_Mesh) :: mesh_dst type(med_fldlist_type), pointer :: FldListFr type(med_fldlist_entry_type), pointer :: fldptr - character(len=*), parameter :: subname=' (module_med_map: RouteHandles_init) ' + character(len=*), parameter :: subname=' (med_map_mod: RouteHandles_init) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -304,7 +304,7 @@ subroutine med_map_routehandles_initfrom_fieldbundle(n1, n2, FBsrc, FBdst, mapin ! local variables type(ESMF_Field) :: fldsrc type(ESMF_Field) :: flddst - character(len=*), parameter :: subname=' (module_MED_map:med_map_routehandles_initfrom_fieldbundle) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_routehandles_initfrom_fieldbundle) ' !--------------------------------------------- rc = ESMF_SUCCESS @@ -653,7 +653,7 @@ logical function med_map_RH_is_created_RH3d(RHs,n1,n2,mapindex,rc) integer , intent(out) :: rc ! local variables - character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH3d) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_RH_is_created_RH3d) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -678,7 +678,7 @@ logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) ! local variables integer :: rc1, rc2 logical :: mapexists - character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH1d) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_RH_is_created_RH1d) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -718,7 +718,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & use ESMF use esmFlds , only : med_fldList_entry_type, med_fldList_getNumFlds, med_fldList_type use esmFlds , only : med_fld_getFldInfo - use med_internalstate_mod , only : compname, mapnames + use med_internalstate_mod , only : compname, mapnames, rof_name use med_internalstate_mod , only : packed_data_type, nmappers ! input/output variables @@ -750,7 +750,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & character(CL), allocatable :: fieldNameList(:) character(CS) :: mapnorm_mapindex character(len=CX) :: tmpstr - character(len=*), parameter :: subname=' (module_MED_map:med_packed_field_create) ' + character(len=*), parameter :: subname=' (med_map_mod:med_packed_field_create) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -817,7 +817,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & //', mapnorm '//trim(mapnorm_mapindex) & //' '//trim(fieldnamelist(nf)) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - else + else if(rof_name .ne. 'xrof' .and. compname(destcomp) .ne. 'ocn') then if (mapnorm_mapindex /= packed_data(mapindex)%mapnorm) then write(tmpstr,*)'Map type '//trim(mapnames(mapindex)) & //', destcomp '//trim(compname(destcomp)) & @@ -953,7 +953,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d type(ESMF_Field), pointer :: fieldlist_dst(:) real(r8), pointer :: data_norm(:) real(r8), pointer :: data_dst(:,:) - character(len=*), parameter :: subname=' (module_MED_map:med_map_field_packed) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -1165,7 +1165,7 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: lsize_src integer :: lsize_dst - character(len=*), parameter :: subname=' (module_MED_map:med_map_field_normalized) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_field_normalized) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -1278,7 +1278,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r logical :: checkflag = .false. character(len=CS) :: lfldname real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 - character(len=*), parameter :: subname='(module_MED_map:med_map_field) ' + character(len=*), parameter :: subname='(med_map_mod:med_map_field) ' !--------------------------------------------------- rc = ESMF_SUCCESS @@ -1381,7 +1381,7 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) integer :: spatialDim real(r8), parameter :: deg2rad = shr_const_pi/180.0_R8 ! deg to rads logical :: first_time = .true. - character(len=*), parameter :: subname=' (module_MED_map:med_map_uv_cart3d) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_uv_cart3d) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS From 427ebebbf93e711abe6a24b7540acbb25f52a3a3 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Sat, 29 Jul 2023 09:57:44 -0400 Subject: [PATCH 22/36] add missing return error check for FldsExchange --- mediator/med.F90 | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/mediator/med.F90 b/mediator/med.F90 index 346a98da9..3efc94a6e 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -661,7 +661,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use esmFlds, only : med_fldlist_init1, med_fld_GetFldInfo, med_fldList_entry_type use med_phases_history_mod, only : med_phases_history_init - use med_methods_mod , only : mediator_checkfornans + use med_methods_mod , only : mediator_checkfornans ! input/output variables type(ESMF_GridComp) :: gcomp @@ -921,7 +921,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(isPresent .and. isSet) then - read(cvalue, *) mediator_checkfornans + read(cvalue, *) mediator_checkfornans else mediator_checkfornans = .false. endif @@ -1804,7 +1804,8 @@ subroutine DataInitialize(gcomp, rc) call esmFldsExchange_cesm(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode(1:4)) == 'nems') then - call esmFldsExchange_nems(gcomp, phase='initialize', rc=rc) + call esmFldsExchange_nems(gcomp, phase='initialize', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From 957a0fb588367f0abc9d6a2c34a1ba4182cfaefe Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 31 Jul 2023 16:35:27 +0000 Subject: [PATCH 23/36] address comments --- mediator/med_io_mod.F90 | 2 +- mediator/med_phases_ocnalb_mod.F90 | 9 ++------- 2 files changed, 3 insertions(+), 8 deletions(-) diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 49c1f3d37..265a5ddda 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -1738,7 +1738,7 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) deallocate(minIndexPTile, maxIndexPTile) else - if(maintask) write(logunit,*) trim(subname),' ERROR: '//trim(name1)//' is not present, aborting ' + if(maintask) write(logunit,'(a)') trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ' call ESMF_LogWrite(trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE end if ! end if rcode check diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 636ce16e6..31bd211f0 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -329,9 +329,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! Determine if ocnalb data type will be initialized - and if not return if (first_call) then - if ((ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & - ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) .or. & - ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then ocnalb%created = .true. else ocnalb%created = .false. @@ -495,10 +493,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ofrad(:) = ofrac(:) endif - ! Write mediator ocnalb history if aofluxes are not active - if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc) .and. & - .not. ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & - .not. ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ESMF_ClockIsCreated(dclock)) then From 9b2942ac728aad88054f6718d09024c69241fd70 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Mon, 31 Jul 2023 11:47:16 -0600 Subject: [PATCH 24/36] alternate solution for X case --- mediator/esmFldsExchange_cesm_mod.F90 | 4 ++-- mediator/med_map_mod.F90 | 3 ++- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 13811aec9..a2c4fe435 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2158,7 +2158,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! liquid from river and possibly flood from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' , rc=rc)) then if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofl', compocn, mapconsd, 'none', 'unset') + call addmap_from(comprof, 'Forr_rofl', compocn, mapconsd, 'one', 'unset') else call addmap_from(comprof, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) end if @@ -2182,7 +2182,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! ice from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi' , rc=rc)) then if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofi', compocn, mapconsd, 'none', 'unset') + call addmap_from(comprof, 'Forr_rofi', compocn, mapconsd, 'one', 'unset') else call addmap_from(comprof, 'Forr_rofi', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) end if diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 9f514a4cb..82544370d 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -817,7 +817,8 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & //', mapnorm '//trim(mapnorm_mapindex) & //' '//trim(fieldnamelist(nf)) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - else if(rof_name .ne. 'xrof' .and. compname(destcomp) .ne. 'ocn') then + else + !if(rof_name .ne. 'xrof' .and. compname(destcomp) .ne. 'ocn') then if (mapnorm_mapindex /= packed_data(mapindex)%mapnorm) then write(tmpstr,*)'Map type '//trim(mapnames(mapindex)) & //', destcomp '//trim(compname(destcomp)) & From 3d8e23331f18c90b8945013ac45711ac63f741c7 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 1 Aug 2023 09:16:27 -0600 Subject: [PATCH 25/36] update esmf and pio externals used in srt github workflow --- .github/workflows/srt.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 39526be99..e478c355a 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -26,8 +26,8 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include " LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.4.0 - PARALLELIO_VERSION: pio2_5_10 + ESMF_VERSION: v8.5.0 + PARALLELIO_VERSION: pio2_6_0 CIME_MODEL: cesm CIME_DRIVER: nuopc GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} From 896b6a15158637ee633c6b50ab4e5816b9d5cd00 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 1 Aug 2023 10:16:21 -0600 Subject: [PATCH 26/36] debug workflow --- .github/workflows/srt.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index e478c355a..4eb158870 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -175,6 +175,6 @@ jobs: popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 From 5945f786aa767d4d897053ce5239b47f28176929 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 1 Aug 2023 11:17:04 -0600 Subject: [PATCH 27/36] try adding SRCROOT env variable --- .github/workflows/srt.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 4eb158870..34252cb63 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -153,6 +153,7 @@ jobs: mkdir -p $HOME/cesm/scratch mkdir -p $HOME/cesm/inputdata pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests + export SRCROOT=$GITHUB_WORKSPACE/cesm/ export CIME_TEST_PLATFORM=ubuntu-latest export PIO_INCDIR=$HOME/pio/include export PIO_LIBDIR=$HOME/pio/lib From 8282ebc1791fd43c7896d9806cabaa62817bcbe5 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 1 Aug 2023 17:06:07 -0600 Subject: [PATCH 28/36] remove rof_name --- mediator/med_map_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 82544370d..3ab205bd6 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -718,7 +718,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & use ESMF use esmFlds , only : med_fldList_entry_type, med_fldList_getNumFlds, med_fldList_type use esmFlds , only : med_fld_getFldInfo - use med_internalstate_mod , only : compname, mapnames, rof_name + use med_internalstate_mod , only : compname, mapnames use med_internalstate_mod , only : packed_data_type, nmappers ! input/output variables From ec41c2fc333d74691bf7b302e7f53bda0b517367 Mon Sep 17 00:00:00 2001 From: "denise.worthen" Date: Mon, 7 Aug 2023 08:07:13 -0400 Subject: [PATCH 29/36] revert changes for swnet in prep_ocn --- mediator/med_phases_prep_ocn_mod.F90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 8cae24f3e..7a71f7e90 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -482,6 +482,8 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrad' , ofracr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (FB_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', rc=rc)) then import_swpen_by_bands = .true. call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdr', Fioi_swpen_vdr, rc=rc) @@ -494,8 +496,6 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else import_swpen_by_bands = .false. - call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if ( FB_fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr',rc=rc)) then @@ -528,9 +528,8 @@ subroutine med_phases_prep_ocn_custom(gcomp, rc) ifracr_scaled = ifracr(n) / (frac_sum) ofracr_scaled = ofracr(n) / (frac_sum) endif - if (.not.import_swpen_by_bands) then - Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) - end if + Foxx_swnet(n) = ofracr_scaled*(fswabsv + fswabsi) + ifrac_scaled*Fioi_swpen(n) + if (export_swnet_afracr) then Foxx_swnet_afracr(n) = ofracr_scaled*(fswabsv + fswabsi) end if From 72ee0b2fa13b125e49cfca3db1ec7ee557d30a28 Mon Sep 17 00:00:00 2001 From: Jian Sun Date: Tue, 8 Aug 2023 09:08:18 -0600 Subject: [PATCH 30/36] Add a new XML variable to apply the MPI wrapper script more generically. --- cime_config/config_component.xml | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index 0137597af..a329be743 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -802,6 +802,16 @@ If set will compile and submit with this gpu offload method enabled + + char + + + build_def + env_build.xml + If set will attach this script to the MPI run command, mapping + different MPI ranks to different GPUs within the same compute node + + logical TRUE,FALSE From dabfaa94a5b1bdcbc40bb23fc1122b6cb7ba3dbc Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Mon, 14 Aug 2023 16:19:48 -0400 Subject: [PATCH 31/36] modify cmeps for correct signs from ATM (#97) * account for taux,y sign change from atm * remove custom merge related solely to need to change sign * change sign for faxa_sen to match ATM export * use evap from atm directly --- mediator/esmFldsExchange_nems_mod.F90 | 14 +++++++++++--- mediator/med.F90 | 6 +++--- mediator/med_phases_prep_atm_mod.F90 | 5 ++--- mediator/med_phases_prep_ocn_mod.F90 | 28 ++------------------------- 4 files changed, 18 insertions(+), 35 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index bbdf41568..74a866d5f 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -394,7 +394,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac' .or. & trim(coupling_mode) == 'nems_frac_aoflux_sbs') then - ! to ocn: merge surface stress (custom merge calculation in med_phases_prep_ocn) + ! to ocn: merge surface stress allocate(oflds(2)) allocate(aflds(2)) allocate(iflds(2)) @@ -415,6 +415,10 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(compatm,compatm), trim(aflds(n)), rc=rc)) then call addmap_from(compice, trim(iflds(n)), compocn, mapfcopy, 'unset', 'unset') call addmap_from(compatm, trim(aflds(n)), compocn, mapconsf_aofrac, 'aofrac', 'unset') + call addmrg_to(compocn, trim(oflds(n)), & + mrg_from=compice, mrg_fld=trim(iflds(n)), mrg_type='merge', mrg_fracname='ifrac') + call addmrg_to(compocn, trim(oflds(n)), & + mrg_from=compatm, mrg_fld=trim(aflds(n)), mrg_type='merge', mrg_fracname='ofrac') end if end if end do @@ -437,7 +441,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end if end if - ! to ocn: merged sensible heat flux (custom merge in med_phases_prep_ocn) + ! to ocn: sensible heat flux if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then call addfld_from(compatm, 'Faxa_sen') @@ -447,10 +451,12 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_sen', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_sen', rc=rc)) then call addmap_from(compatm, 'Faxa_sen', compocn, mapconsf_aofrac, 'aofrac', 'unset') + call addmrg_to(compocn, 'Faxa_sen', & + mrg_from=compatm, mrg_fld='Faxa_sen', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if - ! to ocn: evaporation water flux (custom merge in med_phases_prep_ocn) + ! to ocn: evaporation water flux if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then call addfld_from(compatm, 'Faxa_evap') @@ -460,6 +466,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_evap', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_evap' , rc=rc)) then call addmap_from(compatm, 'Faxa_evap', compocn, mapconsf_aofrac, 'aofrac', 'unset') + call addmrg_to(compocn, 'Faxa_evap', & + mrg_from=compatm, mrg_fld='Faxa_evap', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if else if (trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux') then diff --git a/mediator/med.F90 b/mediator/med.F90 index 56fcb7621..c8da4dbb9 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -661,7 +661,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd use esmFlds, only : med_fldlist_init1, med_fld_GetFldInfo, med_fldList_entry_type use med_phases_history_mod, only : med_phases_history_init - use med_methods_mod , only : mediator_checkfornans + use med_methods_mod , only : mediator_checkfornans ! input/output variables type(ESMF_GridComp) :: gcomp @@ -921,7 +921,7 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name="check_for_nans", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if(isPresent .and. isSet) then - read(cvalue, *) mediator_checkfornans + read(cvalue, *) mediator_checkfornans else mediator_checkfornans = .false. endif @@ -1942,7 +1942,7 @@ subroutine DataInitialize(gcomp, rc) ! Initialize ocean albedos (this is needed for cesm and hafs) !---------------------------------------------------------- - if (trim(coupling_mode(1:5)) /= 'nems_') then + if (trim(coupling_mode(1:5)) == 'cesm_') then if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compatm)) then call med_phases_ocnalb_run(gcomp, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 98728a8a6..3ce87e874 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -115,7 +115,6 @@ subroutine med_phases_prep_atm(gcomp, rc) !--- map atm/ocn fluxes from ocn to atm grid if appropriate !--------------------------------------- if (trim(coupling_mode) == 'cesm' .or. & - trim(coupling_mode) == 'hafs' .or. & trim(coupling_mode) == 'nems_frac_aoflux' .or. & trim(coupling_mode) == 'nems_frac_aoflux_sbs') then if (is_local%wrap%aoflux_grid == 'ogrid') then @@ -134,8 +133,7 @@ subroutine med_phases_prep_atm(gcomp, rc) !--------------------------------------- fldList => med_fldList_GetfldListTo(compatm) if (trim(coupling_mode) == 'cesm' .or. & - trim(coupling_mode) == 'nems_frac_aoflux' .or. & - trim(coupling_mode) == 'hafs') then + trim(coupling_mode) == 'nems_frac_aoflux') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compatm), & is_local%wrap%FBExp(compatm), & @@ -147,6 +145,7 @@ subroutine med_phases_prep_atm(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac' .or. & trim(coupling_mode) == 'nems_orig' .or. & + trim(coupling_mode) == 'hafs' .or. & trim(coupling_mode) == 'nems_frac_aoflux_sbs') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compatm), & diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 27e1d55ef..33c12e6e6 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -119,8 +119,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) ! auto merges to ocn if ( trim(coupling_mode) == 'cesm' .or. & trim(coupling_mode) == 'nems_orig_data' .or. & - trim(coupling_mode) == 'nems_frac_aoflux' .or. & - trim(coupling_mode) == 'hafs') then + trim(coupling_mode) == 'nems_frac_aoflux') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compocn), & is_local%wrap%FBExp(compocn), & @@ -131,6 +130,7 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac' .or. & trim(coupling_mode) == 'nems_orig' .or. & + trim(coupling_mode) == 'hafs' .or. & trim(coupling_mode) == 'nems_frac_aoflux_sbs') then call med_merge_auto(& is_local%wrap%med_coupling_active(:,compocn), & @@ -668,30 +668,6 @@ subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) lsize = size(ofrac) allocate(customwgt(lsize)) - if (trim(coupling_mode) == 'nems_orig' .or. & - trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_frac_aoflux_sbs') then - customwgt(:) = -ofrac(:) - call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_evap', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_evap' , wgtA=customwgt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - customwgt(:) = -ofrac(:) - call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_sen', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_sen', wgtA=customwgt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - customwgt(:) = -ofrac(:) - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_taux', & - FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_taux', wgtA=ifrac, & - FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_taux', wgtB=customwgt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_tauy', & - FBinA=is_local%wrap%FBImp(compice,compocn), fnameA='Fioi_tauy', wgtA=ifrac, & - FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_tauy', wgtB=customwgt, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - ! netsw_for_ocn = [downsw_from_atm*(1-ice_fraction)*(1-ocn_albedo)] + [pensw_from_ice*(ice_fraction)] customwgt(:) = ofrac(:) * (1.0_R8 - 0.06_R8) call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', & From a6071c17480e86b59f993064596da88a14c5d3c9 Mon Sep 17 00:00:00 2001 From: Chris Fischer Date: Mon, 21 Aug 2023 16:03:43 -0600 Subject: [PATCH 32/36] Add length to logic format. --- mediator/med_phases_ocnalb_mod.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index 31bd211f0..304d0c7fd 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -242,7 +242,7 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) end if end if - write(msg,'(A,l)') trim(subname)//': use_nextswcday setting is ',use_nextswcday + write(msg,'(A,l1)') trim(subname)//': use_nextswcday setting is ',use_nextswcday call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) if (dbug_flag > 5) then From c24fb5999efafffaa393b886e21780ab7fd3aa08 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Fri, 25 Aug 2023 14:32:31 -0400 Subject: [PATCH 33/36] implement ocean albedo calculation (#92) * flux_albav moved to _init * use_nextswcday for using clock instead of scalar field * min_albedo for setting min albedo used max(min_albedo,....) * giving a min_albedo value sets logical use_min_albedo, otherwise false and min_albedo=0 * set mean albdif and albdir via config. If not present, defaults to current values --- .github/workflows/srt.yml | 11 +- cime_config/config_component.xml | 42 +++++- cime_config/namelist_definition_drv.xml | 2 +- mediator/esmFldsExchange_cesm_mod.F90 | 4 +- mediator/esmFldsExchange_nems_mod.F90 | 20 ++- mediator/med.F90 | 13 +- mediator/med_internalstate_mod.F90 | 1 - mediator/med_io_mod.F90 | 6 +- mediator/med_map_mod.F90 | 22 +-- mediator/med_methods_mod.F90 | 7 +- mediator/med_phases_history_mod.F90 | 2 +- mediator/med_phases_ocnalb_mod.F90 | 169 +++++++++++++++++------- mediator/med_phases_prep_ocn_mod.F90 | 92 +------------ 13 files changed, 219 insertions(+), 172 deletions(-) diff --git a/.github/workflows/srt.yml b/.github/workflows/srt.yml index 39526be99..34252cb63 100644 --- a/.github/workflows/srt.yml +++ b/.github/workflows/srt.yml @@ -26,8 +26,8 @@ jobs: CPPFLAGS: "-I/usr/include -I/usr/local/include " LDFLAGS: "-L/usr/lib/x86_64-linux-gnu -lnetcdf -lnetcdff -lpnetcdf" # Versions of all dependencies can be updated here - ESMF_VERSION: v8.4.0 - PARALLELIO_VERSION: pio2_5_10 + ESMF_VERSION: v8.5.0 + PARALLELIO_VERSION: pio2_6_0 CIME_MODEL: cesm CIME_DRIVER: nuopc GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} @@ -153,6 +153,7 @@ jobs: mkdir -p $HOME/cesm/scratch mkdir -p $HOME/cesm/inputdata pushd $GITHUB_WORKSPACE/cesm/cime/CIME/tests + export SRCROOT=$GITHUB_WORKSPACE/cesm/ export CIME_TEST_PLATFORM=ubuntu-latest export PIO_INCDIR=$HOME/pio/include export PIO_LIBDIR=$HOME/pio/lib @@ -175,6 +176,6 @@ jobs: popd # the following can be used by developers to login to the github server in case of errors # see https://github.com/marketplace/actions/debugging-with-tmate for further details -# - name: Setup tmate session -# if: ${{ failure() }} -# uses: mxschmitt/action-tmate@v3 + - name: Setup tmate session + if: ${{ failure() }} + uses: mxschmitt/action-tmate@v3 diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index f986cfad2..a329be743 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -784,6 +784,34 @@ If TRUE, the component libraries are always built with OpenMP capability. + + char + + + build_def + env_build.xml + If set will compile and submit with this gpu type enabled + + + + char + + + build_def + env_build.xml + If set will compile and submit with this gpu offload method enabled + + + + char + + + build_def + env_build.xml + If set will attach this script to the MPI run command, mapping + different MPI ranks to different GPUs within the same compute node + + logical TRUE,FALSE @@ -1798,12 +1826,22 @@ pes or cores per node for accounting purposes + + integer + 0 + + 1 + + mach_pes_last + env_mach_pes.xml + Number of CPU cores per GPU node used for simulation + + integer 0 - 1 - 1 + 1 mach_pes env_mach_pes.xml diff --git a/cime_config/namelist_definition_drv.xml b/cime_config/namelist_definition_drv.xml index d9001cfb7..dec6868f1 100644 --- a/cime_config/namelist_definition_drv.xml +++ b/cime_config/namelist_definition_drv.xml @@ -938,7 +938,7 @@ default: ogrid - xgrid + ogrid diff --git a/mediator/esmFldsExchange_cesm_mod.F90 b/mediator/esmFldsExchange_cesm_mod.F90 index 13811aec9..a2c4fe435 100644 --- a/mediator/esmFldsExchange_cesm_mod.F90 +++ b/mediator/esmFldsExchange_cesm_mod.F90 @@ -2158,7 +2158,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! liquid from river and possibly flood from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' , rc=rc)) then if (trim(rof2ocn_liq_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofl', compocn, mapconsd, 'none', 'unset') + call addmap_from(comprof, 'Forr_rofl', compocn, mapconsd, 'one', 'unset') else call addmap_from(comprof, 'Forr_rofl', compocn, map_rof2ocn_liq, 'none', rof2ocn_liq_rmap) end if @@ -2182,7 +2182,7 @@ subroutine esmFldsExchange_cesm(gcomp, phase, rc) ! ice from river to ocean if (fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi' , rc=rc)) then if (trim(rof2ocn_ice_rmap) == 'unset') then - call addmap_from(comprof, 'Forr_rofi', compocn, mapconsd, 'none', 'unset') + call addmap_from(comprof, 'Forr_rofi', compocn, mapconsd, 'one', 'unset') else call addmap_from(comprof, 'Forr_rofi', compocn, map_rof2ocn_ice, 'none', rof2ocn_ice_rmap) end if diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 74a866d5f..30066c59e 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -38,6 +38,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) use esmFlds , only : addmap_from => med_fldList_addmap_from use esmFlds , only : addfld_aoflux => med_fldList_addfld_aoflux use esmFlds , only : addmap_aoflux => med_fldList_addmap_aoflux + use esmFlds , only : addfld_ocnalb => med_fldList_addfld_ocnalb + use esmFlds , only : addmap_ocnalb => med_fldList_addmap_ocnalb ! input/output parameters: type(ESMF_GridComp) :: gcomp @@ -167,9 +169,12 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) deallocate(flds) end if - ! TODO: unused, but required to maintain B4B repro for mediator restarts; should be removed + ! Advertise the ocean albedos. These are not sent to the ATM in UFS. if (phase == 'advertise') then - call addfld_from(compice, 'mean_sw_pen_to_ocn') + call addfld_ocnalb('So_avsdr') + call addfld_ocnalb('So_avsdf') + call addfld_ocnalb('So_anidr') + call addfld_ocnalb('So_anidf') end if !===================================================================== @@ -329,6 +334,17 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) end if end if + ! to ocn: swpen thru ice w/o bands + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then + call addfld_from(compice, 'Fioi_swpen') + end if + else + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen', rc=rc)) then + call addmap_from(compice, 'Fioi_swpen', compocn, mapfcopy, 'unset', 'unset') + end if + end if + ! to ocn: from sw from atm and sw net from ice (custom merge in med_phases_prep_ocn) ! - downward direct near-infrared ("n" or "i") incident solar radiation ! - downward diffuse near-infrared ("n" or "i") incident solar radiation diff --git a/mediator/med.F90 b/mediator/med.F90 index c8da4dbb9..3efc94a6e 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -1804,7 +1804,8 @@ subroutine DataInitialize(gcomp, rc) call esmFldsExchange_cesm(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode(1:4)) == 'nems') then - call esmFldsExchange_nems(gcomp, phase='initialize', rc=rc) + call esmFldsExchange_nems(gcomp, phase='initialize', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'hafs') then call esmFldsExchange_hafs(gcomp, phase='initialize', rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1939,14 +1940,12 @@ subroutine DataInitialize(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------- - ! Initialize ocean albedos (this is needed for cesm and hafs) + ! Initialize ocean albedos !---------------------------------------------------------- - if (trim(coupling_mode(1:5)) == 'cesm_') then - if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compatm)) then - call med_phases_ocnalb_run(gcomp, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compatm)) then + call med_phases_ocnalb_run(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if !--------------------------------------- diff --git a/mediator/med_internalstate_mod.F90 b/mediator/med_internalstate_mod.F90 index c5497293f..66e2eb1db 100644 --- a/mediator/med_internalstate_mod.F90 +++ b/mediator/med_internalstate_mod.F90 @@ -262,7 +262,6 @@ subroutine med_internalstate_init(gcomp, rc) end do end if is_local%wrap%num_icesheets = num_icesheets - call NUOPC_CompAttributeGet(gcomp, name='mediator_present', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then diff --git a/mediator/med_io_mod.F90 b/mediator/med_io_mod.F90 index 82e0b04d0..265a5ddda 100644 --- a/mediator/med_io_mod.F90 +++ b/mediator/med_io_mod.F90 @@ -75,7 +75,7 @@ module med_io_mod character(*),parameter :: prefix = "med_io_" character(*),parameter :: modName = "(med_io_mod) " character(*),parameter :: version = "cmeps0" - + integer :: pio_iotype integer :: pio_ioformat type(iosystem_desc_t), pointer :: io_subsystem @@ -1738,8 +1738,8 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) deallocate(minIndexPTile, maxIndexPTile) else - if(maintask) write(logunit,*) trim(subname),' ERROR: '//trim(name1)//' is not present, aborting ' - call ESMF_LogWrite(trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ', ESMF_LOGMSG_INFO) + if(maintask) write(logunit,'(a)') trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ' + call ESMF_LogWrite(trim(subname)//' ERROR: '//trim(name1)//' is not present, aborting ', ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE end if ! end if rcode check diff --git a/mediator/med_map_mod.F90 b/mediator/med_map_mod.F90 index 18752dc2f..54bcbb154 100644 --- a/mediator/med_map_mod.F90 +++ b/mediator/med_map_mod.F90 @@ -111,7 +111,7 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun type(ESMF_Mesh) :: mesh_dst type(med_fldlist_type), pointer :: FldListFr type(med_fldlist_entry_type), pointer :: fldptr - character(len=*), parameter :: subname=' (module_med_map: RouteHandles_init) ' + character(len=*), parameter :: subname=' (med_map_mod: RouteHandles_init) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -259,7 +259,8 @@ subroutine med_map_RouteHandles_initfrom_esmflds(gcomp, flds_scalar_name, llogun if (chkerr(rc,__LINE__,u_FILE_u)) return if (maintask) then write(logunit,'(a)') trim(subname)//' created field_NormOne for '& - //compname(n1)//'->'//compname(n2)//' with mapping '//trim(mapnames(mapindex)) + //trim(compname(n1))//'->'//trim(compname(n2))//' with mapping '& + //trim(mapnames(mapindex)) end if end if end do ! end of loop over map_indiex mappers @@ -304,7 +305,7 @@ subroutine med_map_routehandles_initfrom_fieldbundle(n1, n2, FBsrc, FBdst, mapin ! local variables type(ESMF_Field) :: fldsrc type(ESMF_Field) :: flddst - character(len=*), parameter :: subname=' (module_MED_map:med_map_routehandles_initfrom_fieldbundle) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_routehandles_initfrom_fieldbundle) ' !--------------------------------------------- rc = ESMF_SUCCESS @@ -653,7 +654,7 @@ logical function med_map_RH_is_created_RH3d(RHs,n1,n2,mapindex,rc) integer , intent(out) :: rc ! local variables - character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH3d) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_RH_is_created_RH3d) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -678,7 +679,7 @@ logical function med_map_RH_is_created_RH1d(RHs,mapindex,rc) ! local variables integer :: rc1, rc2 logical :: mapexists - character(len=*), parameter :: subname=' (module_MED_map:med_map_RH_is_created_RH1d) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_RH_is_created_RH1d) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -750,7 +751,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & character(CL), allocatable :: fieldNameList(:) character(CS) :: mapnorm_mapindex character(len=CX) :: tmpstr - character(len=*), parameter :: subname=' (module_MED_map:med_packed_field_create) ' + character(len=*), parameter :: subname=' (med_map_mod:med_packed_field_create) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -818,6 +819,7 @@ subroutine med_map_packed_field_create(destcomp, flds_scalar_name, & //' '//trim(fieldnamelist(nf)) call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) else + !if(rof_name .ne. 'xrof' .and. compname(destcomp) .ne. 'ocn') then if (mapnorm_mapindex /= packed_data(mapindex)%mapnorm) then write(tmpstr,*)'Map type '//trim(mapnames(mapindex)) & //', destcomp '//trim(compname(destcomp)) & @@ -953,7 +955,7 @@ subroutine med_map_field_packed(FBSrc, FBDst, FBFracSrc, field_normOne, packed_d type(ESMF_Field), pointer :: fieldlist_dst(:) real(r8), pointer :: data_norm(:) real(r8), pointer :: data_dst(:,:) - character(len=*), parameter :: subname=' (module_MED_map:med_map_field_packed) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_field_packed) ' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -1165,7 +1167,7 @@ subroutine med_map_field_normalized(field_src, field_dst, routehandles, maptype, integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fields integer :: lsize_src integer :: lsize_dst - character(len=*), parameter :: subname=' (module_MED_map:med_map_field_normalized) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_field_normalized) ' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -1278,7 +1280,7 @@ subroutine med_map_field(field_src, field_dst, routehandles, maptype, fldname, r logical :: checkflag = .false. character(len=CS) :: lfldname real(ESMF_KIND_R8), parameter :: fillValue = 9.99e20_ESMF_KIND_R8 - character(len=*), parameter :: subname='(module_MED_map:med_map_field) ' + character(len=*), parameter :: subname='(med_map_mod:med_map_field) ' !--------------------------------------------------- rc = ESMF_SUCCESS @@ -1381,7 +1383,7 @@ subroutine med_map_uv_cart3d(FBsrc, FBdst, routehandles, mapindex, rc) integer :: spatialDim real(r8), parameter :: deg2rad = shr_const_pi/180.0_R8 ! deg to rads logical :: first_time = .true. - character(len=*), parameter :: subname=' (module_MED_map:med_map_uv_cart3d) ' + character(len=*), parameter :: subname=' (med_map_mod:med_map_uv_cart3d) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/mediator/med_methods_mod.F90 b/mediator/med_methods_mod.F90 index 54fe20ec1..649c9c511 100644 --- a/mediator/med_methods_mod.F90 +++ b/mediator/med_methods_mod.F90 @@ -1354,7 +1354,10 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) call med_methods_Field_GetFldPtr(lfield, fldptr1=dataptro1, fldptr2=dataptro2, rank=lranko, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if (lranki == 1 .and. lranko == 1) then + if (lranki == 0 .and. lranko == 0) then + ! do nothing + call ESMF_LogWrite(trim(subname)//": Both ranki and ranko are 0", ESMF_LOGMSG_INFO) + elseif (lranki == 1 .and. lranko == 1) then if (.not.med_methods_FieldPtr_Compare(dataPtro1, dataPtri1, subname, rc)) then call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", ESMF_LOGMSG_ERROR) @@ -1397,7 +1400,7 @@ subroutine med_methods_FB_accum(FBout, FBin, copy, rc) else write(msgString,'(a,2i8)') trim(subname)//": ranki, ranko = ",lranki,lranko - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_ERROR) call ESMF_LogWrite(trim(subname)//": ERROR ranki ranko not supported "//trim(lfieldnamelist(n)), & ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE diff --git a/mediator/med_phases_history_mod.F90 b/mediator/med_phases_history_mod.F90 index 5f150a4b7..7d59a7fea 100644 --- a/mediator/med_phases_history_mod.F90 +++ b/mediator/med_phases_history_mod.F90 @@ -25,7 +25,7 @@ module med_phases_history_mod use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef, med_io_close use perf_mod , only : t_startf, t_stopf use pio , only : file_desc_t - + implicit none private diff --git a/mediator/med_phases_ocnalb_mod.F90 b/mediator/med_phases_ocnalb_mod.F90 index a5ef002c7..31bd211f0 100644 --- a/mediator/med_phases_ocnalb_mod.F90 +++ b/mediator/med_phases_ocnalb_mod.F90 @@ -6,13 +6,11 @@ module med_phases_ocnalb_mod use med_utils_mod , only : chkerr => med_utils_chkerr use med_methods_mod , only : FB_diagnose => med_methods_FB_diagnose use med_methods_mod , only : State_GetScalar => med_methods_State_GetScalar - use med_internalstate_mod , only : mapconsf, mapnames, compatm, compocn + use med_internalstate_mod , only : mapconsf, mapnames, compatm, compocn, maintask use perf_mod , only : t_startf, t_stopf -#ifdef CESMCOUPLED use shr_orb_mod , only : shr_orb_cosz, shr_orb_decl use shr_orb_mod , only : shr_orb_params, SHR_ORB_UNDEF_INT, SHR_ORB_UNDEF_REAL use shr_log_mod , only : shr_log_unit -#endif implicit none private @@ -26,11 +24,10 @@ module med_phases_ocnalb_mod !-------------------------------------------------------------------------- ! Private interfaces !-------------------------------------------------------------------------- -#ifdef CESMCOUPLED + private med_phases_ocnalb_init private med_phases_ocnalb_orbital_update private med_phases_ocnalb_orbital_init -#endif !-------------------------------------------------------------------------- ! Private data @@ -47,25 +44,30 @@ module med_phases_ocnalb_mod logical :: created ! has memory been allocated here end type ocnalb_type - ! Conversion from degrees to radians character(*),parameter :: u_FILE_u = & __FILE__ -#ifdef CESMCOUPLED character(len=CL) :: orb_mode ! attribute - orbital mode integer :: orb_iyear ! attribute - orbital year integer :: orb_iyear_align ! attribute - associated with model year real(R8) :: orb_obliq ! attribute - obliquity in degrees real(R8) :: orb_mvelp ! attribute - moving vernal equinox longitude real(R8) :: orb_eccen ! attribute and update- orbital eccentricity -#endif + character(len=*) , parameter :: orb_fixed_year = 'fixed_year' character(len=*) , parameter :: orb_variable_year = 'variable_year' character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' + ! used, reused in module + logical :: flux_albav ! use average dif and dir albedos + logical :: use_nextswcday ! use the scalar field for next time (otherwise, will be set using clock) + logical :: use_min_albedo ! apply minimum value of albedo for direct vis, nir + real(R8) :: min_albedo ! minimum value of albedo for direct vis, nir + real(R8) :: albdif ! 60 deg reference albedo, diffuse + real(R8) :: albdir ! 60 deg reference albedo, direct !=============================================================================== contains !=============================================================================== -#ifdef CESMCOUPLED + subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) !----------------------------------------------------------------------- @@ -74,11 +76,12 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) ! All input field bundles are ASSUMED to be on the ocean grid !----------------------------------------------------------------------- - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE - use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_Mesh, ESMF_MeshGet - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet - use ESMF , only : ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet - use ESMF , only : operator(==) + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_Mesh, ESMF_MeshGet + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : ESMF_FieldBundleGet, ESMF_Field, ESMF_FieldGet + use NUOPC , only : NUOPC_CompAttributeGet + use ESMF , only : operator(==) ! Arguments type(ESMF_GridComp) :: gcomp @@ -97,7 +100,11 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) type(InternalState) :: is_local real(R8), pointer :: ownedElemCoords(:) character(len=CL) :: tempc1,tempc2 + character(len=CS) :: cvalue + logical :: use_min_ocnalb + logical :: isPresent, isSet integer :: fieldCount + character(CL) :: msg type(ESMF_Field), pointer :: fieldlist(:) character(*), parameter :: subname = '(med_phases_ocnalb_init) ' !----------------------------------------------------------------------- @@ -186,13 +193,65 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) call med_phases_ocnalb_orbital_init(gcomp, logunit, iam==0, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Determine if reference albedos are used + flux_albav = .false. + call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flux_albav + end if + ! Set reference albedo values + call NUOPC_CompAttributeGet(gcomp, name="albdif", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) albdif + else + albdif = 0.06_r8 + end if + call NUOPC_CompAttributeGet(gcomp, name="albdir", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) albdir + else + albdir = 0.07_r8 + end if + ! Determine if direct albedo should have a minimum value + call NUOPC_CompAttributeGet(gcomp, name="ocean_albedo_limit", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) min_albedo + use_min_albedo = .true. + else + min_albedo = 0.0_R8 + use_min_ocnalb = .false. + endif + ! Allow setting of albedo timestep using the clock instead of the atm's next timestep + use_nextswcday = .true. + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (.not. isPresent ) then + use_nextswcday = .false. + endif + + if (flux_albav) then + write(msg,'(2(A,f8.2))') trim(subname)//': mean albedos set: albdif = ',albdif,', albdir = ',albdir + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + else + if (use_min_albedo) then + write(msg,'(A,f8.2)') trim(subname)//': min_albedo setting = ',min_albedo + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + end if + end if + write(msg,'(A,l)') trim(subname)//': use_nextswcday setting is ',use_nextswcday + call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif call t_stopf('MED:'//subname) end subroutine med_phases_ocnalb_init -#endif + !=============================================================================== subroutine med_phases_ocnalb_run(gcomp, rc) @@ -201,8 +260,10 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! Compute ocean albedos (on the ocean grid) !----------------------------------------------------------------------- + use NUOPC_Mediator, only : NUOPC_MediatorGet use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_TimeInterval use ESMF , only : ESMF_Clock, ESMF_ClockGet, ESMF_Time, ESMF_TimeGet + use ESMF , only : ESMF_ClockIsCreated, ESMF_ClockGetNextTime use ESMF , only : ESMF_VM, ESMF_VMGet use ESMF , only : ESMF_LogWrite, ESMF_LogFoundError use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO @@ -211,11 +272,11 @@ subroutine med_phases_ocnalb_run(gcomp, rc) use ESMF , only : operator(+) use NUOPC , only : NUOPC_CompAttributeGet use med_constants_mod , only : shr_const_pi + use med_phases_history_mod, only : med_phases_history_write_med ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc -#ifdef CESMCOUPLED ! local variables type(ocnalb_type), save :: ocnalb type(ESMF_VM) :: vm @@ -224,12 +285,13 @@ subroutine med_phases_ocnalb_run(gcomp, rc) logical :: update_alb type(InternalState) :: is_local type(ESMF_Clock) :: clock + type(ESMF_Clock) :: dclock type(ESMF_Time) :: currTime + type(ESMF_Time) :: nextTime type(ESMF_TimeInterval) :: timeStep character(CL) :: cvalue character(CS) :: starttype ! config start type character(CL) :: runtype ! initial, continue, hybrid, branch - logical :: flux_albav ! flux avg option real(R8) :: nextsw_cday ! calendar day of next atm shortwave real(R8), pointer :: ofrac(:) real(R8), pointer :: ofrad(:) @@ -246,21 +308,13 @@ subroutine med_phases_ocnalb_run(gcomp, rc) real(R8) :: obliqr ! Earth orbit real(R8) :: delta ! Solar declination angle in radians real(R8) :: eccf ! Earth orbit eccentricity factor - real(R8), parameter :: albdif = 0.06_r8 ! 60 deg reference albedo, diffuse - real(R8), parameter :: albdir = 0.07_r8 ! 60 deg reference albedo, direct real(R8), parameter :: const_deg2rad = shr_const_pi/180.0_R8 ! deg to rads character(CL) :: msg logical :: first_call = .true. character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- -#endif - rc = ESMF_SUCCESS - -#ifndef CESMCOUPLED - RETURN ! the following code is not executed unless the model is CESM - -#else + rc = ESMF_SUCCESS ! Determine main task call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) @@ -275,8 +329,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! Determine if ocnalb data type will be initialized - and if not return if (first_call) then - if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & - ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then ocnalb%created = .true. else ocnalb%created = .false. @@ -331,6 +384,26 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) if (chkerr(rc,__LINE__,u_FILE_u)) return else + ! obtain nextsw_cday from atm if it is in the import state + if (use_nextswcday) then + call State_GetScalar(& + state=is_local%wrap%NstateImp(compatm), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, & + scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & + scalar_value=nextsw_cday, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + first_call = .false. + + else + ! Note that med_methods_State_GetScalar includes a broadcast to all other pets + if (use_nextswcday) then call State_GetScalar(& state=is_local%wrap%NstateImp(compatm), & flds_scalar_name=is_local%wrap%flds_scalar_name, & @@ -338,27 +411,14 @@ subroutine med_phases_ocnalb_run(gcomp, rc) scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & scalar_value=nextsw_cday, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - - first_call = .false. - - else - - ! Note that med_methods_State_GetScalar includes a broadcast to all other pets - call State_GetScalar(& - state=is_local%wrap%NstateImp(compatm), & - flds_scalar_name=is_local%wrap%flds_scalar_name, & - flds_scalar_num=is_local%wrap%flds_scalar_num, & - scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & - scalar_value=nextsw_cday, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if - call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) flux_albav - ! Get orbital values call med_phases_ocnalb_orbital_update(clock, logunit, iam==0, eccen, obliqr, lambm0, mvelpp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -393,6 +453,9 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ocnalb%anidr(n) = (.026_r8/(cosz**1.7_r8 + 0.065_r8)) + & (.150_r8*(cosz - 0.100_r8 ) * & (cosz - 0.500_r8 ) * (cosz - 1.000_r8 ) ) + if (use_min_albedo) then + ocnalb%anidr(n) = max (ocnalb%anidr(n), min_albedo) + end if ocnalb%avsdr(n) = ocnalb%anidr(n) ocnalb%anidf(n) = albdif ocnalb%avsdf(n) = albdif @@ -430,18 +493,25 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ofrad(:) = ofrac(:) endif + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o, rc=rc)) then + call NUOPC_MediatorGet(gcomp, driverClock=dClock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (ESMF_ClockIsCreated(dclock)) then + call med_phases_history_write_med(gcomp, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + if (dbug_flag > 1) then call FB_diagnose(is_local%wrap%FBMed_ocnalb_o, string=trim(subname)//' FBMed_ocnalb_o', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if call t_stopf('MED:'//subname) -#endif - end subroutine med_phases_ocnalb_run !=============================================================================== -#ifdef CESMCOUPLED + subroutine med_phases_ocnalb_orbital_init(gcomp, logunit, maintask, rc) !---------------------------------------------------------- @@ -601,7 +671,6 @@ subroutine med_phases_ocnalb_orbital_update(clock, logunit, maintask, eccen, ob endif end subroutine med_phases_ocnalb_orbital_update -#endif !=============================================================================== diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 33c12e6e6..52faa2175 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -31,8 +31,7 @@ module med_phases_prep_ocn_mod public :: med_phases_prep_ocn_accum ! called from run sequence public :: med_phases_prep_ocn_avg ! called from run sequence - private :: med_phases_prep_ocn_custom_cesm - private :: med_phases_prep_ocn_custom_nems + private :: med_phases_prep_ocn_custom character(*), parameter :: u_FILE_u = & __FILE__ @@ -217,13 +216,8 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) end if ! custom merges to ocean - if (trim(coupling_mode) == 'cesm') then - call med_phases_prep_ocn_custom_cesm(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode(1:5)) == 'nems_') then - call med_phases_prep_ocn_custom_nems(gcomp, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + call med_phases_prep_ocn_custom(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ocean accumulator call FB_accum(is_local%wrap%FBExpAccumOcn, is_local%wrap%FBExp(compocn), rc=rc) @@ -315,7 +309,7 @@ subroutine med_phases_prep_ocn_avg(gcomp, rc) end subroutine med_phases_prep_ocn_avg !----------------------------------------------------------------------------- - subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) + subroutine med_phases_prep_ocn_custom(gcomp, rc) !--------------------------------------- ! custom calculations for cesm @@ -372,7 +366,7 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) integer :: lsize real(R8) :: c1,c2,c3,c4 character(len=64), allocatable :: fldnames(:) - character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_cesm)' + character(len=*), parameter :: subname='(med_phases_prep_ocn_custom)' !--------------------------------------- rc = ESMF_SUCCESS @@ -620,80 +614,6 @@ subroutine med_phases_prep_ocn_custom_cesm(gcomp, rc) end if call t_stopf('MED:'//subname) - end subroutine med_phases_prep_ocn_custom_cesm - - !----------------------------------------------------------------------------- - subroutine med_phases_prep_ocn_custom_nems(gcomp, rc) - - ! ---------------------------------------------- - ! Custom calculation for nems_orig or nems_frac - ! ---------------------------------------------- - - use ESMF , only : ESMF_GridComp - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(InternalState) :: is_local - real(R8), pointer :: customwgt(:) - real(R8), pointer :: ifrac(:) - real(R8), pointer :: ofrac(:) - integer :: lsize - character(len=*), parameter :: subname='(med_phases_prep_ocn_custom_nems)' - !--------------------------------------- - - rc = ESMF_SUCCESS - - call t_startf('MED:'//subname) - if (dbug_flag > 20) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - end if - call memcheck(subname, 5, maintask) - - ! Get the internal state - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! get ice and open ocean fractions on the ocn mesh - call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrac' , ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - lsize = size(ofrac) - allocate(customwgt(lsize)) - - ! netsw_for_ocn = [downsw_from_atm*(1-ice_fraction)*(1-ocn_albedo)] + [pensw_from_ice*(ice_fraction)] - customwgt(:) = ofrac(:) * (1.0_R8 - 0.06_R8) - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdr' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdr', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swvdf' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_vdf', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndr' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idr', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', & - FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_swndf' , wgtA=customwgt, & - FBinB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_swpen_idf', wgtB=ifrac, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - deallocate(customwgt) - - if (dbug_flag > 20) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - end if - call t_stopf('MED:'//subname) - - end subroutine med_phases_prep_ocn_custom_nems + end subroutine med_phases_prep_ocn_custom end module med_phases_prep_ocn_mod From a5dea5f178fc98a4ab39c58aa43c37da6ad25d08 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Thu, 5 Oct 2023 10:12:11 -0400 Subject: [PATCH 34/36] refactor nems esmFldsExchange (#99) * clean up ufs fields exchange by consolidating logical blocks * remove extraneous trim on fldname variables * remove conditionals on mediator fields --- mediator/esmFldsExchange_nems_mod.F90 | 607 ++++++++++++-------------- mediator/med.F90 | 3 +- mediator/med_fraction_mod.F90 | 14 +- mediator/med_phases_prep_atm_mod.F90 | 33 +- mediator/med_phases_prep_ocn_mod.F90 | 32 +- 5 files changed, 294 insertions(+), 395 deletions(-) diff --git a/mediator/esmFldsExchange_nems_mod.F90 b/mediator/esmFldsExchange_nems_mod.F90 index 30066c59e..a11d62b53 100644 --- a/mediator/esmFldsExchange_nems_mod.F90 +++ b/mediator/esmFldsExchange_nems_mod.F90 @@ -49,6 +49,7 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local integer :: n, maptype + logical :: med_aoflux_to_ocn character(len=CX) :: msgString character(len=CL) :: cvalue character(len=CS) :: fldname @@ -75,6 +76,12 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) write(msgString,'(A,i6,A)') trim(subname)//': maptype is ',maptype,', '//mapnames(maptype) call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + if (trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux') then + med_aoflux_to_ocn = .true. + else + med_aoflux_to_ocn = .false. + end if + !===================================================================== ! scalar information !===================================================================== @@ -83,8 +90,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps - call addfld_to(n, trim(cvalue)) - call addfld_from(n, trim(cvalue)) + call addfld_to(n , trim(cvalue)) + call addfld_from(n , trim(cvalue)) end do end if @@ -98,78 +105,45 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if (is_local%wrap%comp_present(compocn)) call addfld_from(compocn, 'So_omask') if (is_local%wrap%comp_present(complnd)) call addfld_from(complnd, 'Sl_lfrin') else - if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then + if ( fldchk(is_local%wrap%FBexp(compice) , 'So_omask', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_omask', rc=rc)) then call addmap_from(compocn, 'So_omask', compice, mapfcopy, 'unset', 'unset') end if end if - if ( trim(coupling_mode) == 'nems_orig_data') then - ! atm fields required for atm/ocn flux calculation - allocate(flds(10)) - flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', & - 'Sa_shum', 'Sa_u10m', 'Sa_v10m', 'Sa_t2m ', 'Sa_q2m '/) + ! fields required for atm/ocn flux calculation + if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then + ! from atm: states for fluxes + allocate(flds(13)) + flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', 'Sa_pslv', & + 'Sa_shum', 'Sa_ptem', 'Sa_dens', 'Sa_u10m', 'Sa_v10m', 'Sa_t2m ', & + 'Sa_q2m '/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then - if (is_local%wrap%comp_present(compatm) )then - call addfld_from(compatm, trim(fldname)) - end if + call addfld_from(compatm , fldname) else - if ( fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap_from(compatm, trim(fldname), compocn, maptype, 'one', 'unset') - end if - end if - end do - deallocate(flds) - - ! fields returned by the atm/ocn flux computation which are otherwise unadvertised - allocate(flds(8)) - flds = (/'So_tref ', 'So_qref ', 'So_ustar ', 'So_re ','So_ssq ', & - 'So_u10 ', 'So_duu10n', 'Faox_lat '/) - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - call addfld_aoflux(trim(fldname)) - end if - end do - deallocate(flds) - end if - - if (trim(coupling_mode) == 'nems_frac_aoflux' .or. trim(coupling_mode) == 'nems_frac_aoflux_sbs') then - allocate(flds(12)) - flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot ', 'Sa_pbot ', & - 'Sa_pslv ', 'Sa_shum ', 'Sa_ptem ', 'Sa_dens ', 'Sa_u10m ', & - 'Sa_v10m ', 'Faxa_lwdn'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compatm) )then - call addfld_from(compatm, trim(fldname)) + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then + call addmap_from(compatm, fldname, compocn, maptype, 'one', 'unset') end if - else - if ( fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap_from(compatm, trim(fldname), compocn, maptype, 'one', 'unset') - end if end if end do deallocate(flds) - ! fields returned by the atm/ocn flux computation which are otherwise unadvertised - allocate(flds(13)) - flds = (/'So_tref ', 'So_qref ','So_u10 ', 'So_ustar ','So_ssq ', & - 'So_re ', 'So_duu10n','Faox_lwup', 'Faox_sen ','Faox_lat ', & - 'Faox_evap', 'Faox_taux','Faox_tauy'/) + ! from med: fields returned by the atm/ocn flux computation, otherwise unadvertised + allocate(flds(8)) + flds = (/'So_tref ', 'So_qref ', 'So_ustar ', 'So_re ','So_ssq ', 'So_u10 ', & + 'So_duu10n', 'Faox_lat '/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then - call addfld_aoflux(trim(fldname)) + call addfld_aoflux(fldname) end if end do deallocate(flds) end if - ! Advertise the ocean albedos. These are not sent to the ATM in UFS. + ! from med: ocean albedos (not sent to the ATM in UFS). if (phase == 'advertise') then call addfld_ocnalb('So_avsdr') call addfld_ocnalb('So_avsdf') @@ -184,16 +158,16 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: fractions (computed in med_phases_prep_atm) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then - call addfld_from(compice, 'Si_ifrac') - call addfld_to(compatm, 'Si_ifrac') + call addfld_from(compice , 'Si_ifrac') + call addfld_to(compatm , 'Si_ifrac') end if ! ofrac used by atm if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then - call addfld_from(compatm, 'Sa_ofrac') + call addfld_from(compatm , 'Sa_ofrac') end if ! lfrac used by atm if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compatm)) then - call addfld_to(compatm, 'Sl_lfrac') + call addfld_to(compatm , 'Sl_lfrac') end if end if @@ -207,39 +181,40 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! - mean snow volume per unit area ! - surface temperatures allocate(flds(9)) - flds = (/'Faii_taux', 'Faii_tauy', 'Faii_lat ', 'Faii_sen ', 'Faii_lwup', & - 'Faii_evap', 'Si_vice ', 'Si_vsno ', 'Si_t '/) + flds = (/'Faii_taux', 'Faii_tauy', 'Faii_lat ', 'Faii_sen ', 'Faii_lwup', 'Faii_evap', & + 'Si_vice ', 'Si_vsno ', 'Si_t '/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then - call addfld_from(compice, trim(fldname)) - call addfld_to(compatm, trim(fldname)) + call addfld_from(compice , fldname) + call addfld_to(compatm , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then - call addmap_from(compice, trim(fldname), compatm, maptype, 'ifrac', 'unset') - call addmrg_to(compatm, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compatm) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), fldname, rc=rc)) then + call addmap_from(compice, fldname, compatm, maptype, 'ifrac', 'unset') + call addmrg_to(compatm, fldname, mrg_from=compice, mrg_fld=fldname, mrg_type='copy') end if end if end do deallocate(flds) + ! to atm: unmerged sea ice albedo, 4 bands allocate(flds(4)) flds = (/'Si_avsdr', 'Si_avsdf', 'Si_anidr', 'Si_anidf'/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm)) then - call addfld_from(compice, trim(fldname)) - call addfld_to(compatm, trim(fldname)) + call addfld_from(compice , fldname) + call addfld_to(compatm , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then - call addmap_from(compice, trim(fldname), compatm, maptype, 'ifrac', 'unset') - call addmrg_to(compatm, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compatm) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), fldname, rc=rc)) then + call addmap_from(compice, fldname, compatm, maptype, 'ifrac', 'unset') + call addmrg_to(compatm, fldname, mrg_from=compice, mrg_fld=fldname, mrg_type='copy') end if end if end do @@ -248,8 +223,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: unmerged surface temperatures from ocn if (phase == 'advertise') then if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then - call addfld_from(compocn, 'So_t') - call addfld_to(compatm, 'So_t') + call addfld_from(compocn , 'So_t') + call addfld_to(compatm , 'So_t') end if else if ( fldchk(is_local%wrap%FBexp(compatm) , 'So_t', rc=rc) .and. & @@ -262,8 +237,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to atm: unmerged surface temperatures from lnd if (phase == 'advertise') then if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compatm)) then - call addfld_from(complnd, 'Sl_t') - call addfld_to(compatm, 'Sl_t') + call addfld_from(complnd , 'Sl_t') + call addfld_to(compatm , 'Sl_t') end if else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sl_t', rc=rc) .and. & @@ -278,35 +253,31 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! - surface latent heat flux, ! - surface sensible heat flux ! - surface upward longwave heat flux - ! - evaporation water flux from water, not in the list do we need to send it to atm? - if (trim(coupling_mode) == 'nems_frac_aoflux') then - if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compatm)) then - allocate(flds(5)) - flds = (/ 'lat ', 'sen ', 'lwup', 'taux', 'tauy' /) - if (phase == 'advertise') then - do n = 1,size(flds) - call addfld_aoflux('Faox_'//trim(flds(n))) - call addfld_to(compatm, 'Faox_'//trim(flds(n))) - end do - else - do n = 1,size(flds) - if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_'//trim(flds(n)), rc=rc)) then - if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then - call addmap_aoflux('Faox_'//trim(flds(n)), compatm, maptype, 'ofrac', 'unset') - end if - call addmrg_to(compatm, 'Faox_'//trim(flds(n)), mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='copy') - end if - end do + allocate(flds(5)) + flds = (/ 'Faox_lat ', 'Faox_sen ', 'Faox_lwup', 'Faox_taux', 'Faox_tauy' /) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld_aoflux(fldname) + call addfld_to(compatm , fldname) + end if + else + if (fldchk(is_local%wrap%FBMed_aoflux_o, fldname, rc=rc)) then + if (trim(is_local%wrap%aoflux_grid) == 'ogrid') then + call addmap_aoflux(fldname, compatm, maptype, 'ofrac', 'unset') + end if + call addmrg_to(compatm, fldname, mrg_from=compmed, mrg_fld=fldname, mrg_type='copy') end if - deallocate(flds) end if - end if + end do + deallocate(flds) ! to atm: surface roughness length from wav if (phase == 'advertise') then if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compatm)) then - call addfld_from(compwav, 'Sw_z0') - call addfld_to(compatm, 'Sw_z0') + call addfld_from(compwav , 'Sw_z0') + call addfld_to(compatm , 'Sw_z0') end if else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sw_z0', rc=rc) .and. & @@ -323,8 +294,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: sea level pressure from atm if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compatm, 'Sa_pslv') - call addfld_to(compocn, 'Sa_pslv') + call addfld_from(compatm , 'Sa_pslv') + call addfld_to(compocn , 'Sa_pslv') end if else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Sa_pslv', rc=rc) .and. & @@ -337,14 +308,13 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! to ocn: swpen thru ice w/o bands if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compice, 'Fioi_swpen') + call addfld_from(compice , 'Fioi_swpen') end if else if (fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen', rc=rc)) then call addmap_from(compice, 'Fioi_swpen', compocn, mapfcopy, 'unset', 'unset') end if end if - ! to ocn: from sw from atm and sw net from ice (custom merge in med_phases_prep_ocn) ! - downward direct near-infrared ("n" or "i") incident solar radiation ! - downward diffuse near-infrared ("n" or "i") incident solar radiation @@ -359,8 +329,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) do n = 1,size(oflds) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compatm, trim(aflds(n))) - call addfld_to(compocn, trim(oflds(n))) + call addfld_from(compatm , trim(aflds(n))) + call addfld_to(compocn , trim(oflds(n))) end if else if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & @@ -373,8 +343,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) do n = 1,size(oflds) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compice, trim(iflds(n))) - call addfld_to(compocn, trim(oflds(n))) + call addfld_from(compice , trim(iflds(n))) + call addfld_to(compocn , trim(oflds(n))) end if else if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & @@ -394,190 +364,153 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compatm, trim(fldname)) - call addfld_to(compocn, trim(fldname)) + call addfld_from(compatm , fldname) + call addfld_to(compocn , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(compocn) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap_from(compatm, trim(fldname), compocn, maptype, 'one', 'unset') - call addmrg_to(compocn, trim(fldname), & - mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ofrac') + if ( fldchk(is_local%wrap%FBexp(compocn) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then + call addmap_from(compatm, fldname, compocn, maptype, 'one', 'unset') + call addmrg_to(compocn, fldname, & + mrg_from=compatm, mrg_fld=fldname, mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if end do - deallocate(flds) - if (trim(coupling_mode) == 'nems_orig' .or. trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_frac_aoflux_sbs') then - ! to ocn: merge surface stress - allocate(oflds(2)) - allocate(aflds(2)) - allocate(iflds(2)) - oflds = (/'Foxx_taux', 'Foxx_tauy'/) - aflds = (/'Faxa_taux', 'Faxa_tauy'/) - iflds = (/'Fioi_taux', 'Fioi_tauy'/) - do n = 1,size(oflds) - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compatm) & - .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compice, trim(iflds(n))) - call addfld_from(compatm, trim(aflds(n))) - call addfld_to(compocn, trim(oflds(n))) + !to ocn: surface stress from mediator or atm and ice stress via auto merge + flds = (/'taux', 'tauy'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then + call addfld_aoflux('Faox_'//fldname) + call addfld_from(compatm , 'Faxa_'//fldname) + call addfld_from(compice , 'Fioi_'//fldname) + call addfld_to(compocn , 'Foxx_'//fldname) + end if + else + if (med_aoflux_to_ocn) then + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_'//fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_'//fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_'//fldname, rc=rc)) then + call addmap_from(compice, 'Fioi_'//fldname, compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, 'Foxx_'//fldname, & + mrg_from=compmed, mrg_fld='Faox_'//fldname, mrg_type='merge', mrg_fracname='ofrac') + call addmrg_to(compocn, 'Foxx_'//fldname, & + mrg_from=compice, mrg_fld='Fioi_'//fldname, mrg_type='merge', mrg_fracname='ifrac') end if else - if ( fldchk(is_local%wrap%FBexp(compocn) , trim(oflds(n)), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice), trim(iflds(n)), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), trim(aflds(n)), rc=rc)) then - call addmap_from(compice, trim(iflds(n)), compocn, mapfcopy, 'unset', 'unset') - call addmap_from(compatm, trim(aflds(n)), compocn, mapconsf_aofrac, 'aofrac', 'unset') - call addmrg_to(compocn, trim(oflds(n)), & - mrg_from=compice, mrg_fld=trim(iflds(n)), mrg_type='merge', mrg_fracname='ifrac') - call addmrg_to(compocn, trim(oflds(n)), & - mrg_from=compatm, mrg_fld=trim(aflds(n)), mrg_type='merge', mrg_fracname='ofrac') + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_'//fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_'//fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_'//fldname, rc=rc)) then + call addmap_from(compice, 'Fioi_'//fldname, compocn, mapfcopy, 'unset', 'unset') + call addmap_from(compatm, 'Faxa_'//fldname, compocn, mapconsf_aofrac, 'aofrac', 'unset') + call addmrg_to(compocn, 'Foxx_'//fldname, & + mrg_from=compice, mrg_fld='Fioi_'//fldname, mrg_type='merge', mrg_fracname='ifrac') + call addmrg_to(compocn, 'Foxx_'//fldname, & + mrg_from=compatm, mrg_fld='Faxa_'//fldname, mrg_type='merge', mrg_fracname='ofrac') end if end if + end if end do - deallocate(oflds) - deallocate(aflds) - deallocate(iflds) + deallocate(flds) - ! to ocn: net long wave via auto merge - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compatm, 'Faxa_lwnet') - call addfld_to(compocn, 'Faxa_lwnet') + ! to ocn: net long wave via auto merge + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld_aoflux('Faox_lwup') + call addfld_from(compatm , 'Faxa_lwnet') + call addfld_from(compatm , 'Faxa_lwdn') + call addfld_to(compocn , 'Foxx_lwnet') + end if + else + if (med_aoflux_to_ocn) then + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_lwnet', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc)) then + call addmap_from(compatm, 'Faxa_lwdn', compocn, maptype, 'one', 'unset') + call addmrg_to(compocn, 'Foxx_lwnet', & + mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') + call addmrg_to(compocn, 'Foxx_lwnet', & + mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') end if else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_lwnet', rc=rc) .and. & + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_lwnet', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwnet', rc=rc)) then call addmap_from(compatm, 'Faxa_lwnet', compocn, mapconsf_aofrac, 'aofrac', 'unset') - call addmrg_to(compocn, 'Faxa_lwnet', & + call addmrg_to(compocn, 'Foxx_lwnet', & mrg_from=compatm, mrg_fld='Faxa_lwnet', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if + end if - ! to ocn: sensible heat flux - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compatm, 'Faxa_sen') - call addfld_to(compocn, 'Faxa_sen') + ! to ocn: sensible heat flux + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld_aoflux('Faox_sen') + call addfld_from(compatm , 'Faxa_sen') + call addfld_to(compocn , 'Foxx_sen') + end if + else + if (med_aoflux_to_ocn) then + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_sen', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_sen' , rc=rc)) then + call addmrg_to(compocn, 'Foxx_sen', & + mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_sen', rc=rc) .and. & + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_sen', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_sen', rc=rc)) then call addmap_from(compatm, 'Faxa_sen', compocn, mapconsf_aofrac, 'aofrac', 'unset') - call addmrg_to(compocn, 'Faxa_sen', & + call addmrg_to(compocn, 'Foxx_sen', & mrg_from=compatm, mrg_fld='Faxa_sen', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if + end if - ! to ocn: evaporation water flux - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compatm, 'Faxa_evap') - call addfld_to(compocn, 'Faxa_evap') + ! to ocn: evaporation water flux + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then + call addfld_aoflux('Faox_evap') + call addfld_from(compatm , 'Faxa_evap') + call addfld_to(compocn , 'Foxx_evap') + end if + else + if (med_aoflux_to_ocn) then + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_evap', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_evap' , rc=rc)) then + call addmrg_to(compocn, 'Foxx_evap', & + mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faxa_evap', rc=rc) .and. & + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_evap', rc=rc) .and. & fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_evap' , rc=rc)) then call addmap_from(compatm, 'Faxa_evap', compocn, mapconsf_aofrac, 'aofrac', 'unset') - call addmrg_to(compocn, 'Faxa_evap', & + call addmrg_to(compocn, 'Foxx_evap', & mrg_from=compatm, mrg_fld='Faxa_evap', mrg_type='copy_with_weights', mrg_fracname='ofrac') end if end if - else if (trim(coupling_mode) == 'nems_orig_data' .or. trim(coupling_mode) == 'nems_frac_aoflux') then - ! nems_orig_data - ! to ocn: surface stress from mediator and ice stress via auto merge - allocate(flds(2)) - flds = (/'taux', 'tauy'/) - do n = 1,size(flds) - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then - call addfld_aoflux('Faox_'//trim(flds(n))) - call addfld_from(compice , 'Fioi_'//trim(flds(n))) - call addfld_to(compocn , 'Foxx_'//trim(flds(n))) - end if - else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_'//trim(flds(n)), rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_'//trim(flds(n)), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_'//trim(flds(n)), rc=rc)) then - call addmap_from(compice, 'Fioi_'//trim(flds(n)), compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compocn, 'Foxx_'//trim(flds(n)), & - mrg_from=compmed, mrg_fld='Faox_'//trim(flds(n)), mrg_type='merge', mrg_fracname='ofrac') - call addmrg_to(compocn, 'Foxx_'//trim(flds(n)), & - mrg_from=compice, mrg_fld='Fioi_'//trim(flds(n)), mrg_type='merge', mrg_fracname='ifrac') - end if - end if - end do - deallocate(flds) - - ! to ocn: long wave net via auto merge - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compocn)) then - call addfld_aoflux('Faox_lwup') - call addfld_from(compatm, 'Faxa_lwdn') - call addfld_to(compocn, 'Foxx_lwnet') - end if - else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_lwnet', rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc)) then - call addmap_from(compatm, 'Faxa_lwdn', compocn, maptype, 'one', 'unset') - call addmrg_to(compocn, 'Foxx_lwnet', & - mrg_from=compmed, mrg_fld='Faox_lwup', mrg_type='merge', mrg_fracname='ofrac') - call addmrg_to(compocn, 'Foxx_lwnet', & - mrg_from=compatm, mrg_fld='Faxa_lwdn', mrg_type='merge', mrg_fracname='ofrac') - end if - end if - - ! to ocn: sensible heat flux from mediator via auto merge - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compocn)) then - call addfld_aoflux('Faox_sen') - call addfld_to(compocn, 'Faox_sen') - end if - else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faox_sen', rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_sen' , rc=rc)) then - call addmrg_to(compocn, 'Faox_sen', & - mrg_from=compmed, mrg_fld='Faox_sen', mrg_type='copy_with_weights', mrg_fracname='ofrac') - end if - end if - - ! to ocn: evaporation water flux from mediator via auto merge - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compocn)) then - call addfld_aoflux('Faox_evap') - call addfld_to(compocn, 'Faox_evap') - end if - else - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Faox_evap', rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_evap' , rc=rc)) then - call addmrg_to(compocn, 'Faox_evap', & - mrg_from=compmed, mrg_fld='Faox_evap', mrg_type='copy_with_weights', mrg_fracname='ofrac') - end if - end if end if - ! to ocn: water flux due to melting ice from ice - ! to ocn: heat flux from melting ice from ice - ! to ocn: salt flux from ice + ! to ocn: unmerged fluxes from ice + ! - water flux due to melting ice from ice + ! - heat flux from melting ice from ice + ! - salt flux from ice allocate(flds(3)) flds = (/'Fioi_meltw', 'Fioi_melth', 'Fioi_salt '/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compice, trim(fldname)) - call addfld_to(compocn, trim(fldname)) + call addfld_from(compice , fldname) + call addfld_to(compocn , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(compocn) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then - call addmap_from(compice, trim(fldname), compocn, mapfcopy, 'unset', 'unset') - call addmrg_to(compocn, trim(fldname), & - mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy_with_weights', mrg_fracname='ifrac') + if ( fldchk(is_local%wrap%FBexp(compocn) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), fldname, rc=rc)) then + call addmap_from(compice, fldname, compocn, mapfcopy, 'unset', 'unset') + call addmrg_to(compocn, fldname, & + mrg_from=compice, mrg_fld=fldname, mrg_type='copy_with_weights', mrg_fracname='ifrac') end if end if end do @@ -590,14 +523,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compwav) .and. is_local%wrap%comp_present(compocn)) then - call addfld_from(compwav, trim(fldname)) - call addfld_to(compocn, trim(fldname)) + call addfld_from(compwav , fldname) + call addfld_to(compocn , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(compocn) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compwav,compwav), trim(fldname), rc=rc)) then - call addmap_from(compwav, trim(fldname), compocn, mapbilnr_nstod, 'one', 'unset') - call addmrg_to(compocn, trim(fldname), mrg_from=compwav, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compocn) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav,compwav), fldname, rc=rc)) then + call addmap_from(compwav, fldname, compocn, mapbilnr_nstod, 'one', 'unset') + call addmrg_to(compocn, fldname, mrg_from=compwav, mrg_fld=fldname, mrg_type='copy') end if end if end do @@ -607,14 +540,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! FIELDS TO ICE (compice) !===================================================================== - ! to ice - fluxes from atm - ! to ice: downward longwave heat flux from atm - ! to ice: downward direct near-infrared incident solar radiation from atm - ! to ice: downward direct visible incident solar radiation from atm - ! to ice: downward diffuse near-infrared incident solar radiation from atm - ! to ice: downward Diffuse visible incident solar radiation from atm - ! to ice: rain from atm - ! to ice: snow from atm + ! to ice: fluxes from atm + ! - downward longwave heat flux from atm + ! - downward direct near-infrared incident solar radiation from atm + ! - downward direct visible incident solar radiation from atm + ! - downward diffuse near-infrared incident solar radiation from atm + ! - downward Diffuse visible incident solar radiation from atm + ! - rain from atm + ! - snow from atm allocate(flds(7)) flds = (/'Faxa_lwdn ', 'Faxa_swndr', 'Faxa_swvdr', 'Faxa_swndf', 'Faxa_swvdf', & @@ -623,69 +556,67 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compice)) then - call addfld_from(compatm, trim(fldname)) - call addfld_to(compice, trim(fldname)) + call addfld_from(compatm , fldname) + call addfld_to(compice , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap_from(compatm, trim(fldname), compice, maptype, 'one', 'unset') - call addmrg_to(compice, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compice) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then + call addmap_from(compatm, fldname, compice, maptype, 'one', 'unset') + call addmrg_to(compice, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') end if end if end do deallocate(flds) - ! to ice - state from atm - ! to ice: height at the lowest model level from atm - ! to ice: pressure at the lowest model level from atm - ! to ice: temperature at the lowest model level from atm - ! to ice: zonal wind at the lowest model level from atm - ! to ice: meridional wind at the lowest model level from atm - ! to ice: specific humidity at the lowest model level from atm + ! to ice: states from atm + ! - height at the lowest model level from atm + ! - pressure at the lowest model level from atm + ! - temperature at the lowest model level from atm + ! - zonal wind at the lowest model level from atm + ! - meridional wind at the lowest model level from atm + ! - specific humidity at the lowest model level from atm allocate(flds(6)) - flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', & - 'Sa_shum'/) + flds = (/'Sa_u ', 'Sa_v ', 'Sa_z ', 'Sa_tbot', 'Sa_pbot', 'Sa_shum'/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compice)) then - call addfld_from(compatm, trim(fldname)) - call addfld_to(compice, trim(fldname)) + call addfld_from(compatm , fldname) + call addfld_to(compice , fldname) endif else - if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap_from(compatm, trim(fldname), compice, maptype, 'one', 'unset') - call addmrg_to(compice, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compice) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then + call addmap_from(compatm, fldname, compice, maptype, 'one', 'unset') + call addmrg_to(compice, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') end if end if end do deallocate(flds) - ! to ice - states and fluxes from ocn - ! to ice: sea surface temperature from ocn - ! to ice: sea surface salinity from ocn - ! to ice: zonal sea water velocity from ocn - ! to ice: meridional sea water velocity from ocn - ! to ice: zonal sea surface slope from ocn - ! to ice: meridional sea surface slope from ocn - ! to ice: ocean melt and freeze potential from ocn + ! to ice: states and fluxes from ocn + ! - sea surface temperature from ocn + ! - sea surface salinity from ocn + ! - zonal sea water velocity from ocn + ! - meridional sea water velocity from ocn + ! - zonal sea surface slope from ocn + ! - meridional sea surface slope from ocn + ! - ocean melt and freeze potential from ocn allocate(flds(7)) - flds = (/'So_t ', 'So_s ', 'So_u ', 'So_v ','So_dhdx', & - 'So_dhdy', 'Fioo_q '/) + flds = (/'So_t ', 'So_s ', 'So_u ', 'So_v ','So_dhdx', 'So_dhdy', 'Fioo_q '/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compice)) then - call addfld_from(compocn, trim(fldname)) - call addfld_to(compice, trim(fldname)) + call addfld_from(compocn , fldname) + call addfld_to(compice , fldname) endif else - if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then - call addmap_from(compocn, trim(fldname), compice, mapfcopy , 'unset', 'unset') - call addmrg_to(compice, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compice) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), fldname, rc=rc)) then + call addmap_from(compocn, fldname, compice, mapfcopy , 'unset', 'unset') + call addmrg_to(compice, fldname, mrg_from=compocn, mrg_fld=fldname, mrg_type='copy') end if end if end do @@ -693,8 +624,8 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then - call addfld_from(compwav, 'Sw_elevation_spectrum') - call addfld_to(compice, 'Sw_elevation_spectrum') + call addfld_from(compwav , 'Sw_elevation_spectrum') + call addfld_to(compice , 'Sw_elevation_spectrum') end if else if ( fldchk(is_local%wrap%FBExp(compice) , 'Sw_elevation_spectrum', rc=rc) .and. & @@ -709,63 +640,69 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) ! FIELDS TO WAV (compwav) !===================================================================== - ! to wav - 10m winds and bottom temperature from atm + ! to wav: states from atm + ! - 10m meridonal and zonal winds + ! - bottom temperature from atm allocate(flds(3)) flds = (/'Sa_u10m', 'Sa_v10m', 'Sa_tbot'/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(compwav)) then - call addfld_from(compatm, trim(fldname)) - call addfld_to(compwav, trim(fldname)) + call addfld_from(compatm , fldname) + call addfld_to(compwav , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap_from(compatm, trim(fldname), compwav, mapbilnr_nstod, 'one', 'unset') - call addmrg_to(compwav, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compwav) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then + call addmap_from(compatm, fldname, compwav, mapbilnr_nstod, 'one', 'unset') + call addmrg_to(compwav, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') end if end if end do deallocate(flds) - ! to wav: sea ice fraction, thickness and floe diameter + ! to wav: states from ice + ! - sea ice fraction + ! - sea ice thickness + ! - sea ice floe diameter allocate(flds(3)) flds = (/'Si_ifrac ', 'Si_floediam', 'Si_thick '/) do n = 1,size(flds) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compwav)) then - call addfld_from(compice, trim(fldname)) - call addfld_to(compwav, trim(fldname)) + call addfld_from(compice , fldname) + call addfld_to(compwav , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then - call addmap_from(compice, trim(fldname), compwav, mapbilnr_nstod , 'one', 'unset') - call addmrg_to(compwav, trim(fldname), mrg_from=compice, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(compwav) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), fldname, rc=rc)) then + call addmap_from(compice, fldname, compwav, mapbilnr_nstod , 'one', 'unset') + call addmrg_to(compwav, fldname, mrg_from=compice, mrg_fld=fldname, mrg_type='copy') end if end if end do deallocate(flds) - ! to wav: zonal sea water velocity from ocn - ! to wav: meridional sea water velocity from ocn - ! to wav: surface temperature from ocn - allocate(flds(3)) - flds = (/'So_u', 'So_v', 'So_t'/) - do n = 1,size(flds) - fldname = trim(flds(n)) - if (phase == 'advertise') then - if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compwav)) then - call addfld_from(compocn, trim(fldname)) - call addfld_to(compwav, trim(fldname)) - end if - else - if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then - call addmap_from(compocn, trim(fldname), compwav, mapbilnr_nstod , 'one', 'unset') - call addmrg_to(compwav, trim(fldname), mrg_from=compocn, mrg_fld=trim(fldname), mrg_type='copy') + ! to wav: states from ocn + ! - zonal sea water velocity from ocn + ! - meridional sea water velocity from ocn + ! - surface temperature from ocn + allocate(flds(3)) + flds = (/'So_u', 'So_v', 'So_t'/) + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + if (is_local%wrap%comp_present(compocn) .and. is_local%wrap%comp_present(compwav)) then + call addfld_from(compocn , fldname) + call addfld_to(compwav , fldname) + end if + else + if ( fldchk(is_local%wrap%FBexp(compwav) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), fldname, rc=rc)) then + call addmap_from(compocn, fldname, compwav, mapbilnr_nstod , 'one', 'unset') + call addmrg_to(compwav, fldname, mrg_from=compocn, mrg_fld=fldname, mrg_type='copy') end if end if end do @@ -796,14 +733,14 @@ subroutine esmFldsExchange_nems(gcomp, phase, rc) fldname = trim(flds(n)) if (phase == 'advertise') then if (is_local%wrap%comp_present(compatm) .and. is_local%wrap%comp_present(complnd)) then - call addfld_from(compatm, trim(fldname)) - call addfld_to(complnd, trim(fldname)) + call addfld_from(compatm , fldname) + call addfld_to(complnd , fldname) end if else - if ( fldchk(is_local%wrap%FBexp(complnd) , trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then - call addmap_from(compatm, trim(fldname), complnd, maptype, 'one', 'unset') - call addmrg_to(complnd, trim(fldname), mrg_from=compatm, mrg_fld=trim(fldname), mrg_type='copy') + if ( fldchk(is_local%wrap%FBexp(complnd) , fldname, rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), fldname, rc=rc)) then + call addmap_from(compatm, fldname, complnd, maptype, 'one', 'unset') + call addmrg_to(complnd, fldname, mrg_from=compatm, mrg_fld=fldname, mrg_type='copy') end if end if end do diff --git a/mediator/med.F90 b/mediator/med.F90 index 3efc94a6e..9bb936f60 100644 --- a/mediator/med.F90 +++ b/mediator/med.F90 @@ -934,7 +934,6 @@ subroutine AdvertiseFields(gcomp, importState, exportState, clock, rc) endif endif - if (profile_memory) call ESMF_VMLogMemInfo("Leaving "//trim(subname)) call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -1775,7 +1774,7 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- ! NOTE: this section must be done BEFORE the second call to esmFldsExchange - ! Create field bundles for mediator ocean albedo computation + ! Create field bundles for mediator atm/ocean flux computation fieldCount = med_fldList_GetNumFlds(med_fldList_getaofluxfldList()) if ( fieldCount > 0 ) then if ( is_local%wrap%med_coupling_active(compocn,compatm) .or. & diff --git a/mediator/med_fraction_mod.F90 b/mediator/med_fraction_mod.F90 index 2fd83972a..7fe0315b6 100644 --- a/mediator/med_fraction_mod.F90 +++ b/mediator/med_fraction_mod.F90 @@ -365,11 +365,8 @@ subroutine med_fraction_init(gcomp, rc) call med_map_field(field_src, field_dst, is_local%wrap%RH(compocn,compatm,:), maptype, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Set 'aofrac' in FBfrac(compatm) - if (trim(coupling_mode) == 'nems_orig' .or. & - trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_frac_aoflux' .or. & - trim(coupling_mode) == 'nems_frac_aoflux_sbs') then + ! Set 'aofrac' in FBfrac(compatm) if available + if ( fldbun_fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', rc=rc)) then call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', Sa_ofrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBFrac(compatm), 'aofrac', aofrac, rc) @@ -788,11 +785,8 @@ subroutine med_fraction_set(gcomp, rc) call med_map_field(field_src, field_dst, is_local%wrap%RH(compice,compatm,:), maptype, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - ! Set 'aofrac' from FBImp(compatm) to FBfrac(compatm) - if (trim(coupling_mode) == 'nems_orig' .or. & - trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_frac_aoflux' .or. & - trim(coupling_mode) == 'nems_frac_aoflux_sbs') then + ! Set 'aofrac' from FBImp(compatm) to FBfrac(compatm) if available + if ( fldbun_fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', rc=rc)) then call fldbun_getdata1d(is_local%wrap%FBImp(compatm,compatm), 'Sa_ofrac', Sa_ofrac, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return call fldbun_getdata1d(is_local%wrap%FBFrac(compatm), 'aofrac', aofrac, rc) diff --git a/mediator/med_phases_prep_atm_mod.F90 b/mediator/med_phases_prep_atm_mod.F90 index 3ce87e874..01d1a52d0 100644 --- a/mediator/med_phases_prep_atm_mod.F90 +++ b/mediator/med_phases_prep_atm_mod.F90 @@ -132,30 +132,15 @@ subroutine med_phases_prep_atm(gcomp, rc) !--- merge all fields to atm !--------------------------------------- fldList => med_fldList_GetfldListTo(compatm) - if (trim(coupling_mode) == 'cesm' .or. & - trim(coupling_mode) == 'nems_frac_aoflux') then - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compatm), & - is_local%wrap%FBExp(compatm), & - is_local%wrap%FBFrac(compatm), & - is_local%wrap%FBImp(:,compatm), & - fldList, & - FBMed1=is_local%wrap%FBMed_ocnalb_a, & - FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_orig' .or. & - trim(coupling_mode) == 'hafs' .or. & - trim(coupling_mode) == 'nems_frac_aoflux_sbs') then - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compatm), & - is_local%wrap%FBExp(compatm), & - is_local%wrap%FBFrac(compatm), & - is_local%wrap%FBImp(:,compatm), & - fldList, & - rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compatm), & + is_local%wrap%FBExp(compatm), & + is_local%wrap%FBFrac(compatm), & + is_local%wrap%FBImp(:,compatm), & + fldList, & + FBMed1=is_local%wrap%FBMed_ocnalb_a, & + FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then call FB_diagnose(is_local%wrap%FBExp(compatm),string=trim(subname)//' FBexp(compatm) ', rc=rc) diff --git a/mediator/med_phases_prep_ocn_mod.F90 b/mediator/med_phases_prep_ocn_mod.F90 index 52faa2175..d76f3e81a 100644 --- a/mediator/med_phases_prep_ocn_mod.F90 +++ b/mediator/med_phases_prep_ocn_mod.F90 @@ -116,30 +116,14 @@ subroutine med_phases_prep_ocn_accum(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return fldList => med_fldList_GetfldListTo(compocn) ! auto merges to ocn - if ( trim(coupling_mode) == 'cesm' .or. & - trim(coupling_mode) == 'nems_orig_data' .or. & - trim(coupling_mode) == 'nems_frac_aoflux') then - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compocn), & - is_local%wrap%FBExp(compocn), & - is_local%wrap%FBFrac(compocn), & - is_local%wrap%FBImp(:,compocn), & - fldList, & - FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (trim(coupling_mode) == 'nems_frac' .or. & - trim(coupling_mode) == 'nems_orig' .or. & - trim(coupling_mode) == 'hafs' .or. & - trim(coupling_mode) == 'nems_frac_aoflux_sbs') then - call med_merge_auto(& - is_local%wrap%med_coupling_active(:,compocn), & - is_local%wrap%FBExp(compocn), & - is_local%wrap%FBFrac(compocn), & - is_local%wrap%FBImp(:,compocn), & - fldList, & - rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if + call med_merge_auto(& + is_local%wrap%med_coupling_active(:,compocn), & + is_local%wrap%FBExp(compocn), & + is_local%wrap%FBFrac(compocn), & + is_local%wrap%FBImp(:,compocn), & + fldList, & + FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! compute enthaly associated with rain, snow, condensation and liquid river runoff ! the sea-ice model already accounts for the enthalpy flux (as part of melth), so From 65aeefb34ea5d3aefba759c500a67ea6592d3153 Mon Sep 17 00:00:00 2001 From: James Edwards Date: Tue, 10 Oct 2023 13:42:12 -0600 Subject: [PATCH 35/36] fix hang on abort issue --- cesm/driver/esmApp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/cesm/driver/esmApp.F90 b/cesm/driver/esmApp.F90 index 12cf1537d..5215ea2aa 100644 --- a/cesm/driver/esmApp.F90 +++ b/cesm/driver/esmApp.F90 @@ -139,7 +139,7 @@ program esmApp ! Call Run for the ensemble driver !----------------------------------------------------------------------------- call ESMF_GridCompRun(ensemble_driver_comp, userRc=urc, rc=rc) - if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, & + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & file=__FILE__)) & call ESMF_Finalize(endflag=ESMF_END_ABORT) From 493a9b9a228dc520cf94d183a14a70048aedb13e Mon Sep 17 00:00:00 2001 From: James Edwards Date: Thu, 12 Oct 2023 16:28:43 -0600 Subject: [PATCH 36/36] support for job_priority on derecho --- cime_config/config_component.xml | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/cime_config/config_component.xml b/cime_config/config_component.xml index a329be743..d73964961 100644 --- a/cime_config/config_component.xml +++ b/cime_config/config_component.xml @@ -534,6 +534,15 @@ List of job ids for most recent case.submit + + char + regular + regular,premium,economy + run_begin_stop_restart + env_run.xml + job priority for systems supporting this option + +