diff --git a/config/cesm/config_files.xml b/config/cesm/config_files.xml index 5fd586014c0..9ff04054c79 100644 --- a/config/cesm/config_files.xml +++ b/config/cesm/config_files.xml @@ -212,6 +212,19 @@ $CIMEROOT/config/xml_schemas/config_compsets.xsd + + char + unset + + $CIMEROOT/src/components/stub_comps/siac + $CIMEROOT/src/components/xcpl_comps/xiac + + case_comps + env_case.xml + Root directory of the case integrated assessment component + $CIMEROOT/config/xml_schemas/config_compsets.xsd + + char unset @@ -502,6 +515,19 @@ $CIMEROOT/config/xml_schemas/entry_id_version3.xsd + + char + unset + + $COMP_ROOT_DIR_IAC/cime_config/config_component.xml + + case_last + env_case.xml + file containing specification of component specific definitions and values(for documentation only - DO NOT EDIT) + $CIMEROOT/config/xml_schemas/entry_id.xsd + $CIMEROOT/config/xml_schemas/entry_id_version3.xsd + + char diff --git a/config/cesm/config_grids.xml b/config/cesm/config_grids.xml index 11d501bb4ba..2a6724fe25b 100644 --- a/config/cesm/config_grids.xml +++ b/config/cesm/config_grids.xml @@ -44,6 +44,7 @@ ww3a ww3a ww3a + null @@ -277,6 +278,12 @@ tx0.66v1 + + T62 + T62 + tx0.25v1 + + T62 T62 @@ -1002,11 +1009,11 @@ tx0.66v1 - + C96 C96 - tx0.66v1 - tx0.66v1 + tx0.25v1 + tx0.25v1 @@ -1400,7 +1407,9 @@ EXPERIMENTAL FVM physics grid + + 320 384 @@ -1433,6 +1442,14 @@ Experimental for MOM6 experiments + + 1440 1080 + $DIN_LOC_ROOT/share/domains/domain.ocn.tx0.25v1.190207.nc + $DIN_LOC_ROOT/share/meshes/tx0.25v1_190204_ESMFmesh.nc + tx0.25v1 is tripole v1 0.25-deg MOM6 grid: + Experimental for MOM6 experiments + + 3600 2400 $DIN_LOC_ROOT/share/domains/domain.ocn.tx0.1v2.161014.nc @@ -1461,7 +1478,9 @@ Experimental, under development + + 360 180 @@ -1554,8 +1573,8 @@ OCN2WAV_SMAPNAME ICE2WAV_SMAPNAME - ROF2OCN_LIQ_RMAPNAME - ROF2OCN_ICE_RMAPNAME + ROF2OCN_LIQ_RMAPNAME + ROF2OCN_ICE_RMAPNAME LND2ROF_FMAPNAME ROF2LND_FMAPNAME diff --git a/config/cesm/config_grids_common.xml b/config/cesm/config_grids_common.xml index 82f9d56a0dc..ff3e2595a1d 100644 --- a/config/cesm/config_grids_common.xml +++ b/config/cesm/config_grids_common.xml @@ -1,6 +1,7 @@ + @@ -459,7 +460,6 @@ cpl/gridmaps/gland4km/map_gland4km_to_gx3v7_nnsm_e1000r500_180502.nc cpl/gridmaps/gland4km/map_gland4km_to_gx3v7_nnsm_e1000r500_180502.nc - cpl/gridmaps/gland5km/map_gland5km_to_gx1v6_nn_open_ocean_nnsm_e1000r300_marginal_sea_171105.nc cpl/gridmaps/gland5km/map_gland5km_to_gx1v6_nnsm_e1000r300_171105.nc @@ -490,4 +490,26 @@ cpl/gridmaps/gland20km/map_gland20km_to_gx3v7_nnsm_e1000r500_180502.nc + + + + + + cpl/gridmaps/ww3a/map_ww3a_TO_gx3v7_splice_150428.nc + cpl/gridmaps/gx3v7/map_gx3v7_TO_ww3a_splice_150428.nc + cpl/gridmaps/gx3v7/map_gx3v7_TO_ww3a_splice_150428.nc + + + + cpl/gridmaps/ww3a/map_ww3a_TO_gx1v6_splice_150428.nc + cpl/gridmaps/gx1v6/map_gx1v6_TO_ww3a_splice_150428.nc + cpl/gridmaps/gx1v6/map_gx1v6_TO_ww3a_splice_150428.nc + + + + cpl/gridmaps/ww3a/map_ww3a_TO_gx1v7_splice_170214.nc + cpl/gridmaps/gx1v7/map_gx1v7_TO_ww3a_splice_170214.nc + cpl/gridmaps/gx1v7/map_gx1v7_TO_ww3a_splice_170214.nc + + diff --git a/config/cesm/config_grids_mct.xml b/config/cesm/config_grids_mct.xml index c7e4abc0eda..b5ed729b98f 100644 --- a/config/cesm/config_grids_mct.xml +++ b/config/cesm/config_grids_mct.xml @@ -75,6 +75,7 @@ cpl/gridmaps/gx1v6/map_gx1v6_TO_fv1.9x2.5_aave.130322.nc cpl/gridmaps/gx1v6/map_gx1v6_TO_fv1.9x2.5_aave.130322.nc + cpl/gridmaps/fv1.9x2.5/map_fv1.9x2.5_TO_gx1v7_aave.181205.nc cpl/gridmaps/fv1.9x2.5/map_fv1.9x2.5_TO_gx1v7_blin.181205.nc @@ -82,6 +83,7 @@ cpl/gridmaps/gx1v7/map_gx1v7_TO_fv1.9x2.5_aave.181205.nc cpl/gridmaps/gx1v7/map_gx1v7_TO_fv1.9x2.5_aave.181205.nc + cpl/cpl6/map_fv1.9x2.5_to_tx1v1_aave_da_090710.nc cpl/cpl6/map_fv1.9x2.5_to_tx1v1_bilin_da_090710.nc @@ -349,24 +351,6 @@ - - cpl/gridmaps/ww3a/map_ww3a_TO_gx3v7_splice_150428.nc - cpl/gridmaps/gx3v7/map_gx3v7_TO_ww3a_splice_150428.nc - cpl/gridmaps/gx3v7/map_gx3v7_TO_ww3a_splice_150428.nc - - - - cpl/gridmaps/ww3a/map_ww3a_TO_gx1v6_splice_150428.nc - cpl/gridmaps/gx1v6/map_gx1v6_TO_ww3a_splice_150428.nc - cpl/gridmaps/gx1v6/map_gx1v6_TO_ww3a_splice_150428.nc - - - - cpl/gridmaps/ww3a/map_ww3a_TO_gx1v7_splice_170214.nc - cpl/gridmaps/gx1v7/map_gx1v7_TO_ww3a_splice_170214.nc - cpl/gridmaps/gx1v7/map_gx1v7_TO_ww3a_splice_170214.nc - - cpl/gridmaps/ww3a/map_ww3a_TO_tx1v1_blin.170523.nc cpl/gridmaps/tx1v1/map_tx1v1_TO_ww3a_blin.170523.nc diff --git a/config/cesm/machines/config_machines.xml b/config/cesm/machines/config_machines.xml index 10180ba10bb..956fdd1531b 100644 --- a/config/cesm/machines/config_machines.xml +++ b/config/cesm/machines/config_machines.xml @@ -2309,7 +2309,7 @@ This allows using a different mpirun command to launch unit tests - /home1/06242/tg855414/ESMF-INSTALL/master/lib/libg/Linux.intel.64.intelmpi.default/esmf.mk + /work/06242/tg855414/stampede2/ESMF-INSTALL/8.0.0bs28/lib/libO/Linux.intel.64.intelmpi.default/esmf.mk ON @@ -2421,7 +2421,7 @@ This allows using a different mpirun command to launch unit tests netcdf/4.3.0 pnetcdf /scratch4/NCEPDEV/nems/noscrub/emc.nemspara/soft/modulefiles - esmf/8.0.0bs27g + esmf/8.0.0bs28g diff --git a/config/e3sm/config_files.xml b/config/e3sm/config_files.xml index f1476c4c0d6..738514de330 100644 --- a/config/e3sm/config_files.xml +++ b/config/e3sm/config_files.xml @@ -365,6 +365,19 @@ $CIMEROOT/config/xml_schemas/entry_id_version3.xsd + + char + unset + + $CIMEROOT/src/components/stub_comps/siac/cime_config/config_component.xml + + case_last + env_case.xml + file containing specification of component specific definitions and values(for documentation only - DO NOT EDIT) + $CIMEROOT/config/xml_schemas/entry_id.xsd + $CIMEROOT/config/xml_schemas/entry_id_version3.xsd + + char unset diff --git a/config/e3sm/config_grids.xml b/config/e3sm/config_grids.xml index 6040eb0cf14..49b3615d54b 100644 --- a/config/e3sm/config_grids.xml +++ b/config/e3sm/config_grids.xml @@ -45,6 +45,7 @@ ww3a ww3a ww3a + null diff --git a/config/e3sm/tests.py b/config/e3sm/tests.py index 5e94a275932..d68f17ced72 100644 --- a/config/e3sm/tests.py +++ b/config/e3sm/tests.py @@ -41,6 +41,7 @@ "SMS_Ln9.ne4_ne4.FC5AV1C-L.cam-outfrq9s", "SMS.ne4_ne4.FC5AV1C-L.cam-cosplite", "SMS_R_Ld5.T42_T42.FSCM5A97", + "SMS_R_Ld5.ne4_ne4.FSCM5A97", "SMS_D_Ln5.ne4_ne4.FC5AV1C-L", ) }, diff --git a/config/xml_schemas/entry_id_base_version3.xsd b/config/xml_schemas/entry_id_base_version3.xsd index a173554a5bd..f4599927e9e 100644 --- a/config/xml_schemas/entry_id_base_version3.xsd +++ b/config/xml_schemas/entry_id_base_version3.xsd @@ -40,7 +40,7 @@ - + diff --git a/doc/source/index.rst b/doc/source/index.rst index 8665ab5e8ee..23edd2b13b1 100644 --- a/doc/source/index.rst +++ b/doc/source/index.rst @@ -14,7 +14,7 @@ and libraries. Table of contents ----------------- .. toctree:: - :maxdepth: 3 + :maxdepth: 2 what_cime/index.rst users_guide/index.rst diff --git a/doc/source/users_guide/creating-new-compsets.rst b/doc/source/users_guide/creating-new-compsets.rst deleted file mode 100644 index 440267bc2e7..00000000000 --- a/doc/source/users_guide/creating-new-compsets.rst +++ /dev/null @@ -1,61 +0,0 @@ -.. _creating-new-compsets: - -===================== -Creating New Compsets -===================== - -A description of how CIME interprets a compset name is given in the section :ref:`defining-compsets` . - -To create a new compset, you will at a minimum have to: - -1. edit the approprite ``config_components.xml`` file(s) to add your new requirements -2. edit associate ``namelist_definitions_xxx.xml`` in the associated ``cime_config`` directories. - (e.g. if a change is made to the the ``config_components.xml`` for ``DOCN`` then ``namelist_definitions_docn.xml`` file will also need to be modified). - -It is important to point out, that you will need expertise in the target component(s) you are trying to modify in order to add new compset functionality for that particular component. -We provide a few examples below that outline this process for a few simple cases. - -Example 1: ----------- - -Say you want to add a new mode, ``FOO``, to the data ocean model, ``DOCN``. Lets call this mode, ``FOO``. -This would imply when parsing the compset longname, CIME would need to be able to recognize the string ``_DOCN%FOO_``. -To enable this, you will need to do the following: - -1. edit ``$CIMEROOT/src/components/data_comps/docn/cime_config/config_component.xml`` (see the ``FOO`` additions below). - - * add an entry to the ```` block as shown below :: - - - DOCN - ... - new mode - .... - - - * add an entry to the ```` block as shown below:: - - - .... - - .... - prescribed - ... - - - * modify any of the other xml entries that need a new dependence on ``FOO`` - -2. edit ``$CIMEROOT/src/components/data_comps/docn/cime_config/namelist_definition_docn.xml`` (see the ``FOO`` additions below). - - * add an entry to the ``datamode`` block as shown below. :: - - - .... - ...FOO - ... - - - * add additional changes to ``namelist_definition_docn.xml`` for the new mode - - -.. todo:: Add additional examples for creating a case diff --git a/doc/source/users_guide/use_cases/cesm-nml.rst b/doc/source/users_guide/use_cases/cesm-nml.rst deleted file mode 100644 index 9082523d326..00000000000 --- a/doc/source/users_guide/use_cases/cesm-nml.rst +++ /dev/null @@ -1,92 +0,0 @@ -================================================================= -Customizing CESM active component-specific namelist settings -================================================================= - ---- -CAM ---- - -CAM's `configure `_ and `build-namelist `_ utilities are called by ``Buildconf/cam.buildnml.csh``. The folllowing are used to set compset variables (for example, "-phys cam5" for CAM_CONFIG_OPTS) and in general should not be modified for supported compsets: -:: - - `CAM_CONFIG_OPTS `_ - `CAM_NAMELIST_OPTS `_ - `CAM_NML_USECASE `_ - -For complete documentation of namelist settings, see `CAM namelist variables `_. - -To modify CAM namelist settings, add the appropriate keyword/value pair at the end of the **$CASEROOT/user_nl_cam** file. (See the documentation for each file at the top of that file.) - -For example, to change the solar constant to 1363.27, modify **user_nl_cam** file to contain the following line at the end: -:: - - solar_const=1363.27 - -To see the result, call **preview_namelists** and verify that the new value appears in **CaseDocs/atm_in**. - ---- -CLM ---- - -CIME calls **$SRCROOT/components/clm/cime_config/buildnml** to generate the CLM namelist variables. -CLM-specific CIME xml variables are set in **$SRCROOT/components/clm/cime_config/config_component.xml** and are used by CLM's **buildnml** script to generate the namelist. - -For complete documentation of namelist settings, see `CLM namelist variables `_. - -To modify CLM namelist settings, add the appropriate keyword/value pair at the end of the **$CASEROOT/user_nl_clm** file. To see the result, call **preview_namelists** and verify that the changes appear correctly in **CaseDocs/lnd_in**. - ---- -RTM ---- - -CIME calls **$SRCROOT/components/rtm/cime_config/buildnml** to generate the RTM namelist variables. - -For complete documentation of namelist settings, see RTM namelist variables. //SHOULD THERE BE A LINK HERE?// - -To modify RTM namelist settings, add the appropriate keyword/value pair at the end of the **$CASEROOT/user_nl_rtm** file. To see the result of your change, call **preview_namelists** and verify that the changes appear correctly in **CaseDocs/rof_in**. - ---- -CICE ---- - -The CICE `configure `_ and `build-namelist `_ utilities are called by **Buildconf/cice.buildnml.csh**. Note that `CICE_CONFIG_OPTS `_ and `CICE_NAMELIST_OPTS `_ are used to set compset-specific variables and in general should not be modified for supported compsets. - -For complete documentation of namelist settings, see `CICE namelist variables `_. - -To modify CICE namelist settings, add the appropriate keyword/value pair at the end of the **$CASEROOT/user_nl_cice** file. (See the documentation for each file at the top of that file.) To see the result of your change, call **preview_namelists** and verify that the changes appear correctly in **CaseDocs/ice_in**. - -In addition, **case.setup** creates CICE's compile time `block decomposition variables `_ in **env_build.xml** as follows: -:: - - ./case.setup - ? - Buildconf/cice.buildnml.csh and $NTASKS_ICE and $NTHRDS_ICE - ? - env_build.xml variables CICE_BLCKX, CICE_BLCKY, CICE_MXBLCKS, CICE_DECOMPTYPE - CPP variables in cice.buildexe.csh - ----- -POP2 ----- -See `POP2 namelist variables `_ for complete description of the POP2 runtime namelist variables. Note that `OCN_COUPLING, OCN_ICE_FORCING andOCN_TRANSIENT `_ are normally used ONLY to set compset-specific variables and should not be edited. For complete documentation of namelist settings, see `CICE namelist variables `_. - -To modify POP2 namelist settings, add the appropriate keyword/value pair at the end of the **$CASEROOT/user_nl_pop2** file. (See the documentation for each file at the top of that file.) To see the result of your change, call **preview_namelists** and verify that the changes appear correctly in **CaseDocs/ocn_in**. - -In addition, **cesm_setup** generates POP2's compile-time `block decomposition variables `_ in **env_build.xml** as shown here: -:: - - ./cesm_setup - ? - Buildconf/pop2.buildnml.csh and $NTASKS_OCN and $NTHRDS_OCN - ? - env_build.xml variables POP2_BLCKX, POP2_BLCKY, POP2_MXBLCKS, POP2_DECOMPTYPE - CPP variables in pop2.buildexe.csh - ----- -CISM ----- -See `CISM namelist variables `_ for a complete description of the CISM runtime namelist variables. This includes variables that appear both in **cism_in** and in **cism.config**. - -To modify any of these settings, add the appropriate keyword/value pair at the end of the **user_nl_cism** file. (See the documentation for each file at the top of that file.) To see the result of your change, call **preview_namelists** and verify that the changes appear correctly in **CaseDocs/cism_in** and **CaseDocs/cism.config**. - -Some CISM runtime settings are sets via **env_run.xml**, as documented in `CISM runtime variables `_. The model resolution, for example, is set via ``CISM_GRID``. The value of ``CISM_GRID`` determines the default value of a number of other namelist parameters. diff --git a/doc/source/users_guide/use_cases/datamod-nml.rst b/doc/source/users_guide/use_cases/datamod-nml.rst deleted file mode 100644 index cb6dd3f7934..00000000000 --- a/doc/source/users_guide/use_cases/datamod-nml.rst +++ /dev/null @@ -1,100 +0,0 @@ -.. _changing-data-model-namelists: - -Customizing data model namelists and stream files ---------------------------------------------------- - -Data Atmosphere (DATM) -~~~~~~~~~~~~~~~~~~~~~~ - -DATM is discussed in detail in :ref:`data atmosphere overview `. -DATM can be user-customized by changing either its *namelist input files* or its *stream files*. -The namelist file for DATM is **datm_in** (or **datm_in_NNN** for multiple instances). - -- To modify **datm_in** or **datm_in_NNN**, add the appropriate keyword/value pair(s) for the namelist changes that you want at the end of the **user_nl_datm** file or the **user_nl_datm_NNN** file in ``$CASEROOT``. - -- To modify the contents of a DATM stream file, first run **preview_namelists** to list the *streams.txt* files in the **CaseDocs/** directory. Then, in the same directory: - - 1. Make a *copy* of the file with the string *"user_"* prepended. - ``> cp datm.streams.txt.[extension] user_datm.streams.txt[extension.`` - 2. **Change the permissions of the file to be writeable.** (chmod 644) - ``chmod 644 user_datm.streams.txt[extension`` - 3. Edit the **user_datm.streams.txt.*** file. - -**Example** - -If the stream txt file is **datm.streams.txt.CORE2_NYF.GISS**, the modified copy should be **user_datm.streams.txt.CORE2_NYF.GISS**. -After calling **preview_namelists** again, your edits should appear in **CaseDocs/datm.streams.txt.CORE2_NYF.GISS**. - -Data Ocean (DOCN) -~~~~~~~~~~~~~~~~~~~~~~ - -DOCN is discussed in detail in :ref:`data ocean overview `. -DOCN can be user-customized by changing either its namelist input or its stream files. -The namelist file for DOCN is **docn_in** (or **docn_in_NNN** for multiple instances). - -- To modify **docn_in** or **docn_in_NNN**, add the appropriate keyword/value pair(s) for the namelist changes that you want at the end of the file in ``$CASEROOT``. - -- To modify the contents of a DOCN stream file, first run **preview_namelists** to list the *streams.txt* files in the **CaseDocs/** directory. Then, in the same directory: - - 1. Make a *copy* of the file with the string *"user_"* prepended. - ``> cp docn.streams.txt.[extension] user_docn.streams.txt[extension.`` - 2. **Change the permissions of the file to be writeable.** (chmod 644) - ``chmod 644 user_docn.streams.txt[extension`` - 3. Edit the **user_docn.streams.txt.*** file. - -**Example** - -As an example, if the stream text file is **docn.stream.txt.prescribed**, the modified copy should be **user_docn.streams.txt.prescribed**. -After changing this file and calling **preview_namelists** again, your edits should appear in **CaseDocs/docn.streams.txt.prescribed**. - -Data Sea-ice (DICE) -~~~~~~~~~~~~~~~~~~~~~~ - -DICE is discussed in detail in :ref:`data sea-ice overview `. -DICE can be user-customized by changing either its namelist input or its stream files. -The namelist file for DICE is ``dice_in`` (or ``dice_in_NNN`` for multiple instances) and its values can be changed by editing the ``$CASEROOT`` file ``user_nl_dice`` (or ``user_nl_dice_NNN`` for multiple instances). - -- To modify **dice_in** or **dice_in_NNN**, add the appropriate keyword/value pair(s) for the namelist changes that you want at the end of the file in ``$CASEROOT``. - -- To modify the contents of a DICE stream file, first run **preview_namelists** to list the *streams.txt* files in the **CaseDocs/** directory. Then, in the same directory: - - 1. Make a *copy* of the file with the string *"user_"* prepended. - ``> cp dice.streams.txt.[extension] user_dice.streams.txt[extension.`` - 2. **Change the permissions of the file to be writeable.** (chmod 644) - ``chmod 644 user_dice.streams.txt[extension`` - 3. Edit the **user_dice.streams.txt.*** file. - -Data Land (DLND) -~~~~~~~~~~~~~~~~~~~~~~ - -DLND is discussed in detail in :ref:`data land overview `. -DLND can be user-customized by changing either its namelist input or its stream files. -The namelist file for DLND is ``dlnd_in`` (or ``dlnd_in_NNN`` for multiple instances) and its values can be changed by editing the ``$CASEROOT`` file ``user_nl_dlnd`` (or ``user_nl_dlnd_NNN`` for multiple instances). - -- To modify **dlnd_in** or **dlnd_in_NNN**, add the appropriate keyword/value pair(s) for the namelist changes that you want at the end of the file in ``$CASEROOT``. - -- To modify the contents of a DLND stream file, first run **preview_namelists** to list the *streams.txt* files in the **CaseDocs/** directory. Then, in the same directory: - - 1. Make a *copy* of the file with the string *"user_"* prepended. - ``> cp dlnd.streams.txt.[extension] user_dlnd.streams.txt[extension.`` - 2. **Change the permissions of the file to be writeable.** (chmod 644) - ``chmod 644 user_dlnd.streams.txt[extension`` - 3. Edit the **user_dlnd.streams.txt.*** file. - -Data River (DROF) -~~~~~~~~~~~~~~~~~~~~~~ - -DROF is discussed in detail in :ref:`data river overview `. -DROF can be user-customized by changing either its namelist input or its stream files. -The namelist file for DROF is ``drof_in`` (or ``drof_in_NNN`` for multiple instances) and its values can be changed by editing the ``$CASEROOT`` file ``user_nl_drof`` (or ``user_nl_drof_NNN`` for multiple instances). - -- To modify **drof_in** or **drof_in_NNN**, add the appropriate keyword/value pair(s) for the namelist changes that you want at the end of the file in ``$CASEROOT``. - -- To modify the contents of a DROF stream file, first run **preview_namelists** to list the *streams.txt* files in the **CaseDocs/** directory. Then, in the same directory: - - 1. Make a *copy* of the file with the string *"user_"* prepended. - ``> cp drof.streams.txt.[extension] user_drof.streams.txt[extension.`` - 2. **Change the permissions of the file to be writeable.** (chmod 644) - ``chmod 644 user_drof.streams.txt[extension`` - 3. Edit the **user_drof.streams.txt.*** file. - diff --git a/doc/source/users_guide/use_cases/driver-nml.rst b/doc/source/users_guide/use_cases/driver-nml.rst deleted file mode 100644 index 768beaf1c7e..00000000000 --- a/doc/source/users_guide/use_cases/driver-nml.rst +++ /dev/null @@ -1,20 +0,0 @@ - -Modifying driver namelists -------------------------------------------- - -Driver namelist variables belong in two groups: - -1. Those that are set directly from ``$CASEROOT`` xml variables. - -2. Those that are set by the driver utility **$CIMEROOT/src/drivers/mct/cime_config/buildnml**. - -All driver namelist variables are defined in the file **$CIMEROOT/src/drivers/mct/cime_config/namelist_definition_drv.xml**. -The variables that can be changed only by modifying xml variables appear with the *entry* attribute ``modify_via_xml="xml_variable_name"``. - -All other variables that appear in the **namelist_definition_drv.xml** file can be modified by adding a keyword value pair at the end of ``user_nl_cpl``. -For example, to change the driver namelist value of ``eps_frac`` to ``1.0e-15``, add the following line to the end of the ``user_nl_cpl``: -:: - - eps_frac = 1.0e-15 - -To see the result of change, call **preview_namelists** and verify that the new value appears in **CaseDocs/drv_in**. diff --git a/doc/source/users_guide/use_cases/namelist-gen.rst b/doc/source/users_guide/use_cases/namelist-gen.rst deleted file mode 100644 index 2d380f958cf..00000000000 --- a/doc/source/users_guide/use_cases/namelist-gen.rst +++ /dev/null @@ -1,29 +0,0 @@ -.. _namelist-gen: - -Changing namelist values -========================= - -All CIME-compliant components generate their namelist settings using a **buildnml** file located in the component's **cime_config** directory -For example, the CIME data atmosphere model (DATM) generates namelists using the script **$CIMEROOT/components/data_comps/datm/cime_config/buildnml**. - -User-specific component namelist changes should be made only by: - -- editing the **$CASEROOT/user_nl_xxx** files. - -- using :ref:`xmlchange` to modify xml variables in **env_run.xml**, **env_build.xml** or **env_mach_pes.xml**. - -You can preview the component namelists by running **preview_namelists** from ``$CASEROOT``. -This results in the creation of component namelists (for example, atm_in, lnd_in, and so on) in **$CASEROOT/CaseDocs/**. The namelist files are there only for user reference and SHOULD NOT BE EDITED since they are overwritten every time **preview_namelists** and **case.submit** are called. - -Here are two examples of how to invoke **xmlchange**: - -:: - - xmlchange = - -- OR -- - xmlchange -id -val -file - -The ``-id`` argument identifies the variable to be changed, and ``-val`` is the intended value of that variable. See the **help** text for more usage information: -:: - - xmlchange --help diff --git a/scripts/Tools/Makefile b/scripts/Tools/Makefile index aaf7e8bb1b6..58c1261e845 100644 --- a/scripts/Tools/Makefile +++ b/scripts/Tools/Makefile @@ -91,7 +91,7 @@ include $(CASEROOT)/Macros.make # Unless DEBUG mode is enabled, use NDEBUG to turn off assert statements. ifeq ($(strip $(DEBUG)),TRUE) - #CPPDEFS += -DDEBUG + CPPDEFS += -DDEBUG else CPPDEFS += -DNDEBUG endif @@ -103,14 +103,6 @@ endif ifeq ($(COMP_INTERFACE), nuopc) CPPDEFS += -DNUOPC_INTERFACE - CPPDEFS += -DESMFUSE_$(COMP_ATM) - CPPDEFS += -DESMFUSE_$(COMP_LND) - CPPDEFS += -DESMFUSE_$(COMP_OCN) - CPPDEFS += -DESMFUSE_$(COMP_ICE) - CPPDEFS += -DESMFUSE_$(COMP_ROF) - CPPDEFS += -DESMFUSE_$(COMP_WAV) - CPPDEFS += -DESMFUSE_$(COMP_GLC) - CPPDEFS += -DESMFUSE_$(COMP_ESP) else CPPDEFS += -DMCT_INTERFACE endif @@ -136,12 +128,6 @@ ifeq (,$(SHAREDPATH)) INSTALL_SHAREDPATH = $(EXEROOT)/$(SHAREDPATH) endif -include $(CASEROOT)/Macros.make - -ifeq ($(strip $(USE_FMS)), TRUE) - SLIBS += -lfms -endif - # Decide whether to use a C++ or Fortran linker, based on whether we # are using any C++ code and the compiler-dependent CXX_LINKER variable ifeq ($(USE_CXX), TRUE) @@ -294,13 +280,11 @@ ifeq ($(strip $(USE_ALBANY)), TRUE) include $(ALBANY_PATH)/export_albany.in endif -ifeq ($(strip $(USE_KOKKOS)), TRUE) - include $(INSTALL_SHAREDPATH)/Makefile.kokkos - SLIBS += $(KOKKOS_LIBS) - CFLAGS += $(KOKKOS_CXXFLAGS) - CXX_LDFLAGS += $(KOKKOS_LDFLAGS) +ifeq ($(strip $(USE_FMS)), TRUE) + SLIBS += -lfms endif + # Set MOAB info if it is being used ifeq ($(strip $(USE_MOAB)), TRUE) ifdef MOAB_PATH @@ -454,7 +438,7 @@ ifdef INC_MOAB endif ifeq ($(MODEL),driver) - INCLDIR += -I$(EXEROOT)/atm/obj -I$(EXEROOT)/ice/obj -I$(EXEROOT)/ocn/obj -I$(EXEROOT)/glc/obj -I$(EXEROOT)/rof/obj -I$(EXEROOT)/wav/obj -I$(EXEROOT)/esp/obj + INCLDIR += -I$(EXEROOT)/atm/obj -I$(EXEROOT)/ice/obj -I$(EXEROOT)/ocn/obj -I$(EXEROOT)/glc/obj -I$(EXEROOT)/rof/obj -I$(EXEROOT)/wav/obj -I$(EXEROOT)/esp/obj -I$(EXEROOT)/iac/obj # nagfor and gcc have incompatible LDFLAGS. # nagfor requires the weird "-Wl,-Wl,," syntax. # If done in config_compilers.xml, we break MCT. @@ -848,6 +832,7 @@ ifeq ($(ULIBDEP),$(null)) ULIBDEP += $(LIBROOT)/librof.a ULIBDEP += $(LIBROOT)/libglc.a ULIBDEP += $(LIBROOT)/libwav.a + ULIBDEP += $(LIBROOT)/libiac.a ULIBDEP += $(LIBROOT)/libesp.a ifeq ($(COMP_GLC), cism) ULIBDEP += $(CISM_LIBDIR)/libglimmercismfortran.a @@ -946,6 +931,9 @@ clean_dependsocn: clean_dependswav: $(RM) -f $(EXEROOT)/wav/obj/Srcfiles +clean_dependsiac: + $(RM) -f $(EXEROOT)/iac/obj/Srcfiles + clean_dependsglc: $(RM) -f $(EXEROOT)/glc/obj/Srcfiles @@ -964,7 +952,7 @@ clean_dependslnd: clean_dependscsmshare: $(RM) -f $(SHAREDLIBROOT)/$(SHAREDPATH)/$(COMP_INTERFACE)/$(ESMFDIR)/$(NINST_VALUE)/csm_share/Srcfiles -clean_depends: clean_dependsatm clean_dependscpl clean_dependswav clean_dependsglc clean_dependsice clean_dependsrof clean_dependslnd clean_dependscsmshare clean_dependsesp +clean_depends: clean_dependsatm clean_dependscpl clean_dependswav clean_dependsglc clean_dependsice clean_dependsrof clean_dependslnd clean_dependscsmshare clean_dependsesp clean_dependsiac cleanatm: @@ -982,6 +970,10 @@ cleanwav: $(RM) -f $(LIBROOT)/libwav.a $(RM) -fr $(EXEROOT)/wav/obj +cleaniac: + $(RM) -f $(LIBROOT)/libiac.a + $(RM) -fr $(EXEROOT)/iac/obj + cleanesp: $(RM) -f $(LIBROOT)/libesp.a $(RM) -fr $(EXEROOT)/esp/obj @@ -1018,7 +1010,7 @@ cleangptl: $(RM) -f $(GPTLLIB) $(RM) -fr $(SHAREDLIBROOT)/$(SHAREDPATH)/gptl -clean: cleanatm cleanocn cleanwav cleanglc cleanice cleanrof cleanlnd cleanesp +clean: cleanatm cleanocn cleanwav cleanglc cleanice cleanrof cleanlnd cleanesp cleaniac realclean: clean cleancsmshare cleanpio cleanmct cleangptl diff --git a/scripts/Tools/archive_metadata b/scripts/Tools/archive_metadata index 85f4930b7ec..8114a3eaf40 100755 --- a/scripts/Tools/archive_metadata +++ b/scripts/Tools/archive_metadata @@ -565,7 +565,7 @@ def get_case_status(case_dict): # exclude the proc directories in the sta size estimates for subdir in ['atm/hist', 'cpl/hist', 'esp/hist', 'ice/hist', 'glc/hist', 'lnd/hist', 'logs', 'ocn/hist', 'rest', 'rof/hist', - 'wav/hist']: + 'wav/hist', 'iac/hist']: path = os.path.join(case_dict['sta_path'], subdir) if os.path.isdir(path): case_dict['sta_size'] += get_disk_usage(path) diff --git a/scripts/Tools/case.build b/scripts/Tools/case.build index 00573d4b8dc..162fd6123f8 100755 --- a/scripts/Tools/case.build +++ b/scripts/Tools/case.build @@ -69,7 +69,7 @@ def parse_command_line(args, description): # config_file = files.get_value("CONFIG_CPL_FILE") # component = Component(config_file, "CPL") # comps = [x.lower() for x in component.get_valid_model_components()] - comps = ["cpl","atm","lnd","ice","ocn","rof","glc","wav","esp"] + comps = ["cpl","atm","lnd","ice","ocn","rof","glc","wav","esp","iac"] libs = ["csmshare", "mct", "pio", "gptl"] allobjs = comps + libs diff --git a/scripts/Tools/xmlconvertors/config_pes_converter.py b/scripts/Tools/xmlconvertors/config_pes_converter.py index 2a633365400..a02bf7cfab0 100755 --- a/scripts/Tools/xmlconvertors/config_pes_converter.py +++ b/scripts/Tools/xmlconvertors/config_pes_converter.py @@ -74,7 +74,7 @@ def to_cime5(self): commentnode.text = "none" for d in ['ntasks', 'nthrds', 'rootpe']: newnode = ET.SubElement(pesnode, d) - for comp in ['atm', 'lnd', 'rof', 'ice', 'ocn', 'glc', 'wav', 'cpl']: + for comp in ['atm', 'lnd', 'rof', 'ice', 'ocn', 'glc', 'wav', 'cpl', 'iac']: tag = d + '_' + comp if tag in self.data[d]: ET.SubElement(newnode, tag).text = str(self.data[d][tag]) @@ -127,7 +127,7 @@ def set_data(self, xmlnode): # Set Defaults for d in ['ntasks', 'nthrds', 'rootpe']: self.data[d] = {} - for comp in ['atm', 'lnd', 'ice', 'ocn', 'glc', 'rof', 'wav', 'cpl']: + for comp in ['atm', 'lnd', 'ice', 'ocn', 'glc', 'rof', 'wav', 'cpl', 'iac']: self.data['ntasks']['ntasks_' + comp] = self.ISDEFAULT self.data['nthrds']['nthrds_' + comp] = self.ISDEFAULT self.data['rootpe']['rootpe_' + comp] = self.ISDEFAULT @@ -144,7 +144,7 @@ def set_data(self, xmlnode): self.data['pesize'] = xmlnode.get('PECOUNT', default='any') self.data['compset'] = xmlnode.get('CCSM_LCOMPSET', default='any') for d in ['ntasks', 'nthrds', 'rootpe']: - for comp in ['atm', 'lnd', 'ice', 'ocn', 'glc', 'rof', 'wav', 'cpl']: + for comp in ['atm', 'lnd', 'ice', 'ocn', 'glc', 'rof', 'wav', 'cpl', 'iac']: tag = d + '_' + comp node = xmlnode.find(tag.upper()) if node is not None: @@ -169,7 +169,7 @@ def set_data(self, xmlnode): atmtag = d + '_atm' if self.data[d][atmtag] == self.ISDEFAULT: self.data[d][atmtag] = self.DEFAULTS[d] - for comp in ['lnd', 'rof', 'ice', 'ocn', 'glc', 'wav', 'cpl']: + for comp in ['lnd', 'rof', 'ice', 'ocn', 'glc', 'wav', 'cpl', 'iac']: tag = d + '_' + comp if self.data[d][tag] == self.ISDEFAULT: self.data[d][tag] = self.data[d][atmtag] diff --git a/scripts/Tools/xmlconvertors/grid_xml_converter.py b/scripts/Tools/xmlconvertors/grid_xml_converter.py index a4f31944b61..da26917a493 100755 --- a/scripts/Tools/xmlconvertors/grid_xml_converter.py +++ b/scripts/Tools/xmlconvertors/grid_xml_converter.py @@ -116,7 +116,7 @@ def set_data(self, xmlnode): self.data['maps'] = {} self.xmlnode = xmlnode for k in ['atm_grid', 'lnd_grid', 'ocn_grid', 'rof_grid', 'glc_grid', - 'wav_grid', 'ice_grid']: + 'wav_grid', 'ice_grid', 'iac_grid' ]: att = xmlnode.get(k) if att is not None: self.data[k] = att.strip() diff --git a/scripts/lib/CIME/BuildTools/macroconditiontree.py b/scripts/lib/CIME/BuildTools/macroconditiontree.py index e01f784d741..4172f2621f5 100644 --- a/scripts/lib/CIME/BuildTools/macroconditiontree.py +++ b/scripts/lib/CIME/BuildTools/macroconditiontree.py @@ -53,7 +53,7 @@ def __init__(self, name, settings): "found after the ambiguity check was complete, " \ "or there is a mixture of appending and initial " \ "settings in the condition tree." - self._assignments.append((name, setting.value, setting.force_no_append)) + self._assignments.append((name, setting.value)) self._set_up += setting.set_up self._tear_down += setting.tear_down else: @@ -138,8 +138,8 @@ def write_out(self, writer): if self._is_leaf: for line in self._set_up: writer.write_line(line) - for (name, value, force_no_append) in self._assignments: - if self._do_append and not force_no_append: + for (name, value) in self._assignments: + if self._do_append: writer.append_variable(name, value) else: writer.set_variable(name, value) diff --git a/scripts/lib/CIME/BuildTools/valuesetting.py b/scripts/lib/CIME/BuildTools/valuesetting.py index 8289ffba23e..706e8fb01f4 100644 --- a/scripts/lib/CIME/BuildTools/valuesetting.py +++ b/scripts/lib/CIME/BuildTools/valuesetting.py @@ -28,14 +28,13 @@ class ValueSetting(object): has_special_case """ - def __init__(self, value, do_append, conditions, set_up, tear_down, force_no_append=False): # pylint: disable=too-many-arguments + def __init__(self, value, do_append, conditions, set_up, tear_down): # pylint: disable=too-many-arguments """Create a ValueSetting object by specifying all its data.""" self.value = value self.do_append = do_append self.conditions = conditions self.set_up = set_up self.tear_down = tear_down - self.force_no_append = force_no_append def is_ambiguous_with(self, other): """Check to see if this setting conflicts with another one. diff --git a/scripts/lib/CIME/XML/grids.py b/scripts/lib/CIME/XML/grids.py index 93fd54ca9b6..64402bbeb67 100644 --- a/scripts/lib/CIME/XML/grids.py +++ b/scripts/lib/CIME/XML/grids.py @@ -157,7 +157,7 @@ def _read_config_grids(self, name, compset, atmnlev, lndnlev): # determine component grids and associated required domains and gridmaps # TODO: this should be in XML, not here - prefix = {"atm":"a%", "lnd":"l%", "ocnice":"oi%", "rof":"r%", "wav":"w%", "glc":"g%", "mask":"m%"} + prefix = {"atm":"a%", "lnd":"l%", "ocnice":"oi%", "rof":"r%", "wav":"w%", "glc":"g%", "mask":"m%", "iac":"z%"} lname = "" for component_gridname in self._comp_gridnames: if lname: @@ -204,7 +204,7 @@ def _get_domains(self, component_grids, atmlevregex, lndlevregex, driver): # use component_grids to create grids dictionary # TODO: this should be in XML, not here grids = [("atm", "a%"), ("lnd", "l%"), ("ocn", "o%"), ("mask", "m%"),\ - ("ice", "i%"), ("rof", "r%"), ("glc", "g%"), ("wav", "w%")] + ("ice", "i%"), ("rof", "r%"), ("glc", "g%"), ("wav", "w%"), ("iac", "z%")] domains = {} mask_name = None if 'm%' in component_grids: @@ -281,7 +281,7 @@ def _get_gridmaps(self, component_grids, driver): set all mapping files for config_grids.xml v2 schema """ grids = [("atm_grid","a%"), ("lnd_grid","l%"), ("ocn_grid","o%"), \ - ("rof_grid","r%"), ("glc_grid","g%"), ("wav_grid","w%")] + ("rof_grid","r%"), ("glc_grid","g%"), ("wav_grid","w%"), ("iac_grid","z%")] gridmaps = {} # (1) set all possibly required gridmaps to idmap diff --git a/scripts/lib/CIME/case/case.py b/scripts/lib/CIME/case/case.py index 220a554bb45..ba7b942e417 100644 --- a/scripts/lib/CIME/case/case.py +++ b/scripts/lib/CIME/case/case.py @@ -544,29 +544,30 @@ def _valid_compset_impl(self, compset_name, comp_classes, comp_hash): ('2000_DATM%NYF_SLND_DICE%SSMI_DOCN%DOM_DROF%NYF_SGLC_SWAV_SESP', ['2000', 'DATM%NYF', 'SLND', 'DICE%SSMI', 'DOCN%DOM', 'DROF%NYF', 'SGLC', 'SWAV', 'SESP']) >>> Case(read_only=False)._valid_compset_impl('2000_DICE%SSMI_DOCN%DOM_DATM%NYF_DROF%NYF', ['CPL', 'ATM', 'LND', 'ICE', 'OCN', 'ROF', 'GLC', 'WAV', 'ESP'], {'datm':1,'satm':1,'dlnd':2,'slnd':2,'dice':3,'sice':3,'docn':4,'socn':4,'drof':5,'srof':5,'sglc':6,'swav':7,'ww3':7,'sesp':8}) ('2000_DATM%NYF_SLND_DICE%SSMI_DOCN%DOM_DROF%NYF_SGLC_SWAV_SESP', ['2000', 'DATM%NYF', 'SLND', 'DICE%SSMI', 'DOCN%DOM', 'DROF%NYF', 'SGLC', 'SWAV', 'SESP']) + >>> Case(read_only=False)._valid_compset_impl('2000_DICE%SSMI_DOCN%DOM_DATM%NYF_DROF%NYF_TEST', ['CPL', 'ATM', 'LND', 'ICE', 'OCN', 'ROF', 'GLC', 'WAV', 'ESP'], {'datm':1,'satm':1,'dlnd':2,'slnd':2,'dice':3,'sice':3,'docn':4,'socn':4,'drof':5,'srof':5,'sglc':6,'swav':7,'ww3':7,'sesp':8}) + ('2000_DATM%NYF_SLND_DICE%SSMI_DOCN%DOM_DROF%NYF_SGLC_SWAV_SESP_TEST', ['2000', 'DATM%NYF', 'SLND', 'DICE%SSMI', 'DOCN%DOM', 'DROF%NYF', 'SGLC', 'SWAV', 'SESP']) >>> Case(read_only=False)._valid_compset_impl('1850_CAM60_CLM50%BGC-CROP_CICE_POP2%ECO%ABIO-DIC_MOSART_CISM2%NOEVOLVE_WW3_BGC%BDRD', ['CPL', 'ATM', 'LND', 'ICE', 'OCN', 'ROF', 'GLC', 'WAV', 'ESP'], {'datm':1,'satm':1, 'cam':1,'dlnd':2,'clm':2,'slnd':2,'cice':3,'dice':3,'sice':3,'pop':4,'docn':4,'socn':4,'mosart':5,'drof':5,'srof':5,'cism':6,'sglc':6,'ww':7,'swav':7,'ww3':7,'sesp':8}) - ('1850_CAM60_CLM50%BGC-CROP_CICE_POP2%ECO%ABIO-DIC_MOSART_CISM2%NOEVOLVE_WW3_SESP_BGC%BDRD', ['1850', 'CAM60', 'CLM50%BGC-CROP', 'CICE', 'POP2%ECO%ABIO-DIC', 'MOSART', 'CISM2%NOEVOLVE', 'WW3', 'SESP', 'BGC%BDRD']) + ('1850_CAM60_CLM50%BGC-CROP_CICE_POP2%ECO%ABIO-DIC_MOSART_CISM2%NOEVOLVE_WW3_SESP_BGC%BDRD', ['1850', 'CAM60', 'CLM50%BGC-CROP', 'CICE', 'POP2%ECO%ABIO-DIC', 'MOSART', 'CISM2%NOEVOLVE', 'WW3', 'SESP']) + >>> Case(read_only=False)._valid_compset_impl('1850_CAM60_CLM50%BGC-CROP_CICE_POP2%ECO%ABIO-DIC_MOSART_CISM2%NOEVOLVE_WW3_BGC%BDRD_TEST', ['CPL', 'ATM', 'LND', 'ICE', 'OCN', 'ROF', 'GLC', 'WAV', 'IAC', 'ESP'], {'datm':1,'satm':1, 'cam':1,'dlnd':2,'clm':2,'slnd':2,'cice':3,'dice':3,'sice':3,'pop':4,'docn':4,'socn':4,'mosart':5,'drof':5,'srof':5,'cism':6,'sglc':6,'ww':7,'swav':7,'ww3':7,'sesp':8}) + ('1850_CAM60_CLM50%BGC-CROP_CICE_POP2%ECO%ABIO-DIC_MOSART_CISM2%NOEVOLVE_WW3_SIAC_SESP_BGC%BDRD_TEST', ['1850', 'CAM60', 'CLM50%BGC-CROP', 'CICE', 'POP2%ECO%ABIO-DIC', 'MOSART', 'CISM2%NOEVOLVE', 'WW3', 'SIAC', 'SESP']) """ # Find the models declared in the compset model_set = [None]*len(comp_classes) components = compset_name.split('_') model_set[0] = components[0] - # Check for BGC - if components[-1][0:3] == 'BGC': - bgc = components[-1] - last_ind = len(components) - 1 - else: - bgc = None - last_ind = len(components) - - for model in components[1:last_ind]: + noncomps = [] + for model in components[1:]: match = Case.__mod_match_re__.match(model.lower()) expect(match is not None, "No model match for {}".format(model)) mod_match = match.group(1) - expect(mod_match in comp_hash, - "Unknown model type, {}".format(model)) - comp_ind = comp_hash[mod_match] - model_set[comp_ind] = model + # Check for noncomponent appends (BGC & TEST) + if mod_match in ('bgc', 'test'): + noncomps.append(model) + else: + expect(mod_match in comp_hash, + "Unknown model type, {}".format(model)) + comp_ind = comp_hash[mod_match] + model_set[comp_ind] = model # Fill in missing components with stubs for comp_ind in range(1, len(model_set)): @@ -577,10 +578,10 @@ def _valid_compset_impl(self, compset_name, comp_classes, comp_hash): model_set[comp_ind] = stub # Return the completed compset - if bgc is not None: - model_set.append(bgc) - compsetname = '_'.join(model_set) + for noncomp in noncomps: + compsetname = compsetname + '_' + noncomp + return compsetname, model_set # RE to match component type name without optional piece (stuff after %). @@ -759,8 +760,7 @@ def _get_component_config_data(self, files, driver=None): logger.info("{} component is {}".format(comp_class, self._component_description[comp_class])) for env_file in self._env_entryid_files: env_file.add_elements_by_group(compobj, attributes=attlist) - - self.clean_up_lookups() + self.clean_up_lookups(allow_undefined=driver=='nuopc') def _setup_mach_pes(self, pecount, multi_driver, ninst, machine_name, mpilib): #-------------------------------------------- diff --git a/scripts/lib/CIME/case/case_submit.py b/scripts/lib/CIME/case/case_submit.py index 180d4f1dfd9..9907f6b7ab7 100644 --- a/scripts/lib/CIME/case/case_submit.py +++ b/scripts/lib/CIME/case/case_submit.py @@ -41,7 +41,7 @@ def _submit(case, job=None, no_batch=False, prereq=None, allow_fail=False, resub rpointer = "rpointer.drv" expect(os.path.exists(os.path.join(rundir,rpointer)), "CONTINUE_RUN is true but this case does not appear to have restart files staged in {}".format(rundir)) - # Finally we open the rpointer.drv file and check that it's correct + # Finally we open the rpointer file and check that it's correct casename = case.get_value("CASE") with open(os.path.join(rundir,rpointer), "r") as fd: ncfile = fd.readline().strip() diff --git a/scripts/testlist_cmeps.xml b/scripts/testlist_cmeps.xml deleted file mode 100644 index a2584a8b885..00000000000 --- a/scripts/testlist_cmeps.xml +++ /dev/null @@ -1,401 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 b/src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 index 741e79da16c..9c3f2d03e1c 100644 --- a/src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 +++ b/src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 @@ -27,16 +27,14 @@ module atm_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_grid_mod , only : shr_nuopc_grid_ArrayToState - use shr_nuopc_grid_mod , only : shr_nuopc_grid_StateToArray use shr_strdata_mod , only : shr_strdata_type use shr_const_mod , only : SHR_CONST_SPVAL - use dshr_nuopc_mod , only : fld_list_type, fldsMax, fld_list_realize + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData use datm_shr_mod , only : datm_shr_read_namelists use datm_shr_mod , only : iradsw, datm_shr_getNextRadCDay - use datm_comp_mod , only : datm_comp_init, datm_comp_run, datm_comp_advertise - use mct_mod , only : mct_Avect, mct_Avect_info + use datm_comp_mod , only : datm_comp_advertise, datm_comp_init, datm_comp_run + use datm_comp_mod , only : datm_comp_import, datm_comp_export implicit none private ! except @@ -57,9 +55,6 @@ module atm_comp_nuopc type (fld_list_type) :: fldsToAtm(fldsMax) type (fld_list_type) :: fldsFrAtm(fldsMax) - type(shr_strdata_type) :: SDATM - type(mct_aVect) :: x2a - type(mct_aVect) :: a2x integer :: compid ! mct comp id integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom @@ -71,8 +66,6 @@ module atm_comp_nuopc character(len=256) :: case_name ! case name character(len=80) :: calendar ! calendar name logical :: atm_prognostic ! data is sent back to datm - character(len=CXX) :: flds_a2x = '' - character(len=CXX) :: flds_x2a = '' logical :: use_esmf_metadata = .false. character(*),parameter :: modName = "(atm_comp_nuopc)" integer, parameter :: debug_import = 0 ! if > 0 will diagnose import fields @@ -89,12 +82,11 @@ subroutine SetServices(gcomp, rc) integer, intent(out) :: rc ! local variables - integer :: dbrc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) @@ -129,7 +121,7 @@ subroutine SetServices(gcomp, rc) specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine SetServices @@ -140,6 +132,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -153,19 +146,17 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: ierr ! error code integer :: shrlogunit ! original log unit integer :: shrloglev ! original log level - logical :: isPresent integer :: localPet logical :: flds_co2a ! use case logical :: flds_co2b ! use case logical :: flds_co2c ! use case logical :: flds_wiso ! use case - integer :: dbrc character(len=CL) :: fileName ! generic file name character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! generate local mpi comm @@ -198,8 +189,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- filename = "datm_in"//trim(inst_suffix) - call datm_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDATM, atm_prognostic) + call datm_shr_read_namelists(filename, mpicom, my_task, master_task, logunit, atm_prognostic) !-------------------------------- ! determine necessary toggles for below @@ -208,35 +198,33 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2a - call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeGet(gcomp, name='flds_co2b', value=cvalue, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2b - call ESMF_LogWrite('flds_co2b = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('flds_co2b = '// trim(cvalue), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2c - call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeGet(gcomp, name='flds_wiso', value=cvalue, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_wiso - call ESMF_LogWrite('flds_wiso = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('flds_wiso = '// trim(cvalue), ESMF_LOGMSG_INFO) !-------------------------------- ! advertise import and export fields !-------------------------------- call datm_comp_advertise(importState, exportState, & - atm_prognostic, & - flds_wiso, flds_co2a, flds_co2b, flds_co2c, & - fldsFrAtm_num, fldsFrAtm, fldsToAtm_num, fldsToAtm, & - flds_a2x, flds_x2a, rc) + atm_prognostic, flds_wiso, flds_co2a, flds_co2b, flds_co2c, & + fldsFrAtm_num, fldsFrAtm, fldsToAtm_num, fldsToAtm, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -250,6 +238,8 @@ end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -280,7 +270,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) real(R8) :: orbMvelpp ! orb moving vernal eq (radians) real(R8) :: orbLambm0 ! orb mean long of perhelion (radians) real(R8) :: orbObliqr ! orb obliquity (radians) - integer :: dbrc + integer :: nxg, nyg character(len=*), parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- @@ -288,7 +278,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! from the config attributes of the gridded component rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to my log file @@ -357,7 +347,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then calendar = shr_cal_gregorian else - call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), ESMF_LOGMSG_ERROR, rc=dbrc) + call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), ESMF_LOGMSG_ERROR) rc = ESMF_Failure return end if @@ -389,13 +379,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Initialize model !---------------------------------------------------------------------------- - call datm_comp_init(x2a, a2x, & - SDATM, mpicom, compid, my_task, master_task, & + call datm_comp_init(mpicom, compid, my_task, master_task, & inst_suffix, inst_name, logunit, read_restart, & scmMode, scmlat, scmlon, & orbEccen, orbMvelpp, orbLambm0, orbObliqr, & calendar, modeldt, current_ymd, current_tod, current_mon, & - atm_prognostic, EMesh) + atm_prognostic, EMesh, nxg, nyg) !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -403,7 +392,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! by replacing the advertised fields with the newly created fields of the same name. !-------------------------------- - call fld_list_realize( & + call dshr_realize( & state=ExportState, & fldList=fldsFrAtm, & numflds=fldsFrAtm_num, & @@ -413,7 +402,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) mesh=Emesh, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call fld_list_realize( & + call dshr_realize( & state=importState, & fldList=fldsToAtm, & numflds=fldsToAtm_num, & @@ -425,21 +414,20 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- ! Pack export state - ! Copy from a2x to exportState ! Set the coupling scalars !-------------------------------- - call shr_nuopc_grid_ArrayToState(a2x%rattr, flds_a2x, exportState, grid_option='mesh', rc=rc) + call datm_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDATM%nxg),flds_scalar_index_nx, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDATM%nyg),flds_scalar_index_ny, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -449,7 +437,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- if (debug_export > 0) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + call shr_nuopc_methods_State_diagnose(exportState, subname//':ES',rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -465,15 +453,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_log_clock_advance, shr_nuopc_memcheck use perf_mod, only : t_startf, t_stopf + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -501,12 +491,11 @@ subroutine ModelAdvance(gcomp, rc) real(R8) :: orbLambm0 ! orb mean long of perhelion (radians) real(R8) :: orbObliqr ! orb obliquity (radians) character(len=256) :: cvalue - integer :: dbrc character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- call t_startf(subname) rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call shr_nuopc_memcheck(subname, 5, my_task==master_task) !-------------------------------- @@ -535,7 +524,7 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- if (atm_prognostic) then - call shr_nuopc_grid_StateToArray(importState, x2a%rattr, flds_x2a, grid_option='mesh', rc=rc) + call datm_comp_import(importState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -543,6 +532,7 @@ subroutine ModelAdvance(gcomp, rc) ! Run model !-------------------------------- + call t_startf('datm_get_attributes') ! Get orbital parameters (these can be changed by the mediator) ! TODO: need to put in capability for these to be modified for variable orbitals call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, rc=rc) @@ -557,9 +547,12 @@ subroutine ModelAdvance(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) orbMvelpp + call t_stopf('datm_get_attributes') ! Determine if need to write restarts + call t_startf('datm_get_clockinfo') + call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -587,14 +580,17 @@ subroutine ModelAdvance(gcomp, rc) call ESMF_TimeIntervalGet( timeStep, s=modeldt, rc=rc ) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('datm_get_clockinfo') + ! Advance the model - call datm_comp_run( x2a, a2x, & - SDATM, mpicom, compid, my_task, master_task, & + call t_startf('datm_run') + call datm_comp_run( mpicom, compid, my_task, master_task, & inst_suffix, logunit, & orbEccen, orbMvelpp, orbLambm0, orbObliqr, & write_restart, nextYMD, nextTOD, mon, modeldt, calendar, & atm_prognostic, case_name) + call t_stopf('datm_run') ! Use nextYMD and nextTOD here since since the component - clock is advance at the END of the time interval nextsw_cday = datm_shr_getNextRadCDay( nextYMD, nextTOD, stepno, modeldt, iradsw, calendar ) @@ -603,12 +599,16 @@ subroutine ModelAdvance(gcomp, rc) ! Pack export state !-------------------------------- - call shr_nuopc_grid_ArrayToState(a2x%rattr, flds_a2x, exportState, grid_option='mesh', rc=rc) + call t_startf('datm_export') + call datm_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('datm_export') + call t_startf('datm_export_setscalar') call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('datm_export_setscalar') !-------------------------------- ! diagnostics @@ -619,7 +619,7 @@ subroutine ModelAdvance(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if if(my_task == master_task) then - call shr_nuopc_log_clock_advance(clock, 'ATM', logunit) + call shr_nuopc_log_clock_advance(clock, 'DATM', logunit) endif !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -628,7 +628,7 @@ subroutine ModelAdvance(gcomp, rc) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) call t_stopf(subname) end subroutine ModelAdvance @@ -640,20 +640,19 @@ subroutine ModelFinalize(gcomp, rc) integer, intent(out) :: rc ! local variables - integer :: dbrc character(*), parameter :: F00 = "('(datm_comp_final) ',8a)" character(*), parameter :: F91 = "('(datm_comp_final) ',73('-'))" character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) if (my_task == master_task) then write(logunit,F91) write(logunit,F00) 'datm : end of main integration loop' write(logunit,F91) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ModelFinalize diff --git a/src/components/data_comps/datm/nuopc/datm_comp_mod.F90 b/src/components/data_comps/datm/nuopc/datm_comp_mod.F90 index dff6722e109..2450690262f 100644 --- a/src/components/data_comps/datm/nuopc/datm_comp_mod.F90 +++ b/src/components/data_comps/datm/nuopc/datm_comp_mod.F90 @@ -1,6 +1,7 @@ #ifdef AIX @PROCESS ALIAS_SIZE(805306368) #endif + module datm_comp_mod ! !USES: @@ -35,8 +36,7 @@ module datm_comp_mod use shr_dmodel_mod , only : shr_dmodel_translate_list, shr_dmodel_translateAV_list use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use dshr_nuopc_mod , only : fld_list_type - use dshr_nuopc_mod , only : dshr_fld_add + use dshr_nuopc_mod , only : fld_list_type, dshr_fld_add, dshr_export, dshr_import use datm_shr_mod , only : datm_shr_esat, datm_shr_CORE2getFactors use datm_shr_mod , only : datamode ! namelist input use datm_shr_mod , only : wiso_datm ! namelist input @@ -46,6 +46,7 @@ module datm_comp_mod use datm_shr_mod , only : iradsw ! namelist input use datm_shr_mod , only : nullstr use datm_shr_mod , only : presaero + use datm_shr_mod , only : SDATM ! !PUBLIC TYPES: @@ -59,11 +60,18 @@ module datm_comp_mod public :: datm_comp_advertise public :: datm_comp_init public :: datm_comp_run + public :: datm_comp_import + public :: datm_comp_export !-------------------------------------------------------------------------- ! Private data !-------------------------------------------------------------------------- + type(mct_aVect) :: x2a + type(mct_aVect) :: a2x + character(CXX) :: flds_a2x = '' + character(CXX) :: flds_x2a = '' + integer :: debug_import = 0 ! debug level (if > 0 will print all import fields) integer :: debug_export = 0 ! debug level (if > 0 will print all export fields) @@ -76,15 +84,19 @@ module datm_comp_mod integer :: krc,krl,ksc,ksl,kswndr,kswndf,kswvdr,kswvdf,kswnet integer :: kanidr,kanidf,kavsdr,kavsdf integer :: kshum_16O, kshum_18O, kshum_HDO - integer :: krc_18O, krc_HDO - integer :: krl_18O, krl_HDO - integer :: ksc_18O, ksc_HDO - integer :: ksl_18O, ksl_HDO + integer :: krc_16O, krc_18O, krc_HDO + integer :: krl_16O, krl_18O, krl_HDO + integer :: ksc_16O, ksc_18O, ksc_HDO + integer :: ksl_16O, ksl_18O, ksl_HDO integer :: stbot,swind,sz,spbot,sshum,stdew,srh,slwdn,sswdn,sswdndf,sswdndr integer :: sprecc,sprecl,sprecn,sco2p,sco2d,sswup,sprec,starcf integer :: srh_16O, srh_18O, srh_HDO, sprecn_16O, sprecn_18O, sprecn_HDO integer :: sprecsf integer :: sprec_af,su_af,sv_af,stbot_af,sshum_af,spbot_af,slwdn_af,sswdn_af + integer :: kbcphidry, kbcphodry, kbcphiwet + integer :: kocphidry, kocphodry, kocphiwet + integer :: kdstdry1, kdstdry2, kdstdry3, kdstdry4 + integer :: kdstwet1, kdstwet2, kdstwet3, kdstwet4 type(mct_avect) :: avstrm ! av of data from stream character(len=CS), pointer :: avifld(:) ! character array for field names coming from streams @@ -98,8 +110,6 @@ module datm_comp_mod character(len=CL), pointer :: olist_st(:) ! output character array for translation (stifld->strmofld) integer , pointer :: count_st(:) ! number of fields in translation (stifld->strmofld) character(len=CXX) :: flds_strm = '' ! colon deliminated string of field names - character(len=CXX) :: flds_a2x_mod - character(len=CXX) :: flds_x2a_mod real(R8), pointer :: xc(:), yc(:) ! arrays of model latitudes and longitudes real(R8), pointer :: windFactor(:) @@ -122,6 +132,8 @@ module datm_comp_mod data dTarc / 0.49_R8, 0.06_R8,-0.73_R8, -0.89_R8,-0.77_R8,-1.02_R8, & -1.99_R8,-0.91_R8, 1.72_R8, 2.30_R8, 1.81_R8, 1.06_R8/ + logical :: flds_co2a, flds_co2b, flds_co2c, flds_wiso + character(len=*),parameter :: rpfile = 'rpointer.atm' character(*),parameter :: u_FILE_u = & __FILE__ @@ -131,10 +143,8 @@ module datm_comp_mod !=============================================================================== subroutine datm_comp_advertise(importState, exportState, & - atm_prognostic, & - flds_wiso, flds_co2a, flds_co2b, flds_co2c, & - fldsFrAtm_num, fldsFrAtm, fldsToAtm_num, fldsToAtm, & - flds_a2x, flds_x2a, rc) + atm_prognostic, flds_wiso_in, flds_co2a_in, flds_co2b_in, flds_co2c_in, & + fldsFrAtm_num, fldsFrAtm, fldsToAtm_num, fldsToAtm, rc) ! 1. determine export and import fields to advertise to mediator ! 2. determine translation of fields from streams to export/import fields @@ -144,16 +154,14 @@ subroutine datm_comp_advertise(importState, exportState, & type(ESMF_State) :: importState type(ESMF_State) :: exportState logical , intent(in) :: atm_prognostic - logical , intent(in) :: flds_wiso ! use case - logical , intent(in) :: flds_co2a ! use case - logical , intent(in) :: flds_co2b ! use case - logical , intent(in) :: flds_co2c ! use case + logical , intent(in) :: flds_wiso_in ! use case + logical , intent(in) :: flds_co2a_in ! use case + logical , intent(in) :: flds_co2b_in ! use case + logical , intent(in) :: flds_co2c_in ! use case integer , intent(out) :: fldsFrAtm_num type (fld_list_type) , intent(out) :: fldsFrAtm(:) integer , intent(out) :: fldsToAtm_num type (fld_list_type) , intent(out) :: fldsToAtm(:) - character(len=*) , intent(out) :: flds_a2x - character(len=*) , intent(out) :: flds_x2a integer , intent(out) :: rc ! local variables @@ -162,6 +170,11 @@ subroutine datm_comp_advertise(importState, exportState, & rc = ESMF_SUCCESS + flds_wiso = flds_wiso_in + flds_co2a = flds_co2a_in + flds_co2b = flds_co2b_in + flds_co2c = flds_co2c_in + !------------------- ! export fields !------------------- @@ -196,28 +209,22 @@ subroutine datm_comp_advertise(importState, exportState, & call dshr_fld_add(data_fld="rainc", data_fld_array=avifld, model_fld="Faxa_rainc", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=krc, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - call dshr_fld_add(data_fld="rainl", data_fld_array=avifld, model_fld="Faxa_rainl", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=krl, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) call dshr_fld_add(data_fld="snowc", data_fld_array=avifld, model_fld="Faxa_snowc", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=ksc, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - call dshr_fld_add(data_fld="snowl", data_fld_array=avifld, model_fld="Faxa_snowl", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=ksl, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) call dshr_fld_add(data_fld="swndr", data_fld_array=avifld, model_fld="Faxa_swndr", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=kswndr, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - call dshr_fld_add(data_fld="swvdr", data_fld_array=avifld, model_fld="Faxa_swvdr", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=kswvdr, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - call dshr_fld_add(data_fld="swndf", data_fld_array=avifld, model_fld="Faxa_swndf", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=kswndf, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - call dshr_fld_add(data_fld="swvdf", data_fld_array=avifld, model_fld="Faxa_swvdf", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=kswvdf, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - call dshr_fld_add(data_fld="swnet", data_fld_array=avifld, model_fld="Faxa_swnet", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=kswnet, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) @@ -232,98 +239,114 @@ subroutine datm_comp_advertise(importState, exportState, & call dshr_fld_add(data_fld="shum", data_fld_array=avifld, model_fld="Sa_shum", model_fld_array=avofld, & model_fld_concat=flds_a2x, model_fld_index=kshum , fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - call dshr_fld_add(data_fld="lwdn", data_fld_array=avifld, model_fld="Faxa_lwdn", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=klwdn , fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) + call dshr_fld_add(data_fld="lwdn", data_fld_array=avifld, & + model_fld="Faxa_lwdn", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=klwdn, & + fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) if (flds_co2a .or. flds_co2b .or. flds_co2c) then - call dshr_fld_add(data_fld="co2prog", data_fld_array=avifld, model_fld="Sa_co2prog", model_fld_array=avofld, & - model_fld_concat=flds_x2a, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) + call dshr_fld_add(data_fld="co2prog", data_fld_array=avifld, & + model_fld="Sa_co2prog", model_fld_array=avofld, model_fld_concat=flds_x2a, & + fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - call dshr_fld_add(data_fld="co2diag", data_fld_array=avifld, model_fld="Sa_co2diag", model_fld_array=avofld, & - model_fld_concat=flds_x2a, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) + call dshr_fld_add(data_fld="co2diag", data_fld_array=avifld, & + model_fld="Sa_co2diag", model_fld_array=avofld, model_fld_concat=flds_x2a, & + fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) end if if (presaero) then - call dshr_fld_add(data_fld="bcphidry", data_fld_array=avifld, model_fld="Faxa_bcphidry", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="bcphodry", data_fld_array=avifld, model_fld="Faxa_bcphodry", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="bcphiwet", data_fld_array=avifld, model_fld="Faxa_bcphiwet", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="ocphidry", data_fld_array=avifld, model_fld="Faxa_ocphidry", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="ocphodry", data_fld_array=avifld, model_fld="Faxa_ocphodry", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="ocphiwet", data_fld_array=avifld, model_fld="Faxa_ocphiwet", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="dstwet1", data_fld_array=avifld, model_fld="Faxa_dstwet1", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="dstwet2", data_fld_array=avifld, model_fld="Faxa_dstwet2", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="dstwet3", data_fld_array=avifld, model_fld="Faxa_dstwet3", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="dstwet4", data_fld_array=avifld, model_fld="Faxa_dstwet4", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="dstdry1", data_fld_array=avifld, model_fld="Faxa_dstdry1", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="dstdry2", data_fld_array=avifld, model_fld="Faxa_dstdry2", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) + call dshr_fld_add(data_fld="bcphidry", data_fld_array=avifld, & + model_fld="Faxa_bcphidry", model_fld_array=avofld, model_fld_index=kbcphidry, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="bcphodry", data_fld_array=avifld, & + model_fld="Faxa_bcphodry", model_fld_array=avofld, model_fld_index=kbcphodry, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="bcphiwet", data_fld_array=avifld, & + model_fld="Faxa_bcphiwet", model_fld_array=avofld, model_fld_index=kbcphiwet, model_fld_concat=flds_a2x) + + call dshr_fld_add(med_fld='Faxa_bcph', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=3) + + call dshr_fld_add(data_fld="ocphidry", data_fld_array=avifld, & + model_fld="Faxa_ocphidry", model_fld_array=avofld, model_fld_index=kocphidry, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="ocphodry", data_fld_array=avifld, & + model_fld="Faxa_ocphodry", model_fld_array=avofld, model_fld_index=kocphodry, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="ocphiwet", data_fld_array=avifld, & + model_fld="Faxa_ocphiwet", model_fld_array=avofld, model_fld_index=kocphiwet, model_fld_concat=flds_a2x) + + call dshr_fld_add(med_fld='Faxa_ocph', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=3) + + call dshr_fld_add(data_fld="dstwet1", data_fld_array=avifld, & + model_fld="Faxa_dstwet1", model_fld_array=avofld, model_fld_index=kdstwet1, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="dstwet2", data_fld_array=avifld, & + model_fld="Faxa_dstwet2", model_fld_array=avofld, model_fld_index=kdstwet2, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="dstwet3", data_fld_array=avifld, & + model_fld="Faxa_dstwet3", model_fld_array=avofld, model_fld_index=kdstwet3, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="dstwet4", data_fld_array=avifld, & + model_fld="Faxa_dstwet4", model_fld_array=avofld, model_fld_index=kdstwet4, model_fld_concat=flds_a2x) + + call dshr_fld_add(med_fld='Faxa_dstwet', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=4) + + call dshr_fld_add(data_fld="dstdry1", data_fld_array=avifld, & + model_fld="Faxa_dstdry1", model_fld_array=avofld, model_fld_index=kdstdry1, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="dstdry2", data_fld_array=avifld, & + model_fld="Faxa_dstdry2", model_fld_array=avofld, model_fld_index=kdstdry2, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="dstdry3", data_fld_array=avifld, & + model_fld="Faxa_dstdry3", model_fld_array=avofld, model_fld_index=kdstdry3, model_fld_concat=flds_a2x) + call dshr_fld_add(data_fld="dstdry4", data_fld_array=avifld, & + model_fld="Faxa_dstdry4", model_fld_array=avofld, model_fld_index=kdstdry4, model_fld_concat=flds_a2x) + + call dshr_fld_add(med_fld='Faxa_dstdry', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=4) - call dshr_fld_add(data_fld="dstdry3", data_fld_array=avifld, model_fld="Faxa_dstdry3", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="dstdry4", data_fld_array=avifld, model_fld="Faxa_dstdry4", model_fld_array=avofld, & - model_fld_concat=flds_a2x, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) end if - ! isotopic forcing - + ! isopic forcing if (flds_wiso) then - - call dshr_fld_add(data_fld="rainc_18O", data_fld_array=avifld, model_fld="Faxa_rainc_18O", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=krc_18O, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="rainc_HDO", data_fld_array=avifld, model_fld="Faxa_rainc_HDO", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=krc_HDO, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="rainl_18O", data_fld_array=avifld, model_fld="Faxa_rainl_18O", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=krl_18O, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="rainl_HDO", data_fld_array=avifld, model_fld="Faxa_rainl_HDO", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=krl_HDO, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="snowc_18O", data_fld_array=avifld, model_fld="Faxa_snowc_18O", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=ksc_18O, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="snowc_HDO", data_fld_array=avifld, model_fld="Faxa_snowc_HDO", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=ksc_HDO, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="snowl_18O", data_fld_array=avifld, model_fld="Faxa_snowl_18O", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=ksl_18O, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="snowl_HDO", data_fld_array=avifld, model_fld="Faxa_snowl_HDO", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=ksl_HDO, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="shum_16O", data_fld_array=avifld, model_fld="Sa_shum_16O", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=kshum_16O, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="shum_18O", data_fld_array=avifld, model_fld="Sa_shum_18O", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=kshum_18O, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) - - call dshr_fld_add(data_fld="shum_HDO", data_fld_array=avifld, model_fld="Sa_shum_HDO", model_fld_array=avofld, & - model_fld_concat=flds_a2x, model_fld_index=kshum_HDO, fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm) + call dshr_fld_add(data_fld="rainc_16O", data_fld_array=avifld,& + model_fld="Faxa_rainc_18O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=krc_16O) + call dshr_fld_add(data_fld="rainc_18O", data_fld_array=avifld,& + model_fld="Faxa_rainc_18O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=krc_18O) + call dshr_fld_add(data_fld="rainc_HDO", data_fld_array=avifld, & + model_fld="Faxa_rainc_HDO", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=krc_HDO) + call dshr_fld_add(med_fld='Faxa_rainc_wiso', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=3) + + call dshr_fld_add(data_fld="rainl_16O", data_fld_array=avifld, & + model_fld="Faxa_rainl_16O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=krl_16O) + call dshr_fld_add(data_fld="rainl_18O", data_fld_array=avifld, & + model_fld="Faxa_rainl_18O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=krl_18O) + call dshr_fld_add(data_fld="rainl_HDO", data_fld_array=avifld, & + model_fld="Faxa_rainl_HDO", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=krl_HDO) + call dshr_fld_add(med_fld='Faxa_rainl_wiso', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=3) + + call dshr_fld_add(data_fld="snowc_16O", data_fld_array=avifld, & + model_fld="Faxa_snowc_16O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=ksc_18O) + call dshr_fld_add(data_fld="snowc_18O", data_fld_array=avifld, & + model_fld="Faxa_snowc_18O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=ksc_18O) + call dshr_fld_add(data_fld="snowc_HDO", data_fld_array=avifld, & + model_fld="Faxa_snowc_HDO", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=ksc_HDO) + call dshr_fld_add(med_fld='Faxa_snowc_wiso', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=3) + + call dshr_fld_add(data_fld="snowl_16O", data_fld_array=avifld, & + model_fld="Faxa_snowl_16O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=ksl_18O) + call dshr_fld_add(data_fld="snowl_18O", data_fld_array=avifld, & + model_fld="Faxa_snowl_18O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=ksl_18O) + call dshr_fld_add(data_fld="snowl_HDO", data_fld_array=avifld, & + model_fld="Faxa_snowl_HDO", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=ksl_HDO) + call dshr_fld_add(med_fld='Faxa_snowl_wiso', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=3) + + call dshr_fld_add(data_fld="shum_16O", data_fld_array=avifld, & + model_fld="Sa_shum_16O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=kshum_16O) + call dshr_fld_add(data_fld="shum_18O", data_fld_array=avifld, & + model_fld="Sa_shum_18O", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=kshum_18O) + call dshr_fld_add(data_fld="shum_HDO", data_fld_array=avifld, & + model_fld="Sa_shum_HDO", model_fld_array=avofld, model_fld_concat=flds_a2x, model_fld_index=kshum_HDO) + call dshr_fld_add(med_fld='Faxa_shum_wiso', fldlist_num=fldsFrAtm_num, fldlist=fldsFrAtm, & + ungridded_lbound=1, ungridded_ubound=3) end if !------------------- @@ -380,13 +403,6 @@ subroutine datm_comp_advertise(importState, exportState, & end do end if - !------------------- - ! Save flds_x2a and flds_a2x as module variables for use in debugging - !------------------- - - flds_x2a_mod = trim(flds_x2a) - flds_a2x_mod = trim(flds_a2x) - !------------------- ! module character arrays stifld and stofld !------------------- @@ -443,22 +459,18 @@ end subroutine datm_comp_advertise !=============================================================================== - subroutine datm_comp_init(x2a, a2x, & - SDATM, mpicom, compid, my_task, master_task, & + subroutine datm_comp_init(mpicom, compid, my_task, master_task, & inst_suffix, inst_name, logunit, read_restart, & scmMode, scmlat, scmlon, & orbEccen, orbMvelpp, orbLambm0, orbObliqr, & calendar, modeldt, current_ymd, current_tod, current_mon, & - atm_prognostic, mesh) + atm_prognostic, mesh, nxg, nyg) use dshr_nuopc_mod, only : dshr_fld_add ! !DESCRIPTION: initialize data atm model ! !INPUT/OUTPUT PARAMETERS: - type(mct_aVect) , intent(inout) :: x2a - type(mct_aVect) , intent(inout) :: a2x - type(shr_strdata_type) , intent(inout) :: SDATM ! model shr_strdata instance (output) integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: compid ! mct comp id integer , intent(in) :: my_task ! my task in mpi communicator mpicom @@ -481,6 +493,7 @@ subroutine datm_comp_init(x2a, a2x, & integer , intent(in) :: current_mon ! model month logical , intent(in) :: atm_prognostic ! if true, need x2a data type(ESMF_Mesh) , intent(inout) :: mesh + integer , intent(out) :: nxg, nyg !--- local variables --- integer :: n,k ! generic counters @@ -648,9 +661,9 @@ subroutine datm_comp_init(x2a, a2x, & call t_startf('datm_initmctavs') if (my_task == master_task) write(logunit,F00) 'allocate AVs' - call mct_aVect_init(a2x, rList=flds_a2x_mod, lsize=lsize) + call mct_aVect_init(a2x, rList=flds_a2x, lsize=lsize) call mct_aVect_zero(a2x) - call mct_aVect_init(x2a, rList=flds_x2a_mod, lsize=lsize) + call mct_aVect_init(x2a, rList=flds_x2a, lsize=lsize) call mct_aVect_zero(x2a) ! Initialize internal attribute vectors for optional streams @@ -730,6 +743,9 @@ subroutine datm_comp_init(x2a, a2x, & call t_stopf('datm_initmctavs') + nxg = SDATM%nxg + nyg = SDATM%nyg + !---------------------------------------------------------------------------- ! Read restart !---------------------------------------------------------------------------- @@ -787,27 +803,11 @@ subroutine datm_comp_init(x2a, a2x, & !---------------------------------------------------------------------------- call t_adj_detailf(+2) - call datm_comp_run(& - x2a=x2a, & - a2x=a2x, & - SDATM=SDATM, & - mpicom=mpicom, & - compid=compid, & - my_task=my_task, & - master_task=master_task, & - inst_suffix=inst_suffix, & - logunit=logunit, & - orbEccen=orbEccen, & - orbMvelpp=orbMvelpp, & - orbLambm0=orbLambm0, & - orbObliqr=orbObliqr, & - write_restart=.false., & - target_ymd=current_ymd, & - target_tod=current_tod, & - target_mon=current_mon, & - calendar=calendar, & - modeldt=modeldt, & - atm_prognostic=atm_prognostic) + call datm_comp_run(mpicom=mpicom, compid=compid, my_task=my_task, & + master_task=master_task, inst_suffix=inst_suffix, logunit=logunit, & + orbEccen=orbEccen, orbMvelpp=orbMvelpp, orbLambm0=orbLambm0, orbObliqr=orbObliqr, & + write_restart=.false., target_ymd=current_ymd, target_tod=current_tod, target_mon=current_mon, & + calendar=calendar, modeldt=modeldt, atm_prognostic=atm_prognostic) call t_adj_detailf(-2) call t_stopf('DATM_INIT') @@ -816,8 +816,7 @@ end subroutine datm_comp_init !=============================================================================== - subroutine datm_comp_run(x2a, a2x, & - SDATM, mpicom, compid, my_task, master_task, & + subroutine datm_comp_run(mpicom, compid, my_task, master_task, & inst_suffix, logunit, & orbEccen, orbMvelpp, orbLambm0, orbObliqr, & write_restart, target_ymd, target_tod, target_mon, modeldt, calendar, & @@ -826,9 +825,6 @@ subroutine datm_comp_run(x2a, a2x, & ! !DESCRIPTION: run method for datm model ! !INPUT/OUTPUT PARAMETERS: - type(mct_aVect) , intent(inout) :: x2a - type(mct_aVect) , intent(inout) :: a2x - type(shr_strdata_type) , intent(inout) :: SDATM integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: compid ! mct comp id integer , intent(in) :: my_task ! my task in mpi communicator mpicom @@ -877,7 +873,7 @@ subroutine datm_comp_run(x2a, a2x, & if (debug_import > 0 .and. my_task == master_task .and. atm_prognostic) then do nfld = 1, mct_aVect_nRAttr(x2a) - call shr_string_listGetName(trim(flds_x2a_mod), nfld, fldname) + call shr_string_listGetName(trim(flds_x2a), nfld, fldname) do n = 1, mct_aVect_lsize(x2a) write(logunit,F0D)'import: ymd,tod,n = '// trim(fldname),target_ymd, target_tod, & n, x2a%rattr(nfld,n) @@ -1385,7 +1381,7 @@ subroutine datm_comp_run(x2a, a2x, & if (debug_export > 0 .and. my_task == master_task) then do nfld = 1, mct_aVect_nRAttr(a2x) - call shr_string_listGetName(trim(flds_a2x_mod), nfld, fldname) + call shr_string_listGetName(trim(flds_a2x), nfld, fldname) do n = 1, mct_aVect_lsize(a2x) write(logunit,F0D)'export: ymd,tod,n = '// trim(fldname),target_ymd, target_tod, & n, a2x%rattr(nfld,n) @@ -1426,4 +1422,227 @@ subroutine datm_comp_run(x2a, a2x, & end subroutine datm_comp_run + !=============================================================================== + + subroutine datm_comp_import(importState, rc) + + ! input/output variables + type(ESMF_State) :: importState + integer, intent(out) :: rc + + ! local variables + integer :: k + !---------------------------------------------------------------- + + k = mct_aVect_indexRA(x2a, 'Sx_avsdr') + call dshr_import(importState, 'Sx_avsdr', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Sx_avsdf') + call dshr_import(importState, 'Sx_avsdf', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Sx_ansdr') + call dshr_import(importState, 'Sx_anidr', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Sx_anidf') + call dshr_import(importState, 'Sx_anidf', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Sx_tref') + call dshr_import(importState, 'Sx_tref', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Sx_qref') + call dshr_import(importState, 'Sx_qref', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Sx_t') + call dshr_import(importState, 'Sx_t', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'So_t') + call dshr_import(importState, 'So_t', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Sl_snowh') + call dshr_import(importState, 'Sl_snowh', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Sl_lfrac') + call dshr_import(importState, 'Sl_lfrac', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Si_lfrac') + call dshr_import(importState, 'Si_lfrac', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'So_ofrac') + call dshr_import(importState, 'So_ofrac', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Faxx_taux') + call dshr_import(importState, 'Faxx_taux', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Faxx_tauy') + call dshr_import(importState, 'Faxx_tauy', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Faxx_lat') + call dshr_import(importState, 'Faxx_lat', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Faxx_sen') + call dshr_import(importState, 'Faxx_sen', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Faxx_lwup') + call dshr_import(importState, 'Faxx_lwup', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(x2a, 'Faxx_evap') + call dshr_import(importState, 'Faxx_evap', x2a%rattr(:,k), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine datm_comp_import + + !=============================================================================== + + subroutine datm_comp_export(exportState, rc) + + ! input/output variables + type(ESMF_State) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: k + !---------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call dshr_export(a2x%rattr(ktopo,:) , exportState, 'Sa_topo', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kz,:) , exportState, 'Sa_z', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(ku,:) , exportState, 'Sa_u', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kv,:) , exportState, 'Sa_v', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kptem,:) , exportState, 'Sa_ptem', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kdens,:) , exportState, 'Sa_dens', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kpslv,:) , exportState, 'Sa_pslv', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(ktbot,:) , exportState, 'Sa_tbot', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kpbot,:) , exportState, 'Sa_pbot', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kshum,:) , exportState, 'Sa_shum', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(krc,:) , exportState, 'Faxa_rainc', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(krl,:) , exportState, 'Faxa_rainl', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(ksc,:) , exportState, 'Faxa_snowc', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(ksl,:) , exportState, 'Faxa_snowl', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(kswndr,:), exportState, 'Faxa_swndr', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kswndf,:), exportState, 'Faxa_swndf', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kswvdr,:), exportState, 'Faxa_swvdr', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kswvdf,:), exportState, 'Faxa_swvdf', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kswnet,:), exportState, 'Faxa_swnet', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(klwdn,:) , exportState, 'Faxa_lwdn', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (flds_co2a .or. flds_co2b .or. flds_co2c) then + call dshr_export(avstrm%rattr(sco2p,:), exportState, 'Sa_co2prog' , rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(avstrm%rattr(sco2d,:), exportState, 'Sa_co2diag' , rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + if (presaero) then + call dshr_export(a2x%rattr(kbcphidry,:), exportState, 'Faxa_bcph', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kbcphodry,:), exportState, 'Faxa_bcph', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kbcphiwet,:), exportState, 'Faxa_bcph', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(kocphidry,:), exportState, 'Faxa_ocph', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kocphodry,:), exportState, 'Faxa_ocph', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kocphiwet,:), exportState, 'Faxa_ocph', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(kdstwet1,:), exportState, 'Faxa_dstwet', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kdstwet2,:), exportState, 'Faxa_dstwet', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kdstwet3,:), exportState, 'Faxa_dstwet', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kdstwet4,:), exportState, 'Faxa_dstwet', ungridded_index=4, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(kdstdry1,:), exportState, 'Faxa_dstdry', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kdstdry2,:), exportState, 'Faxa_dstdry', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kdstdry3,:), exportState, 'Faxa_dstdry', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kdstdry4,:), exportState, 'Faxa_dstdry', ungridded_index=4, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + if (flds_wiso) then + call dshr_export(a2x%rattr(krc_16O,:), exportState, 'Faxa_rainc_wiso', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(krc_18O,:), exportState, 'Faxa_rainc_wiso', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(krc_HDO,:), exportState, 'Faxa_rainc_wiso', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(krl_16O,:), exportState, 'Faxa_rainl_wiso', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(krl_18O,:), exportState, 'Faxa_rainl_wiso', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(krl_HDO,:), exportState, 'Faxa_rainl_wiso', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(ksc_16O,:), exportState, 'Faxa_snowc_wiso', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(ksc_18O,:), exportState, 'Faxa_snowc_wiso', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(ksc_HDO,:), exportState, 'Faxa_snowc_wiso', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(ksl_16O,:), exportState, 'Faxa_snowl_wiso', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(ksl_18O,:), exportState, 'Faxa_snowl_wiso', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(ksl_HDO,:), exportState, 'Faxa_snowl_wiso', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(a2x%rattr(kshum_16O,:), exportState, 'Faxa_shum_wiso', ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kshum_18O,:), exportState, 'Faxa_shum_wiso', ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(a2x%rattr(kshum_HDO,:), exportState, 'Faxa_shum_wiso', ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + end subroutine datm_comp_export + end module datm_comp_mod diff --git a/src/components/data_comps/datm/nuopc/datm_shr_mod.F90 b/src/components/data_comps/datm/nuopc/datm_shr_mod.F90 index 3f06aef6bcd..a08b4f08aaf 100644 --- a/src/components/data_comps/datm/nuopc/datm_shr_mod.F90 +++ b/src/components/data_comps/datm/nuopc/datm_shr_mod.F90 @@ -38,6 +38,9 @@ module datm_shr_mod ! Note that model decomp will now come from reading in the mesh directly + ! stream data type + type(shr_strdata_type), public :: SDATM + ! input namelist variables character(CL) , public :: restfilm ! model restart file namelist character(CL) , public :: restfils ! stream restart file namelist @@ -60,7 +63,7 @@ module datm_shr_mod !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine datm_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDATM, atm_prognostic) + logunit, atm_prognostic) ! !INPUT/OUTPUT PARAMETERS: character(len=*) , intent(in) :: filename ! input namelist filename @@ -68,7 +71,6 @@ subroutine datm_shr_read_namelists(filename, mpicom, my_task, master_task, & integer(IN) , intent(in) :: my_task ! my task in mpi communicator mpicom integer(IN) , intent(in) :: master_task ! task number of master task integer(IN) , intent(in) :: logunit ! logging unit number - type(shr_strdata_type) , intent(inout) :: SDATM logical , intent(out) :: atm_prognostic ! flag !--- local variables --- diff --git a/src/components/data_comps/dice/nuopc/dice_comp_mod.F90 b/src/components/data_comps/dice/nuopc/dice_comp_mod.F90 index 9a46b3a60c8..387752c137c 100644 --- a/src/components/data_comps/dice/nuopc/dice_comp_mod.F90 +++ b/src/components/data_comps/dice/nuopc/dice_comp_mod.F90 @@ -30,7 +30,7 @@ module dice_comp_mod use shr_strdata_mod , only : shr_strdata_print, shr_strdata_restRead use shr_strdata_mod , only : shr_strdata_advance, shr_strdata_restWrite use shr_dmodel_mod , only : shr_dmodel_translateAV - use dshr_nuopc_mod , only : fld_list_type, dshr_fld_add + use dshr_nuopc_mod , only : fld_list_type, dshr_fld_add, dshr_import, dshr_export use dice_shr_mod , only : datamode ! namelist input use dice_shr_mod , only : rest_file ! namelist input use dice_shr_mod , only : rest_file_strm ! namelist input @@ -39,6 +39,7 @@ module dice_comp_mod use dice_shr_mod , only : flux_Qacc ! namelist input -activates water accumulation/melt wrt Q use dice_shr_mod , only : flux_Qacc0 ! namelist input -initial water accumulation value use dice_shr_mod , only : nullstr + use dice_shr_mod , only : SDICE use dice_flux_atmice_mod , only : dice_flux_atmice use shr_pcdf_mod @@ -53,11 +54,18 @@ module dice_comp_mod public :: dice_comp_advertise public :: dice_comp_init public :: dice_comp_run + public :: dice_comp_import + public :: dice_comp_export !-------------------------------------------------------------------------- ! Private data !-------------------------------------------------------------------------- + type(mct_aVect) :: x2i + type(mct_aVect) :: i2x + character(CXX) :: flds_i2x = '' + character(CXX) :: flds_x2i = '' + integer :: debug_import = 0 ! debug level (if > 0 will print all import fields) integer :: debug_export = 0 ! debug level (if > 0 will print all export fields) @@ -106,8 +114,6 @@ module dice_comp_mod character(len=CS), pointer :: strmifld(:) character(len=CS), pointer :: strmofld(:) character(len=CXX) :: flds_strm = '' ! colon deliminated string of field names - character(len=CXX) :: flds_i2x_mod - character(len=CXX) :: flds_x2i_mod logical :: firstcall = .true. ! first call logical character(len=*),parameter :: rpfile = 'rpointer.ice' @@ -120,8 +126,7 @@ module dice_comp_mod subroutine dice_comp_advertise(importState, exportState, & ice_present, ice_prognostic, & - fldsFrIce_num, fldsFrIce, fldsToIce_num, fldsToIce, & - flds_i2x, flds_x2i, rc) + fldsFrIce_num, fldsFrIce, fldsToIce_num, fldsToIce, rc) ! input/output arguments type(ESMF_State) , intent(inout) :: importState @@ -132,8 +137,6 @@ subroutine dice_comp_advertise(importState, exportState, & integer , intent(out) :: fldsFrIce_num type (fld_list_type) , intent(out) :: fldsToIce(:) type (fld_list_type) , intent(out) :: fldsFrIce(:) - character(len=*) , intent(out) :: flds_i2x - character(len=*) , intent(out) :: flds_x2i integer , intent(out) :: rc ! local variables @@ -150,6 +153,10 @@ subroutine dice_comp_advertise(importState, exportState, & fldsFrIce(1)%stdname = trim(flds_scalar_name) ! export fields that have a corresponding stream field + ! - model_fld_index sets the module variables kiFrac + ! - model_fld_concat variable sets the output variable flds_i2x + ! - model_fld_array sets the module character array avofld + ! - data_fld_array sets the module character array avifld call dshr_fld_add(data_fld='ifrac', data_fld_array=avifld, model_fld='Si_ifrac', model_fld_array=avofld, & model_fld_concat=flds_i2x, model_fld_index=kiFrac, fldlist_num=fldsFrIce_num, fldlist=fldsFrIce) @@ -276,47 +283,31 @@ subroutine dice_comp_advertise(importState, exportState, & call dshr_fld_add(model_fld='So_s', model_fld_concat=flds_x2i, model_fld_index=ksalinity, & fldlist_num=fldsToIce_num, fldlist=fldsToIce) - call dshr_fld_add(model_fld='Faxa_bcphidry', model_fld_concat=flds_x2i, model_fld_index=kbcphidry, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_bcphodry', model_fld_concat=flds_x2i, model_fld_index=kbcphodry, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_bcphiwet', model_fld_concat=flds_x2i, model_fld_index=kbcphiwet, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_ocphidry', model_fld_concat=flds_x2i, model_fld_index=kocphidry, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_ocphodry', model_fld_concat=flds_x2i, model_fld_index=kocphodry, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_ocphiwet', model_fld_concat=flds_x2i, model_fld_index=kocphiwet, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_dstdry1', model_fld_concat=flds_x2i, model_fld_index=kdstdry1, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_dstdry2', model_fld_concat=flds_x2i, model_fld_index=kdstdry2, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_dstdry3', model_fld_concat=flds_x2i, model_fld_index=kdstdry3, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_dstdry4', model_fld_concat=flds_x2i, model_fld_index=kdstdry4, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_dstwet1', model_fld_concat=flds_x2i, model_fld_index=kdstwet1, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_dstwet2', model_fld_concat=flds_x2i, model_fld_index=kdstwet2, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_dstwet3', model_fld_concat=flds_x2i, model_fld_index=kdstwet3, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) - - call dshr_fld_add(model_fld='Faxa_dstwet4', model_fld_concat=flds_x2i, model_fld_index=kdstwet4, & - fldlist_num=fldsToIce_num, fldlist=fldsToIce) + call dshr_fld_add(model_fld='Faxa_bcphidry', model_fld_concat=flds_x2i, model_fld_index=kbcphidry) + call dshr_fld_add(model_fld='Faxa_bcphodry', model_fld_concat=flds_x2i, model_fld_index=kbcphodry) + call dshr_fld_add(model_fld='Faxa_bcphiwet', model_fld_concat=flds_x2i, model_fld_index=kbcphiwet) + call dshr_fld_add(med_fld='Faxa_bcph', fldlist_num=fldsToIce_num, fldlist=fldsToIce, & + ungridded_lbound=1, ungridded_ubound=3) + + call dshr_fld_add(model_fld='Faxa_ocphidry', model_fld_concat=flds_x2i, model_fld_index=kocphidry) + call dshr_fld_add(model_fld='Faxa_ocphodry', model_fld_concat=flds_x2i, model_fld_index=kocphodry) + call dshr_fld_add(model_fld='Faxa_ocphiwet', model_fld_concat=flds_x2i, model_fld_index=kocphiwet) + call dshr_fld_add(med_fld='Faxa_ocph', fldlist_num=fldsToIce_num, fldlist=fldsToIce, & + ungridded_lbound=1, ungridded_ubound=3) + + call dshr_fld_add(model_fld='Faxa_dstdry1', model_fld_concat=flds_x2i, model_fld_index=kdstdry1) + call dshr_fld_add(model_fld='Faxa_dstdry2', model_fld_concat=flds_x2i, model_fld_index=kdstdry2) + call dshr_fld_add(model_fld='Faxa_dstdry3', model_fld_concat=flds_x2i, model_fld_index=kdstdry3) + call dshr_fld_add(model_fld='Faxa_dstdry4', model_fld_concat=flds_x2i, model_fld_index=kdstdry4) + call dshr_fld_add(med_fld='Faxa_dstdry', fldlist_num=fldsToIce_num, fldlist=fldsToIce, & + ungridded_lbound=1, ungridded_ubound=4) + + call dshr_fld_add(model_fld='Faxa_dstwet1', model_fld_concat=flds_x2i, model_fld_index=kdstwet1) + call dshr_fld_add(model_fld='Faxa_dstwet2', model_fld_concat=flds_x2i, model_fld_index=kdstwet2) + call dshr_fld_add(model_fld='Faxa_dstwet3', model_fld_concat=flds_x2i, model_fld_index=kdstwet3) + call dshr_fld_add(model_fld='Faxa_dstwet4', model_fld_concat=flds_x2i, model_fld_index=kdstwet4) + call dshr_fld_add(med_fld='Faxa_dstwet', fldlist_num=fldsToIce_num, fldlist=fldsToIce, & + ungridded_lbound=1, ungridded_ubound=4) end if @@ -334,29 +325,18 @@ subroutine dice_comp_advertise(importState, exportState, & enddo end if - ! Save flds_x2i and flds_i2x as module variables for use in debugging - - flds_x2i_mod = trim(flds_x2i) - flds_i2x_mod = trim(flds_i2x) - end subroutine dice_comp_advertise !=============================================================================== - subroutine dice_comp_init(x2i, i2x, & - flds_x2i_fields, flds_i2x_fields, flds_i2o_per_cat, & - SDICE, mpicom, compid, my_task, master_task, & + subroutine dice_comp_init(flds_i2o_per_cat, mpicom, compid, my_task, master_task, & inst_suffix, inst_name, logunit, read_restart, & - scmMode, scmlat, scmlon, calendar, mesh) + scmMode, scmlat, scmlon, calendar, mesh, nxg, nyg) ! !DESCRIPTION: initialize dice model ! input/output parameters: - type(mct_aVect) , intent(inout) :: x2i, i2x ! input/output attribute vectors - character(len=*) , intent(in) :: flds_x2i_fields ! fields from mediator - character(len=*) , intent(in) :: flds_i2x_fields ! fields to mediator logical , intent(in) :: flds_i2o_per_cat ! .true. if select per ice thickness fields from ice - type(shr_strdata_type) , intent(inout) :: SDICE ! dice shr_strdata instance (output) integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: compid ! mct comp id integer , intent(in) :: my_task ! my task in mpi communicator mpicom @@ -370,6 +350,7 @@ subroutine dice_comp_init(x2i, i2x, & real(R8) , intent(in) :: scmLon ! single column lon character(len=*) , intent(in) :: calendar ! calendar type type(ESMF_Mesh) , intent(in) :: mesh ! ESMF dice mesh + integer , intent(out) :: nxg, nyg !--- local variables --- integer :: n,k ! generic counters @@ -520,7 +501,7 @@ subroutine dice_comp_init(x2i, i2x, & call t_startf('dice_initmctavs') if (my_task == master_task) write(logunit,F00) 'allocate AVs' - call mct_aVect_init(i2x, rList=flds_i2x_fields, lsize=lsize) + call mct_aVect_init(i2x, rList=flds_i2x, lsize=lsize) call mct_aVect_zero(i2x) ! optional per thickness category fields @@ -529,7 +510,7 @@ subroutine dice_comp_init(x2i, i2x, & kswpen_iFrac_01 = mct_aVect_indexRA(i2x,'PFioi_swpen_ifrac_01') end if - call mct_aVect_init(x2i, rList=flds_x2i_fields, lsize=lsize) + call mct_aVect_init(x2i, rList=flds_x2i, lsize=lsize) call mct_aVect_zero(x2i) allocate(water(lsize)) @@ -542,6 +523,9 @@ subroutine dice_comp_init(x2i, i2x, & call t_stopf('dice_initmctavs') + nxg = SDICE%nxg + nyg = SDICE%nyg + !---------------------------------------------------------------------------- ! Read restart !---------------------------------------------------------------------------- @@ -613,18 +597,14 @@ end subroutine dice_comp_init !=============================================================================== - subroutine dice_comp_run(x2i, i2x, flds_i2o_per_cat, & - SDICE, mpicom, my_task, master_task, & + subroutine dice_comp_run(flds_i2o_per_cat, mpicom, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & calendar, modeldt, target_ymd, target_tod, cosArg, case_name ) ! !DESCRIPTION: run method for dice model ! input/output parameters: - type(mct_aVect) , intent(inout) :: x2i - type(mct_aVect) , intent(inout) :: i2x logical , intent(in) :: flds_i2o_per_cat ! .true. if select per ice thickness fields from ice - type(shr_strdata_type) , intent(inout) :: SDICE integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: my_task ! my task in mpi communicator mpicom integer , intent(in) :: master_task ! task number of master task @@ -660,7 +640,7 @@ subroutine dice_comp_run(x2i, i2x, flds_i2o_per_cat, & if (debug_import > 1 .and. my_task == master_task) then do nfld = 1, mct_aVect_nRAttr(x2i) - call shr_string_listGetName(trim(flds_x2i_mod), nfld, fldname) + call shr_string_listGetName(trim(flds_x2i), nfld, fldname) do n = 1, mct_aVect_lsize(x2i) write(logunit,F0D)'import: ymd,tod,n = '// trim(fldname),target_ymd, target_tod, & n, x2i%rattr(nfld,n) @@ -802,7 +782,7 @@ subroutine dice_comp_run(x2i, i2x, flds_i2o_per_cat, & end do - ! compute atm/ice surface fluxes + ! compute ice/ice surface fluxes call dice_flux_atmice( & iMask ,x2i%rAttr(kz,:) ,x2i%rAttr(kua,:) ,x2i%rAttr(kva,:) , & x2i%rAttr(kptem,:) ,x2i%rAttr(kshum,:) ,x2i%rAttr(kdens,:) ,x2i%rAttr(ktbot,:), & @@ -869,7 +849,7 @@ subroutine dice_comp_run(x2i, i2x, flds_i2o_per_cat, & if (debug_export > 1 .and. my_task == master_task) then do nfld = 1, mct_aVect_nRAttr(i2x) - call shr_string_listGetName(trim(flds_i2x_mod), nfld, fldname) + call shr_string_listGetName(trim(flds_i2x), nfld, fldname) do n = 1, mct_aVect_lsize(i2x) write(logunit,F0D)'export: ymd,tod,n = '// trim(fldname),target_ymd, target_tod, & n, i2x%rattr(nfld,n) @@ -914,4 +894,160 @@ subroutine dice_comp_run(x2i, i2x, flds_i2o_per_cat, & end subroutine dice_comp_run + !=============================================================================== + + subroutine dice_comp_import(importState, rc) + + ! input/output variables + type(ESMF_State) :: importState + integer, intent(out) :: rc + + ! local variables + integer :: k + !---------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call dshr_import(importState, 'Sa_z', x2i%rattr(kz,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Sa_u', x2i%rattr(kua,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Sa_v', x2i%rattr(kva,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Sa_ptem', x2i%rattr(kptem,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Sa_dens', x2i%rattr(kdens,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Sa_tbot', x2i%rattr(ktbot,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Sa_shum', x2i%rattr(kshum,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Faxa_swndr' , x2i%rattr(kswndr,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_swndf' , x2i%rattr(kswndf,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_swvdr' , x2i%rattr(kswvdr,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_swvdf' , x2i%rattr(kswvdf,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Faxa_bcph', x2i%rattr(kbcphidry,:), ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_bcph', x2i%rattr(kbcphodry,:), ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_bcph', x2i%rattr(kbcphiwet,:), ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Faxa_ocph', x2i%rattr(kocphidry,:), ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_ocph', x2i%rattr(kocphodry,:), ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_ocph', x2i%rattr(kocphiwet,:), ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Faxa_dstwet', x2i%rattr(kdstwet1,:), ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_dstwet', x2i%rattr(kdstwet2,:), ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_dstwet', x2i%rattr(kdstwet3,:), ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_dstwet', x2i%rattr(kdstwet4,:), ungridded_index=4, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Faxa_dstdry', x2i%rattr(kdstdry1,:), ungridded_index=1, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_dstdry', x2i%rattr(kdstdry2,:), ungridded_index=2, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_dstdry', x2i%rattr(kdstdry3,:), ungridded_index=3, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'Faxa_dstdry', x2i%rattr(kdstdry4,:), ungridded_index=4, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Fioo_q' , x2i%rattr(kq,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_import(importState, 'So_s' , x2i%rattr(ksalinity,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine dice_comp_import + + !=============================================================================== + + subroutine dice_comp_export(exportState, rc) + + ! input/output variables + type(ESMF_State) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: k + !---------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call dshr_export(i2x%rattr(kiFrac,:) , exportState, 'Si_ifrac', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(km,:) , exportState, 'Si_imask', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(kt,:), exportState, 'Si_t', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(ktref,:), exportState, 'Si_tref' , rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(kqref,:), exportState, 'Si_qref', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(kavsdr,:), exportState, 'Si_avsdr', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(kanidr,:), exportState, 'Si_anidr', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(kavsdf,:), exportState, 'Si_avsdf', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(kanidf,:), exportState, 'Si_anidf', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(kswnet,:), exportState, 'Faii_swnet', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(ksen,:), exportState, 'Faii_sen', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(klat,:), exportState, 'Faii_lat', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(klwup,:), exportState, 'Faii_lwup', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(kevap,:), exportState, 'Faii_evap', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(ktauxa,:), exportState, 'Faii_taux', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(ktauya,:), exportState, 'Faii_tauy', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(kmelth,:), exportState, 'Fioi_melth', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(kmeltw,:), exportState, 'Fioi_meltw', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(kswpen,:), exportState, 'Fioi_swpen', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(ktauxo,:), exportState, 'Fioi_taux', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(ktauyo,:), exportState, 'Fioi_tauy', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(ksalt,:), exportState, 'Fioi_salt', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(kbcpho,:), exportState, 'Fioi_bcpho', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dshr_export(i2x%rattr(kbcphi,:), exportState, 'Fioi_bcphi', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(i2x%rattr(kflxdst,:), exportState, 'Fioi_flxdst', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine dice_comp_export + end module dice_comp_mod diff --git a/src/components/data_comps/dice/nuopc/dice_shr_mod.F90 b/src/components/data_comps/dice/nuopc/dice_shr_mod.F90 index 5744f57e80a..4cc947f5dda 100644 --- a/src/components/data_comps/dice/nuopc/dice_shr_mod.F90 +++ b/src/components/data_comps/dice/nuopc/dice_shr_mod.F90 @@ -25,6 +25,9 @@ module dice_shr_mod ! Note that model decomp will now come from reading in the mesh directly + ! stream data type + type(shr_strdata_type), public :: SDICE + ! input namelist variables character(CL) , public :: restfilm ! model restart file namelist character(CL) , public :: restfils ! stream restart file namelist @@ -44,7 +47,7 @@ module dice_shr_mod !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine dice_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDICE, ice_present, ice_prognostic) + logunit, ice_present, ice_prognostic) ! !DESCRIPTION: Read in dice namelists implicit none @@ -55,7 +58,6 @@ subroutine dice_shr_read_namelists(filename, mpicom, my_task, master_task, & integer(IN) , intent(in) :: my_task ! my task in mpi communicator mpicom integer(IN) , intent(in) :: master_task ! task number of master task integer(IN) , intent(in) :: logunit ! logging unit number - type(shr_strdata_type) , intent(inout) :: SDICE logical , intent(out) :: ice_present ! flag logical , intent(out) :: ice_prognostic ! flag diff --git a/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 b/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 index 794ea07dafd..c6064bdd9e7 100644 --- a/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 +++ b/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 @@ -26,18 +26,14 @@ module ice_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_grid_mod , only : shr_nuopc_grid_ArrayToState - use shr_nuopc_grid_mod , only : shr_nuopc_grid_StateToArray - use shr_const_mod , only : SHR_CONST_SPVAL + use shr_const_mod , only : shr_const_spval, shr_const_pi use shr_strdata_mod , only : shr_strdata_type use shr_cal_mod , only : shr_cal_ymd2julian - use shr_const_mod , only : shr_const_pi - use dshr_nuopc_mod , only : fld_list_type, fldsMax, fld_list_realize + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData use dice_shr_mod , only : dice_shr_read_namelists use dice_comp_mod , only : dice_comp_init, dice_comp_run, dice_comp_advertise - use mct_mod , only : mct_Avect, mct_Avect_info - + use dice_comp_mod , only : dice_comp_import, dice_comp_export implicit none private ! except @@ -57,9 +53,7 @@ module ice_comp_nuopc integer :: fldsFrIce_num = 0 type (fld_list_type) :: fldsToIce(fldsMax) type (fld_list_type) :: fldsFrIce(fldsMax) - type(shr_strdata_type) :: SDICE - type(mct_aVect) :: x2i - type(mct_aVect) :: i2x + integer :: compid ! mct comp id integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom @@ -70,13 +64,10 @@ module ice_comp_nuopc integer, parameter :: master_task=0 ! task number of master task logical :: read_restart ! start from restart character(len=256) :: case_name ! case name - integer :: dbrc logical :: flds_i2o_per_cat ! .true. if select per ice thickness ! category fields are passed from ice to ocean character(len=80) :: calendar ! calendar name integer :: modeldt ! integer timestep - character(len=CXX) :: flds_i2x = '' - character(len=CXX) :: flds_x2i = '' logical :: use_esmf_metadata = .false. real(R8) ,parameter :: pi = shr_const_pi ! pi character(*),parameter :: modName = "(ice_comp_nuopc)" @@ -95,7 +86,7 @@ subroutine SetServices(gcomp, rc) character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) @@ -131,7 +122,7 @@ subroutine SetServices(gcomp, rc) specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine SetServices @@ -165,7 +156,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! generate local mpi comm @@ -199,7 +190,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) filename = "dice_in"//trim(inst_suffix) call dice_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDICE, ice_present, ice_prognostic) + logunit, ice_present, ice_prognostic) !-------------------------------- ! Advertise import and export fields @@ -207,8 +198,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call dice_comp_advertise(importstate, exportState, & ice_present, ice_prognostic, & - fldsFrIce_num, fldsFrIce, fldsToIce_num, fldsToIce, & - flds_i2x, flds_x2i, rc) + fldsFrIce_num, fldsFrIce, fldsToIce_num, fldsToIce, rc) !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -217,7 +207,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call shr_file_setLogUnit (shrlogunit) call shr_file_setLogLevel(shrloglev) - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine InitializeAdvertise @@ -251,11 +241,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) real(R8) :: cosarg ! for setting ice temp pattern real(R8) :: jday, jday0 ! elapsed day counters logical :: write_restart + integer :: nxg, nyg character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to my log file @@ -310,7 +301,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) calendar = shr_cal_gregorian else call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), & - ESMF_LOGMSG_ERROR, rc=dbrc) + ESMF_LOGMSG_ERROR) rc = ESMF_Failure return end if @@ -329,11 +320,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Initialize model !-------------------------------- - call dice_comp_init(x2i, i2x, & - flds_x2i, flds_i2x, flds_i2o_per_cat, & - SDICE, mpicom, compid, my_task, master_task, & + call dice_comp_init(flds_i2o_per_cat, mpicom, compid, my_task, master_task, & inst_suffix, inst_name, logunit, read_restart, & - scmMode, scmlat, scmlon, calendar, Emesh) + scmMode, scmlat, scmlon, calendar, Emesh, nxg, nyg) !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -341,7 +330,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! by replacing the advertised fields with the newly created fields of the same name. !-------------------------------- - call fld_list_realize( & + call dshr_realize( & state=ExportState, & fldList=fldsFrIce, & numflds=fldsFrIce_num, & @@ -351,7 +340,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) mesh=Emesh, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call fld_list_realize( & + call dshr_realize( & state=importState, & fldList=fldsToIce, & numflds=fldsToIce_num, & @@ -381,22 +370,19 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) cosArg = 2.0_R8*pi*(jday - jday0)/365.0_R8 write_restart = .false. - call dice_comp_run(x2i, i2x, & - flds_i2o_per_cat, SDICE, mpicom, my_task, master_task, & + call dice_comp_run(flds_i2o_per_cat, mpicom, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & calendar, modeldt, current_ymd, current_tod, cosArg) ! Pack export state - call shr_nuopc_grid_ArrayToState(i2x%rattr, flds_i2x, exportState, grid_option='mesh', rc=rc) + call dice_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - nx_global = SDICE%nxg - ny_global = SDICE%nyg - call shr_nuopc_methods_State_SetScalar(dble(nx_global),flds_scalar_index_nx, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(ny_global),flds_scalar_index_ny, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -421,7 +407,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine InitializeRealize @@ -454,7 +440,7 @@ subroutine ModelAdvance(gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call shr_nuopc_memcheck(subname, 5, my_task==master_task) !-------------------------------- ! Reset shr logging to my log file @@ -480,7 +466,7 @@ subroutine ModelAdvance(gcomp, rc) ! Unpack import state !-------------------------------- - call shr_nuopc_grid_StateToArray(importState, x2i%rattr, flds_x2i, grid_option='mesh', rc=rc) + call dice_comp_import(importState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- @@ -520,8 +506,7 @@ subroutine ModelAdvance(gcomp, rc) ! Run dice read_restart = .false. - call dice_comp_run(x2i, i2x, & - flds_i2o_per_cat, SDICE, mpicom, my_task, master_task, & + call dice_comp_run(flds_i2o_per_cat, mpicom, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & calendar, modeldt, next_ymd, next_tod, cosArg, case_name) @@ -529,7 +514,7 @@ subroutine ModelAdvance(gcomp, rc) ! Pack export state !-------------------------------- - call shr_nuopc_grid_ArrayToState(i2x%rattr, flds_i2x, exportState, grid_option='mesh', rc=rc) + call dice_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- @@ -545,7 +530,7 @@ subroutine ModelAdvance(gcomp, rc) call shr_nuopc_log_clock_advance(clock, 'ICE', logunit) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -574,7 +559,7 @@ subroutine ModelFinalize(gcomp, rc) write(logunit,F00) ' dice: end of main integration loop' write(logunit,F91) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ModelFinalize diff --git a/src/components/data_comps/dlnd/nuopc/dlnd_comp_mod.F90 b/src/components/data_comps/dlnd/nuopc/dlnd_comp_mod.F90 index 14303ab8132..55520daf7c4 100644 --- a/src/components/data_comps/dlnd/nuopc/dlnd_comp_mod.F90 +++ b/src/components/data_comps/dlnd/nuopc/dlnd_comp_mod.F90 @@ -30,14 +30,14 @@ module dlnd_comp_mod use shr_cal_mod , only : shr_cal_datetod2string use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use dshr_nuopc_mod , only : fld_list_type - use dshr_nuopc_mod , only : dshr_fld_add - use glc_elevclass_mod , only : glc_get_num_elevation_classes, glc_elevclass_as_string, glc_elevclass_init + use dshr_nuopc_mod , only : fld_list_type, dshr_fld_add, dshr_import, dshr_export + use glc_elevclass_mod , only : glc_elevclass_as_string, glc_elevclass_init use dlnd_shr_mod , only : datamode ! namelist input use dlnd_shr_mod , only : rest_file ! namelist input use dlnd_shr_mod , only : rest_file_strm ! namelist input use dlnd_shr_mod , only : domain_fracname ! namelist input use dlnd_shr_mod , only : nullstr + use dlnd_shr_mod , only : SDLND ! !PUBLIC TYPES: implicit none @@ -50,16 +50,20 @@ module dlnd_comp_mod public :: dlnd_comp_advertise public :: dlnd_comp_init public :: dlnd_comp_run + public :: dlnd_comp_export !-------------------------------------------------------------------------- ! Private data !-------------------------------------------------------------------------- + type(mct_aVect) :: x2l + type(mct_aVect) :: l2x character(len=CS), pointer :: avifld(:) ! char array field names coming from streams character(len=CS), pointer :: avofld(:) ! char array field names to be sent/recd from med - character(len=CXX) :: flds_l2x_mod - character(len=CXX) :: flds_x2l_mod + character(len=CXX) :: flds_l2x = '' + character(len=CXX) :: flds_x2l = '' integer :: kf ! index for frac in AV + integer :: glc_nec real(R8), pointer :: lfrac(:) ! land frac character(len=*), parameter :: rpfile = 'rpointer.lnd' integer , parameter :: nec_len = 2 ! length of elevation class index in field names @@ -71,26 +75,23 @@ module dlnd_comp_mod !=============================================================================== subroutine dlnd_comp_advertise(importState, exportState, & - lnd_present, lnd_prognostic, glc_nec, & - fldsFrLnd_num, fldsFrLnd, fldsToLnd_num, fldsToLnd, & - flds_l2x, flds_x2l, rc) + lnd_present, lnd_prognostic, glc_nec_in, & + fldsFrLnd_num, fldsFrLnd, fldsToLnd_num, fldsToLnd, rc) ! 1. determine export and import fields to advertise to mediator ! 2. determine translation of fields from streams to export/import fields ! input/output arguments - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - integer , intent(in) :: glc_nec - logical , intent(in) :: lnd_present - logical , intent(in) :: lnd_prognostic - integer , intent(out) :: fldsFrLnd_num - type (fld_list_type) , intent(out) :: fldsFrLnd(:) - integer , intent(out) :: fldsToLnd_num - type (fld_list_type) , intent(out) :: fldsToLnd(:) - character(len=*) , intent(out) :: flds_l2x - character(len=*) , intent(out) :: flds_x2l - integer , intent(out) :: rc + type(ESMF_State) :: importState + type(ESMF_State) :: exportState + integer , intent(in) :: glc_nec_in + logical , intent(in) :: lnd_present + logical , intent(in) :: lnd_prognostic + integer , intent(out) :: fldsFrLnd_num + type (fld_list_type) , intent(out) :: fldsFrLnd(:) + integer , intent(inout) :: fldsToLnd_num + type (fld_list_type) , intent(inout) :: fldsToLnd(:) + integer , intent(out) :: rc ! local variables integer :: n @@ -103,6 +104,10 @@ subroutine dlnd_comp_advertise(importState, exportState, & if (.not. lnd_present) return + glc_nec = glc_nec_in + + call glc_elevclass_init(glc_nec) + !------------------- ! export fields !------------------- @@ -112,11 +117,9 @@ subroutine dlnd_comp_advertise(importState, exportState, & fldsFrLnd_num=1 fldsFrLnd(1)%stdname = trim(flds_scalar_name) - call dshr_fld_add(model_fld="Sl_lfrin", model_fld_concat=flds_l2x, model_fld_index=kf, & - fldlist_num=fldsFrLnd_num, fldlist=fldsFrLnd) + call dshr_fld_add(model_fld="Sl_lfrin", model_fld_concat=flds_l2x, model_fld_index=kf) ! The actual snow field names will have the elevation class index at the end (e.g., Sl_tsrf01, tsrf01) - call glc_elevclass_init(glc_nec) if (glc_nec > 0) then do n = 0, glc_nec nec_str = glc_elevclass_as_string(n) @@ -124,73 +127,57 @@ subroutine dlnd_comp_advertise(importState, exportState, & data_fld_name = "tsrf" // nec_str model_fld_name = "Sl_tsrf" // nec_str call dshr_fld_add(data_fld=trim(data_fld_name), data_fld_array=avifld, & - model_fld=trim(model_fld_name), model_fld_array=avofld, & - model_fld_concat=flds_l2x, fldlist_num=fldsFrLnd_num, fldlist=fldsFrLnd) + model_fld=trim(model_fld_name), model_fld_array=avofld, model_fld_concat=flds_l2x) data_fld_name = "topo" // nec_str model_fld_name = "Sl_topo" // nec_str call dshr_fld_add(data_fld=trim(data_fld_name), data_fld_array=avifld, & - model_fld=trim(model_fld_name), model_fld_array=avofld, & - model_fld_concat=flds_l2x, fldlist_num=fldsFrLnd_num, fldlist=fldsFrLnd) + model_fld=trim(model_fld_name), model_fld_array=avofld, model_fld_concat=flds_l2x) data_fld_name = "qice" // nec_str model_fld_name = "Flgl_qice" // nec_str call dshr_fld_add(data_fld=trim(data_fld_name), data_fld_array=avifld, & - model_fld=trim(model_fld_name), model_fld_array=avofld, & - model_fld_concat=flds_l2x, fldlist_num=fldsFrLnd_num, fldlist=fldsFrLnd) + model_fld=trim(model_fld_name), model_fld_array=avofld, model_fld_concat=flds_l2x) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end do + + ! The following puts all of the elevation class fields as an + ! undidstributed dimension in the export state field + + call dshr_fld_add(med_fld="Sl_lfrin", fldlist_num=fldsFrLnd_num, fldlist=fldsFrLnd) + call dshr_fld_add(med_fld='Sl_tsrf_elev', fldlist_num=fldsFrLnd_num, fldlist=fldsFrLnd, & + ungridded_lbound=1, ungridded_ubound=glc_nec) + call dshr_fld_add(med_fld='Sl_topo_elev', fldlist_num=fldsFrLnd_num, fldlist=fldsFrLnd, & + ungridded_lbound=1, ungridded_ubound=glc_nec) + call dshr_fld_add(med_fld='Flgl_qice_elev', fldlist_num=fldsFrLnd_num, fldlist=fldsFrLnd, & + ungridded_lbound=1, ungridded_ubound=glc_nec) + end if ! Non snow fields that nead to be added if dlnd is in cplhist mode - ! "Sl_t " - ! "Sl_tref " - ! "Sl_qref " - ! "Sl_avsdr " - ! "Sl_anidr " - ! "Sl_avsdf " - ! "Sl_anidf " - ! "Sl_snowh " - ! "Fall_taux " - ! "Fall_tauy " - ! "Fall_lat " - ! "Fall_sen " - ! "Fall_lwup " - ! "Fall_evap " - ! "Fall_swnet " - ! "Sl_landfrac " - ! "Sl_fv " - ! "Sl_ram1 " - ! "Fall_flxdst1" - ! "Fall_flxdst2" - ! "Fall_flxdst3" - ! "Fall_flxdst4" + ! "Sl_t " "Sl_tref " "Sl_qref " "Sl_avsdr " + ! "Sl_anidr " "Sl_avsdf " "Sl_anidf " "Sl_snowh " + ! "Fall_taux " "Fall_tauy " "Fall_lat " "Fall_sen " + ! "Fall_lwup " "Fall_evap " "Fall_swnet " "Sl_landfrac " + ! "Sl_fv " "Sl_ram1 " + ! "Fall_flxdst1" "Fall_flxdst2" "Fall_flxdst3" "Fall_flxdst4" do n = 1,fldsFrLnd_num call NUOPC_Advertise(exportState, standardName=fldsFrLnd(n)%stdname, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return enddo - !------------------- - ! Save flds_l2x and flds_x2l as module variables for use in debugging - !------------------- - - flds_x2l_mod = trim(flds_x2l) - flds_l2x_mod = trim(flds_l2x) - end subroutine dlnd_comp_advertise !=============================================================================== - subroutine dlnd_comp_init(x2l, l2x, & - SDLND, mpicom, compid, my_task, master_task, & + subroutine dlnd_comp_init(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, & - scmMode, scmlat, scmlon, calendar, current_ymd, current_tod, mesh) + scmMode, scmlat, scmlon, calendar, current_ymd, current_tod, mesh, nxg, nyg) ! !DESCRIPTION: initialize dlnd model ! !INPUT/OUTPUT PARAMETERS: - type(mct_aVect) , intent(inout) :: x2l, l2x ! input/output attribute vectors - type(shr_strdata_type) , intent(inout) :: SDLND ! model shr_strdata instance (output) integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: compid ! mct comp id integer , intent(in) :: my_task ! my task in mpi communicator mpicom @@ -205,6 +192,7 @@ subroutine dlnd_comp_init(x2l, l2x, & integer , intent(in) :: current_ymd ! model date integer , intent(in) :: current_tod ! model sec into model date type(ESMF_Mesh) , intent(in) :: mesh ! ESMF docn mesh + integer , intent(out) :: nxg, nyg ! global size of model grid !--- local variables --- integer :: n,k ! generic counters @@ -356,12 +344,14 @@ subroutine dlnd_comp_init(x2l, l2x, & !---------------------------------------------------------------------------- if (my_task == master_task) write(logunit,F00) 'allocate AVs' - - call mct_aVect_init(l2x, rList=flds_l2x_mod, lsize=lsize) + call mct_aVect_init(l2x, rList=flds_l2x, lsize=lsize) call mct_aVect_zero(l2x) - call mct_aVect_init(x2l, rList=flds_x2l_mod, lsize=lsize) + call mct_aVect_init(x2l, rList=flds_x2l, lsize=lsize) call mct_aVect_zero(x2l) + nxg = SDLND%nxg + nyg = SDLND%nyg + !---------------------------------------------------------------------------- ! Read restart !---------------------------------------------------------------------------- @@ -410,8 +400,7 @@ subroutine dlnd_comp_init(x2l, l2x, & call t_adj_detailf(+2) write_restart = .false. - call dlnd_comp_run(x2l, l2x, & - SDLND, mpicom, my_task, master_task, & + call dlnd_comp_run(mpicom, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & current_ymd, current_tod) @@ -427,17 +416,13 @@ end subroutine dlnd_comp_init !=============================================================================== - subroutine dlnd_comp_run(x2l, l2x, & - SDLND, mpicom, my_task, master_task, & + subroutine dlnd_comp_run(mpicom, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & target_ymd, target_tod, case_name) ! !DESCRIPTION: run method for dlnd model ! input/output variables: - type(mct_aVect) , intent(inout) :: x2l - type(mct_aVect) , intent(inout) :: l2x - type(shr_strdata_type) , intent(inout) :: SDLND integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: my_task ! my task in mpi communicator mpicom integer , intent(in) :: master_task ! task number of master task @@ -538,4 +523,41 @@ subroutine dlnd_comp_run(x2l, l2x, & end subroutine dlnd_comp_run + !=============================================================================== + + subroutine dlnd_comp_export(exportState, rc) + + ! input/output variables + type(ESMF_State) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: k,n + character(nec_len) :: nec_str ! elevation class, as character string + !---------------------------------------------------------------- + + rc = ESMF_SUCCESS + + k = mct_aVect_indexRA(l2x, "Sl_lfrin") + call dshr_export(l2x%rattr(k,:), exportState, "Sl_lfrin", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + do n = 1,glc_nec + nec_str = glc_elevclass_as_string(n) + + k = mct_aVect_indexRA(l2x, "Sl_tsrf" // nec_str) + call dshr_export(l2x%rattr(k,:), exportState, "Sl_tsrf_elev", ungridded_index=n, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(l2x, "Sl_topo" // nec_str) + call dshr_export(l2x%rattr(k,:), exportState, "Sl_topo_elev", ungridded_index=n, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(l2x, "Flgl_qice" // nec_str) + call dshr_export(l2x%rattr(k,:), exportState, "Flgl_qice_elev", ungridded_index=n, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + end subroutine dlnd_comp_export + end module dlnd_comp_mod diff --git a/src/components/data_comps/dlnd/nuopc/dlnd_shr_mod.F90 b/src/components/data_comps/dlnd/nuopc/dlnd_shr_mod.F90 index 8e55712583e..175d7e59aa0 100644 --- a/src/components/data_comps/dlnd/nuopc/dlnd_shr_mod.F90 +++ b/src/components/data_comps/dlnd/nuopc/dlnd_shr_mod.F90 @@ -23,6 +23,9 @@ module dlnd_shr_mod ! Public data !-------------------------------------------------------------------------- + ! stream data type + type(shr_strdata_type), public :: SDLND + ! input namelist variables character(CL) , public :: restfilm ! model restart file namelist character(CL) , public :: restfils ! stream restart file namelist @@ -40,7 +43,7 @@ module dlnd_shr_mod !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine dlnd_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDLND, lnd_present, lnd_prognostic) + logunit, lnd_present, lnd_prognostic) ! !DESCRIPTION: Read in dlnd namelists implicit none @@ -51,7 +54,6 @@ subroutine dlnd_shr_read_namelists(filename, mpicom, my_task, master_task, & integer(IN) , intent(in) :: my_task ! my task in mpi communicator mpicom integer(IN) , intent(in) :: master_task ! task number of master task integer(IN) , intent(in) :: logunit ! logging unit number - type(shr_strdata_type) , intent(inout) :: SDLND logical , intent(out) :: lnd_present ! flag logical , intent(out) :: lnd_prognostic ! flag diff --git a/src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 b/src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 index 00ea9b54307..ba6dedacf0b 100644 --- a/src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 +++ b/src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 @@ -25,15 +25,13 @@ module lnd_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_grid_mod , only : shr_nuopc_grid_ArrayToState - use shr_nuopc_grid_mod , only : shr_nuopc_grid_StateToArray use shr_const_mod , only : SHR_CONST_SPVAL use shr_strdata_mod , only : shr_strdata_type - use dshr_nuopc_mod , only : fld_list_type, fldsMax, fld_list_realize + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData use dlnd_shr_mod , only : dlnd_shr_read_namelists use dlnd_comp_mod , only : dlnd_comp_init, dlnd_comp_run, dlnd_comp_advertise - use mct_mod , only : mct_Avect, mct_Avect_info + use dlnd_comp_mod , only : dlnd_comp_export implicit none private ! except @@ -54,9 +52,6 @@ module lnd_comp_nuopc type (fld_list_type) :: fldsToLnd(fldsMax) type (fld_list_type) :: fldsFrLnd(fldsMax) - type(shr_strdata_type) :: SDLND - type(mct_aVect) :: x2d - type(mct_aVect) :: d2x integer :: compid ! mct comp id integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom @@ -67,13 +62,9 @@ module lnd_comp_nuopc integer ,parameter :: master_task=0 ! task number of master task character(CL) :: case_name ! case name logical :: lnd_prognostic ! data is sent back to dlnd - character(CXX) :: flds_l2x = '' - character(CXX) :: flds_x2l = '' character(len=80) :: calendar ! calendar name logical :: use_esmf_metadata = .false. character(*),parameter :: modName = "(lnd_comp_nuopc)" - integer, parameter :: debug_import = 0 ! if > 0 will diagnose import fields - integer, parameter :: debug_export = 0 ! if > 0 will diagnose export fields character(*),parameter :: u_FILE_u = & __FILE__ @@ -85,12 +76,11 @@ subroutine SetServices(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - integer :: dbrc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) @@ -122,7 +112,7 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine SetServices @@ -153,13 +143,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(len=CL) :: logfile integer :: glc_nec ! number of elevation classes integer :: localPet - integer :: dbrc character(len=CL) :: fileName ! generic file name character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! generate local mpi comm @@ -193,7 +182,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) filename = "dlnd_in"//trim(inst_suffix) call dlnd_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDLND, lnd_present, lnd_prognostic) + logunit, lnd_present, lnd_prognostic) !-------------------------------- ! advertise import and export fields @@ -202,14 +191,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call NUOPC_CompAttributeGet(gcomp, name='glc_nec', value=cvalue, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) glc_nec - call ESMF_LogWrite('glc_nec = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('glc_nec = '// trim(cvalue), ESMF_LOGMSG_INFO) call dlnd_comp_advertise(importState, exportState, & lnd_present, lnd_prognostic, glc_nec, & - fldsFrLnd_num, fldsFrLnd, fldsToLnd_num, fldsToLnd, & - flds_l2x, flds_x2l, rc) + fldsFrLnd_num, fldsFrLnd, fldsToLnd_num, fldsToLnd, rc) - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -246,12 +234,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) real(R8) :: scmLat = shr_const_SPVAL ! single column lat real(R8) :: scmLon = shr_const_SPVAL ! single column lon logical :: read_restart ! start from restart - integer :: dbrc + integer :: nxg, nyg character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to my log file @@ -294,7 +282,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then calendar = shr_cal_gregorian else - call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), ESMF_LOGMSG_ERROR, rc=dbrc) + call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), ESMF_LOGMSG_ERROR) rc = ESMF_Failure return end if @@ -317,10 +305,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Initialize model !---------------------------------------------------------------------------- - call dlnd_comp_init(x2d, d2x, & - SDLND, mpicom, compid, my_task, master_task, & + call dlnd_comp_init(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, & - scmMode, scmlat, scmlon, calendar, current_ymd, current_tod, Emesh) + scmMode, scmlat, scmlon, calendar, current_ymd, current_tod, Emesh, nxg, nyg) !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -328,7 +315,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! by replacing the advertised fields with the newly created fields of the same name. !-------------------------------- - call fld_list_realize( & + call dshr_realize( & state=ExportState, & fldList=fldsFrLnd, & numflds=fldsFrLnd_num, & @@ -338,30 +325,22 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) mesh=Emesh, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call fld_list_realize( & - state=importState, & - fldList=fldsToLnd, & - numflds=fldsToLnd_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':dlndImport',& - mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! No import send for now - only export snow fields !-------------------------------- ! Pack export state - ! Copy from d2x to exportState + ! Copy from l2x to exportState ! Set the coupling scalars !-------------------------------- - call shr_nuopc_grid_ArrayToState(d2x%rattr, flds_l2x, exportState, grid_option='mesh', rc=rc) + call dlnd_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDLND%nxg),flds_scalar_index_nx, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDLND%nyg),flds_scalar_index_ny, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -369,10 +348,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! diagnostics !-------------------------------- - if (debug_export > 0) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif + call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) @@ -382,14 +359,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance + + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -407,12 +387,11 @@ subroutine ModelAdvance(gcomp, rc) integer :: yr ! year integer :: mon ! month integer :: day ! day in month - integer :: dbrc character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call shr_nuopc_memcheck(subname, 5, my_task==master_task) @@ -428,7 +407,7 @@ subroutine ModelAdvance(gcomp, rc) call NUOPC_ModelGet(gcomp, modelClock=clock, importState=importState, exportState=exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (debug_export > 0 .and. my_task == master_task) then + if (my_task == master_task) then call shr_nuopc_methods_Clock_TimePrint(clock,subname//'clock',rc=rc) endif @@ -437,8 +416,9 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- if (lnd_prognostic) then - call shr_nuopc_grid_StateToArray(importState, x2d%rattr, flds_x2l, grid_option='mesh', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! No import state for now - only snow fields + !call dlnd_comp_import(importState, rc=rc) + !if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if !-------------------------------- @@ -469,8 +449,7 @@ subroutine ModelAdvance(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yr, mon, day, nextymd) - call dlnd_comp_run(x2d, d2x, & - SDLND, mpicom, my_task, master_task, & + call dlnd_comp_run(mpicom, my_task, master_task, & inst_suffix, logunit, read_restart=.false., write_restart=write_restart, & target_ymd=nextYMD, target_tod=nextTOD, case_name=case_name) @@ -478,21 +457,19 @@ subroutine ModelAdvance(gcomp, rc) ! Pack export state !-------------------------------- - call shr_nuopc_grid_ArrayToState(d2x%rattr, flds_l2x, exportState, grid_option='mesh', rc=rc) + call dlnd_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- - if (debug_export > 0) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif + call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return if (my_task == master_task) then call shr_nuopc_log_clock_advance(clock, 'LND', logunit) endif - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) @@ -506,20 +483,19 @@ subroutine ModelFinalize(gcomp, rc) integer, intent(out) :: rc ! local variables - integer :: dbrc character(*), parameter :: F00 = "('(dlnd_comp_final) ',8a)" character(*), parameter :: F91 = "('(dlnd_comp_final) ',73('-'))" character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) if (my_task == master_task) then write(logunit,F91) write(logunit,F00) ' dlnd : end of main integration loop' write(logunit,F91) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ModelFinalize diff --git a/src/components/data_comps/docn/nuopc/docn_comp_mod.F90 b/src/components/data_comps/docn/nuopc/docn_comp_mod.F90 index c16e37e706d..360f09ead97 100644 --- a/src/components/data_comps/docn/nuopc/docn_comp_mod.F90 +++ b/src/components/data_comps/docn/nuopc/docn_comp_mod.F90 @@ -1,10 +1,10 @@ #ifdef AIX @PROCESS ALIAS_SIZE(805306368) #endif + module docn_comp_mod ! !USES: - use shr_pcdf_mod , only : shr_pcdf_readwrite use NUOPC , only : NUOPC_Advertise use ESMF , only : ESMF_State, ESMF_SUCCESS, ESMF_State use ESMF , only : ESMF_Mesh, ESMF_DistGrid, ESMF_MeshGet, ESMF_DistGridGet @@ -34,12 +34,14 @@ module docn_comp_mod use shr_strdata_mod , only : shr_strdata_print, shr_strdata_restRead use shr_strdata_mod , only : shr_strdata_advance, shr_strdata_restWrite use shr_dmodel_mod , only : shr_dmodel_translateAV - use dshr_nuopc_mod , only : fld_list_type, dshr_fld_add + use shr_pcdf_mod , only : shr_pcdf_readwrite + use dshr_nuopc_mod , only : fld_list_type, dshr_fld_add, dshr_import, dshr_export use docn_shr_mod , only : datamode ! namelist input use docn_shr_mod , only : aquap_option ! derived from datamode namelist input use docn_shr_mod , only : rest_file ! namelist input use docn_shr_mod , only : rest_file_strm ! namelist input use docn_shr_mod , only : nullstr + use docn_shr_mod , only : SDOCN ! !PUBLIC TYPES: implicit none @@ -52,6 +54,8 @@ module docn_comp_mod public :: docn_comp_advertise public :: docn_comp_init public :: docn_comp_run + public :: docn_comp_import + public :: docn_comp_export private :: prescribed_sst @@ -59,6 +63,11 @@ module docn_comp_mod ! Private data !-------------------------------------------------------------------------- + type(mct_aVect) :: x2o + type(mct_aVect) :: o2x + character(CXX) :: flds_o2x = '' + character(CXX) :: flds_x2o = '' + integer :: debug_import = 0 ! debug level (if > 0 will print all import fields) integer :: debug_export = 0 ! debug level (if > 0 will print all export fields) @@ -82,8 +91,6 @@ module docn_comp_mod character(len=CS), pointer :: stifld(:) ! names of fields in input streams character(len=CS), pointer :: stofld(:) ! local names of fields in input streams for calculations character(CXX) :: flds_strm = '' ! set in docn_comp_init - character(len=CXX) :: flds_o2x_mod ! set in docn_comp_advertise - character(len=CXX) :: flds_x2o_mod ! set in docn_comp_advertise logical :: ocn_prognostic_mod ! set in docn_comp_advertise integer , pointer :: imask(:) ! integer ocean mask @@ -101,30 +108,22 @@ module docn_comp_mod !=============================================================================== subroutine docn_comp_advertise(importState, exportState, & - ocn_present, ocn_prognostic, ocnrof_prognostic, & - fldsFrOcn_num, fldsFrOcn, fldsToOcn_num, fldsToOcn, & - flds_o2x, flds_x2o, rc) + ocn_prognostic, fldsFrOcn_num, fldsFrOcn, fldsToOcn_num, fldsToOcn, rc) ! input/output arguments type(ESMF_State) , intent(inout) :: importState type(ESMF_State) , intent(inout) :: exportState - logical , intent(in) :: ocn_present logical , intent(in) :: ocn_prognostic - logical , intent(in) :: ocnrof_prognostic integer , intent(out) :: fldsToOcn_num integer , intent(out) :: fldsFrOcn_num type (fld_list_type) , intent(out) :: fldsToOcn(:) type (fld_list_type) , intent(out) :: fldsFrOcn(:) - character(len=*) , intent(out) :: flds_o2x - character(len=*) , intent(out) :: flds_x2o integer , intent(out) :: rc ! local variables integer :: n !------------------------------------------------------------------------------- - if (.not. ocn_present) return - !-------------------------------- ! export fields !-------------------------------- @@ -136,29 +135,29 @@ subroutine docn_comp_advertise(importState, exportState, & call dshr_fld_add(model_fld='So_omask', model_fld_concat=flds_o2x, model_fld_index=ksomask, & fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) - call dshr_fld_add(model_fld='Fioo_q', model_fld_concat=flds_o2x, model_fld_index=kq, & fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) ! export fields that have a corresponding stream field - call dshr_fld_add(data_fld='t', data_fld_array=avifld, model_fld='So_t', model_fld_array=avofld, & - model_fld_concat=flds_o2x, model_fld_index=kt, fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) - - call dshr_fld_add(data_fld='s', data_fld_array=avifld, model_fld='So_s', model_fld_array=avofld, & - model_fld_concat=flds_o2x, model_fld_index=ks, fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) - - call dshr_fld_add(data_fld='u', data_fld_array=avifld, model_fld='So_u', model_fld_array=avofld, & - model_fld_concat=flds_o2x, model_fld_index=ku, fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) - - call dshr_fld_add(data_fld='v', data_fld_array=avifld, model_fld='So_v', model_fld_array=avofld, & - model_fld_concat=flds_o2x, model_fld_index=kv, fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) - - call dshr_fld_add(data_fld='dhdx', data_fld_array=avifld, model_fld='So_dhdx', model_fld_array=avofld, & - model_fld_concat=flds_o2x, model_fld_index=kdhdx, fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) - - call dshr_fld_add(data_fld='dhdy', data_fld_array=avifld, model_fld='So_dhdy', model_fld_array=avofld, & - model_fld_concat=flds_o2x, model_fld_index=kdhdy, fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) + call dshr_fld_add(data_fld='t', data_fld_array=avifld, & + model_fld='So_t', model_fld_array=avofld, model_fld_concat=flds_o2x, model_fld_index=kt, & + fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) + call dshr_fld_add(data_fld='s', data_fld_array=avifld, & + model_fld='So_s', model_fld_array=avofld, model_fld_concat=flds_o2x, model_fld_index=ks, & + fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) + call dshr_fld_add(data_fld='u', data_fld_array=avifld, & + model_fld='So_u', model_fld_array=avofld, model_fld_concat=flds_o2x, model_fld_index=ku, & + fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) + call dshr_fld_add(data_fld='v', data_fld_array=avifld, & + model_fld='So_v', model_fld_array=avofld, model_fld_concat=flds_o2x, model_fld_index=kv, & + fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) + call dshr_fld_add(data_fld='dhdx', data_fld_array=avifld, & + model_fld='So_dhdx', model_fld_array=avofld, model_fld_concat=flds_o2x, model_fld_index=kdhdx, & + fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) + call dshr_fld_add(data_fld='dhdy', data_fld_array=avifld, & + model_fld='So_dhdy', model_fld_array=avofld, model_fld_concat=flds_o2x, model_fld_index=kdhdy, & + fldlist_num=fldsFrOcn_num, fldlist=fldsFrOcn) !------------------- ! import fields (have no corresponding stream fields) @@ -185,6 +184,7 @@ subroutine docn_comp_advertise(importState, exportState, & fldlist_num=fldsToOcn_num, fldlist=fldsToOcn) call dshr_fld_add(model_fld='Foxx_rofi', model_fld_concat=flds_x2o, model_fld_index=krofi, & fldlist_num=fldsToOcn_num, fldlist=fldsToOcn) + end if !------------------- @@ -208,11 +208,9 @@ subroutine docn_comp_advertise(importState, exportState, & end if !------------------- - ! Save flds_x2o and flds_o2x as module variables for use in debugging + ! Save as module variables for use in debugging !------------------- - flds_x2o_mod = trim(flds_x2o) - flds_o2x_mod = trim(flds_o2x) ocn_prognostic_mod = ocn_prognostic !------------------- @@ -234,19 +232,15 @@ end subroutine docn_comp_advertise !=============================================================================== - subroutine docn_comp_init(x2o, o2x, & - SDOCN, mpicom, compid, my_task, master_task, & + subroutine docn_comp_init(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, & - scmMode, scmlat, scmlon, calendar, current_ymd, current_tod, modeldt, mesh) - + scmMode, scmlat, scmlon, calendar, current_ymd, current_tod, modeldt, mesh, nxg, nyg) ! !DESCRIPTION: initialize docn model use pio , only : iosystem_desc_t use shr_pio_mod, only : shr_pio_getiosys, shr_pio_getiotype ! --- input/output arguments --- - type(mct_aVect) , intent(inout) :: x2o, o2x ! input/output attribute vectors - type(shr_strdata_type) , intent(inout) :: SDOCN ! model shr_strdata instance (output) integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: compid ! mct comp id integer , intent(in) :: my_task ! my task in mpi communicator mpicom @@ -262,6 +256,7 @@ subroutine docn_comp_init(x2o, o2x, & integer , intent(in) :: current_tod ! model sec into model date integer , intent(in) :: modeldt ! model time step type(ESMF_Mesh) , intent(in) :: mesh ! ESMF docn mesh + integer , intent(out) :: nxg, nyg !--- local variables --- integer :: n,k ! generic counters @@ -424,14 +419,14 @@ subroutine docn_comp_init(x2o, o2x, & call t_startf('docn_initavs') if (my_task == master_task) write(logunit,F00) 'allocate AVs' - call mct_aVect_init(o2x, rList=flds_o2x_mod, lsize=lsize) + call mct_aVect_init(o2x, rList=flds_o2x, lsize=lsize) call mct_aVect_zero(o2x) kfrac = mct_aVect_indexRA(SDOCN%grid%data,'frac') o2x%rAttr(ksomask,:) = SDOCN%grid%data%rAttr(kfrac,:) if (ocn_prognostic_mod) then - call mct_aVect_init(x2o, rList=flds_x2o_mod, lsize=lsize) + call mct_aVect_init(x2o, rList=flds_x2o, lsize=lsize) call mct_aVect_zero(x2o) ! Initialize internal attribute vectors for optional streams @@ -472,6 +467,9 @@ subroutine docn_comp_init(x2o, o2x, & call t_stopf('docn_initavs') + nxg = SDOCN%nxg + nyg = SDOCN%nyg + !---------------------------------------------------------------------------- ! Read restart !---------------------------------------------------------------------------- @@ -535,21 +533,10 @@ subroutine docn_comp_init(x2o, o2x, & call t_adj_detailf(+2) - call docn_comp_run(& - x2o=x2o, & - o2x=o2x, & - SDOCN=SDOCN, & - mpicom=mpicom, & - compid=compid, & - my_task=my_task, & - master_task=master_task, & - inst_suffix=inst_suffix, & - logunit=logunit, & - read_restart=read_restart, & - write_restart=.false., & - target_ymd=current_ymd, & - target_tod=current_tod, & - modeldt=modeldt) + call docn_comp_run(mpicom=mpicom, compid=compid, my_task=my_task, & + master_task=master_task, inst_suffix=inst_suffix, logunit=logunit, & + read_restart=read_restart, write_restart=.false., & + target_ymd=current_ymd, target_tod=current_tod, modeldt=modeldt) if (my_task == master_task) then write(logunit,F00) 'docn_comp_init done' @@ -563,18 +550,13 @@ end subroutine docn_comp_init !=============================================================================== - subroutine docn_comp_run(x2o, o2x, & - SDOCN, mpicom, compid, my_task, master_task, & + subroutine docn_comp_run(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & target_ymd, target_tod, modeldt, case_name) ! !DESCRIPTION: run method for docn model - implicit none ! !INPUT/OUTPUT PARAMETERS: - type(mct_aVect) , intent(inout) :: x2o - type(mct_aVect) , intent(inout) :: o2x - type(shr_strdata_type) , intent(inout) :: SDOCN integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: compid ! mct comp id integer , intent(in) :: my_task ! my task in mpi communicator mpicom @@ -589,21 +571,20 @@ subroutine docn_comp_run(x2o, o2x, & character(len=*) , intent(in), optional :: case_name ! case name !--- local --- - integer :: n,nfld ! indices - integer :: lsize ! size of attr vect - real(R8) :: dt ! timestep - integer :: nu ! unit number - character(len=18) :: date_str - character(len=CS) :: fldname - character(len=CL) :: local_case_name - real(R8), parameter :: & - swp = 0.67_R8*(exp((-1._R8*shr_const_zsrflyr) /1.0_R8)) + 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) - + integer :: n,nfld ! indices + integer :: lsize ! size of attr vect + real(R8) :: dt ! timestep + integer :: nu ! unit number + character(len=18) :: date_str + character(len=CS) :: fldname + character(len=CL) :: local_case_name character(*), parameter :: F00 = "('(docn_comp_run) ',8a)" character(*), parameter :: F01 = "('(docn_comp_run) ',a, i7,2x,i5,2x,i5,2x,d21.14)" character(*), parameter :: F04 = "('(docn_comp_run) ',2a,2i8,'s')" character(*), parameter :: F0D = "('(docn_comp_run) ',a, i7,2x,i5,2x,i5,2x,d21.14)" character(*), parameter :: subName = "(docn_comp_run) " + real(R8), parameter :: & + swp = 0.67_R8*(exp((-1._R8*shr_const_zsrflyr) /1.0_R8)) + 0.33_R8*exp((-1._R8*shr_const_zsrflyr)/17.0_R8) !------------------------------------------------------------------------------- !-------------------- @@ -612,7 +593,7 @@ subroutine docn_comp_run(x2o, o2x, & if (debug_import > 0 .and. my_task == master_task .and. ocn_prognostic_mod) then do nfld = 1, mct_aVect_nRAttr(x2o) - call shr_string_listGetName(trim(flds_x2o_mod), nfld, fldname) + call shr_string_listGetName(trim(flds_x2o), nfld, fldname) do n = 1, mct_aVect_lsize(x2o) write(logunit,F0D)'import: ymd,tod,n = '// trim(fldname),target_ymd, target_tod, & n, x2o%rattr(nfld,n) @@ -627,6 +608,7 @@ subroutine docn_comp_run(x2o, o2x, & else local_case_name = " " endif + !-------------------- ! ADVANCE OCN !-------------------- @@ -818,7 +800,7 @@ subroutine docn_comp_run(x2o, o2x, & if (debug_export > 1 .and. my_task == master_task) then do nfld = 1, mct_aVect_nRAttr(o2x) - call shr_string_listGetName(trim(flds_o2x_mod), nfld, fldname) + call shr_string_listGetName(trim(flds_o2x), nfld, fldname) do n = 1, mct_aVect_lsize(o2x) write(logunit,F0D)'export: ymd,tod,n = '// trim(fldname),target_ymd, target_tod, & n, o2x%rattr(nfld,n) @@ -870,6 +852,77 @@ end subroutine docn_comp_run !=============================================================================== + subroutine docn_comp_import(importState, rc) + + ! input/output variables + type(ESMF_State) :: importState + integer, intent(out) :: rc + !---------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call dshr_import(importState, 'Foxx_swnet', x2o%rattr(kswnet,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Foxx_lwup', x2o%rattr(klwup,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Foxx_sen', x2o%rattr(ksen,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Foxx_lat', x2o%rattr(klat,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Faxa_lwdn', x2o%rattr(klwdn,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Faxa_snow', x2o%rattr(ksnow,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_import(importState, 'Fioi_melth', x2o%rattr(kmelth,:), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine docn_comp_import + + !=============================================================================== + + subroutine docn_comp_export(exportState, rc) + + ! input/output variables + type(ESMF_State) :: exportState + integer, intent(out) :: rc + !---------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call dshr_export(o2x%rattr(ksomask,:), exportState, 'So_omask', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(o2x%rattr(kt,:), exportState, 'So_t', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(o2x%rattr(ks,:), exportState, 'So_s', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(o2x%rattr(ku,:), exportState, 'So_u', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(o2x%rattr(kv,:), exportState, 'So_v', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(o2x%rattr(kdhdx,:), exportState, 'So_dhdx', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(o2x%rattr(kdhdy,:), exportState, 'So_dhdy', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + call dshr_export(o2x%rattr(kq,:), exportState, 'Fioo_q', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine docn_comp_export + + !=============================================================================== + subroutine prescribed_sst(xc, yc, lsize, sst_option, sst) real(R8) , intent(in) :: xc(:) !degrees diff --git a/src/components/data_comps/docn/nuopc/docn_shr_mod.F90 b/src/components/data_comps/docn/nuopc/docn_shr_mod.F90 index 36a2d1c52a4..8fdc128fc84 100644 --- a/src/components/data_comps/docn/nuopc/docn_shr_mod.F90 +++ b/src/components/data_comps/docn/nuopc/docn_shr_mod.F90 @@ -25,6 +25,9 @@ module docn_shr_mod ! Note that model decomp will now come from reading in the mesh directly + ! stream data type + type(shr_strdata_type), public :: SDOCN + ! input namelist variables character(CL) , public :: restfilm ! model restart file namelist character(CL) , public :: restfils ! stream restart file namelist @@ -42,7 +45,7 @@ module docn_shr_mod !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine docn_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDOCN, ocn_present, ocn_prognostic, ocnrof_prognostic) + logunit, ocn_prognostic) ! !DESCRIPTION: Read in docn namelists implicit none @@ -53,10 +56,7 @@ subroutine docn_shr_read_namelists(filename, mpicom, my_task, master_task, & integer(IN) , intent(in) :: my_task ! my task in mpi communicator mpicom integer(IN) , intent(in) :: master_task ! task number of master task integer(IN) , intent(in) :: logunit ! logging unit number - type(shr_strdata_type) , intent(inout) :: SDOCN - logical , intent(out) :: ocn_present ! flag logical , intent(out) :: ocn_prognostic ! flag - logical , intent(out) :: ocnrof_prognostic ! flag !--- local variables --- integer(IN) :: nunit ! unit number @@ -148,11 +148,6 @@ subroutine docn_shr_read_namelists(filename, mpicom, my_task, master_task, & ! Determine present and prognostic flag !---------------------------------------------------------------------------- - ocn_present = .true. - if (trim(datamode) == 'NULL') then - ocn_present = .false. - end if - ocn_prognostic = .false. if (force_prognostic_true) then ocn_prognostic = .true. @@ -164,11 +159,6 @@ subroutine docn_shr_read_namelists(filename, mpicom, my_task, master_task, & ocn_prognostic = .true. endif - ocnrof_prognostic = .false. - if (force_prognostic_true .or. (trim(datamode) == 'IAF')) then - ocnrof_prognostic = .true. - end if - end subroutine docn_shr_read_namelists end module docn_shr_mod diff --git a/src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 b/src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 index 9e25adcdb01..88bb5da6866 100644 --- a/src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 +++ b/src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 @@ -12,12 +12,9 @@ module ocn_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet - use med_constants_mod , only : R8, I8, CL, CXX - use med_constants_mod , only : shr_log_Unit + use med_constants_mod , only : R8, CL use med_constants_mod , only : shr_cal_ymd2date, shr_cal_noleap, shr_cal_gregorian use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - use med_constants_mod , only : shr_file_getloglevel, shr_file_setloglevel - use med_constants_mod , only : shr_file_setIO, shr_file_getUnit use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_num use shr_nuopc_scalars_mod , only : flds_scalar_index_nx @@ -26,15 +23,12 @@ module ocn_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_grid_mod , only : shr_nuopc_grid_ArrayToState - use shr_nuopc_grid_mod , only : shr_nuopc_grid_StateToArray use shr_strdata_mod , only : shr_strdata_type - use shr_const_mod , only : SHR_CONST_SPVAL - use dshr_nuopc_mod , only : fld_list_type, fldsMax, fld_list_realize + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData use docn_shr_mod , only : docn_shr_read_namelists use docn_comp_mod , only : docn_comp_init, docn_comp_run, docn_comp_advertise - use mct_mod , only : mct_Avect, mct_Avect_info + use docn_comp_mod , only : docn_comp_import, docn_comp_export implicit none @@ -56,9 +50,6 @@ module ocn_comp_nuopc type (fld_list_type) :: fldsToOcn(fldsMax) type (fld_list_type) :: fldsFrOcn(fldsMax) - type(shr_strdata_type) :: SDOCN - type(mct_aVect) :: x2o - type(mct_aVect) :: o2x integer :: compid ! mct comp id integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom @@ -70,9 +61,7 @@ module ocn_comp_nuopc character(CL) :: case_name ! case name character(len=80) :: calendar ! calendar name logical :: ocn_present ! flag - logical :: ocn_prognostic ! flag - character(CXX) :: flds_o2x = '' - character(CXX) :: flds_x2o = '' + logical :: ocn_prognostic ! flag integer :: logunit ! logging unit number logical :: use_esmf_metadata = .false. character(*),parameter :: modName = "(ocn_comp_nuopc)" @@ -91,13 +80,11 @@ subroutine SetServices(gcomp, rc) ! local variables integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - integer :: dbrc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) @@ -132,16 +119,18 @@ subroutine SetServices(gcomp, rc) specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -149,39 +138,24 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! local variables type(ESMF_VM) :: vm - integer :: lmpicom - character(len=CL) :: cvalue - logical :: activefld - integer :: n,nflds - integer :: ierr ! error code integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - integer :: dbrc - logical :: isPresent - character(len=CL) :: diro - character(len=CL) :: logfile - logical :: ocnrof_prognostic ! flag - integer :: localPet character(len=CL) :: fileName ! generic file name character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- - ! generate local mpi comm + ! get mpi data !---------------------------------------------------------------------------- call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, mpiCommunicator=lmpicom, localPet=localPet, rc=rc) + call ESMF_VMGet(vm, mpiCommunicator=mpicom, localPet=my_task, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call mpi_comm_dup(lmpicom, mpicom, ierr) - call mpi_comm_rank(mpicom, my_task, ierr) - !---------------------------------------------------------------------------- ! determine instance information !---------------------------------------------------------------------------- @@ -193,48 +167,50 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit) !---------------------------------------------------------------------------- ! Read input namelists and set present and prognostic flags !---------------------------------------------------------------------------- filename = "docn_in"//trim(inst_suffix) - call docn_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDOCN, ocn_present, ocn_prognostic, ocnrof_prognostic) + call docn_shr_read_namelists(filename, mpicom, my_task, master_task, logunit, ocn_prognostic) - ! TODO: - hard wire prognostic for now to get atm/ocn flux - ! computation and ocn albedos computed in mediator - ocn_prognostic = .true. + write(6,*)'DEBUG: ocn_prognostic = ',ocn_prognostic !-------------------------------- ! Advertise import and export fields !-------------------------------- call docn_comp_advertise(importstate, exportState, & - ocn_present, ocn_prognostic, ocnrof_prognostic, & - fldsFrOcn_num, fldsFrOcn, fldsToOcn_num, fldsToOcn, & - flds_o2x, flds_x2o, rc) + ocn_prognostic, fldsFrOcn_num, fldsFrOcn, fldsToOcn_num, fldsToOcn, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Reset shr logging to original values !---------------------------------------------------------------------------- call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + + use shr_const_mod, only : shr_const_spval + + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc ! local variables + integer :: n + integer :: nxg, nyg + character(CL) :: cvalue type(ESMF_Mesh) :: Emesh type(ESMF_Time) :: currTime type(ESMF_TimeInterval) :: timeStep @@ -246,28 +222,21 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: current_day ! model day integer :: current_tod ! model sec into model date integer :: modeldt ! model timestep - integer :: n - character(CL) :: cvalue - integer :: ierr ! error code logical :: scmMode = .false. ! single column mode - real(R8) :: scmLat = shr_const_SPVAL ! single column lat - real(R8) :: scmLon = shr_const_SPVAL ! single column lon - integer :: dbrc - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level + real(R8) :: scmLat = shr_const_spval ! single column lat + real(R8) :: scmLon = shr_const_spval ! single column lon + integer :: shrlogunit ! original log unit character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to my log file !---------------------------------------------------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logUnit) !-------------------------------- @@ -314,7 +283,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then calendar = shr_cal_gregorian else - call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), ESMF_LOGMSG_ERROR, rc=dbrc) + call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), ESMF_LOGMSG_ERROR) rc = ESMF_Failure return end if @@ -340,10 +309,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Initialize model !---------------------------------------------------------------------------- - call docn_comp_init(x2o, o2x, & - SDOCN, mpicom, compid, my_task, master_task, & + call docn_comp_init(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, & - scmMode, scmlat, scmlon, calendar, current_ymd, current_tod, modeldt, Emesh) + scmMode, scmlat, scmlon, calendar, current_ymd, current_tod, modeldt, Emesh, nxg, nyg) !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -351,46 +319,41 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! by replacing the advertised fields with the newly created fields of the same name. !-------------------------------- - if (ocn_present) then - ! export fields - call fld_list_realize( & - state=ExportState, & - fldList=fldsFrOcn, & - numflds=fldsFrOcn_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':docnExport',& - mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - ! import fields - if (ocn_prognostic) then - call fld_list_realize( & - state=importState, & - fldList=fldsToOcn, & - numflds=fldsToOcn_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':docnImport',& - mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if + ! export fields + call dshr_realize( & + state=ExportState, & + fldList=fldsFrOcn, & + numflds=fldsFrOcn_num, & + flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, & + tag=subname//':docnExport',& + mesh=Emesh, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! import fields + call dshr_realize( & + state=importState, & + fldList=fldsToOcn, & + numflds=fldsToOcn_num, & + flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, & + tag=subname//':docnImport',& + mesh=Emesh, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Pack export state - ! Copy from o2x to exportState ! Set the coupling scalars !-------------------------------- - call shr_nuopc_grid_ArrayToState(o2x%rattr, flds_o2x, exportState, grid_option='mesh', rc=rc) + call docn_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDOCN%nxg),flds_scalar_index_nx, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDOCN%nyg),flds_scalar_index_ny, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -407,7 +370,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (use_esmf_metadata) then @@ -415,14 +377,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance + + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -443,14 +408,12 @@ subroutine ModelAdvance(gcomp, rc) integer :: mon ! month integer :: day ! day in month integer :: modeldt ! model timestep - integer :: dbrc integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call shr_nuopc_memcheck(subname, 5, my_task==master_task) @@ -459,8 +422,6 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -479,7 +440,7 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- if (ocn_prognostic) then - call shr_nuopc_grid_StateToArray(importState, x2o%rattr, flds_x2o, grid_option='mesh', rc=rc) + call docn_comp_import(importState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -518,8 +479,7 @@ subroutine ModelAdvance(gcomp, rc) ! Advance the model - call docn_comp_run(x2o, o2x, & - SDOCN, mpicom, compid, my_task, master_task, & + call docn_comp_run(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & nextYMD, nextTOD, modeldt, case_name=case_name) @@ -527,7 +487,7 @@ subroutine ModelAdvance(gcomp, rc) ! Pack export state !-------------------------------- - call shr_nuopc_grid_ArrayToState(o2x%rattr, flds_o2x, exportState, grid_option='mesh', rc=rc) + call docn_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- @@ -541,9 +501,8 @@ subroutine ModelAdvance(gcomp, rc) if (my_task == master_task) then call shr_nuopc_log_clock_advance(clock, 'OCN', logunit) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine ModelAdvance @@ -551,11 +510,11 @@ end subroutine ModelAdvance !=============================================================================== subroutine ModelFinalize(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables - integer :: dbrc character(*), parameter :: F00 = "('(docn_comp_final) ',8a)" character(*), parameter :: F91 = "('(docn_comp_final) ',73('-'))" character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) ' @@ -567,7 +526,7 @@ subroutine ModelFinalize(gcomp, rc) write(logunit,F00) 'docn : end of main integration loop' write(logunit,F91) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ModelFinalize diff --git a/src/components/data_comps/drof/nuopc/drof_comp_mod.F90 b/src/components/data_comps/drof/nuopc/drof_comp_mod.F90 index 375592c0ef4..87c93dc4037 100644 --- a/src/components/data_comps/drof/nuopc/drof_comp_mod.F90 +++ b/src/components/data_comps/drof/nuopc/drof_comp_mod.F90 @@ -29,8 +29,7 @@ module drof_comp_mod use shr_cal_mod , only : shr_cal_datetod2string use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use dshr_nuopc_mod , only : fld_list_type - use dshr_nuopc_mod , only : dshr_fld_add + use dshr_nuopc_mod , only : fld_list_type, dshr_fld_add, dshr_export use drof_shr_mod , only : datamode ! namelist input use drof_shr_mod , only : rest_file ! namelist input use drof_shr_mod , only : rest_file_strm ! namelist input @@ -47,6 +46,7 @@ module drof_comp_mod public :: drof_comp_advertise public :: drof_comp_init public :: drof_comp_run + public :: drof_comp_export !-------------------------------------------------------------------------- ! Private data @@ -495,4 +495,29 @@ subroutine drof_comp_run(x2r, r2x, & end subroutine drof_comp_run + !=============================================================================== + + subroutine drof_comp_export(r2x, exportState, rc) + + ! input/output variables + type(mct_aVect) :: r2x + type(ESMF_State) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: k + !---------------------------------------------------------------- + + rc = ESMF_SUCCESS + + k = mct_aVect_indexRA(r2x, 'Forr_rofl') + call dshr_export(r2x%rattr(k,:), exportState, 'Forr_rofl', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(r2x, 'Forr_rofi') + call dshr_export(r2x%rattr(k,:), exportState, 'Forr_rofi', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine drof_comp_export + end module drof_comp_mod diff --git a/src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 b/src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 index 3afa884d5e2..7cde9dec63d 100644 --- a/src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 +++ b/src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 @@ -25,15 +25,14 @@ module rof_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_grid_mod , only : shr_nuopc_grid_ArrayToState - use shr_nuopc_grid_mod , only : shr_nuopc_grid_StateToArray use shr_const_mod , only : SHR_CONST_SPVAL use shr_strdata_mod , only : shr_strdata_type - use dshr_nuopc_mod , only : fld_list_type, fldsMax, fld_list_realize + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData use drof_shr_mod , only : drof_shr_read_namelists use drof_comp_mod , only : drof_comp_init, drof_comp_run, drof_comp_advertise - use mct_mod , only : mct_Avect, mct_Avect_info + use drof_comp_mod , only : drof_comp_export + use mct_mod , only : mct_Avect implicit none private ! except @@ -129,8 +128,11 @@ end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance + + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -319,7 +321,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! by replacing the advertised fields with the newly created fields of the same name. !-------------------------------- - call fld_list_realize( & + call dshr_realize( & state=ExportState, & fldList=fldsFrRof, & numflds=fldsFrRof_num, & @@ -329,7 +331,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) mesh=Emesh, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! Todo: no import state for now - should this be added? + ! No import state for now !-------------------------------- ! Pack export state @@ -337,7 +339,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Set the coupling scalars !-------------------------------- - call shr_nuopc_grid_ArrayToState(r2x%rattr, flds_r2x, exportState, 'mesh', rc=rc) + call drof_comp_export(r2x, exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(SDROF%nxg),flds_scalar_index_nx, exportState, & @@ -429,8 +431,7 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- if (rof_prognostic) then - call shr_nuopc_grid_StateToArray(importState, x2r%rattr, flds_x2r, 'mesh', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! Do nothing for now end if !-------------------------------- @@ -475,7 +476,7 @@ subroutine ModelAdvance(gcomp, rc) ! Pack export state !-------------------------------- - call shr_nuopc_grid_ArrayToState(r2x%rattr, flds_r2x, exportState, 'mesh', rc=rc) + call drof_comp_export(r2x, exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- diff --git a/src/components/data_comps/dshr_nuopc/dshr_nuopc_mod.F90 b/src/components/data_comps/dshr_nuopc/dshr_nuopc_mod.F90 index 9ad306c375b..9e6a85019ba 100644 --- a/src/components/data_comps/dshr_nuopc/dshr_nuopc_mod.F90 +++ b/src/components/data_comps/dshr_nuopc/dshr_nuopc_mod.F90 @@ -1,32 +1,38 @@ module dshr_nuopc_mod - use ESMF use NUOPC - use NUOPC_Model , only : NUOPC_ModelGet + use NUOPC_Model + use ESMF use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_nuopc_time_mod , only : shr_nuopc_time_alarmInit - use shr_kind_mod , only : R8=>SHR_KIND_R8, CS=>SHR_KIND_CS + use shr_kind_mod , only : r8=>shr_kind_r8, cs=>shr_kind_cs, cxx=>shr_kind_cxx + use shr_string_mod , only : shr_string_listGetIndex use shr_sys_mod , only : shr_sys_abort implicit none public public :: dshr_fld_add - public :: fld_list_add ! TODO: remove - public :: fld_list_realize ! TODO: rename to dshr_realize + public :: dshr_import + public :: dshr_export + public :: dshr_realize public :: ModelInitPhase ! TODO: rename to dshr_modelinit public :: ModelSetRunClock ! TODO: rename to dshr_setrunclock public :: ModelSetMetaData ! TODO rename to dshr_setmetadata type fld_list_type character(len=128) :: stdname + integer :: ungridded_lbound = 0 + integer :: ungridded_ubound = 0 end type fld_list_type interface dshr_fld_add ; module procedure & + dshr_fld_add, & dshr_fld_add_model, & dshr_fld_add_model_and_data end interface dshr_fld_add + integer :: gridTofieldMap = 2 ! ungridded dimension is innermost integer , parameter :: fldsMax = 100 integer , parameter :: dbug = 10 character(*), parameter :: modName = "(dhsr_nuopc_mod)" @@ -37,36 +43,49 @@ module dshr_nuopc_mod contains !=============================================================================== - subroutine dshr_fld_add_model(model_fld, model_fld_concat, model_fld_index, & - fldlist_num, fldlist) + subroutine dshr_fld_add(med_fld, fldlist_num, fldlist, ungridded_lbound, ungridded_ubound) + + ! input/output variables + character(len=*) , intent(in) :: med_fld + integer , intent(inout) :: fldlist_num + type(fld_list_type) , intent(inout) :: fldlist(:) + integer , optional , intent(in) :: ungridded_lbound + integer , optional , intent(in) :: ungridded_ubound + + ! local variables + integer :: rc + character(len=*), parameter :: subname='(dshr_nuopc_mod:dshr_fld_add)' + ! ---------------------------------------------- - use shr_string_mod, only : shr_string_listGetIndex + call dshr_fld_list_add(fldlist_num, fldlist, med_fld, ungridded_lbound, ungridded_ubound) + + end subroutine dshr_fld_add + +!=============================================================================== + + subroutine dshr_fld_add_model(model_fld, model_fld_concat, model_fld_index, & + fldlist_num, fldlist, ungridded_lbound, ungridded_ubound) ! input/output variables - character(len=*) , intent(in) :: model_fld - character(len=*) , intent(inout) :: model_fld_concat - integer, optional , intent(out) :: model_fld_index - integer , intent(inout) :: fldlist_num - type(fld_list_type) , intent(inout) :: fldlist(:) + character(len=*) , intent(in) :: model_fld + character(len=*) , intent(inout) :: model_fld_concat + integer , optional , intent(out) :: model_fld_index + integer , optional , intent(inout) :: fldlist_num + type(fld_list_type) , optional , intent(inout) :: fldlist(:) + integer , optional , intent(in) :: ungridded_lbound + integer , optional , intent(in) :: ungridded_ubound ! local variables integer :: rc - integer :: dbrc character(len=*), parameter :: subname='(dshr_nuopc_mod:dshr_fld_add_model)' ! ---------------------------------------------- - fldlist_num = fldlist_num + 1 - if (fldlist_num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR fldlist_num > fldsMax "//trim(model_fld), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - return - endif - fldlist(fldlist_num)%stdname = trim(model_fld) - if (len_trim(model_fld_concat) + len_trim(model_fld) + 1 >= len(model_fld_concat)) then - call ESMF_LogWrite(subname//': ERROR: max len of model_fld_concat has been exceeded', & - ESMF_LOGMSG_ERROR, line=__LINE__, file= u_FILE_u, rc=dbrc) + call ESMF_LogWrite(subname//': ERROR: max len of model_fld_concat has been exceeded', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return end if + if (trim(model_fld_concat) == '') then model_fld_concat = trim(model_fld) else @@ -77,29 +96,36 @@ subroutine dshr_fld_add_model(model_fld, model_fld_concat, model_fld_index, & call shr_string_listGetIndex(trim(model_fld_concat), trim(model_fld), model_fld_index) end if + !---------------------------------- + ! Update fldlist array if appropriate + !---------------------------------- + + if (present(fldlist_num) .and. present(fldlist)) then + call dshr_fld_list_add(fldlist_num, fldlist, model_fld, ungridded_lbound, ungridded_ubound) + end if + end subroutine dshr_fld_add_model !=============================================================================== subroutine dshr_fld_add_model_and_data( data_fld, data_fld_array, & model_fld, model_fld_array, model_fld_concat, model_fld_index, & - fldlist_num, fldlist) - - use shr_string_mod, only : shr_string_listGetIndex - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR + fldlist_num, fldlist, ungridded_lbound, ungridded_ubound) ! input/output variables - character(len=*) , intent(in) :: data_fld - character(len=*) , pointer :: data_fld_array(:) - character(len=*) , intent(in) :: model_fld - character(len=*) , pointer :: model_fld_array(:) - character(len=*) , intent(inout) , optional :: model_fld_concat - integer , intent(out) , optional :: model_fld_index - integer , intent(inout) , optional :: fldlist_num - type(fld_list_type), intent(inout) , optional :: fldlist(:) + character(len=*) , intent(in) :: data_fld + character(len=*) , pointer :: data_fld_array(:) + character(len=*) , intent(in) :: model_fld + character(len=*) , pointer :: model_fld_array(:) + character(len=*) , optional , intent(inout) :: model_fld_concat + integer , optional , intent(out) :: model_fld_index + integer , optional , intent(inout) :: fldlist_num + type(fld_list_type) , optional , intent(inout) :: fldlist(:) + integer , optional , intent(in) :: ungridded_lbound + integer , optional , intent(in) :: ungridded_ubound ! local variables - integer :: dbrc + integer :: rc integer :: n, oldsize, id character(len=CS), pointer :: new_data_fld_array(:) character(len=CS), pointer :: new_model_fld_array(:) @@ -108,6 +134,8 @@ subroutine dshr_fld_add_model_and_data( data_fld, data_fld_array, & !---------------------------------- ! Create new data_fld_array and model_fld_array + ! Model is what the data model sends and receives from the mediator + ! Data is what the data model obtains from the various streams !---------------------------------- ! 1) determine new index @@ -148,9 +176,8 @@ subroutine dshr_fld_add_model_and_data( data_fld, data_fld_array, & !---------------------------------- if (present(model_fld_concat)) then - if (len_trim(model_fld_concat) + len_trim(model_fld) + 1 >= len(model_fld_concat)) then - call ESMF_LogWrite(subname//': ERROR: max len of model_fld_concat has been exceeded', & - ESMF_LOGMSG_ERROR, line=__LINE__, file= u_FILE_u, rc=dbrc) + if (len_trim(model_fld_concat) + len_trim(model_fld) + 1 >= cxx) then + call ESMF_LogWrite(subname//': ERROR: max len of model_fld_concat has been exceeded', ESMF_LOGMSG_INFO) call shr_sys_abort() end if if (trim(model_fld_concat) == '') then @@ -168,33 +195,25 @@ subroutine dshr_fld_add_model_and_data( data_fld, data_fld_array, & !---------------------------------- ! Update fldlist array if appropriate !---------------------------------- - if (present(fldlist_num) .and. present(fldlist)) then - fldlist_num = fldlist_num + 1 - if (fldlist_num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR fldlist_num > fldsMax "//trim(model_fld), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) - return - endif - fldlist(fldlist_num)%stdname = trim(model_fld) + call dshr_fld_list_add(fldlist_num, fldlist, model_fld, ungridded_lbound, ungridded_ubound) end if end subroutine dshr_fld_add_model_and_data !=============================================================================== - subroutine fld_list_add(num, fldlist, stdname, flds_concat) - use ESMF, only : ESMF_LogWrite, ESMF_LOGMSG_ERROR + subroutine dshr_fld_list_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound) ! input/output variables integer, intent(inout) :: num type(fld_list_type), intent(inout) :: fldlist(:) character(len=*), intent(in) :: stdname - character(len=*), optional, intent(inout) :: flds_concat + integer, optional, intent(in) :: ungridded_lbound + integer, optional, intent(in) :: ungridded_ubound ! local variables integer :: rc - integer :: dbrc character(len=*), parameter :: subname='(dshr_nuopc_mod:fld_list_add)' !---------------------------------------------------------------------- @@ -202,36 +221,24 @@ subroutine fld_list_add(num, fldlist, stdname, flds_concat) num = num + 1 if (num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE return endif fldlist(num)%stdname = trim(stdname) - if (present(flds_concat)) then - if (len_trim(flds_concat) + len_trim(stdname) + 1 >= len(flds_concat)) then - call ESMF_LogWrite(subname//': ERROR: max len of flds_concat has been exceeded', & - ESMF_LOGMSG_ERROR, line=__LINE__, file= u_FILE_u, rc=dbrc) - end if - if (trim(flds_concat) == '') then - flds_concat = trim(stdname) - else - flds_concat = trim(flds_concat)//':'//trim(stdname) - end if + if (present(ungridded_lbound) .and. present(ungridded_ubound)) then + fldlist(num)%ungridded_lbound = ungridded_lbound + fldlist(num)%ungridded_ubound = ungridded_ubound end if - end subroutine fld_list_add + end subroutine dshr_fld_list_add !=============================================================================== - subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scalar_num, mesh, tag, rc) - - use NUOPC , only : NUOPC_IsConnected, NUOPC_Realize - use ESMF , only : ESMF_MeshLoc_Element, ESMF_FieldCreate, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_MAXSTR, ESMF_Field, ESMF_State, ESMF_Mesh, ESMF_StateRemove - use ESMF , only : ESMF_LogFoundError, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LOGERR_PASSTHRU + subroutine dshr_realize(state, fldList, numflds, flds_scalar_name, flds_scalar_num, mesh, tag, rc) + ! input/output variables type(ESMF_State) , intent(inout) :: state type(fld_list_type) , intent(in) :: fldList(:) integer , intent(in) :: numflds @@ -242,7 +249,6 @@ subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scal integer , intent(inout) :: rc ! local variables - integer :: dbrc integer :: n type(ESMF_Field) :: field character(len=80) :: stdname @@ -256,16 +262,23 @@ subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scal if (NUOPC_IsConnected(state, fieldName=stdname)) then if (stdname == trim(flds_scalar_name)) then call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected on root pe", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) ! Create the scalar field call SetScalarField(field, flds_scalar_name, flds_scalar_num, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & - ESMF_LOGMSG_INFO, rc=dbrc) ! Create the field - field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (fldlist(n)%ungridded_lbound > 0 .and. fldlist(n)%ungridded_ubound > 0) then + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, & + ungriddedLbound=(/fldlist(n)%ungridded_lbound/), & + ungriddedUbound=(/fldlist(n)%ungridded_ubound/), gridToFieldMap=(/gridToFieldMap/), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + end if + call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & + ESMF_LOGMSG_INFO) endif ! NOW call NUOPC_Realize @@ -274,7 +287,7 @@ subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scal else if (stdname /= trim(flds_scalar_name)) then call ESMF_LogWrite(subname // trim(tag) // " Field = "// trim(stdname) // " is not connected.", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) call ESMF_StateRemove(state, (/stdname/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return end if @@ -287,9 +300,6 @@ subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) ! ---------------------------------------------- ! create a field with scalar data on the root pe ! ---------------------------------------------- - use ESMF, only : ESMF_Field, ESMF_DistGrid, ESMF_Grid - use ESMF, only : ESMF_DistGridCreate, ESMF_GridCreate, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU - use ESMF, only : ESMF_FieldCreate, ESMF_GridCreate, ESMF_TYPEKIND_R8 type(ESMF_Field) , intent(inout) :: field character(len=*) , intent(in) :: flds_scalar_name @@ -317,11 +327,13 @@ subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) end subroutine SetScalarField - end subroutine fld_list_realize + end subroutine dshr_realize !=============================================================================== subroutine ModelInitPhase(gcomp, importState, exportState, clock, rc) + + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -339,6 +351,8 @@ end subroutine ModelInitPhase !=============================================================================== subroutine ModelSetRunClock(gcomp, rc) + + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -352,14 +366,13 @@ subroutine ModelSetRunClock(gcomp, rc) integer :: restart_n ! Number until restart interval integer :: restart_ymd ! Restart date (YYYYMMDD) type(ESMF_ALARM) :: restart_alarm - integer :: dbrc character(len=128) :: name integer :: alarmcount character(len=*),parameter :: subname='dshr_nuopc_mod:(ModelSetRunClock) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! query the Component for its clocks call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) @@ -390,7 +403,7 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_GridCompGet(gcomp, name=name, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//'setting alarms for' // trim(name), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//'setting alarms for' // trim(name), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -425,7 +438,7 @@ subroutine ModelSetRunClock(gcomp, rc) call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ModelSetRunClock @@ -485,4 +498,110 @@ subroutine ModelSetMetadata(gcomp, name, rc) end subroutine ModelSetMetadata + !----------------------------------------------------------------------------- + + subroutine dshr_export(array, state, fldname, ungridded_index, rc) + + ! ---------------------------------- + ! copy array data to state fields + ! ---------------------------------- + + ! input/otuput variables + real(r8) , intent(inout) :: array(:) + type(ESMF_State) , intent(inout) :: state + character(len=*) , intent(in) :: fldname + integer, optional, intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: lsize, n + type(ESMF_Field) :: lfield + real(R8), pointer :: farray1d(:) + real(R8), pointer :: farray2d(:,:) + character(*),parameter :: subName = "(dshr_nuopc_mod: dshr_export)" + !---------------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(state, itemName=trim(fldname), field=lfield, rc=rc) + if (.not. shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) then + call ESMF_LogWrite(trim(subname)//": fldname = "//trim(fldname)//" copy", ESMF_LOGMSG_INFO) + + lsize = size(array) + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=farray2d, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do n = 1,lsize + farray2d(n,ungridded_index) = array(n) + enddo + else if (gridToFieldMap == 2) then + do n = 1,lsize + farray2d(ungridded_index,n) = array(n) + end do + end if + else + call ESMF_FieldGet(lfield, farrayPtr=farray1d, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize + farray1d(n) = array(n) + enddo + end if + end if + + end subroutine dshr_export + + !----------------------------------------------------------------------------- + + subroutine dshr_import(state, fldname, array, ungridded_index, rc) + + ! ---------------------------------- + ! copy state field to array data + ! ---------------------------------- + + ! input/output variables + type(ESMF_State) , intent(in) :: state + character(len=*) , intent(in) :: fldname + real(r8) , intent(inout) :: array(:) + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: lsize, n + type(ESMF_Field) :: lfield + real(R8), pointer :: farray1d(:) + real(R8), pointer :: farray2d(:,:) + character(*),parameter :: subName = "(dshr_nuopc_mod: dshr_import)" + !---------------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(state, itemName=trim(fldname), field=lfield, rc=rc) + if (.not. shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) then + call ESMF_LogWrite(trim(subname)//": fldname = "//trim(fldname)//" copy", ESMF_LOGMSG_INFO) + + lsize = size(array) + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=farray2d, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do n = 1,lsize + array(n) = farray2d(n,ungridded_index) + enddo + else if (gridToFieldMap == 2) then + do n = 1,lsize + array(n) = farray2d(ungridded_index,n) + enddo + end if + else + call ESMF_FieldGet(lfield, farrayPtr=farray1d, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,lsize + array(n) = farray1d(n) + enddo + end if + end if + + end subroutine dshr_import + end module dshr_nuopc_mod diff --git a/src/components/data_comps/dwav/nuopc/dwav_comp_mod.F90 b/src/components/data_comps/dwav/nuopc/dwav_comp_mod.F90 index 2017ebc18b2..1de4a2a7bd5 100644 --- a/src/components/data_comps/dwav/nuopc/dwav_comp_mod.F90 +++ b/src/components/data_comps/dwav/nuopc/dwav_comp_mod.F90 @@ -30,12 +30,12 @@ module dwav_comp_mod use shr_cal_mod , only : shr_cal_datetod2string use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use dshr_nuopc_mod , only : fld_list_type - use dshr_nuopc_mod , only : dshr_fld_add + use dshr_nuopc_mod , only : fld_list_type, dshr_fld_add, dshr_export use dwav_shr_mod , only : datamode ! namelist input use dwav_shr_mod , only : rest_file ! namelist input use dwav_shr_mod , only : rest_file_strm ! namelist input use dwav_shr_mod , only : nullstr + use dwav_shr_mod , only : SDWAV ! !PUBLIC TYPES: implicit none @@ -48,16 +48,18 @@ module dwav_comp_mod public :: dwav_comp_advertise public :: dwav_comp_init public :: dwav_comp_run - public :: dwav_comp_final + public :: dwav_comp_export !-------------------------------------------------------------------------- ! Private data !-------------------------------------------------------------------------- + type(mct_aVect) :: x2w + type(mct_aVect) :: w2x character(len=CS), pointer :: avifld(:) ! character array for field names coming from streams character(len=CS), pointer :: avofld(:) ! character array for field names to be sent/received from mediator - character(len=CXX) :: flds_w2x_mod - character(len=CXX) :: flds_x2w_mod + character(CXX) :: flds_w2x = '' + character(CXX) :: flds_x2w = '' character(len=*), parameter :: rpfile = 'rpointer.wav' character(*) , parameter :: u_FILE_u = & __FILE__ @@ -68,8 +70,7 @@ module dwav_comp_mod subroutine dwav_comp_advertise(importState, exportState, & wav_present, wav_prognostic, & - fldsFrWav_num, fldsFrWav, fldsToWav_num, fldsToWav, & - flds_w2x, flds_x2w, rc) + fldsFrWav_num, fldsFrWav, fldsToWav_num, fldsToWav, rc) ! 1. determine export and import fields to advertise to mediator ! 2. determine translation of fields from streams to export/import fields @@ -83,8 +84,6 @@ subroutine dwav_comp_advertise(importState, exportState, & type (fld_list_type) , intent(out) :: fldsFrWav(:) integer , intent(out) :: fldsToWav_num type (fld_list_type) , intent(out) :: fldsToWav(:) - character(len=*) , intent(out) :: flds_w2x - character(len=*) , intent(out) :: flds_x2w integer , intent(out) :: rc ! local variables @@ -124,27 +123,17 @@ subroutine dwav_comp_advertise(importState, exportState, & if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return enddo - !------------------- - ! Save flds_w2x and flds_x2w as module variables for use in debugging - !------------------- - - flds_x2w_mod = trim(flds_x2w) - flds_w2x_mod = trim(flds_w2x) - end subroutine dwav_comp_advertise !=============================================================================== - subroutine dwav_comp_init(x2w, w2x, & - SDWAV, mpicom, compid, my_task, master_task, & + subroutine dwav_comp_init(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, & - target_ymd, target_tod, calendar, mesh) + target_ymd, target_tod, calendar, mesh, nxg, nyg) ! !DESCRIPTION: initialize dwav model ! !INPUT/OUTPUT PARAMETERS: - type(mct_aVect) , intent(inout) :: x2w, w2x ! input/output attribute vectors - type(shr_strdata_type) , intent(inout) :: SDWAV ! model integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: compid ! mct comp id integer , intent(in) :: my_task ! my task in mpi communicator mpicom @@ -156,6 +145,7 @@ subroutine dwav_comp_init(x2w, w2x, & integer , intent(in) :: target_tod ! model sec into model date character(len=*) , intent(in) :: calendar ! calendar type type(ESMF_Mesh) , intent(in) :: mesh ! ESMF docn mesh + integer , intent(out) :: nxg, nyg !--- local variables --- integer :: n,k ! generic counters @@ -309,7 +299,7 @@ subroutine dwav_comp_init(x2w, w2x, & deallocate(domlon, domlat) !---------------------------------------------------------------------------- - ! Initialize SDLND attributes for streams and mapping of streams to model domain + ! Initialize SDWAV attributes for streams and mapping of streams to model domain !---------------------------------------------------------------------------- call shr_strdata_init_streams(SDWAV, compid, mpicom, my_task) @@ -323,10 +313,15 @@ subroutine dwav_comp_init(x2w, w2x, & if (my_task == master_task) write(logunit,F00) 'allocate AVs' - call mct_avect_init(w2x, rlist=flds_w2x_mod, lsize=lsize) + call mct_avect_init(w2x, rlist=flds_w2x, lsize=lsize) call mct_avect_zero(w2x) - call mct_avect_init(x2w, rlist=flds_x2w_mod, lsize=lsize) - call mct_avect_zero(x2w) + + ! no import state for now + ! call mct_avect_init(x2w, rlist=flds_x2w, lsize=lsize) + ! call mct_avect_zero(x2w) + + nxg = SDWAV%nxg + nyg = SDWAV%nyg !---------------------------------------------------------------------------- ! Read restart @@ -372,8 +367,7 @@ subroutine dwav_comp_init(x2w, w2x, & !---------------------------------------------------------------------------- write_restart = .false. - call dwav_comp_run(x2w, w2x, & - SDWAV, mpicom, my_task, master_task, & + call dwav_comp_run(mpicom, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & target_ymd, target_tod) @@ -387,17 +381,13 @@ end subroutine dwav_comp_init !=============================================================================== - subroutine dwav_comp_run(x2w, w2x, & - SDWAV, mpicom, my_task, master_task, & + subroutine dwav_comp_run(mpicom, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & target_ymd, target_tod, case_name) ! DESCRIPTION: run method for dwav model ! input/output parameters: - type(mct_aVect) , intent(inout) :: x2w - type(mct_aVect) , intent(inout) :: w2x - type(shr_strdata_type) , intent(inout) :: SDWAV integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: my_task ! my task in mpi communicator mpicom integer , intent(in) :: master_task ! task number of master task @@ -498,27 +488,30 @@ end subroutine dwav_comp_run !=============================================================================== - subroutine dwav_comp_final(my_task, master_task, logunit) + subroutine dwav_comp_export(exportState, rc) - ! !DESCRIPTION: finalize method for dwav model + ! input/output variables + type(ESMF_State) :: exportState + integer, intent(out) :: rc - ! !INPUT/OUTPUT PARAMETERS: - integer , intent(in) :: my_task ! my task in mpi communicator mpicom - integer , intent(in) :: master_task ! task number of master task - integer , intent(in) :: logunit ! logging unit number - - !--- formats --- - character(*), parameter :: F00 = "('(dwav_comp_final) ',8a)" - character(*), parameter :: F91 = "('(dwav_comp_final) ',73('-'))" - character(*), parameter :: subName = "(dwav_comp_final) " - !------------------------------------------------------------------------------- + ! local variables + integer :: k + !---------------------------------------------------------------- - if (my_task == master_task) then - write(logunit,F91) - write(logunit,F00) 'dwav: end of main integration loop' - write(logunit,F91) - end if + rc = ESMF_SUCCESS + + k = mct_aVect_indexRA(w2x, "Sw_lamult") + call dshr_export(w2x%rattr(k,:), exportState, "Sw_lamult", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(w2x, "Sw_ustokes") + call dshr_export(w2x%rattr(k,:), exportState, "Sw_ustokes", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + k = mct_aVect_indexRA(w2x, "Sw_vstokes") + call dshr_export(w2x%rattr(k,:), exportState, "Sw_vstokes", rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end subroutine dwav_comp_final + end subroutine dwav_comp_export end module dwav_comp_mod diff --git a/src/components/data_comps/dwav/nuopc/dwav_shr_mod.F90 b/src/components/data_comps/dwav/nuopc/dwav_shr_mod.F90 index 61814664eba..8723b99d98c 100644 --- a/src/components/data_comps/dwav/nuopc/dwav_shr_mod.F90 +++ b/src/components/data_comps/dwav/nuopc/dwav_shr_mod.F90 @@ -23,6 +23,9 @@ module dwav_shr_mod ! Public data !-------------------------------------------------------------------------- + ! stream data type + type(shr_strdata_type), public :: SDWAV + ! input namelist variables character(CL) , public :: restfilm ! model restart file namelist character(CL) , public :: restfils ! stream restart file namelist @@ -39,7 +42,7 @@ module dwav_shr_mod !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine dwav_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDWAV, wav_present, wav_prognostic) + logunit, wav_present, wav_prognostic) ! !DESCRIPTION: Read in dwav namelists implicit none @@ -50,7 +53,6 @@ subroutine dwav_shr_read_namelists(filename, mpicom, my_task, master_task, & integer(IN) , intent(in) :: my_task ! my task in mpi communicator mpicom integer(IN) , intent(in) :: master_task ! task number of master task integer(IN) , intent(in) :: logunit ! logging unit number - type(shr_strdata_type) , intent(inout) :: SDWAV logical , intent(out) :: wav_present ! flag logical , intent(out) :: wav_prognostic ! flag @@ -105,7 +107,7 @@ subroutine dwav_shr_read_namelists(filename, mpicom, my_task, master_task, & ! Read dshr namelist !---------------------------------------------------------------------------- - call shr_strdata_readnml(SDWAV,trim(filename),mpicom=mpicom) + call shr_strdata_readnml(SDWAV, trim(filename), mpicom=mpicom) !---------------------------------------------------------------------------- ! Determine and validate datamode diff --git a/src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 b/src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 index 24e0600de0f..b910b9cd43f 100644 --- a/src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 +++ b/src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 @@ -23,17 +23,16 @@ module wav_comp_nuopc use shr_nuopc_scalars_mod , only : flds_scalar_index_ny use shr_nuopc_methods_mod , only : shr_nuopc_methods_Clock_TimePrint use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_diagnose use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_grid_mod , only : shr_nuopc_grid_ArrayToState - use shr_nuopc_grid_mod , only : shr_nuopc_grid_StateToArray use shr_const_mod , only : SHR_CONST_SPVAL use shr_strdata_mod , only : shr_strdata_type - use dshr_nuopc_mod , only : fld_list_type, fldsMax, fld_list_realize + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData use dwav_shr_mod , only : dwav_shr_read_namelists use dwav_comp_mod , only : dwav_comp_init, dwav_comp_run, dwav_comp_advertise - use mct_mod + use dwav_comp_mod , only : dwav_comp_export + implicit none private ! except @@ -53,9 +52,7 @@ module wav_comp_nuopc integer :: fldsFrWav_num = 0 type (fld_list_type) :: fldsToWav(fldsMax) type (fld_list_type) :: fldsFrWav(fldsMax) - type(shr_strdata_type) :: SDWAV - type(mct_aVect) :: x2w - type(mct_aVect) :: w2x + integer :: compid ! mct comp id integer :: mpicom ! mpi communicator integer :: my_task ! my task in mpi communicator mpicom @@ -65,13 +62,9 @@ module wav_comp_nuopc logical :: read_restart ! start from restart character(len=256) :: case_name ! case name character(len=80) :: calendar ! calendar name - character(CXX) :: flds_w2x = '' - character(CXX) :: flds_x2w = '' - logical :: wav_prognostic ! flag + logical :: wav_prognostic ! flag logical :: use_esmf_metadata = .false. character(*), parameter :: modName = "(wav_comp_nuopc)" - integer, parameter :: debug_import = 0 ! if > 0 will diagnose import fields - integer, parameter :: debug_export = 0 ! if > 0 will diagnose export fields character(*), parameter :: u_FILE_u = & __FILE__ @@ -83,12 +76,11 @@ subroutine SetServices(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - integer :: dbrc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) @@ -121,13 +113,14 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance @@ -149,7 +142,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(len=512) :: diro character(len=512) :: logfile integer :: localPet - integer :: dbrc character(len=16) :: inst_name ! fullname of current instance (ie. "wav_0001") character(len=CL) :: fileName ! generic file name integer :: inst_index ! number of current instance (ie. 1) @@ -157,7 +149,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! generate local mpi comm @@ -190,7 +182,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) filename = "dwav_in"//trim(inst_suffix) call dwav_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDWAV, wav_present, wav_prognostic) + logunit, wav_present, wav_prognostic) !-------------------------------- ! advertise import and export fields @@ -198,11 +190,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call dwav_comp_advertise(importState, exportState, & wav_present, wav_prognostic, & - fldsFrWav_num, fldsFrWav, fldsToWav_num, fldsToWav, & - flds_w2x, flds_x2w, rc) + fldsFrWav_num, fldsFrWav, fldsToWav_num, fldsToWav, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to original values @@ -216,6 +207,8 @@ end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -235,12 +228,12 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(CL) :: cvalue integer :: shrlogunit ! original log unit integer :: shrloglev ! original log level - integer :: dbrc + integer :: nxg, nyg character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to my log file @@ -283,7 +276,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) else if (esmf_caltype == ESMF_CALKIND_GREGORIAN) then calendar = shr_cal_gregorian else - call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), ESMF_LOGMSG_ERROR, rc=dbrc) + call ESMF_LogWrite(subname//" ERROR bad ESMF calendar name "//trim(calendar), ESMF_LOGMSG_ERROR) rc = ESMF_Failure return end if @@ -306,10 +299,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Initialize model !-------------------------------- - call dwav_comp_init(x2w, w2x, & - SDWAV, mpicom, compid, my_task, master_task, & + call dwav_comp_init(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, & - current_ymd, current_tod, calendar, EMesh) + current_ymd, current_tod, calendar, EMesh, nxg, nyg) !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -317,7 +309,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! by replacing the advertised fields with the newly created fields of the same name. !-------------------------------- - call fld_list_realize( & + call dshr_realize( & state=ExportState, & fldList=fldsFrWav, & numflds=fldsFrWav_num, & @@ -327,39 +319,23 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) mesh=Emesh, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call fld_list_realize( & - state=importState, & - fldList=fldsToWav, & - numflds=fldsToWav_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':dwavImport',& - mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - !-------------------------------- ! Pack export state !-------------------------------- - call shr_nuopc_grid_ArrayToState(w2x%rattr, flds_w2x, exportState, grid_option='mesh', rc=rc) + call dwav_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDWAV%nxg),flds_scalar_index_nx, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDWAV%nyg),flds_scalar_index_ny, exportState, & + call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - !-------------------------------- - ! diagnostics - !-------------------------------- - - if (debug_export > 0) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif + call shr_nuopc_methods_State_diagnose(exportState, subname//':ES', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) @@ -373,14 +349,17 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance + + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -398,13 +377,12 @@ subroutine ModelAdvance(gcomp, rc) integer :: day ! day in month integer :: next_ymd ! model date integer :: next_tod ! model sec into model date - integer :: dbrc character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call shr_nuopc_memcheck(subname, 3, my_task==master_task) call shr_file_getLogUnit (shrlogunit) @@ -419,17 +397,12 @@ subroutine ModelAdvance(gcomp, rc) call NUOPC_ModelGet(gcomp, modelClock=clock, importState=importState, exportState=exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (debug_export > 0 .and. my_task == master_task) then - call shr_nuopc_methods_Clock_TimePrint(clock,subname//'clock',rc=rc) - endif - !-------------------------------- ! Unpack import state !-------------------------------- if (wav_prognostic) then - call shr_nuopc_grid_StateToArray(importState, x2w%rattr, flds_x2w, grid_option='mesh', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! no import data for now end if !-------------------------------- @@ -462,8 +435,7 @@ subroutine ModelAdvance(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yr, mon, day, next_ymd) - call dwav_comp_run(x2w, w2x, & - SDWAV, mpicom, my_task, master_task, & + call dwav_comp_run(mpicom, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & next_ymd, next_tod, case_name=case_name) @@ -471,23 +443,21 @@ subroutine ModelAdvance(gcomp, rc) ! Pack export state !-------------------------------- - call shr_nuopc_grid_ArrayToState(w2x%rattr, flds_w2x, exportState, grid_option='mesh', rc=rc) + call dwav_comp_export(exportState, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- - if (debug_export > 0) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif + call shr_nuopc_methods_State_diagnose(exportState, subname//':ES', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return if (my_task == master_task) then call shr_nuopc_log_clock_advance(clock, 'WAV', logunit) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) @@ -501,20 +471,19 @@ subroutine ModelFinalize(gcomp, rc) integer, intent(out) :: rc ! local variables - integer :: dbrc character(*), parameter :: F00 = "('(dwav_comp_final) ',8a)" character(*), parameter :: F91 = "('(dwav_comp_final) ',73('-'))" character(len=*),parameter :: subname=trim(modName)//':(ModelFinalize) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) if (my_task == master_task) then write(logunit,F91) write(logunit,F00) ' dwav : end of main integration loop' write(logunit,F91) end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ModelFinalize diff --git a/src/components/stub_comps/siac/cime_config/buildlib b/src/components/stub_comps/siac/cime_config/buildlib new file mode 120000 index 00000000000..9601a6fa7cc --- /dev/null +++ b/src/components/stub_comps/siac/cime_config/buildlib @@ -0,0 +1 @@ +../../../../build_scripts/buildlib.internal_components \ No newline at end of file diff --git a/src/components/stub_comps/siac/cime_config/buildnml b/src/components/stub_comps/siac/cime_config/buildnml new file mode 100755 index 00000000000..6ddff93c44d --- /dev/null +++ b/src/components/stub_comps/siac/cime_config/buildnml @@ -0,0 +1,7 @@ +#!/usr/bin/env python + +""" +build stub model namelist +""" + +# DO NOTHING diff --git a/src/components/stub_comps/siac/cime_config/config_component.xml b/src/components/stub_comps/siac/cime_config/config_component.xml new file mode 100644 index 00000000000..65e6f18341e --- /dev/null +++ b/src/components/stub_comps/siac/cime_config/config_component.xml @@ -0,0 +1,26 @@ + + + + + + + + Stub iac component + + + + char + siac + siac + case_comp + env_case.xml + Name of iac component + + + + ========================================= + SIAC naming conventions in compset name + ========================================= + + + diff --git a/src/components/stub_comps/siac/mct/iac_comp_mct.F90 b/src/components/stub_comps/siac/mct/iac_comp_mct.F90 new file mode 100644 index 00000000000..2c87fecb488 --- /dev/null +++ b/src/components/stub_comps/siac/mct/iac_comp_mct.F90 @@ -0,0 +1,114 @@ +module iac_comp_mct + +! !USES: + + use mct_mod + use esmf + use seq_cdata_mod + use seq_infodata_mod + +! +! !PUBLIC TYPES: + implicit none + save + private ! except + +!-------------------------------------------------------------------------- +! Public interfaces +!-------------------------------------------------------------------------- + + public :: iac_init_mct + public :: iac_run_mct + public :: iac_final_mct +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +CONTAINS +!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: iac_init_mct +! +! !DESCRIPTION: +! stub iac model init +! +! !REVISION HISTORY: +! +! !INTERFACE: ------------------------------------------------------------------ + + subroutine iac_init_mct( EClock, cdata, x2d, d2x, NLFilename ) + +! !INPUT/OUTPUT PARAMETERS: + + type(ESMF_Clock) , intent(inout) :: EClock + type(seq_cdata) , intent(inout) :: cdata + type(mct_aVect) , intent(inout) :: x2d, d2x + character(len=*), optional , intent(in) :: NLFilename + +!EOP +!------------------------------------------------------------------------------- + + call seq_infodata_PutData(cdata%infodata, & + iac_present=.false., iac_prognostic=.false.) + +end subroutine iac_init_mct + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: iac_run_mct +! +! !DESCRIPTION: +! stub iac model run +! +! !REVISION HISTORY: +! +! !INTERFACE: ------------------------------------------------------------------ + +subroutine iac_run_mct( EClock, cdata, x2d, d2x) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + type(ESMF_Clock) ,intent(inout) :: EClock + type(seq_cdata) ,intent(inout) :: cdata + type(mct_aVect) ,intent(inout) :: x2d + type(mct_aVect) ,intent(inout) :: d2x + +!EOP +!------------------------------------------------------------------------------- + +end subroutine iac_run_mct + +!=============================================================================== +!BOP =========================================================================== +! +! !IROUTINE: iac_final_mct +! +! !DESCRIPTION: +! stub iac model finalize +! +! !REVISION HISTORY: +! +! !INTERFACE: ------------------------------------------------------------------ +! +subroutine iac_final_mct( EClock, cdata, x2d, d2x) + + implicit none + +! !INPUT/OUTPUT PARAMETERS: + + type(ESMF_Clock) ,intent(inout) :: EClock + type(seq_cdata) ,intent(inout) :: cdata + type(mct_aVect) ,intent(inout) :: x2d + type(mct_aVect) ,intent(inout) :: d2x + +!EOP +!------------------------------------------------------------------------------- + + end subroutine iac_final_mct + +!=============================================================================== + +end module iac_comp_mct diff --git a/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 b/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 index dd54be4b7a5..c54f1602041 100644 --- a/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 @@ -3,6 +3,7 @@ module atm_comp_nuopc !---------------------------------------------------------------------------- ! This is the NUOPC cap for XATM !---------------------------------------------------------------------------- + use ESMF use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise @@ -11,11 +12,8 @@ module atm_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet - use med_constants_mod , only : IN, R8, I8, CXX, CL, CS - use med_constants_mod , only : shr_log_Unit + use med_constants_mod , only : R8, CL, CS use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - use med_constants_mod , only : shr_file_getloglevel, shr_file_setloglevel - use med_constants_mod , only : shr_file_setIO, shr_file_getUnit use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_num use shr_nuopc_scalars_mod , only : flds_scalar_index_nx @@ -24,14 +22,11 @@ module atm_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_Clock_TimePrint use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_GetFldPtr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_grid_mod , only : shr_nuopc_grid_Meshinit + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_ChkErr use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index - use dead_nuopc_mod , only : dead_init_nuopc, dead_run_nuopc, dead_final_nuopc + use dead_nuopc_mod , only : dead_init_nuopc, dead_final_nuopc, dead_meshinit use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : state_getimport, state_setexport - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, Print_FieldExchInfo + use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock use med_constants_mod , only : dbug => med_constants_dbug_flag implicit none @@ -43,102 +38,96 @@ module atm_comp_nuopc ! Private module data !-------------------------------------------------------------------------- - integer :: fldsToAtm_num = 0 - integer :: fldsFrAtm_num = 0 - type (fld_list_type) :: fldsToAtm(fldsMax) - type (fld_list_type) :: fldsFrAtm(fldsMax) - real(r8), pointer :: gbuf(:,:) ! model info - real(r8), pointer :: lat(:) - real(r8), pointer :: lon(:) - integer , allocatable :: gindex(:) - real(r8), allocatable :: x2d(:,:) - real(r8), allocatable :: d2x(:,:) - integer :: nxg ! global dim i-direction - integer :: nyg ! global dim j-direction - integer :: my_task ! my task in mpi communicator - integer :: inst_index ! number of current instance (ie. 1) - character(len=12) :: inst_name ! fullname of current instance (ie. "lnd_0001") - character(len=5) :: inst_suffix ! char string associated with instance (ie. "_0001" or "") - integer :: logunit ! logging unit number - logical :: mastertask - logical :: atm_prognostic - - !----- formats ----- + integer :: fldsToAtm_num = 0 + integer :: fldsFrAtm_num = 0 + type (fld_list_type) :: fldsToAtm(fldsMax) + type (fld_list_type) :: fldsFrAtm(fldsMax) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost + + real(r8), pointer :: gbuf(:,:) ! model info + real(r8), pointer :: lat(:) + real(r8), pointer :: lon(:) + integer , allocatable :: gindex(:) + integer :: nxg ! global dim i-direction + integer :: nyg ! global dim j-direction + integer :: inst_index ! number of current instance (ie. 1) + character(len=12) :: inst_name ! fullname of current instance (ie. "lnd_0001") + character(len=5) :: inst_suffix ! char string associated with instance (ie. "_0001" or "") + integer :: logunit ! logging unit number + logical :: mastertask character(*),parameter :: modName = "(xatm_comp_nuopc)" - character(*),parameter :: u_FILE_u = __FILE__ + character(*),parameter :: u_FILE_u = & + __FILE__ - - !=============================================================================== - contains - !=============================================================================== +!=============================================================================== +contains +!=============================================================================== subroutine SetServices(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=ModelInitPhase, phase=0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p1"/), & userRoutine=InitializeAdvertise, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & userRoutine=InitializeRealize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc ! local variables - type(ESMF_VM) :: vm - character(CL) :: cvalue - character(CS) :: stdname - integer :: n - integer :: lsize ! local array size - integer :: ierr ! error code - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - logical :: isPresent - character(len=512) :: diro - character(len=512) :: logfile + integer :: n + integer :: my_task ! my task in mpi communicator + type(ESMF_VM) :: vm + character(CS) :: stdname + integer :: lsize ! local array size + integer :: shrlogunit ! original log unit character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -146,12 +135,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return + + mastertask = (my_task==0) - mastertask = my_task==0 !---------------------------------------------------------------------------- ! determine instance information !---------------------------------------------------------------------------- @@ -163,7 +153,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit) !---------------------------------------------------------------------------- ! Initialize xatm @@ -206,27 +196,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swndf' ) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swvdf' ) call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swnet' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_bcphidry' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_bcphodry' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_bcphiwet' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ocphidry' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ocphodry' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ocphiwet' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstwet1' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstwet2' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstwet3' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstwet4' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstdry1' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstdry2' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstdry3' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstdry4' ) - - do n = 1,fldsFrAtm_num - if(mastertask) write(logunit,*)'Advertising From Xatm ',trim(fldsFrAtm(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrAtm(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end do + call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_bcph' , ungridded_lbound=1, ungridded_ubound=3) + call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ocph' , ungridded_lbound=1, ungridded_ubound=3) + call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) + call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) call fld_list_add(fldsToAtm_num, fldsToAtm, trim(flds_scalar_name)) call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sx_anidr' ) @@ -254,22 +227,25 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToAtm_num, fldsToAtm, 'Faxx_lwup' ) call fld_list_add(fldsToAtm_num, fldsToAtm, 'Faxx_evap' ) + do n = 1,fldsFrAtm_num + if(mastertask) write(logunit,*)'Advertising From Xatm ',trim(fldsFrAtm(n)%stdname) + call NUOPC_Advertise(exportState, standardName=fldsFrAtm(n)%stdname, & + TransferOfferGeomObject='will provide', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + do n = 1,fldsToAtm_num if(mastertask) write(logunit,*)'Advertising To Xatm',trim(fldsToAtm(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToAtm(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - - allocate(d2x(FldsFrAtm_num,lsize)); d2x(:,:) = 0._r8 - allocate(x2d(FldsToAtm_num,lsize)); x2d(:,:) = 0._r8 end if !---------------------------------------------------------------------------- ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -279,6 +255,8 @@ end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + + ! input/output arguments type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -291,7 +269,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) real(r8) :: nextsw_cday integer :: n integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize: xatm) ' !------------------------------------------------------------------------------- @@ -303,16 +280,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logUnit) !-------------------------------- ! generate the mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dead_meshinit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -328,7 +303,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':datmExport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call fld_list_realize( & state=importState, & @@ -338,51 +313,40 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':datmImport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Pack export state - ! Copy from d2x to exportState - ! Set the coupling scalars !-------------------------------- - do n = 1, FldsFrAtm_num - if (fldsFrAtm(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrAtm(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Set time of next radiation computation call ESMF_ClockGetNextTime(clock, nextTime) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - if (mastertask) then - call Print_FieldExchInfo(values=d2x, logunit=logunit, & - fldlist=fldsFrAtm, nflds=fldsFrAtm_num, istr="InitializeRealize: atm->mediator") - end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif #ifdef USE_ESMF_METADATA @@ -398,7 +362,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_AttributeSet(comp, "ModelType", "Sea Ice", convention=convCIM, purpose=purpComp, rc=rc) #endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -408,7 +371,10 @@ end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance + + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -417,19 +383,18 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_Time) :: nexttime type(ESMF_State) :: exportState real(r8) :: nextsw_cday - integer :: n integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - real(r8), pointer :: dataptr(:) character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + + if (dbug > 1) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + end if call shr_nuopc_memcheck(subname, 3, mastertask) + call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -437,48 +402,125 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call dead_run_nuopc('atm', d2x, gbuf) + if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, FldsFrAtm_num - if (fldsFrAtm(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrAtm(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGetNextTime(clock, nextTime) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - if (mastertask) then - call Print_FieldExchInfo(values=d2x, logunit=logunit, & - fldlist=fldsFrAtm, nflds=fldsFrAtm_num, istr="ModelAdvance: atm->mediator") - end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - if(mastertask) then - call shr_nuopc_log_clock_advance(clock, 'ATM', logunit) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + call shr_nuopc_log_clock_advance(clock, 'ATM', logunit) + endif endif - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) + + if (dbug > 5) then + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) + end if end subroutine ModelAdvance !=============================================================================== + subroutine state_setexport(exportState, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: nf, nind + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Start from index 2 in order to Skip the scalar field here + do nf = 2,fldsFrAtm_num + if (fldsFrAtm(nf)%ungridded_ubound == 0) then + call field_setexport(exportState, trim(fldsFrAtm(nf)%stdname), lon, lat, nf=nf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + do nind = 1,fldsFrAtm(nf)%ungridded_ubound + call field_setexport(exportState, trim(fldsFrAtm(nf)%stdname), lon, lat, nf=nf+nind-1, & + ungridded_index=nind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do + + end subroutine state_setexport + + !=============================================================================== + + subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) + + use shr_const_mod , only : pi=>shr_const_pi + + ! intput/otuput variables + type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: lon(:) + real(r8) , intent(in) :: lat(:) + integer , intent(in) :: nf + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: i, ncomp + type(ESMF_Field) :: lfield + real(r8), pointer :: data1d(:) + real(r8), pointer :: data2d(:,:) + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ncomp = 1 + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do i = 1,size(data2d, dim=1) + data2d(i,ungridded_index) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + else if (gridToFieldMap == 2) then + do i = 1,size(data2d, dim=2) + data2d(ungridded_index,i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + else + call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do i = 1,size(data1d) + data1d(i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + + end subroutine field_setexport + + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc diff --git a/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 b/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 index a2bad2375d8..277bda92e18 100644 --- a/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 @@ -14,7 +14,6 @@ module glc_comp_nuopc use med_constants_mod , only : IN, R8, I8, CXX, CL, CS use med_constants_mod , only : shr_log_Unit use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - use med_constants_mod , only : shr_file_getloglevel, shr_file_setloglevel use med_constants_mod , only : shr_file_setIO, shr_file_getUnit use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_num @@ -24,13 +23,13 @@ module glc_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_getFldPtr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_grid_mod , only : shr_nuopc_grid_Meshinit + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_ChkErr use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index - use dead_nuopc_mod , only : dead_init_nuopc, dead_run_nuopc, dead_final_nuopc + use dead_nuopc_mod , only : dead_init_nuopc, dead_final_nuopc, dead_meshinit use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : state_getimport, state_setexport - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, Print_FieldExchInfo + use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock + use med_constants_mod , only : dbug => med_constants_dbug_flag + implicit none private ! except @@ -40,29 +39,28 @@ module glc_comp_nuopc ! Private module data !-------------------------------------------------------------------------- - integer :: fldsToGlc_num = 0 - integer :: fldsFrGlc_num = 0 - type (fld_list_type) :: fldsToGlc(fldsMax) - type (fld_list_type) :: fldsFrGlc(fldsMax) - real(r8), pointer :: gbuf(:,:) ! model info - real(r8), pointer :: lat(:) - real(r8), pointer :: lon(:) - integer , allocatable :: gindex(:) - real(r8), allocatable :: x2d(:,:) - real(r8), allocatable :: d2x(:,:) - integer :: nxg ! global dim i-direction - integer :: nyg ! global dim j-direction - integer :: my_task ! my task in mpi communicator mpicom - integer :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "glc_0001") - character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") - integer :: logunit ! logging unit number - integer ,parameter :: master_task=0 ! task number of master task - logical :: mastertask - character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh - integer, parameter :: dbug = 10 - character(*),parameter :: modName = "(xglc_comp_nuopc)" - character(*),parameter :: u_FILE_u = __FILE__ + integer :: fldsToGlc_num = 0 + integer :: fldsFrGlc_num = 0 + type (fld_list_type) :: fldsToGlc(fldsMax) + type (fld_list_type) :: fldsFrGlc(fldsMax) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost + + real(r8), pointer :: gbuf(:,:) ! model info + real(r8), pointer :: lat(:) + real(r8), pointer :: lon(:) + integer , allocatable :: gindex(:) + integer :: nxg ! global dim i-direction + integer :: nyg ! global dim j-direction + integer :: my_task ! my task in mpi communicator mpicom + integer :: inst_index ! number of current instance (ie. 1) + character(len=16) :: inst_name ! fullname of current instance (ie. "glc_0001") + character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") + integer :: logunit ! logging unit number + integer ,parameter :: master_task=0 ! task number of master task + logical :: mastertask + character(*),parameter :: modName = "(xglc_comp_nuopc)" + character(*),parameter :: u_FILE_u = & + __FILE__ !=============================================================================== contains @@ -75,47 +73,47 @@ subroutine SetServices(gcomp, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=ModelInitPhase, phase=0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p1"/), & userRoutine=InitializeAdvertise, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & userRoutine=InitializeRealize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - use glc_elevclass_mod, only : glc_elevclass_as_string + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance @@ -136,7 +134,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: lsize ! local array size integer :: ierr ! error code integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level logical :: isPresent character(len=512) :: diro character(len=512) :: logfile @@ -147,10 +144,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return mastertask = my_task == master_task @@ -165,7 +162,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit) !---------------------------------------------------------------------------- ! Initialize xglc @@ -185,12 +182,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! advertise import and export fields !-------------------------------- - ! initialize number of elevation classes - call NUOPC_CompAttributeGet(gcomp, name='glc_nec', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_nec - call ESMF_LogWrite('glc_nec = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - if (nxg /= 0 .and. nyg /= 0) then call fld_list_add(fldsFrGlc_num, fldsFrGlc, trim(flds_scalar_name)) @@ -200,33 +191,24 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Sg_topo' ) call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Flgg_hflx' ) + call fld_list_add(fldsToGlc_num, fldsToGlc, trim(flds_scalar_name)) + call fld_list_add(fldsToGlc_num, fldsToGlc, 'Sl_tsrf') + call fld_list_add(fldsToGlc_num, fldsToGlc, 'Sl_topo') + call fld_list_add(fldsToGlc_num, fldsToGlc, 'Flgg_hflx') + do n = 1,fldsFrGlc_num if (mastertask) write(logunit,*)'Advertising From Xglc ',trim(fldsFrGlc(n)%stdname) call NUOPC_Advertise(exportState, standardName=fldsFrglc(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - call fld_list_add(fldsToGlc_num, fldsToGlc, trim(flds_scalar_name)) - do num = 0,glc_nec - nec_str = glc_elevclass_as_string(num) - fldname = 'Sl_tsrf' // nec_str - call fld_list_add(fldsToGlc_num, fldsToGlc, trim(fldname)) - fldname = 'Sl_topo' // nec_str - call fld_list_add(fldsToGlc_num, fldsToGlc, trim(fldname)) - fldname = 'Flgl_qice' // nec_str - call fld_list_add(fldsToGlc_num, fldsToGlc, trim(fldname)) - end do - do n = 1,fldsToGlc_num if (mastertask) write(logunit,*)'Advertising To Xglc ',trim(fldsToGlc(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToglc(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - - allocate(d2x(FldsFrGlc_num,lsize)); d2x(:,:) = 0._r8 - allocate(x2d(FldsToGlc_num,lsize)); x2d(:,:) = 0._r8 end if if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -235,7 +217,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine InitializeAdvertise @@ -243,6 +224,8 @@ end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -252,7 +235,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_Mesh) :: Emesh integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level integer :: n character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- @@ -265,7 +247,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -273,8 +254,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! grid_option specifies grid or mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dead_meshinit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -290,7 +271,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':dglcExport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call fld_list_realize( & state=importState, & @@ -300,7 +281,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':dglcImport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Pack export state @@ -308,32 +289,24 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Set the coupling scalars !-------------------------------- - do n = 1, FldsFrGlc_num - if (fldsFrGlc(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrGlc(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - if (my_task == master_task) then - call Print_FieldExchInfo(values=d2x, logunit=logunit, & - fldlist=fldsFrGlc, nflds=fldsFrGlc_num, istr="InitializeRealize: glc->mediator") - end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif #ifdef USE_ESMF_METADATA @@ -349,7 +322,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_AttributeSet(comp, "ModelType", "Land-Ice", convention=convCIM, purpose=purpComp, rc=rc) #endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -359,6 +331,7 @@ end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance ! input/output variables @@ -370,7 +343,6 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_State) :: exportState integer :: n integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level real(r8), pointer :: dataptr(:) character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- @@ -379,8 +351,6 @@ subroutine ModelAdvance(gcomp, rc) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -388,35 +358,10 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - call dead_run_nuopc('glc', d2x, gbuf) - - do n = 1, FldsFrGlc_num - if (fldsFrGlc(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrGlc(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do - - ! Reset some fields - call shr_nuopc_methods_State_GetFldPtr(exportState, fldname='Sg_icemask', fldptr1=dataptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr) - dataptr(n) = 1.0_R8 - end do - - call shr_nuopc_methods_State_GetFldPtr(exportState, fldname='Sg_icemask_coupled_fluxes', fldptr1=dataptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr) - dataptr(n) = 1.0_R8 - end do - - call shr_nuopc_methods_State_GetFldPtr(exportState, fldname='Sg_ice_covered', fldptr1=dataptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr) - dataptr(n) = 1.0_R8 - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics @@ -424,13 +369,12 @@ subroutine ModelAdvance(gcomp, rc) if (dbug > 1) then call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (my_task == master_task) then call shr_nuopc_log_clock_advance(clock, 'GLC', logunit) endif endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -439,6 +383,99 @@ end subroutine ModelAdvance !=============================================================================== + subroutine state_setexport(exportState, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: nf, nind + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Start from index 2 in order to skip the scalar field + do nf = 2,fldsFrGlc_num + if (fldsFrGlc(nf)%ungridded_ubound == 0) then + call field_setexport(exportState, trim(fldsFrGlc(nf)%stdname), lon, lat, nf=nf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + do nind = 1,fldsFrGlc(nf)%ungridded_ubound + call field_setexport(exportState, trim(fldsFrGlc(nf)%stdname), lon, lat, nf=nf+nind-1, & + ungridded_index=nind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do + + end subroutine state_setexport + + !=============================================================================== + + subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) + + use shr_const_mod , only : pi=>shr_const_pi + + ! intput/otuput variables + type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: lon(:) + real(r8) , intent(in) :: lat(:) + integer , intent(in) :: nf + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: i, ncomp + type(ESMF_Field) :: lfield + real(r8), pointer :: data1d(:) + real(r8), pointer :: data2d(:,:) + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ncomp = 5 + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do i = 1,size(data2d, dim=1) + data2d(i,ungridded_index) = (nf*100) & + * cos (pi*lat(i)/180.0_R8) * cos (pi*lat(i)/180.0_R8) & + * sin (pi*lon(i)/180.0_R8) * sin (pi*lon(i)/180.0_R8) & + + (ncomp*10.0_R8) + enddo + else if (gridToFieldMap == 2) then + do i = 1,size(data2d, dim=2) + data2d(ungridded_index,i) = (nf*100) & + * cos (pi*lat(i)/180.0_R8) * cos (pi*lat(i)/180.0_R8) & + * sin (pi*lon(i)/180.0_R8) * sin (pi*lon(i)/180.0_R8) & + + (ncomp*10.0_R8) + end do + end if + else + call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (fldname == 'Sg_icemask' .or. 'fldname == Sg_icemask_coupled_fluxes' .or. fldname == 'Sg_ice_covered') then + data1d(:) = 1._r8 + else + do i = 1,size(data1d) + data1d(i) = (nf*100) & + * cos (pi*lat(i)/180.0_R8) * cos (pi*lat(i)/180.0_R8) & + * sin (pi*lon(i)/180.0_R8) * sin (pi*lon(i)/180.0_R8) & + + (ncomp*10.0_R8) + end do + end if + end if + + end subroutine field_setexport + + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc diff --git a/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 b/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 index 77ff99cc341..7aedeb6d28a 100644 --- a/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 @@ -3,6 +3,7 @@ module ice_comp_nuopc !---------------------------------------------------------------------------- ! This is the NUOPC cap for XICE !---------------------------------------------------------------------------- + use ESMF use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise @@ -11,11 +12,8 @@ module ice_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet - use med_constants_mod , only : IN, R8, I8, CXX, CL, CS - use med_constants_mod , only : shr_log_Unit + use med_constants_mod , only : R8, CL, CS use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - use med_constants_mod , only : shr_file_getloglevel, shr_file_setloglevel - use med_constants_mod , only : shr_file_setIO, shr_file_getUnit use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_num use shr_nuopc_scalars_mod , only : flds_scalar_index_nx @@ -24,13 +22,11 @@ module ice_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_GetFldPtr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_grid_mod , only : shr_nuopc_grid_Meshinit + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_ChkErr use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index - use dead_nuopc_mod , only : dead_init_nuopc, dead_run_nuopc, dead_final_nuopc + use dead_nuopc_mod , only : dead_init_nuopc, dead_final_nuopc, dead_meshinit use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : state_getimport, state_setexport - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, Print_FieldExchInfo + use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock use med_constants_mod , only : dbug => med_constants_dbug_flag implicit none @@ -46,13 +42,12 @@ module ice_comp_nuopc integer :: fldsFrIce_num = 0 type (fld_list_type) :: fldsToIce(fldsMax) type (fld_list_type) :: fldsFrIce(fldsMax) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost real(r8), pointer :: gbuf(:,:) ! model info real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer , allocatable :: gindex(:) - real(r8), allocatable :: x2d(:,:) - real(r8), allocatable :: d2x(:,:) integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction integer :: my_task ! my task in mpi communicator mpicom @@ -61,8 +56,7 @@ module ice_comp_nuopc character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") integer :: logunit ! logging unit number integer ,parameter :: master_task=0 ! task number of master task - logical :: mastertask - character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh + logical :: mastertask character(*),parameter :: modName = "(xice_comp_nuopc)" character(*),parameter :: u_FILE_u = & __FILE__ @@ -77,46 +71,48 @@ subroutine SetServices(gcomp, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=ModelInitPhase, phase=0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p1"/), & userRoutine=InitializeAdvertise, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & userRoutine=InitializeRealize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices !=============================================================================== + subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance @@ -131,12 +127,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) character(CS) :: stdname integer :: n integer :: lsize ! local array size - integer :: ierr ! error code integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - logical :: isPresent - character(len=512) :: diro - character(len=512) :: logfile character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -144,10 +135,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return mastertask = my_task == master_task @@ -162,7 +153,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit) !---------------------------------------------------------------------------- ! Initialize xice @@ -178,7 +169,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) lat(:) = gbuf(:,dead_grid_lat) lon(:) = gbuf(:,dead_grid_lon) - !-------------------------------- ! advertise import and export fields !-------------------------------- @@ -214,13 +204,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_bcphi' ) call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_flxdst' ) - do n = 1,fldsFrIce_num - if(mastertask) write(logunit,*)'Advertising From Xice ',trim(fldsFrIce(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrIce(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - enddo - call fld_list_add(fldsToIce_num, fldsToIce, trim(flds_scalar_name)) call fld_list_add(fldsToIce_num, fldsToIce, 'So_dhdx' ) call fld_list_add(fldsToIce_num, fldsToIce, 'So_dhdy' ) @@ -243,27 +226,24 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_lwdn' ) call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_rain' ) call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_snow' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_bcphodry' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_bcphidry' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_bcphiwet' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstdry1' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstdry2' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstdry3' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstdry4' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstwet1' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstwet2' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstwet3' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstwet4' ) + call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_bcph' , ungridded_lbound=1, ungridded_ubound=3) + call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_ocph' , ungridded_lbound=1, ungridded_ubound=3) + call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) + call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) + + do n = 1,fldsFrIce_num + if(mastertask) write(logunit,*)'Advertising From Xice ',trim(fldsFrIce(n)%stdname) + call NUOPC_Advertise(exportState, standardName=fldsFrIce(n)%stdname, & + TransferOfferGeomObject='will provide', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo do n = 1,fldsToIce_num if(mastertask) write(logunit,*)'Advertising To Xice ',trim(fldsToIce(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToIce(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end do - - allocate(d2x(FldsFrIce_num,lsize)); d2x(:,:) = 0._r8 - allocate(x2d(FldsToIce_num,lsize)); x2d(:,:) = 0._r8 end if @@ -273,7 +253,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine InitializeAdvertise @@ -290,7 +269,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_Mesh) :: Emesh integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level integer :: n character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- @@ -303,16 +281,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logUnit) !-------------------------------- ! generate the mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dead_meshinit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -328,7 +304,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':diceExport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call fld_list_realize( & state=importState, & @@ -338,40 +314,30 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':diceImport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Pack export state - ! Copy from d2x to exportState - ! Set the coupling scalars !-------------------------------- - do n = 1, FldsFrIce_num - if (fldsFrIce(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrIce(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - if (my_task == master_task) then - call Print_FieldExchInfo(values=d2x, logunit=logunit, & - fldlist=fldsFrIce, nflds=fldsFrIce_num, istr="InitializeRealize: ice->mediator") - end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif #ifdef USE_ESMF_METADATA @@ -387,7 +353,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_AttributeSet(comp, "ModelType", "Sea Ice", convention=convCIM, purpose=purpComp, rc=rc) #endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -397,6 +362,7 @@ end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance ! input/output variables @@ -406,19 +372,15 @@ subroutine ModelAdvance(gcomp, rc) ! local variables type(ESMF_Clock) :: clock type(ESMF_State) :: exportState - integer :: n integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - real(r8), pointer :: dataptr(:) character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) + call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -426,29 +388,10 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - call dead_run_nuopc('ice', d2x, gbuf) - - do n = 1, FldsFrIce_num - if (fldsFrIce(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrIce(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do - - ! Reset some fields - call shr_nuopc_methods_State_GetFldPtr(exportState, fldname='Si_ifrac', fldptr1=dataptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr) - dataptr(n) = min(1.0_R8,max(0.0_R8,dataptr(n))) - end do - - call shr_nuopc_methods_State_GetFldPtr(exportState, fldname='Si_imask', fldptr1=dataptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr) - dataptr(n) = float(nint(min(1.0_R8,max(0.0_R8,dataptr(n))))) - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics @@ -456,13 +399,12 @@ subroutine ModelAdvance(gcomp, rc) if (dbug > 1) then call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (my_task == master_task) then call shr_nuopc_log_clock_advance(clock, 'ICE', logunit) endif endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -471,6 +413,99 @@ end subroutine ModelAdvance !=============================================================================== + subroutine state_setexport(exportState, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: nf, nind + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Start from index 2 in order to skip the scalar field + do nf = 2,fldsFrIce_num + if (fldsFrIce(nf)%ungridded_ubound == 0) then + call field_setexport(exportState, trim(fldsFrIce(nf)%stdname), lon, lat, nf=nf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + do nind = 1,fldsFrIce(nf)%ungridded_ubound + call field_setexport(exportState, trim(fldsFrIce(nf)%stdname), lon, lat, nf=nf+nind-1, & + ungridded_index=nind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do + + end subroutine state_setexport + + !=============================================================================== + + subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) + + use shr_const_mod , only : pi=>shr_const_pi + + ! intput/otuput variables + type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: lon(:) + real(r8) , intent(in) :: lat(:) + integer , intent(in) :: nf + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: i, ncomp + type(ESMF_Field) :: lfield + real(r8), pointer :: data1d(:) + real(r8), pointer :: data2d(:,:) + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ncomp = 3 + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do i = 1,size(data2d, dim=1) + data2d(i,ungridded_index) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + else if (gridToFieldMap == 2) then + do i = 1,size(data2d, dim=2) + data2d(ungridded_index,i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + else + call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do i = 1,size(data1d) + data1d(i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + ! Reset some fields + if (fldname == 'Si_ifrac') then + do i = 1,size(data1d) + data1d(i) = min(1.0_R8,max(0.0_R8,data1d(i))) + end do + else if (fldname == 'Si_imask') then + do i = 1,size(data1d) + data1d(i) = float(nint(min(1.0_R8,max(0.0_R8,data1d(i))))) + end do + end if + end if + + end subroutine field_setexport + + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc diff --git a/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 b/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 index adc89f1c78d..f1feb98a0ed 100644 --- a/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 @@ -3,6 +3,7 @@ module lnd_comp_nuopc !---------------------------------------------------------------------------- ! This is the NUOPC cap for XLND !---------------------------------------------------------------------------- + use ESMF use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise @@ -11,11 +12,8 @@ module lnd_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet - use med_constants_mod , only : IN, R8, I8, CXX, CL, CS - use med_constants_mod , only : shr_log_Unit + use med_constants_mod , only : R8, CL, CS use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - use med_constants_mod , only : shr_file_getloglevel, shr_file_setloglevel - use med_constants_mod , only : shr_file_setIO, shr_file_getUnit use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_num use shr_nuopc_scalars_mod , only : flds_scalar_index_nx @@ -24,13 +22,11 @@ module lnd_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_getFldPtr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_grid_mod , only : shr_nuopc_grid_Meshinit + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_ChkErr use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index - use dead_nuopc_mod , only : dead_init_nuopc, dead_run_nuopc, dead_final_nuopc + use dead_nuopc_mod , only : dead_init_nuopc, dead_final_nuopc, dead_meshinit use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : state_getimport, state_setexport - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, Print_FieldExchInfo + use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock use med_constants_mod , only : dbug=>med_constants_dbug_flag implicit none @@ -46,13 +42,12 @@ module lnd_comp_nuopc integer :: fldsFrLnd_num = 0 type (fld_list_type) :: fldsToLnd(fldsMax) type (fld_list_type) :: fldsFrLnd(fldsMax) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost real(r8), pointer :: gbuf(:,:) ! model info real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer , allocatable :: gindex(:) - real(r8), allocatable :: x2d(:,:) - real(r8), allocatable :: d2x(:,:) integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction integer :: my_task ! my task in mpi communicator mpicom @@ -61,63 +56,68 @@ module lnd_comp_nuopc character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") integer :: logunit ! logging unit number integer ,parameter :: master_task=0 ! task number of master task - logical :: mastertask - character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh + logical :: mastertask character(*),parameter :: modName = "(xlnd_comp_nuopc)" character(*),parameter :: u_FILE_u = & __FILE__ !=============================================================================== contains - !=============================================================================== +!=============================================================================== + subroutine SetServices(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=ModelInitPhase, phase=0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p1"/), & userRoutine=InitializeAdvertise, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & userRoutine=InitializeRealize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices + !=============================================================================== + subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -131,7 +131,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: lsize ! local array size integer :: ierr ! error code integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level logical :: isPresent character(len=512) :: diro character(len=512) :: logfile @@ -142,10 +141,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return mastertask = my_task == master_task @@ -160,7 +159,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit) !---------------------------------------------------------------------------- ! Initialize xlnd @@ -207,17 +206,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lwup' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_evap' ) call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_swnet' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_flxdst1' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_flxdst2' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_flxdst3' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_flxdst4' ) - - do n = 1,fldsFrLnd_num - if (mastertask) write(logunit,*)'Advertising From Xlnd ',trim(fldsFrLnd(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrLnd(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - enddo + call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_flxdst', ungridded_lbound=1, ungridded_ubound=4) call fld_list_add(fldsToLnd_num, fldsToLnd, trim(flds_scalar_name)) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Sa_z' ) @@ -239,30 +228,25 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_swvdr' ) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_swndf' ) call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_swvdf' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_bcphidry') - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_bcphodry') - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_bcphiwet') - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_ocphidry') - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_ocphodry') - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_ocphiwet') - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstdry1' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstdry2' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstdry3' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstdry4' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstwet1' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstwet2' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstwet3' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_dstwet4' ) + call fld_list_add(fldsTolnd_num, fldsTolnd, 'Faxa_bcph' , ungridded_lbound=1, ungridded_ubound=3) + call fld_list_add(fldsTolnd_num, fldsTolnd, 'Faxa_ocph' , ungridded_lbound=1, ungridded_ubound=3) + call fld_list_add(fldsTolnd_num, fldsTolnd, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) + call fld_list_add(fldsTolnd_num, fldsTolnd, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) + + do n = 1,fldsFrLnd_num + if (mastertask) write(logunit,*)'Advertising From Xlnd ',trim(fldsFrLnd(n)%stdname) + call NUOPC_Advertise(exportState, standardName=fldsFrLnd(n)%stdname, & + TransferOfferGeomObject='will provide', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo do n = 1,fldsToLnd_num if(mastertask) write(logunit,*)'Advertising To Xlnd',trim(fldsToLnd(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToLnd(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - allocate(d2x(FldsFrLnd_num,lsize)); d2x(:,:) = 0._r8 - allocate(x2d(FldsToLnd_num,lsize)); x2d(:,:) = 0._r8 end if @@ -270,7 +254,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine InitializeAdvertise @@ -287,7 +270,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_Mesh) :: Emesh integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level type(ESMF_VM) :: vm integer :: n logical :: connected ! is field connected? @@ -302,16 +284,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logUnit) !-------------------------------- ! generate the mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dead_meshinit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -327,7 +307,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':dlndExport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call fld_list_realize( & state=importState, & @@ -337,40 +317,29 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':dlndImport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Pack export state - ! Copy from d2x to exportState - ! Set the coupling scalars !-------------------------------- - do n = 1, FldsFrLnd_num - if (fldsFrLnd(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrLnd(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - if (mastertask) then - call Print_FieldExchInfo(values=d2x, logunit=logunit, & - fldlist=fldsFrLnd, nflds=fldsFrLnd_num, istr="InitializeRealize: lnd->mediator") - end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif #ifdef USE_ESMF_METADATA @@ -386,7 +355,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_AttributeSet(comp, "ModelType", "Land", convention=convCIM, purpose=purpComp, rc=rc) #endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -396,6 +364,7 @@ end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance ! input/output variables @@ -405,19 +374,15 @@ subroutine ModelAdvance(gcomp, rc) ! local variables type(ESMF_Clock) :: clock type(ESMF_State) :: exportState - integer :: n integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - real(r8), pointer :: dataptr(:) character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) + call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -425,41 +390,22 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call dead_run_nuopc('lnd', d2x, gbuf) + if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, FldsFrLnd_num - if (fldsFrLnd(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrLnd(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do - - ! Reset some fields - call shr_nuopc_methods_State_GetFldPtr(exportState, fldname='Sl_lfrin', fldptr1=dataptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr) - dataptr(n) = 1._r8 - end do + call state_setexport(exportState, rc=rc) !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - if (mastertask) then - call Print_FieldExchInfo(values=d2x, logunit=logunit, & - fldlist=fldsFrLnd, nflds=fldsFrLnd_num, istr="ModelAdvance: lnd->mediator") - end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - if(mastertask) then - call shr_nuopc_log_clock_advance(clock, 'LND', logunit) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (mastertask) then + call shr_nuopc_log_clock_advance(clock, 'LND', logunit) + endif endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -468,6 +414,93 @@ end subroutine ModelAdvance !=============================================================================== + subroutine state_setexport(exportState, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: nf, nind + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Start from index 2 in order to Skip the scalar field here + do nf = 2,fldsFrLnd_num + if (fldsFrLnd(nf)%ungridded_ubound == 0) then + call field_setexport(exportState, trim(fldsFrLnd(nf)%stdname), lon, lat, nf=nf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + do nind = 1,fldsFrLnd(nf)%ungridded_ubound + call field_setexport(exportState, trim(fldsFrLnd(nf)%stdname), lon, lat, nf=nf+nind-1, & + ungridded_index=nind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do + + end subroutine state_setexport + + !=============================================================================== + + subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) + + use shr_const_mod , only : pi=>shr_const_pi + + ! intput/otuput variables + type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: lon(:) + real(r8) , intent(in) :: lat(:) + integer , intent(in) :: nf + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: i, ncomp + type(ESMF_Field) :: lfield + real(r8), pointer :: data1d(:) + real(r8), pointer :: data2d(:,:) + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ncomp = 2 + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do i = 1,size(data2d, dim=1) + data2d(i,ungridded_index) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + else if (gridToFieldMap == 2) then + do i = 1,size(data2d, dim=2) + data2d(ungridded_index,i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + else + call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (fldname == 'Sl_lfrin') then + data1d(:) = 1._r8 + else + do i = 1,size(data1d) + data1d(i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + end if + + end subroutine field_setexport + + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc diff --git a/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 b/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 index 7abd2afaa02..259121b447f 100644 --- a/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 @@ -3,6 +3,7 @@ module ocn_comp_nuopc !---------------------------------------------------------------------------- ! This is the NUOPC cap for XOCN !---------------------------------------------------------------------------- + use ESMF use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise @@ -11,11 +12,8 @@ module ocn_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet - use med_constants_mod , only : IN, R8, I8, CXX, CL, CS - use med_constants_mod , only : shr_log_Unit + use med_constants_mod , only : R8, CL, CS use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - use med_constants_mod , only : shr_file_getloglevel, shr_file_setloglevel - use med_constants_mod , only : shr_file_setIO, shr_file_getUnit use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_num use shr_nuopc_scalars_mod , only : flds_scalar_index_nx @@ -23,14 +21,11 @@ module ocn_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_Clock_TimePrint use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_GetFldPtr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_grid_mod , only : shr_nuopc_grid_Meshinit + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_ChkErr use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index - use dead_nuopc_mod , only : dead_init_nuopc, dead_run_nuopc, dead_final_nuopc + use dead_nuopc_mod , only : dead_init_nuopc, dead_final_nuopc, dead_meshinit use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : state_getimport, state_setexport - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, Print_FieldExchInfo + use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock use med_constants_mod , only : dbug=> med_constants_dbug_flag implicit none @@ -46,12 +41,12 @@ module ocn_comp_nuopc integer :: fldsFrOcn_num = 0 type (fld_list_type) :: fldsToOcn(fldsMax) type (fld_list_type) :: fldsFrOcn(fldsMax) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost + real(r8), pointer :: gbuf(:,:) ! model info real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer , allocatable :: gindex(:) - real(r8), allocatable :: x2d(:,:) - real(r8), allocatable :: d2x(:,:) integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction integer :: my_task ! my task in mpi communicator mpicom @@ -60,55 +55,56 @@ module ocn_comp_nuopc character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") integer :: logunit ! logging unit number integer ,parameter :: master_task=0 ! task number of master task - logical :: mastertask - character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh + logical :: mastertask character(*),parameter :: modName = "(xocn_comp_nuopc)" character(*),parameter :: u_FILE_u = __FILE__ !=============================================================================== contains - !=============================================================================== +!=============================================================================== + subroutine SetServices(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=ModelInitPhase, phase=0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p1"/), & userRoutine=InitializeAdvertise, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & userRoutine=InitializeRealize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices @@ -132,10 +128,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: n integer :: lsize ! local array size integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - logical :: isPresent - character(len=512) :: diro - character(len=512) :: logfile character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -147,10 +139,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return mastertask = my_task == master_task @@ -165,7 +157,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit) !---------------------------------------------------------------------------- ! Initialize xocn @@ -181,7 +173,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) lat(:) = gbuf(:,dead_grid_lat) lon(:) = gbuf(:,dead_grid_lon) - !-------------------------------- ! advertise import and export fields !-------------------------------- @@ -199,13 +190,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" ) call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" ) - do n = 1,fldsFrOcn_num - if(mastertask) write(logunit,*)'Advertising From Xocn ',trim(fldsFrOcn(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - enddo - call fld_list_add(fldsToOcn_num, fldsToOcn, trim(flds_scalar_name)) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" ) call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" ) @@ -225,15 +209,19 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" ) call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" ) + do n = 1,fldsFrOcn_num + if(mastertask) write(logunit,*)'Advertising From Xocn ',trim(fldsFrOcn(n)%stdname) + call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, & + TransferOfferGeomObject='will provide', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + do n = 1,fldsToOcn_num if(mastertask) write(logunit,*)'Advertising To Xocn',trim(fldsToOcn(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - - allocate(d2x(FldsFrOcn_num,lsize)); d2x(:,:) = 0._r8 - allocate(x2d(FldsToOcn_num,lsize)); x2d(:,:) = 0._r8 end if call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -242,7 +230,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine InitializeAdvertise @@ -261,7 +248,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_Mesh) :: Emesh integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level integer :: n character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize: xocn) ' !------------------------------------------------------------------------------- @@ -274,16 +260,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- ! generate the mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dead_meshinit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -299,7 +283,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':docnExport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call fld_list_realize( & state=importState, & @@ -309,27 +293,22 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':docnImport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Pack export state - ! Copy from d2x to exportState and set the coupling scalars !-------------------------------- - do n = 1, FldsFrOcn_num - if (fldsFrOcn(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrOcn(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics @@ -337,7 +316,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (dbug > 1) then call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif #ifdef USE_ESMF_METADATA @@ -353,7 +332,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_AttributeSet(comp, "ModelType", "Ocean", convention=convCIM, purpose=purpComp, rc=rc) #endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -372,44 +350,26 @@ subroutine ModelAdvance(gcomp, rc) ! local variables type(ESMF_Clock) :: clock type(ESMF_State) :: exportState - integer :: n integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - real(r8), pointer :: dataptr(:) character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) + call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- ! Pack export state !-------------------------------- - call dead_run_nuopc('ocn', d2x, gbuf) - call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, FldsFrOcn_num - if (fldsFrOcn(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrOcn(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do - - ! reset So_omask - call shr_nuopc_methods_State_GetFldPtr(exportState, fldname='So_omask', fldptr1=dataptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,size(dataptr) - !dataptr(n) = float(nint(min(1.0_R8,max(0.0_R8,dataptr(n))))) - dataptr(n) = 0._r8 - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics @@ -417,13 +377,12 @@ subroutine ModelAdvance(gcomp, rc) if (dbug > 1) then call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if(my_task == master_task) then call shr_nuopc_log_clock_advance(clock, 'OCN', logunit) endif endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -432,7 +391,98 @@ end subroutine ModelAdvance !=============================================================================== + subroutine state_setexport(exportState, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: nf, nind + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Start from index 2 in order to Skip the scalar field here + do nf = 2,fldsFrOcn_num + if (fldsFrOcn(nf)%ungridded_ubound == 0) then + call field_setexport(exportState, trim(fldsFrOcn(nf)%stdname), lon, lat, nf=nf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + do nind = 1,fldsFrOcn(nf)%ungridded_ubound + call field_setexport(exportState, trim(fldsFrOcn(nf)%stdname), lon, lat, nf=nf, & + ungridded_index=nind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do + + end subroutine state_setexport + + !=============================================================================== + + subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) + + use shr_const_mod , only : pi=>shr_const_pi + + ! intput/otuput variables + type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: lon(:) + real(r8) , intent(in) :: lat(:) + integer , intent(in) :: nf + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: i, ncomp + type(ESMF_Field) :: lfield + real(r8), pointer :: data1d(:) + real(r8), pointer :: data2d(:,:) + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ncomp = 4 + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do i = 1,size(data2d, dim=1) + data2d(i,ungridded_index) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + else if (gridToFieldMap == 2) then + do i = 1,size(data2d, dim=2) + data2d(ungridded_index,i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + else + call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do i = 1,size(data1d) + data1d(i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + + if (fldname == 'So_omask') then + do i = 1,size(data1d) + !data1d(i) = float(nint(min(1.0_R8,max(0.0_R8,data1d(i))))) + data1d(i) = 0._r8 + end do + end if + + end subroutine field_setexport + + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc diff --git a/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 b/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 index ceb885e07ca..d85bf0f1400 100644 --- a/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 @@ -3,6 +3,7 @@ module rof_comp_nuopc !---------------------------------------------------------------------------- ! This is the NUOPC cap for XROF !---------------------------------------------------------------------------- + use ESMF use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise @@ -11,11 +12,8 @@ module rof_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet - use med_constants_mod , only : IN, R8, I8, CXX, CL, CS - use med_constants_mod , only : shr_log_Unit + use med_constants_mod , only : R8, CL, CS use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - use med_constants_mod , only : shr_file_getloglevel, shr_file_setloglevel - use med_constants_mod , only : shr_file_setIO, shr_file_getUnit use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_num use shr_nuopc_scalars_mod , only : flds_scalar_index_nx @@ -23,13 +21,11 @@ module rof_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_Clock_TimePrint use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_grid_mod , only : shr_nuopc_grid_Meshinit + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_ChkErr use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index - use dead_nuopc_mod , only : dead_init_nuopc, dead_run_nuopc, dead_final_nuopc + use dead_nuopc_mod , only : dead_init_nuopc, dead_final_nuopc, dead_meshinit use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : state_getimport, state_setexport - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, Print_FieldExchInfo + use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock use med_constants_mod , only : dbug => med_constants_dbug_flag implicit none @@ -45,12 +41,12 @@ module rof_comp_nuopc integer :: fldsFrRof_num = 0 type (fld_list_type) :: fldsToRof(fldsMax) type (fld_list_type) :: fldsFrRof(fldsMax) + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost + real(r8), pointer :: gbuf(:,:) ! model info real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer , allocatable :: gindex(:) - real(r8), allocatable :: x2d(:,:) - real(r8), allocatable :: d2x(:,:) integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction integer :: my_task ! my task in mpi @@ -59,8 +55,7 @@ module rof_comp_nuopc character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") integer :: logunit ! logging unit number integer ,parameter :: master_task=0 ! task number of master task - logical :: mastertask - character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh + logical :: mastertask character(*),parameter :: modName = "(xrof_comp_nuopc)" character(*),parameter :: u_FILE_u = & __FILE__ @@ -68,53 +63,59 @@ module rof_comp_nuopc !=============================================================================== contains !=============================================================================== + subroutine SetServices(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=ModelInitPhase, phase=0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p1"/), & userRoutine=InitializeAdvertise, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & userRoutine=InitializeRealize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices + !=============================================================================== + subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance + type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -128,10 +129,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: lsize ! local array size integer :: ierr ! error code integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - logical :: isPresent - character(len=512) :: diro - character(len=512) :: logfile character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -139,10 +136,10 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return mastertask = my_task == master_task @@ -157,7 +154,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit) !---------------------------------------------------------------------------- ! Initialize xrof @@ -187,13 +184,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrRof_num, fldsFrRof, 'Flrr_volr') call fld_list_add(fldsFrRof_num, fldsFrRof, 'Flrr_volrmch') - do n = 1,fldsFrRof_num - if(mastertask) write(logunit,*)'Advertising From Xrof ',trim(fldsFrRof(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrRof(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - enddo - call fld_list_add(fldsToRof_num, fldsToRof, trim(flds_scalar_name)) call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofsur') call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofgwl') @@ -202,15 +192,19 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofi') call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_irrig') + do n = 1,fldsFrRof_num + if(mastertask) write(logunit,*)'Advertising From Xrof ',trim(fldsFrRof(n)%stdname) + call NUOPC_Advertise(exportState, standardName=fldsFrRof(n)%stdname, & + TransferOfferGeomObject='will provide', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + do n = 1,fldsToRof_num if(mastertask) write(logunit,*)'Advertising To Xrof',trim(fldsToRof(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToRof(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - - allocate(d2x(FldsFrRof_num,lsize)); d2x(:,:) = 0._r8 - allocate(x2d(FldsToRof_num,lsize)); x2d(:,:) = 0._r8 end if if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -219,7 +213,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine InitializeAdvertise @@ -227,6 +220,7 @@ end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -236,7 +230,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_Mesh) :: Emesh integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level integer :: n character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- @@ -249,16 +242,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logUnit) !-------------------------------- ! generate the mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call dead_meshinit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -274,7 +265,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':drofExport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call fld_list_realize( & state=importState, & @@ -284,40 +275,30 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':drofImport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Pack export state - ! Copy from d2x to exportState - ! Set the coupling scalars !-------------------------------- - do n = 1, FldsFrRof_num - if (fldsFrRof(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrRof(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - if (mastertask) then - call Print_FieldExchInfo(values=d2x, logunit=logunit, & - fldlist=fldsFrRof, nflds=fldsFrRof_num, istr="InitializeRealize: rof->mediator") - end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif #ifdef USE_ESMF_METADATA @@ -333,7 +314,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_AttributeSet(comp, "ModelType", "River", convention=convCIM, purpose=purpComp, rc=rc) #endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -343,6 +323,7 @@ end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance ! input/output variables @@ -352,18 +333,15 @@ subroutine ModelAdvance(gcomp, rc) ! local variables type(ESMF_Clock) :: clock type(ESMF_State) :: exportState - integer :: n integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) + call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -371,16 +349,10 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call dead_run_nuopc('rof', d2x, gbuf) + if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, FldsFrRof_num - if (fldsFrRof(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrRof(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics @@ -388,13 +360,12 @@ subroutine ModelAdvance(gcomp, rc) if (dbug > 1) then call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (mastertask) then call shr_nuopc_log_clock_advance(clock, 'ROF', logunit) endif endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -403,6 +374,86 @@ end subroutine ModelAdvance !=============================================================================== + subroutine state_setexport(exportState, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + integer, intent(out) :: rc + + ! local variables + integer :: nf, nind + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + ! Start from index 2 in order to skip the scalar field + do nf = 2,fldsFrRof_num + if (fldsFrRof(nf)%ungridded_ubound == 0) then + call field_setexport(exportState, trim(fldsFrRof(nf)%stdname), lon, lat, nf=nf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + do nind = 1,fldsFrRof(nf)%ungridded_ubound + call field_setexport(exportState, trim(fldsFrRof(nf)%stdname), lon, lat, nf=nf+nind-1, & + ungridded_index=nind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do + + end subroutine state_setexport + + !=============================================================================== + + subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) + + use shr_const_mod , only : pi=>shr_const_pi + + ! intput/otuput variables + type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: lon(:) + real(r8) , intent(in) :: lat(:) + integer , intent(in) :: nf + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: i, ncomp + type(ESMF_Field) :: lfield + real(r8), pointer :: data1d(:) + real(r8), pointer :: data2d(:,:) + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ncomp = 6 + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do i = 1,size(data2d, dim=1) + data2d(i,ungridded_index) = (nf+1) * 1.0_r8 + end do + else if (gridToFieldMap == 2) then + do i = 1,size(data2d, dim=2) + data2d(ungridded_index,i) = (nf+1) * 1.0_r8 + end do + end if + else + call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do i = 1,size(data1d) + data1d(i) = (nf+1) * 1.0_r8 + end do + end if + + end subroutine field_setexport + + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc diff --git a/src/components/xcpl_comps/xshare/nuopc/dead_nuopc_mod.F90 b/src/components/xcpl_comps/xshare/nuopc/dead_nuopc_mod.F90 index cb92e88c6a3..8872275aad2 100644 --- a/src/components/xcpl_comps/xshare/nuopc/dead_nuopc_mod.F90 +++ b/src/components/xcpl_comps/xshare/nuopc/dead_nuopc_mod.F90 @@ -1,32 +1,26 @@ module dead_nuopc_mod - use ESMF , only : ESMF_Gridcomp, ESMF_State, ESMF_StateGet - use ESMF , only : ESMF_Clock, ESMF_Time, ESMF_TimeInterval, ESMF_Alarm - use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockAdvance, ESMF_AlarmSet - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE - use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag - use ESMF , only : ESMF_FIELDSTATUS_COMPLETE, ESMF_FAILURE - use ESMF , only : operator(/=), operator(==), operator(+) - use med_constants_mod , only : IN, R8, CS, CL - use shr_file_mod , only : shr_file_getunit, shr_file_freeunit - use shr_sys_mod , only : shr_sys_abort - use shr_nuopc_utils_mod , only : shr_nuopc_utils_ChkErr + use med_constants_mod , only : R8, CL + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_ChkErr + use shr_sys_mod , only : shr_sys_abort + use ESMF , only : ESMF_Gridcomp, ESMF_State, ESMF_StateGet + use ESMF , only : ESMF_Clock, ESMF_Time, ESMF_TimeInterval, ESMF_Alarm + use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockAdvance, ESMF_AlarmSet + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE + use ESMF , only : ESMF_FAILURE + use ESMF , only : operator(/=), operator(==), operator(+) + implicit none private public :: dead_init_nuopc - public :: dead_run_nuopc public :: dead_final_nuopc + public :: dead_meshinit public :: ModelInitPhase public :: ModelSetRunClock public :: fld_list_add public :: fld_list_realize - public :: state_getimport - public :: state_setexport - public :: Print_FieldExchInfo - - private :: state_getfldptr ! !PUBLIC DATA MEMBERS: integer, public :: dead_grid_lat = 1 ! lat from component @@ -34,13 +28,13 @@ module dead_nuopc_mod integer, public :: dead_grid_area = 3 ! area from component integer, public :: dead_grid_mask = 4 ! mask, 0 = inactive cell integer, public :: dead_grid_frac = 5 ! fractional area coverage - integer, public :: dead_grid_aream = 6 ! area from mapping file - integer, public :: dead_grid_index = 7 ! global index - integer, public :: dead_grid_pid = 8 ! proc id number - integer, public :: dead_grid_total = 8 + integer, public :: dead_grid_index = 6 ! global index + integer, public :: dead_grid_total = 6 type fld_list_type character(len=128) :: stdname + integer :: ungridded_lbound = 0 + integer :: ungridded_ubound = 0 end type fld_list_type public :: fld_list_type @@ -54,32 +48,28 @@ module dead_nuopc_mod !=============================================================================== subroutine dead_read_inparms(model, inst_suffix, logunit, & - nxg, nyg, decomp_type, nproc_x, seg_len, flood) + nxg, nyg, decomp_type, nproc_x, seg_len) use ESMF, only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMBroadcast, ESMF_VMGet - ! input/output varialbes + ! input/output variables character(len=*) , intent(in) :: model character(len=*) , intent(in) :: inst_suffix ! char string associated with instance - integer(IN) , intent(in) :: logunit ! logging unit number - integer(IN) , intent(out) :: nproc_x - integer(IN) , intent(out) :: seg_len - integer(IN) , intent(out) :: nxg ! global dim i-direction - integer(IN) , intent(out) :: nyg ! global dim j-direction - integer(IN) , intent(out) :: decomp_type ! decomposition type - logical , intent(out) :: flood ! rof flood flag + integer , intent(in) :: logunit ! logging unit number + integer , intent(out) :: nproc_x + integer , intent(out) :: seg_len + integer , intent(out) :: nxg ! global dim i-direction + integer , intent(out) :: nyg ! global dim j-direction + integer , intent(out) :: decomp_type ! decomposition type ! local variables - type(ESMF_VM) :: vm - character(CL) :: fileName ! generic file name - integer(IN) :: nunit ! unit number - integer(IN) :: ierr ! error code - integer(IN) :: unitn ! Unit for namelist file - integer(IN) :: tmp(6) ! array for broadcast - integer(IN) :: localPet ! mpi id of current task in current context - integer :: rc ! EMSF return code - - ! formats + type(ESMF_VM) :: vm + character(CL) :: fileName ! generic file name + integer :: nunit ! unit number + integer :: unitn ! Unit for namelist file + integer :: tmp(5) ! array for broadcast + integer :: localPet ! mpi id of current task in current context + integer :: rc ! return code character(*), parameter :: F00 = "('(dead_read_inparms) ',8a)" character(*), parameter :: F01 = "('(dead_read_inparms) ',a,a,4i8)" character(*), parameter :: F03 = "('(dead_read_inparms) ',a,a,i8,a)" @@ -92,27 +82,20 @@ subroutine dead_read_inparms(model, inst_suffix, logunit, & nproc_x = -9999 seg_len = -9999 decomp_type = -9999 - flood = .false. call ESMF_VMGetCurrent(vm, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (chkerr(rc,__LINE__,u_FILE_u)) return if (localPet==0) then - unitn = shr_file_getUnit() - open(unitn, file='x'//model//'_in'//trim(inst_suffix), status='old' ) + open(newunit=unitn, file='x'//model//'_in'//trim(inst_suffix), status='old' ) read(unitn,*) nxg read(unitn,*) nyg read(unitn,*) decomp_type read(unitn,*) nproc_x read(unitn,*) seg_len - if (model.eq.'rof') then - read(unitn,*) flood - end if close (unitn) - call shr_file_freeunit(unitn) endif tmp(1) = nxg @@ -120,20 +103,14 @@ subroutine dead_read_inparms(model, inst_suffix, logunit, & tmp(3) = decomp_type tmp(4) = nproc_x tmp(5) = seg_len - if (model.eq.'rof' .and. flood) then - tmp(6) = 1 - else - tmp(6) = 0 - endif + call ESMF_VMBroadcast(vm, tmp, 6, 0, rc=rc) - nxg = tmp(1) - nyg = tmp(2) + + nxg = tmp(1) + nyg = tmp(2) decomp_type = tmp(3) - nproc_x = tmp(4) - seg_len = tmp(5) - if(tmp(6) == 1) then - flood = .true. - endif + nproc_x = tmp(4) + seg_len = tmp(5) if (localPet==0) then write(logunit,*)' Read in X'//model//' input from file= x'//model//'_in' @@ -145,67 +122,59 @@ subroutine dead_read_inparms(model, inst_suffix, logunit, & write(logunit,F03) model,' Num pes in X : ',nproc_x,' (type 3 only)' write(logunit,F03) model,' Segment Length : ',seg_len,' (type 11 only)' write(logunit,F00) model,' inst_suffix : ',trim(inst_suffix) - if (model.eq.'rof') then - write(logunit,F01) ' Flood mode : ',flood - endif write(logunit,F00) model end if + end subroutine dead_read_inparms !=============================================================================== subroutine dead_setNewGrid(decomp_type, nxg, nyg, logunit, lsize, gbuf, seg_len, nproc_x) - use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VmGet - use shr_const_mod , only : shr_const_pi, shr_const_rearth - ! This sets up some defaults. The user may want to overwrite some ! of these fields in the main program after initialization in complete. + use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VmGet + use shr_const_mod , only : shr_const_pi, shr_const_rearth + ! input/output parameters: - integer(IN) ,intent(in) :: decomp_type ! - integer(IN) ,intent(in) :: nxg,nyg ! global grid sizes - integer(IN) ,intent(in) :: logunit ! output logunit - integer(IN) ,intent(out) :: lsize ! local grid sizes - real(R8) ,pointer :: gbuf(:,:) ! output data - integer(IN) ,intent(in),optional :: seg_len ! seg len decomp setting - integer(IN) ,intent(in),optional :: nproc_x ! 2d decomp setting + integer , intent(in) :: decomp_type ! + integer , intent(in) :: nxg,nyg ! global grid sizes + integer , intent(in) :: logunit ! output logunit + integer , intent(out) :: lsize ! local grid sizes + real(R8), pointer :: gbuf(:,:) ! output data + integer , intent(in),optional :: seg_len ! seg len decomp setting + integer , intent(in),optional :: nproc_x ! 2d decomp setting ! local - type(ESMF_VM) :: vm - integer(IN) :: rc - integer(IN) :: mype - integer(IN) :: totpe ! total number of pes - integer(IN) :: ierr ! error code - logical :: found - integer(IN) :: i,j,ig,jg - integer(IN) :: n,ng,is,ie,js,je,nx,ny ! indices - integer(IN) :: npesx,npesy,mypex,mypey,nxp,nyp - real (R8) :: hscore,bscore - real (R8) :: dx,dy,deg2rad,ys,yc,yn,area,re - integer(IN),allocatable :: gindex(:) - - ! formats + type(ESMF_VM) :: vm + integer :: rc + integer :: mype + integer :: totpe ! total number of pes + logical :: found + integer :: i,j,ig,jg + integer :: n,ng,is,ie,js,je,nx,ny + integer :: npesx,npesy,mypex,mypey,nxp,nyp + real(R8) :: hscore,bscore + real(R8) :: dx,dy,deg2rad,ys,yc,yn,area,re + integer, allocatable :: gindex(:) character(*), parameter :: F00 = "('(dead_setNewGrid) ',8a)" character(*), parameter :: F01 = "('(dead_setNewGrid) ',a,4i8)" character(*), parameter :: subName = "(dead_setNewGrid) " !------------------------------------------------------------------------------- call ESMF_VMGetCurrent(vm, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=mype, peCount=totpe, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - if (decomp_type == 1 .or. & + if ( decomp_type == 1 .or. & decomp_type == 2 .or. & decomp_type == 3 .or. & decomp_type == 4 .or. & decomp_type == 11) then - ! valid else - !------------------------------------------------------------------------- ! invalid decomposition type - !------------------------------------------------------------------------- if (mype == 0) then write(logunit,F01) 'ERROR: invalid decomp_type = ',decomp_type end if @@ -215,7 +184,6 @@ subroutine dead_setNewGrid(decomp_type, nxg, nyg, logunit, lsize, gbuf, seg_len, if (nxg*nyg == 0) then lsize = 0 allocate(gbuf(lsize,dead_grid_total)) - ! gbuf = -888.0_R8 if (mype == 0) then write(logunit,*) subname,' grid size is zero, lsize = ',lsize end if @@ -404,134 +372,46 @@ subroutine dead_init_nuopc(model, inst_suffix, logunit, lsize, gbuf, nxg, nyg) integer , intent(out) :: nyg ! global dim j-direction !--- local variables --- - integer :: ierr ! error code integer :: local_comm ! local communicator - integer :: mype ! pe info - integer :: totpe ! total number of pes integer :: nproc_x integer :: seg_len integer :: decomp_type - logical :: flood=.false. ! rof flood flag character(*), parameter :: subName = "(dead_init_nuopc) " !------------------------------------------------------------------------------- ! Read input parms - call dead_read_inparms(model, inst_suffix, logunit, & - nxg, nyg, decomp_type, nproc_x, seg_len, flood) + call dead_read_inparms(model, inst_suffix, logunit, nxg, nyg, decomp_type, nproc_x, seg_len) ! Initialize grid - call dead_setNewGrid(decomp_type, nxg, nyg, logunit, & - lsize, gbuf, seg_len, nproc_x) + call dead_setNewGrid(decomp_type, nxg, nyg, logunit, lsize, gbuf, seg_len, nproc_x) end subroutine dead_init_nuopc !=============================================================================== - subroutine dead_run_nuopc(model, d2x, gbuf) - - use shr_const_mod , only : shr_const_pi - - ! run method for dead model - - ! input/output parameters: - character(len=*) , intent(in) :: model - real(r8) , intent(inout) :: d2x(:,:) ! dead -> driver - real(r8) , pointer :: gbuf(:,:) ! model grid - - ! local - integer :: n ! index - integer :: nf ! fields loop index - integer :: ki ! index - integer :: lsize ! size of AttrVect - real(R8) :: lat ! latitude - real(R8) :: lon ! longitude - integer :: nflds_d2x - integer :: ncomp - character(*), parameter :: subName = "(dead_run_nuopc) " - !------------------------------------------------------------------------------- - - selectcase(model) - case('atm') - ncomp = 1 - case('lnd') - ncomp = 2 - case('ice') - ncomp = 3 - case('ocn') - ncomp = 4 - case('glc') - ncomp = 5 - case('rof') - ncomp = 6 - case('wav') - ncomp = 7 - end select - - nflds_d2x = size(d2x, dim=1) - lsize = size(d2x, dim=2) - - if (model.eq.'rof') then - do nf=1,nflds_d2x - do n=1,lsize - d2x(nf,n) = (nf+1) * 1.0_r8 - enddo - enddo - else if (model.eq.'glc') then - do nf=1,nflds_d2x - do n=1,lsize - lon = gbuf(n,dead_grid_lon) - lat = gbuf(n,dead_grid_lat) - d2x(nf,n) = (nf*100) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * sin (SHR_CONST_PI*lon/180.0_R8) & - * sin (SHR_CONST_PI*lon/180.0_R8) & - + (ncomp*10.0_R8) - enddo - enddo - else - do nf=1,nflds_d2x - do n=1,lsize - lon = gbuf(n,dead_grid_lon) - lat = gbuf(n,dead_grid_lat) - d2x(nf,n) = (nf*100) & - * cos (SHR_CONST_PI*lat/180.0_R8) & - * sin((SHR_CONST_PI*lon/180.0_R8) & - - (ncomp-1)*(SHR_CONST_PI/3.0_R8) ) & - + (ncomp*10.0_R8) - enddo - enddo - endif - - end subroutine dead_run_nuopc - - !=============================================================================== - subroutine dead_final_nuopc(model, logunit) - use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet - ! finalize method for xcpl component + use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet + ! input/output parameters: character(len=*) , intent(in) :: model integer , intent(in) :: logunit ! logging unit number - !-- local -- + ! local variables type(ESMF_VM) :: vm - integer :: rc - integer :: localPet - - !--- formats --- + integer :: rc + integer :: localPet character(*), parameter :: F00 = "('(dead_comp_final) ',8a)" character(*), parameter :: F91 = "('(dead_comp_final) ',73('-'))" character(*), parameter :: subName = "(dead_comp_final) " !------------------------------------------------------------------------------- call ESMF_VMGetCurrent(vm, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (localPet==0) then write(logunit,F91) @@ -543,17 +423,18 @@ end subroutine dead_final_nuopc !=============================================================================== - subroutine fld_list_add(num, fldlist, stdname) + subroutine fld_list_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound) use ESMF, only : ESMF_LogWrite, ESMF_LOGMSG_ERROR - integer, intent(inout) :: num - type(fld_list_type), intent(inout) :: fldlist(:) - character(len=*), intent(in) :: stdname + ! input/output variables + integer , intent(inout) :: num + type(fld_list_type) , intent(inout) :: fldlist(:) + character(len=*) , intent(in) :: stdname + integer, optional , intent(in) :: ungridded_lbound + integer, optional , intent(in) :: ungridded_ubound ! local variables - integer :: rc - integer :: dbrc character(len=*), parameter :: subname='(dead_nuopc_mod:fld_list_add)' !------------------------------------------------------------------------------- @@ -561,11 +442,16 @@ subroutine fld_list_add(num, fldlist, stdname) num = num + 1 if (num > fldsMax) then call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) return endif fldlist(num)%stdname = trim(stdname) + if (present(ungridded_lbound) .and. present(ungridded_ubound)) then + fldlist(num)%ungridded_lbound = ungridded_lbound + fldlist(num)%ungridded_ubound = ungridded_ubound + end if + end subroutine fld_list_add !=============================================================================== @@ -588,10 +474,10 @@ subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scal integer , intent(inout) :: rc ! local variables - integer :: dbrc - integer :: n - type(ESMF_Field) :: field - character(len=80) :: stdname + integer :: n + type(ESMF_Field) :: field + character(len=80) :: stdname + integer :: gridtoFieldMap=2 character(len=*),parameter :: subname='(dshr_nuopc_mod:fld_list_realize)' ! ---------------------------------------------- @@ -602,16 +488,24 @@ subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scal if (NUOPC_IsConnected(state, fieldName=stdname)) then if (stdname == trim(flds_scalar_name)) then call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected on root pe", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) ! Create the scalar field call SetScalarField(field, flds_scalar_name, flds_scalar_num, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) ! Create the field - field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + if (fldlist(n)%ungridded_lbound > 0 .and. fldlist(n)%ungridded_ubound > 0) then + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, & + ungriddedLbound=(/fldlist(n)%ungridded_lbound/), & + ungriddedUbound=(/fldlist(n)%ungridded_ubound/), & + gridToFieldMap=(/gridToFieldMap/), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + end if endif ! NOW call NUOPC_Realize @@ -620,7 +514,7 @@ subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scal else if (stdname /= trim(flds_scalar_name)) then call ESMF_LogWrite(subname // trim(tag) // " Field = "// trim(stdname) // " is not connected.", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) call ESMF_StateRemove(state, (/stdname/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return end if @@ -633,6 +527,7 @@ subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) ! ---------------------------------------------- ! create a field with scalar data on the root pe ! ---------------------------------------------- + use ESMF, only : ESMF_Field, ESMF_DistGrid, ESMF_Grid use ESMF, only : ESMF_DistGridCreate, ESMF_GridCreate, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU use ESMF, only : ESMF_FieldCreate, ESMF_GridCreate, ESMF_TYPEKIND_R8 @@ -658,7 +553,7 @@ subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return field = ESMF_FieldCreate(name=trim(flds_scalar_name), grid=grid, typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), ungriddedUBound=(/flds_scalar_num/), rc=rc) + ungriddedLBound=(/1/), ungriddedUBound=(/flds_scalar_num/), gridToFieldMap=(/2/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return end subroutine SetScalarField @@ -681,7 +576,7 @@ subroutine ModelInitPhase(gcomp, importState, exportState, clock, rc) ! Switch to IPDv01 by filtering all other phaseMap entries call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, acceptStringList=(/"IPDv01p"/), rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine ModelInitPhase @@ -694,6 +589,7 @@ subroutine ModelSetRunClock(gcomp, rc) use NUOPC_Model , only : NUOPC_ModelGet use NUOPC , only : NUOPC_CompAttributeGet + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -707,24 +603,23 @@ subroutine ModelSetRunClock(gcomp, rc) integer :: restart_n ! Number until restart interval integer :: restart_ymd ! Restart date (YYYYMMDD) type(ESMF_ALARM) :: restart_alarm - integer :: dbrc character(len=128) :: name integer :: alarmcount character(len=*),parameter :: subname='dshr_nuopc_mod:(ModelSetRunClock) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug_flag > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) ! query the Component for its clocks call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! force model clock currtime and timestep to match driver and set stoptime @@ -732,30 +627,30 @@ subroutine ModelSetRunClock(gcomp, rc) mstoptime = mcurrtime + dtimestep call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! set restart alarm !-------------------------------- call ESMF_ClockGetAlarmList(mclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmCount=alarmCount, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (alarmCount == 0) then call ESMF_GridCompGet(gcomp, name=name, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(subname//'setting alarms for' // trim(name), ESMF_LOGMSG_INFO, rc=dbrc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//'setting alarms for' // trim(name), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) restart_n call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) restart_ymd call shr_nuopc_time_alarmInit(mclock, restart_alarm, restart_option, & @@ -763,10 +658,10 @@ subroutine ModelSetRunClock(gcomp, rc) opt_ymd = restart_ymd, & RefTime = mcurrTime, & alarmname = 'alarm_restart', rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -775,208 +670,246 @@ subroutine ModelSetRunClock(gcomp, rc) !-------------------------------- call ESMF_ClockAdvance(mclock,rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug_flag > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine ModelSetRunClock !=============================================================================== - - subroutine state_getimport(state, fldname, output, rc) - - ! ---------------------------------------------- - ! Map import state field to output array - ! ---------------------------------------------- - - ! input/output variables - type(ESMF_State) , intent(in) :: state - character(len=*) , intent(in) :: fldname - real(r8) , intent(out) :: output(:) - integer , intent(out) :: rc + + subroutine dead_meshinit(gcomp, nx_global, ny_global, gindex, lon, lat, Emesh, rc) + + !----------------------------------------- + ! create an Emesh object for Fields + !----------------------------------------- + + use shr_kind_mod , only : R8=>shr_kind_r8 + use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_Mesh + use ESMF , only : ESMF_VMGet, ESMF_GridCompGet, ESMF_VMBroadCast, ESMF_VMAllGatherV + use ESMF , only : ESMF_SUCCESS, ESMF_LOGMSG_INFO, ESMF_LogWrite + use ESMF , only : ESMF_VMGather, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_MeshCreate, ESMF_COORDSYS_SPH_DEG, ESMF_REDUCE_SUM + use ESMF , only : ESMF_VMAllReduce, ESMF_MESHELEMTYPE_QUAD + + ! input/output arguments + type(ESMF_GridComp) :: gcomp + integer , intent(in) :: nx_global + integer , intent(in) :: ny_global + integer , intent(in) :: gindex(:) + real(r8), pointer , intent(in) :: lon(:) + real(r8), pointer , intent(in) :: lat(:) + type(ESMF_Mesh) , intent(inout) :: Emesh + integer , intent(inout) :: rc ! local variables - integer :: g, i - real(R8), pointer :: fldptr(:) - type(ESMF_StateItem_Flag) :: itemFlag - integer :: dbrc - character(len=*), parameter :: subname='(lnd_import_export:state_getimport)' - ! ---------------------------------------------- + integer :: n,n1,n2,de + integer :: iam + integer :: lsize + integer :: numTotElems, numNodes, numConn, nodeindx + integer :: iur,iul,ill,ilr + integer :: xid, yid, xid0, yid0 + real(r8) :: lonur, lonul, lonll, lonlr + integer, pointer :: iurpts(:) + integer, pointer :: elemIds(:) + integer, pointer :: elemTypes(:) + integer, pointer :: elemConn(:) + real(r8),pointer :: elemCoords(:) + integer, pointer :: nodeIds(:) + integer, pointer :: nodeOwners(:) + real(r8),pointer :: nodeCoords(:) + real(r8),pointer :: latG(:) + real(r8),pointer :: lonG(:) + integer ,pointer :: pes_local(:) + integer ,pointer :: pes_global(:) + integer, pointer :: recvOffsets(:) + integer, pointer :: recvCounts(:) + integer :: sendData(1) + type(ESMF_VM) :: vm + integer :: petCount + character(len=*),parameter :: subname='(shr_nuopc_grid_MeshInit)' + !-------------------------------------------------------------- rc = ESMF_SUCCESS - ! Determine if field with name fldname exists in state - call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - ! if field exists then create output array - else do nothing - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then - - ! get field pointer - call state_getfldptr(state, trim(fldname), fldptr, rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! determine output array - do g = 1,size(fldptr) - output(g) = fldptr(g) - end do - end if - - end subroutine state_getimport - - !=============================================================================== - - subroutine state_setexport(state, fldname, input, rc) - ! ---------------------------------------------- - ! Map input array to export state field - ! ---------------------------------------------- + lsize = size(gindex) - ! input/output variables - type(ESMF_State) , intent(inout) :: state - character(len=*) , intent(in) :: fldname - real(r8) , intent(in) :: input(:) - integer , intent(out) :: rc + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! local variables - integer :: g, i - real(R8), pointer :: fldptr(:) - type(ESMF_StateItem_Flag) :: itemFlag - integer :: dbrc - character(len=*), parameter :: subname='(lnd_import_export:state_setexport)' - ! ---------------------------------------------- + call ESMF_VMGet(vm, petCount=petCount, localpet=iam, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - rc = ESMF_SUCCESS - - ! Determine if field with name fldname exists in state - call ESMF_StateGet(state, trim(fldname), itemFlag, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(latG(nx_global*ny_global)) + allocate(lonG(nx_global*ny_global)) - ! if field exists then create output array - else do nothing - if (itemflag /= ESMF_STATEITEM_NOTFOUND) then + allocate(recvoffsets(petCount)) + allocate(recvCounts(petCount)) - ! get field pointer - call state_getfldptr(state, trim(fldname), fldptr, rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + sendData(1) = lsize + call ESMF_VMGather(vm, sendData=sendData, recvData=recvCounts, count=1, rootPet=0, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - ! set fldptr values to input array - do g = 1,size(fldptr) - fldptr(g) = input(g) - end do - end if + call ESMF_VMBroadCast(vm, bcstData=recvCounts, count=petCount, rootPet=0, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - end subroutine state_setexport + recvoffsets(1) = 0 + do n = 2,petCount + recvoffsets(n) = recvoffsets(n-1) + recvCounts(n-1) + end do - !=============================================================================== + call ESMF_VMAllGatherV(vm, lat, lsize, latG, recvCounts, recvOffsets, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMAllGatherV(vm, lon, lsize, lonG, recvCounts, recvOffsets, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + deallocate(recvoffsets) + deallocate(recvCounts) + + ! assumes quadrilaterals for each gridcell (element) + ! element index matches gsmap index value + ! nodeid at lower left of each gridcell matches gsmap index value + ! assumes wrap around in x direction but no wrap in y direction + ! node ids need to be described in counter clockwise direction + ! node id associated with lower left cell is assigned to local PET + ! node ids at top of y boundary assigned to the element to the right + + numTotElems = lsize + + allocate(elemIds(numTotElems)) + allocate(elemTypes(numTotElems)) + elemTypes=(/ESMF_MESHELEMTYPE_QUAD/) + allocate(elemConn(4*numTotElems)) + allocate(elemCoords(2*numTotElems)) + + allocate(nodeIds(numTotElems*4)) + nodeIds = -99 + + elemIds(:) = gindex(:) + numNodes = 0 + numConn = 0 + + do n = 1,numTotElems + elemTypes(n) = ESMF_MESHELEMTYPE_QUAD + elemCoords(2*n-1) = lon(n) + elemCoords(2*n) = lat(n) + + do n1 = 1,4 + + numNodes = numNodes + 1 + nodeindx = numNodes + if (n1 == 1 .or. n1 == 3) xid = mod(elemIds(n)-1,nx_global) + 1 + if (n1 == 2 .or. n1 == 4) xid = mod(elemIds(n) ,nx_global) + 1 + if (n1 == 1 .or. n1 == 2) yid = (elemIds(n)-1)/nx_global + 1 + if (n1 == 3 .or. n1 == 4) yid = (elemIds(n)-1)/nx_global + 2 + nodeIds(numNodes) = (yid-1) * nx_global + xid + n2 = 0 + do while (n2 < numNodes - 1 .and. nodeindx == numNodes) + n2 = n2 + 1 + if (nodeIds(numNodes) == nodeIds(n2)) nodeindx = n2 + enddo + if (nodeindx /= numNodes) then + numNodes = numNodes - 1 + endif - subroutine state_getfldptr(State, fldname, fldptr, rc) - ! ---------------------------------------------- - ! Get pointer to a state field - ! ---------------------------------------------- - use ESMF , only : ESMF_State, ESMF_Field, ESMF_Mesh, ESMF_FieldStatus_Flag - use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_MeshGet - use ESMF , only : ESMF_FIELDSTATUS_COMPLETE, ESMF_FAILURE + numConn = numConn + 1 + elemConn(numConn) = nodeindx + enddo + enddo - type(ESMF_State), intent(in) :: State - character(len=*), intent(in) :: fldname - real(R8), pointer, intent(out) :: fldptr(:) - integer, intent(out) :: rc - ! local variables - type(ESMF_FieldStatus_Flag) :: status - type(ESMF_Field) :: lfield - type(ESMF_Mesh) :: lmesh - integer :: dbrc - integer :: nnodes, nelements - character(len=*), parameter :: subname='(lnd_import_export:state_getfldptr)' - ! ---------------------------------------------- + allocate(nodeCoords(2*numNodes)) + allocate(nodeOwners(numNodes)) + allocate(iurpts(numNodes)) - rc = ESMF_SUCCESS + do n = 1,numNodes - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + xid0 = mod(nodeIds(n)-1, nx_global) + 1 + yid0 = (nodeIds(n)-1) / nx_global + 1 - call ESMF_StateGet(State, itemName=trim(fldname), field=lfield, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + xid = xid0 + yid = max(min(yid0,ny_global),1) + iur = (yid-1) * nx_global + xid + iurpts(n) = iur - call ESMF_FieldGet(lfield, status=status, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + xid = mod(xid0 - 2 + nx_global, nx_global) + 1 + yid = max(min(yid0,ny_global),1) + iul = (yid-1) * nx_global + xid - if (status /= ESMF_FIELDSTATUS_COMPLETE) then - call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - else - call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + xid = mod(xid0 - 2 + nx_global, nx_global) + 1 + yid = max(min(yid0-1,ny_global),1) + ill = (yid-1) * nx_global + xid - call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + xid = xid0 + yid = max(min(yid0-1,ny_global),1) + ilr = (yid-1) * nx_global + xid - if (nnodes == 0 .and. nelements == 0) then - call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", ESMF_LOGMSG_INFO, rc=dbrc) - rc = ESMF_FAILURE - return - end if - - call ESMF_FieldGet(lfield, farrayPtr=fldptr, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - endif ! status + ! write(tmpstr,'(2a,8i6)') subname,' nodecoord = ',n,nodeIds(n),xid0,yid0,iur,iul,ill,ilr + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + ! need to normalize lon values to same 360 degree setting, use lonur as reference value + lonur = lonG(iur) + lonul = lonG(iul) + lonll = lonG(ill) + lonlr = lonG(ilr) - end subroutine state_getfldptr + if (abs(lonul + 360._r8 - lonur) < abs(lonul - lonur)) lonul = lonul + 360._r8 + if (abs(lonul - 360._r8 - lonur) < abs(lonul - lonur)) lonul = lonul - 360._r8 + if (abs(lonll + 360._r8 - lonur) < abs(lonll - lonur)) lonll = lonll + 360._r8 + if (abs(lonll - 360._r8 - lonur) < abs(lonll - lonur)) lonll = lonll - 360._r8 + if (abs(lonlr + 360._r8 - lonur) < abs(lonlr - lonur)) lonlr = lonlr + 360._r8 + if (abs(lonlr - 360._r8 - lonur) < abs(lonlr - lonur)) lonlr = lonlr - 360._r8 - !=============================================================================== - - subroutine Print_FieldExchInfo(values, logunit, fldlist, nflds, istr) - - use med_constants_mod , only : R8 - use ESMF , only : ESMF_MAXSTR + nodeCoords(2*n-1) = 0.25_r8 * (lonur + lonul + lonll + lonlr) + nodeCoords(2*n) = 0.25_r8 * (latG(iur) + latG(iul) + latG(ill) + latG(ilr)) + enddo - ! !DESCRIPTION: - ! Print out information about values to stdount - ! - flag sets the level of information: - ! - print out names of fields in values 2d array - ! - also print out local max and min of data in values 2d array - ! If optional argument istr is present, it will be output before any of the information. + deallocate(lonG) + deallocate(latG) + ! Determine the pes that own each index of iurpts (nodeOwners) - ! input/output parameters: - real(R8) , intent(in) :: values(:,:) ! arrays sent to/recieved from mediator - integer , intent(in) :: logunit - type(fld_list_type) , intent(in) :: fldlist(:) - integer , intent(in) :: nflds - character(*) , intent(in),optional :: istr ! string for print - - !--- local --- - integer :: n ! generic indicies - integer :: nsize ! grid point in values array - real(R8) :: minl(nflds) ! local min - real(R8) :: maxl(nflds) ! local max - character(len=ESMF_MAXSTR) :: name - - !--- formats --- - character(*),parameter :: subName = '(print_FieldExchInfo) ' - character(*),parameter :: F00 = "('(print_FieldExchInfo) ',8a)" - character(*),parameter :: F01 = "('(print_FieldExchInfo) ',a,i9)" - character(*),parameter :: F02 = "('(print_FieldExchInfo) ',a,2es11.3,i4,2x,a)" - !------------------------------------------------------------------------------- + allocate(pes_local(nx_global*ny_global)) + allocate(pes_global(nx_global*ny_global)) + pes_local(:) = 0 + do n = 1,lsize + pes_local(gindex(n)) = iam + end do - if (present(istr)) write(logunit,*) trim(istr) - nsize = size(values, dim=2) - write(logunit,F01) "local size =",nsize - do n = 1, nflds - minl(n) = minval(values(n,:)) - maxl(n) = maxval(values(n,:)) - write(logunit,F02) 'l min/max ',minl(n),maxl(n),n,fldlist(n)%stdname - enddo + call ESMF_VMAllReduce(vm, sendData=pes_local, recvData=pes_global, count=nx_global*ny_global, & + reduceflag=ESMF_REDUCE_SUM, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - end subroutine Print_FieldExchInfo + do n = 1,numNodes + nodeOwners(n) = pes_global(iurpts(n)) + end do + deallocate(pes_local) + deallocate(pes_global) + + Emesh = ESMF_MeshCreate(parametricDim=2, & + spatialDim=2, & + coordSys=ESMF_COORDSYS_SPH_DEG, & + nodeIds=nodeIds(1:numNodes), & + nodeCoords=nodeCoords, & + nodeOwners=nodeOwners, & + elementIds=elemIds,& + elementTypes=elemTypes, & + elementConn=elemConn, & + elementCoords=elemCoords, & + rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + deallocate(iurpts) + deallocate(nodeIds, nodeCoords, nodeOwners) + deallocate(elemIds, elemTypes, elemConn, elemCoords) + + end subroutine dead_meshinit end module dead_nuopc_mod diff --git a/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 b/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 index 21272e5fa27..331ca704e37 100644 --- a/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 +++ b/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 @@ -3,6 +3,7 @@ module wav_comp_nuopc !---------------------------------------------------------------------------- ! This is the NUOPC cap for XWAV !---------------------------------------------------------------------------- + use ESMF use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise @@ -11,11 +12,8 @@ module wav_comp_nuopc use NUOPC_Model , only : model_label_SetRunClock => label_SetRunClock use NUOPC_Model , only : model_label_Finalize => label_Finalize use NUOPC_Model , only : NUOPC_ModelGet - use med_constants_mod , only : IN, R8, I8, CXX, CL, CS - use med_constants_mod , only : shr_log_Unit + use med_constants_mod , only : R8, CL, CS use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - use med_constants_mod , only : shr_file_getloglevel, shr_file_setloglevel - use med_constants_mod , only : shr_file_setIO, shr_file_getUnit use shr_nuopc_scalars_mod , only : flds_scalar_name use shr_nuopc_scalars_mod , only : flds_scalar_num use shr_nuopc_scalars_mod , only : flds_scalar_index_nx @@ -23,13 +21,12 @@ module wav_comp_nuopc use shr_nuopc_methods_mod , only : shr_nuopc_methods_Clock_TimePrint use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_grid_mod , only : shr_nuopc_grid_Meshinit + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_ChkErr use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index - use dead_nuopc_mod , only : dead_init_nuopc, dead_run_nuopc, dead_final_nuopc + use dead_nuopc_mod , only : dead_init_nuopc, dead_final_nuopc, dead_meshinit use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : state_getimport, state_setexport - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, Print_FieldExchInfo + use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock + use med_constants_mod , only : dbug => med_constants_dbug_flag implicit none private ! except @@ -44,70 +41,68 @@ module wav_comp_nuopc integer :: fldsFrWav_num = 0 type (fld_list_type) :: fldsToWav(fldsMax) type (fld_list_type) :: fldsFrWav(fldsMax) - real(r8), pointer :: gbuf(:,:) ! model info + integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost + real(r8), pointer :: lat(:) real(r8), pointer :: lon(:) integer , allocatable :: gindex(:) - real(r8), allocatable :: x2d(:,:) - real(r8), allocatable :: d2x(:,:) integer :: nxg ! global dim i-direction integer :: nyg ! global dim j-direction - integer :: my_task ! my task in mpi communicator mpicom integer :: inst_index ! number of current instance (ie. 1) character(len=16) :: inst_name ! fullname of current instance (ie. "wav_0001") character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") integer :: logunit ! logging unit number - integer, parameter :: master_task = 0 - logical :: mastertask - character(len=*),parameter :: grid_option = "mesh" ! grid_de, grid_arb, grid_reg, mesh + logical :: mastertask character(*),parameter :: modName = "(xwav_comp_nuopc)" - character(*),parameter :: u_FILE_u = __FILE__ - integer, parameter :: dbug = 10 + character(*),parameter :: u_FILE_u = & + __FILE__ !=============================================================================== contains - !=============================================================================== +!=============================================================================== + subroutine SetServices(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! the NUOPC gcomp component will register the generic methods call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! switching to IPD versions call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & userRoutine=ModelInitPhase, phase=0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! set entry point for methods that require specific implementation call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p1"/), & userRoutine=InitializeAdvertise, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & userRoutine=InitializeRealize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! attach specializing method(s) call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Advance, specRoutine=ModelAdvance, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices @@ -115,39 +110,38 @@ end subroutine SetServices !=============================================================================== subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_set_component_logging use shr_nuopc_utils_mod, only : shr_nuopc_get_component_instance + + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock integer, intent(out) :: rc ! local variables + integer :: n type(ESMF_VM) :: vm - character(CL) :: cvalue character(CS) :: stdname - integer :: n - integer :: lsize ! local array size - integer :: ierr ! error code - integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - logical :: isPresent - character(len=512) :: diro - character(len=512) :: logfile + real(r8), pointer :: gbuf(:,:) ! model info + integer :: my_task ! my task in mpi communicator mpicom + integer :: lsize ! local array size + integer :: shrlogunit ! original log unit character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - mastertask = my_task == 0 + mastertask = (my_task == 0) !---------------------------------------------------------------------------- ! determine instance information @@ -160,7 +154,7 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit, shrloglev) + call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit) !---------------------------------------------------------------------------- ! Initialize xwav @@ -188,13 +182,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsFrWav_num, fldsFrWav, 'Sw_vstokes' ) call fld_list_add(fldsFrWav_num, fldsFrWav, 'Sw_hstokes' ) - do n = 1,fldsFrWav_num - if (mastertask) write(logunit,*)'Advertising From Xwav ',trim(fldsFrWav(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrWav(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - enddo - call fld_list_add(fldsToWav_num, fldsToWav, trim(flds_scalar_name)) call fld_list_add(fldsToWav_num, fldsToWav, 'Sa_u' ) call fld_list_add(fldsToWav_num, fldsToWav, 'Sa_v' ) @@ -205,24 +192,28 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call fld_list_add(fldsToWav_num, fldsToWav, 'So_v' ) call fld_list_add(fldsToWav_num, fldsToWav, 'So_bldepth' ) + do n = 1,fldsFrWav_num + if (mastertask) write(logunit,*)'Advertising From Xwav ',trim(fldsFrWav(n)%stdname) + call NUOPC_Advertise(exportState, standardName=fldsFrWav(n)%stdname, & + TransferOfferGeomObject='will provide', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + do n = 1,fldsToWav_num if(mastertask) write(logunit,*)'Advertising To Xwav ',trim(fldsToWav(n)%stdname) call NUOPC_Advertise(importState, standardName=fldsToWav(n)%stdname, & TransferOfferGeomObject='will provide', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo - - allocate(d2x(FldsFrWav_num,lsize)); d2x(:,:) = 0._r8 - allocate(x2d(FldsToWav_num,lsize)); x2d(:,:) = 0._r8 end if call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return + !---------------------------------------------------------------------------- ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine InitializeAdvertise @@ -230,6 +221,8 @@ end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + + ! input/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -239,10 +232,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_Mesh) :: Emesh integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - integer :: n character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' - !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -253,17 +243,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- ! generate the mesh - ! grid_option specifies grid or mesh !-------------------------------- - call shr_nuopc_grid_MeshInit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + call dead_meshinit(gcomp, nxg, nyg, gindex, lon, lat, Emesh, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! realize the actively coupled fields, now that a mesh is established @@ -279,7 +266,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':dwavExport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call fld_list_realize( & state=importState, & @@ -289,40 +276,30 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) flds_scalar_num=flds_scalar_num, & tag=subname//':dwavImport',& mesh=Emesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Pack export state - ! Copy from d2x to exportState - ! Set the coupling scalars !-------------------------------- - do n = 1, FldsFrWav_num - if (fldsFrWav(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrWav(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - if (my_task == master_task) then - call Print_FieldExchInfo(values=d2x, logunit=logunit, & - fldlist=fldsFrWav, nflds=fldsFrWav_num, istr="InitializeRealize: wav->mediator") - end if call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif #ifdef USE_ESMF_METADATA @@ -338,7 +315,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_AttributeSet(comp, "ModelType", "Wave", convention=convCIM, purpose=purpComp, rc=rc) #endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -348,25 +324,25 @@ end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc ! local variables type(ESMF_Clock) :: clock type(ESMF_State) :: exportState - integer :: n integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) call shr_nuopc_memcheck(subname, 3, mastertask) + call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -374,16 +350,10 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call dead_run_nuopc('wav', d2x, gbuf) + if (chkerr(rc,__LINE__,u_FILE_u)) return - do n = 1, FldsFrWav_num - if (fldsFrWav(n)%stdname /= flds_scalar_name) then - call state_setexport(exportState, trim(fldsFrWav(n)%stdname), d2x(n,:), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end do + call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics @@ -391,13 +361,12 @@ subroutine ModelAdvance(gcomp, rc) if (dbug > 1) then call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (my_task == master_task) then + if (chkerr(rc,__LINE__,u_FILE_u)) return + if ( mastertask) then call shr_nuopc_log_clock_advance(clock, 'WAV', logunit) endif endif - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) @@ -406,6 +375,91 @@ end subroutine ModelAdvance !=============================================================================== + subroutine state_setexport(exportState, rc) + + ! input/output variables + type(ESMF_State) , intent(inout) :: exportState + integer , intent(out) :: rc + + ! local variables + integer :: nf, nind, nfstart, ubound + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + nfstart = 0 ! for fields that have ubound > 0 + do nf = 2,fldsFrWav_num ! Start from index 2 in order to skip the scalar field + ubound = fldsFrWav(nf)%ungridded_ubound + if (ubound == 0) then + call field_setexport(exportState, trim(fldsFrWav(nf)%stdname), lon, lat, nf=nf, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + nfstart = nfstart + nf + ubound - 1 + do nind = 1,ubound + call field_setexport(exportState, trim(fldsFrWav(nf)%stdname), lon, lat, nf=nfstart+nind-1, & + ungridded_index=nind, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + end if + end do + + end subroutine state_setexport + + !=============================================================================== + + subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) + + use shr_const_mod , only : pi=>shr_const_pi + + ! intput/otuput variables + type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: fldname + real(r8) , intent(in) :: lon(:) + real(r8) , intent(in) :: lat(:) + integer , intent(in) :: nf + integer, optional , intent(in) :: ungridded_index + integer , intent(out) :: rc + + ! local variables + integer :: i, ncomp + type(ESMF_Field) :: lfield + real(r8), pointer :: data1d(:) + real(r8), pointer :: data2d(:,:) + !-------------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ncomp = 7 + if (present(ungridded_index)) then + call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (gridToFieldMap == 1) then + do i = 1,size(data2d, dim=1) + data2d(i,ungridded_index) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + else if (gridToFieldMap == 2) then + do i = 1,size(data2d, dim=2) + data2d(ungridded_index,i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + else + call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do i = 1,size(data1d) + data1d(i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & + sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) + end do + end if + + end subroutine field_setexport + + !=============================================================================== + subroutine ModelFinalize(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc diff --git a/src/drivers/mct/cime_config/buildexe b/src/drivers/mct/cime_config/buildexe index 5e13c62166b..288f93f4d21 100755 --- a/src/drivers/mct/cime_config/buildexe +++ b/src/drivers/mct/cime_config/buildexe @@ -31,8 +31,13 @@ def _main_func(): gmake = case.get_value("GMAKE") gmake_j = case.get_value("GMAKE_J") num_esp = case.get_value("NUM_COMP_INST_ESP") + ocn_model = case.get_value("COMP_OCN") + atm_model = case.get_value("COMP_ATM") gmake_opts = get_standard_makefile_args(case) + if ocn_model == 'mom' or atm_model == "fv3gfs": + gmake_opts += "USE_FMS=TRUE" + expect((num_esp is None) or (int(num_esp) == 1), "ESP component restricted to one instance") diff --git a/src/drivers/mct/cime_config/config_component.xml b/src/drivers/mct/cime_config/config_component.xml index d916bcdbfcc..d3fb65a3e2e 100644 --- a/src/drivers/mct/cime_config/config_component.xml +++ b/src/drivers/mct/cime_config/config_component.xml @@ -11,7 +11,7 @@ char - CPL,ATM,LND,ICE,OCN,ROF,GLC,WAV,ESP + CPL,ATM,LND,ICE,OCN,ROF,GLC,WAV,IAC,ESP env_case.xml case_comp List of component classes supported by this driver @@ -408,6 +408,7 @@ FALSE FALSE FALSE + FALSE @@ -1109,6 +1110,30 @@ number of wav cells in j direction - DO NOT EDIT (for experts only) + + char + UNSET + build_grid + env_build.xml + iac model (iac) grid + + + + integer + 0 + build_grid + env_build.xml + number of iac cells in i direction - DO NOT EDIT (for experts only) + + + + integer + 0 + build_grid + env_build.xml + number of iac cells in j direction - DO NOT EDIT (for experts only) + + char UNSET @@ -1210,6 +1235,22 @@ path of wav domain file + + char + UNSET + run_domain + env_run.xml + iac domain file + + + + char + $DIN_LOC_ROOT/share/domains + run_domain + env_run.xml + path of iac domain file + + char UNSET @@ -1690,6 +1731,74 @@ wav2ocn state mapping file decomp type + + char + idmap + run_domain + env_run.xml + iac2atm flux mapping file + + + + char + X,Y + X + run_domain + env_run.xml + iac2atm flux mapping file decomp type + + + + char + idmap + run_domain + env_run.xml + iac2atm state mapping file + + + + char + X,Y + X + run_domain + env_run.xml + iac2atm state mapping file decomp type + + + + char + idmap + run_domain + env_run.xml + iac2lnd flux mapping file + + + + char + X,Y + X + run_domain + env_run.xml + iac2lnd flux mapping file decomp type + + + + char + idmap + run_domain + env_run.xml + iac2lnd state mapping file + + + + char + X,Y + X + run_domain + env_run.xml + iac2lnd state mapping file decomp type + + char none,npfix,cart3d,cart3d_diag,cart3d_uvw,cart3d_uvw_diag @@ -1924,6 +2033,7 @@ $MAX_MPITASKS_PER_NODE $MAX_MPITASKS_PER_NODE $MAX_MPITASKS_PER_NODE + $MAX_MPITASKS_PER_NODE mach_pes env_mach_pes.xml @@ -1941,6 +2051,7 @@ 0 0 0 + 0 mach_pes env_mach_pes.xml @@ -1959,6 +2070,7 @@ 1 1 1 + 1 mach_pes env_mach_pes.xml @@ -1977,6 +2089,7 @@ 0 0 0 + 0 mach_pes env_mach_pes.xml @@ -2006,6 +2119,7 @@ 1 1 1 + 1 mach_pes env_mach_pes.xml @@ -2026,6 +2140,7 @@ concurrent concurrent concurrent + concurrent mach_pes env_mach_pes.xml @@ -2044,6 +2159,7 @@ 1 1 1 + 1 mach_pes env_mach_pes.xml @@ -2228,6 +2344,7 @@ default default default + default @@ -2249,6 +2366,7 @@ 64bit_offset 64bit_offset 64bit_offset + 64bit_offset @@ -2270,6 +2388,7 @@ + @@ -2290,6 +2409,7 @@ + @@ -2308,6 +2428,7 @@ 1 1 1 + 1 @@ -2329,6 +2450,7 @@ -99 -99 -99 + -99 @@ -2596,6 +2718,7 @@ FALSE FALSE FALSE + FALSE diff --git a/src/drivers/mct/cime_config/config_component_e3sm.xml b/src/drivers/mct/cime_config/config_component_e3sm.xml index aafd3b4a0ff..7da2b682fc0 100644 --- a/src/drivers/mct/cime_config/config_component_e3sm.xml +++ b/src/drivers/mct/cime_config/config_component_e3sm.xml @@ -496,6 +496,15 @@ where basedt is equal to NCPL_BASE_PERIOD in seconds. + + integer + $ATM_NCPL + run_coupling + env_run.xml + Number of iac coupling intervals per NCPL_BASE_PERIOD. + This is used to set the driver namelist iac_cpl_dt, equal to basedt/IAC_NCPL + where basedt is equal to NCPL_BASE_PERIOD in seconds. + diff --git a/src/drivers/mct/cime_config/config_compsets.xml b/src/drivers/mct/cime_config/config_compsets.xml index 612c44949f0..0386fbfa072 100644 --- a/src/drivers/mct/cime_config/config_compsets.xml +++ b/src/drivers/mct/cime_config/config_compsets.xml @@ -24,6 +24,7 @@ ROF = [DROF, SROF, XROF] GLC = [ SGLC ] WAV = [DWAV, SWAV ] + IAC = [ SIAC ] ESP = [DESP, SESP ] The OPTIONAL %phys attributes specify submodes of the given system @@ -40,7 +41,7 @@ A - 2000_DATM%NYF_SLND_DICE%SSMI_DOCN%DOM_DROF%NYF_SGLC_SWAV + 2000_DATM%NYF_SLND_DICE%SSMI_DOCN%DOM_DROF%NYF_SGLC_SWAV_SIAC diff --git a/src/drivers/mct/cime_config/config_pes.xml b/src/drivers/mct/cime_config/config_pes.xml index ad332b3ff03..db4bebb81a7 100644 --- a/src/drivers/mct/cime_config/config_pes.xml +++ b/src/drivers/mct/cime_config/config_pes.xml @@ -14,7 +14,8 @@ -1 -1 -1 - -1 + -1 + -1 -1 @@ -24,7 +25,8 @@ 1 1 1 - 1 + 1 + 1 1 1 @@ -36,7 +38,8 @@ 0 0 0 - 0 + 0 + 0 0 diff --git a/src/drivers/mct/cime_config/namelist_definition_drv.xml b/src/drivers/mct/cime_config/namelist_definition_drv.xml index 0f0e779377a..f63c78459ee 100644 --- a/src/drivers/mct/cime_config/namelist_definition_drv.xml +++ b/src/drivers/mct/cime_config/namelist_definition_drv.xml @@ -812,6 +812,18 @@ + + char + mapping + seq_infodata_inparm + + IAC_GRID values passed into driver. + + + $IAC_GRID + + + logical mapping @@ -1286,6 +1298,19 @@ + + logical + history + seq_infodata_inparm + + writes iac fields in coupler average history files. + default: true + + + .true. + + + logical history @@ -1622,6 +1647,19 @@ + + integer + time + seq_timemgr_inparm + + iac coupling interval in seconds + set via IAC_NCPL in env_run.xml. + IAC_NCPL is the number of times the iac is coupled per NCPL_BASE_PERIOD + NCPL_BASE_PERIOD is also set in env_run.xml and is the base period + associated with NCPL coupling frequency, nad has valid values: hour,day,year,decade + + + integer time @@ -1711,6 +1749,18 @@ + + integer + time + seq_timemgr_inparm + + iac coupling interval offset in seconds default: 0 + + + 0 + + + integer time @@ -2192,6 +2242,18 @@ + + logical + time + seq_timemgr_inparm + + Whether Pause signals are active for component iac + + + $PAUSE_ACTIVE_IAC + + + logical time @@ -2691,6 +2753,71 @@ + + integer + cime_pes + cime_pes + + the number of mpi tasks assigned to the iac components. + set by NTASKS_IAC in env_configure.xml. + + + $NTASKS_IAC + + + + + integer + cime_pes + cime_pes + + the number of threads per mpi task for the iac component. + set by NTHRDS_IAC in env_configure.xml. + + + $NTHRDS_IAC + + + + + integer + cime_pes + cime_pes + + the global mpi task rank of the root processor assigned to the iac component. + set by ROOTPE_IAC in env_configure.xml. + + + $ROOTPE_IAC + + + + + integer + cime_pes + cime_pes + + the mpi global processors stride associated with the mpi tasks for the iac component. + set by PSTRID_IAC in env_configure.xml. + + + $PSTRID_IAC + + + + + char + cime_pes + cime_pes + concurrent,sequential + + Layout of multi-instance iacs (if there are more than 1) + + + $NINST_IAC_LAYOUT + + + integer cime_pes @@ -4174,6 +4301,126 @@ + + char + mapping + abs + seq_maps + + iac to atm mapping file for fluxes + + + $IAC2ATM_FMAPNAME + + + + + char + mapping + seq_maps + + The type of mapping desired, either "source" or "destination" mapping. + X is associated with rearrangement of the source grid to the + destination grid and then local mapping. Y is associated with mapping + on the source grid and then rearrangement and sum to the destination + grid. + + + $IAC2ATM_FMAPTYPE + X + + + + + char + mapping + abs + seq_maps + + iac to atm mapping file for states + + + $IAC2ATM_SMAPNAME + + + + + char + mapping + seq_maps + + The type of mapping desired, either "source" or "destination" mapping. + X is associated with rearrangement of the source grid to the + destination grid and then local mapping. Y is associated with mapping + on the source grid and then rearrangement and sum to the destination + grid. + + + $IAC2ATM_SMAPTYPE + X + + + + + char + mapping + abs + seq_maps + + iac to lnd mapping file for fluxes + + + $IAC2LND_FMAPNAME + + + + + char + mapping + seq_maps + + The type of mapping desired, either "source" or "destination" mapping. + X is associated with rearrangement of the source grid to the + destination grid and then local mapping. Y is associated with mapping + on the source grid and then rearrangement and sum to the destination + grid. + + + $IAC2LND_FMAPTYPE + X + + + + + char + mapping + abs + seq_maps + + iac to lnd mapping file for states + + + $IAC2LND_SMAPNAME + + + + + char + mapping + seq_maps + + The type of mapping desired, either "source" or "destination" mapping. + X is associated with rearrangement of the source grid to the + destination grid and then local mapping. Y is associated with mapping + on the source grid and then rearrangement and sum to the destination + grid. + + + $IAC2LND_SMAPTYPE + X + + + logical data_assimilation @@ -4222,6 +4469,18 @@ + + logical + data_assimilation + seq_timemgr_inparm + + Whether Data Assimilation is on for component iac + + + $DATA_ASSIMILATION_IAC + + + logical data_assimilation diff --git a/src/drivers/mct/cime_config/namelist_definition_modelio.xml b/src/drivers/mct/cime_config/namelist_definition_modelio.xml index ea5d47f0a4a..660bc93dee3 100644 --- a/src/drivers/mct/cime_config/namelist_definition_modelio.xml +++ b/src/drivers/mct/cime_config/namelist_definition_modelio.xml @@ -60,6 +60,7 @@ $ROF_PIO_STRIDE $GLC_PIO_STRIDE $WAV_PIO_STRIDE + $IAC_PIO_STRIDE -99 @@ -80,6 +81,7 @@ $ROF_PIO_ROOT $GLC_PIO_ROOT $WAV_PIO_ROOT + $IAC_PIO_ROOT -99 @@ -101,6 +103,7 @@ $ROF_PIO_REARRANGER $GLC_PIO_REARRANGER $WAV_PIO_REARRANGER + $IAC_PIO_REARRANGER -99 @@ -121,6 +124,7 @@ $ROF_PIO_NUMTASKS $GLC_PIO_NUMTASKS $WAV_PIO_NUMTASKS + $IAC_PIO_NUMTASKS -99 @@ -143,6 +147,7 @@ $ROF_PIO_TYPENAME $GLC_PIO_TYPENAME $WAV_PIO_TYPENAME + $IAC_PIO_TYPENAME nothing @@ -166,6 +171,7 @@ $ROF_PIO_NETCDF_FORMAT $GLC_PIO_NETCDF_FORMAT $WAV_PIO_NETCDF_FORMAT + $IAC_PIO_NETCDF_FORMAT diff --git a/src/drivers/mct/main/cime_comp_mod.F90 b/src/drivers/mct/main/cime_comp_mod.F90 index 6a59ca1fc5d..a0831467fe3 100644 --- a/src/drivers/mct/main/cime_comp_mod.F90 +++ b/src/drivers/mct/main/cime_comp_mod.F90 @@ -54,6 +54,7 @@ module cime_comp_mod use wav_comp_mct , only: wav_init=>wav_init_mct, wav_run=>wav_run_mct, wav_final=>wav_final_mct use rof_comp_mct , only: rof_init=>rof_init_mct, rof_run=>rof_run_mct, rof_final=>rof_final_mct use esp_comp_mct , only: esp_init=>esp_init_mct, esp_run=>esp_run_mct, esp_final=>esp_final_mct + use iac_comp_mct , only: iac_init=>iac_init_mct, iac_run=>iac_run_mct, iac_final=>iac_final_mct !---------------------------------------------------------------------------- ! cpl7 modules @@ -66,9 +67,11 @@ module cime_comp_mod use seq_comm_mct, only: CPLALLATMID,CPLALLLNDID,CPLALLOCNID,CPLALLICEID use seq_comm_mct, only: CPLALLGLCID,CPLALLROFID,CPLALLWAVID,CPLALLESPID use seq_comm_mct, only: CPLATMID,CPLLNDID,CPLOCNID,CPLICEID,CPLGLCID,CPLROFID,CPLWAVID,CPLESPID + use seq_comm_mct, only: IACID, ALLIACID, CPLALLIACID, CPLIACID use seq_comm_mct, only: num_inst_atm, num_inst_lnd, num_inst_rof use seq_comm_mct, only: num_inst_ocn, num_inst_ice, num_inst_glc use seq_comm_mct, only: num_inst_wav, num_inst_esp + use seq_comm_mct, only: num_inst_iac use seq_comm_mct, only: num_inst_xao, num_inst_frc, num_inst_phys use seq_comm_mct, only: num_inst_total, num_inst_max use seq_comm_mct, only: seq_comm_iamin, seq_comm_name, seq_comm_namelen @@ -101,6 +104,7 @@ module cime_comp_mod use seq_timemgr_mod, only: seq_timemgr_alarm_rofrun use seq_timemgr_mod, only: seq_timemgr_alarm_wavrun use seq_timemgr_mod, only: seq_timemgr_alarm_esprun + use seq_timemgr_mod, only: seq_timemgr_alarm_iacrun use seq_timemgr_mod, only: seq_timemgr_alarm_barrier use seq_timemgr_mod, only: seq_timemgr_alarm_pause use seq_timemgr_mod, only: seq_timemgr_pause_active @@ -149,12 +153,13 @@ module cime_comp_mod use seq_flds_mod, only : seq_flds_w2x_fluxes, seq_flds_x2w_fluxes use seq_flds_mod, only : seq_flds_r2x_fluxes, seq_flds_x2r_fluxes use seq_flds_mod, only : seq_flds_set + use seq_flds_mod, only : seq_flds_z2x_fluxes, seq_flds_x2z_fluxes ! component type and accessor functions use component_type_mod, only: component_get_iamin_compid, component_get_suffix use component_type_mod, only: component_get_iamroot_compid use component_type_mod, only: component_get_name, component_get_c2x_cx - use component_type_mod, only: atm, lnd, ice, ocn, rof, glc, wav, esp + use component_type_mod, only: atm, lnd, ice, ocn, rof, glc, wav, esp, iac use component_mod, only: component_init_pre use component_mod, only: component_init_cc, component_init_cx use component_mod, only: component_run, component_final @@ -170,6 +175,7 @@ module cime_comp_mod use prep_ocn_mod use prep_atm_mod use prep_aoflux_mod + use prep_iac_mod !--- mapping routines --- use seq_map_type_mod @@ -214,6 +220,8 @@ module cime_comp_mod private :: cime_run_ice_recv_post private :: cime_run_wav_setup_send private :: cime_run_wav_recv_post + private :: cime_run_iac_setup_send + private :: cime_run_iac_recv_post private :: cime_run_update_fractions private :: cime_run_calc_budgets1 private :: cime_run_calc_budgets2 @@ -253,6 +261,7 @@ module cime_comp_mod type(mct_aVect) , pointer :: fractions_gx(:) ! Fractions on glc grid, cpl processes type(mct_aVect) , pointer :: fractions_rx(:) ! Fractions on rof grid, cpl processes type(mct_aVect) , pointer :: fractions_wx(:) ! Fractions on wav grid, cpl processes + type(mct_aVect) , pointer :: fractions_zx(:) ! Fractions on iac grid, cpl processes !--- domain equivalent 2d grid size --- integer :: atm_nx, atm_ny ! nx, ny of 2d grid, if known @@ -262,6 +271,7 @@ module cime_comp_mod integer :: rof_nx, rof_ny integer :: glc_nx, glc_ny integer :: wav_nx, wav_ny + integer :: iac_nx, iac_ny !---------------------------------------------------------------------------- ! Infodata: inter-model control flags, domain info @@ -283,6 +293,7 @@ module cime_comp_mod type (ESMF_Clock), target :: EClock_r ! rof clock type (ESMF_Clock), target :: EClock_w ! wav clock type (ESMF_Clock), target :: EClock_e ! esp clock + type (ESMF_Clock), target :: EClock_z ! iac clock logical :: restart_alarm ! restart alarm logical :: history_alarm ! history alarm @@ -298,6 +309,7 @@ module cime_comp_mod logical :: rofrun_alarm ! rof run alarm logical :: wavrun_alarm ! wav run alarm logical :: esprun_alarm ! esp run alarm + logical :: iacrun_alarm ! iac run alarm logical :: tprof_alarm ! timing profile alarm logical :: barrier_alarm ! barrier alarm logical :: t1hr_alarm ! alarm every hour @@ -379,6 +391,7 @@ module cime_comp_mod logical :: flood_present ! .true. => rof is computing flood logical :: wav_present ! .true. => wav is present logical :: esp_present ! .true. => esp is present + logical :: iac_present ! .true. => iac is present logical :: atm_prognostic ! .true. => atm comp expects input logical :: lnd_prognostic ! .true. => lnd comp expects input @@ -390,6 +403,7 @@ module cime_comp_mod logical :: rof_prognostic ! .true. => rof comp expects input logical :: wav_prognostic ! .true. => wav comp expects input logical :: esp_prognostic ! .true. => esp comp expects input + logical :: iac_prognostic ! .true. => iac comp expects input logical :: atm_c2_lnd ! .true. => atm to lnd coupling on logical :: atm_c2_ocn ! .true. => atm to ocn coupling on @@ -412,6 +426,10 @@ module cime_comp_mod logical :: glc_c2_ice ! .true. => glc to ice coupling on logical :: wav_c2_ocn ! .true. => wav to ocn coupling on + logical :: iac_c2_lnd ! .true. => iac to lnd coupling on + logical :: iac_c2_atm ! .true. => iac to atm coupling on + logical :: lnd_c2_iac ! .true. => lnd to iac coupling on + logical :: dead_comps ! .true. => dead components logical :: esmf_map_flag ! .true. => use esmf for mapping @@ -438,6 +456,7 @@ module cime_comp_mod character(CL) :: rof_gnam ! rof grid character(CL) :: glc_gnam ! glc grid character(CL) :: wav_gnam ! wav grid + character(CL) :: iac_gnam ! iac grid logical :: samegrid_ao ! samegrid atm and ocean logical :: samegrid_al ! samegrid atm and land @@ -450,6 +469,7 @@ module cime_comp_mod logical :: samegrid_og ! samegrid glc and ocean logical :: samegrid_ig ! samegrid glc and ice logical :: samegrid_alo ! samegrid atm, lnd, ocean + logical :: samegrid_zl ! samegrid iac and land logical :: read_restart ! local read restart flag character(CL) :: rest_file ! restart file path + filename @@ -537,6 +557,7 @@ module cime_comp_mod integer :: nthreads_ROFID ! OMP glc number of threads integer :: nthreads_WAVID ! OMP wav number of threads integer :: nthreads_ESPID ! OMP esp number of threads + integer :: nthreads_IACID ! OMP iac number of threads integer :: pethreads_GLOID ! OMP number of threads per task @@ -557,6 +578,7 @@ module cime_comp_mod integer :: mpicom_CPLALLGLCID ! MPI comm for CPLALLGLCID integer :: mpicom_CPLALLROFID ! MPI comm for CPLALLROFID integer :: mpicom_CPLALLWAVID ! MPI comm for CPLALLWAVID + integer :: mpicom_CPLALLIACID ! MPI comm for CPLALLIACID integer :: iam_GLOID ! pe number in global id logical :: iamin_CPLID ! pe associated with CPLID @@ -570,6 +592,7 @@ module cime_comp_mod logical :: iamin_CPLALLGLCID ! pe associated with CPLALLGLCID logical :: iamin_CPLALLROFID ! pe associated with CPLALLROFID logical :: iamin_CPLALLWAVID ! pe associated with CPLALLWAVID + logical :: iamin_CPLALLIACID ! pe associated with CPLALLIACID !---------------------------------------------------------------------------- @@ -592,6 +615,7 @@ module cime_comp_mod integer, parameter :: comp_num_rof = 6 integer, parameter :: comp_num_wav = 7 integer, parameter :: comp_num_esp = 8 + integer, parameter :: comp_num_iac = 9 !---------------------------------------------------------------------------- ! misc @@ -599,7 +623,7 @@ module cime_comp_mod integer, parameter :: ens1=1 ! use first instance of ensemble only integer, parameter :: fix1=1 ! temporary hard-coding to first ensemble, needs to be fixed - integer :: eai, eli, eoi, eii, egi, eri, ewi, eei, exi, efi ! component instance counters + integer :: eai, eli, eoi, eii, egi, eri, ewi, eei, exi, efi, ezi ! component instance counters !---------------------------------------------------------------------------- ! formats @@ -770,7 +794,23 @@ subroutine cime_pre_init1(esmf_log_option) call seq_comm_getinfo(CPLALLWAVID, mpicom=mpicom_CPLALLWAVID) iamin_CPLALLWAVID = seq_comm_iamin(CPLALLWAVID) - do eei = 1,num_inst_esp + ! IAC mods + do ezi = 1,num_inst_iac + it=it+1 + comp_id(it) = IACID(ezi) + comp_iamin(it) = seq_comm_iamin(comp_id(it)) + comp_name(it) = seq_comm_name(comp_id(it)) + call seq_comm_getinfo(IACID(ezi), mpicom=comp_comm(it), & + nthreads=nthreads_IACID, iam=comp_comm_iam(it)) + if (seq_comm_iamin(IACID(ezi))) then + complist = trim(complist)//' '//trim(seq_comm_name(IACID(ezi))) + endif + if (seq_comm_iamroot(IACID(ezi))) output_perf = .true. + enddo + call seq_comm_getinfo(CPLALLIACID, mpicom=mpicom_CPLALLIACID) + iamin_CPLALLIACID = seq_comm_iamin(CPLALLIACID) + + do eei = 1,num_inst_esp it=it+1 comp_id(it) = ESPID(eei) comp_iamin(it) = seq_comm_iamin(comp_id(it)) @@ -931,10 +971,11 @@ subroutine cime_pre_init2() !---------------------------------------------------------- !| Timer initialization (has to be after mpi init) !---------------------------------------------------------- + maxthreads = max(nthreads_GLOID,nthreads_CPLID,nthreads_ATMID, & nthreads_LNDID,nthreads_ICEID,nthreads_OCNID,nthreads_GLCID, & - nthreads_ROFID, nthreads_WAVID, nthreads_ESPID, pethreads_GLOID ) - + nthreads_ROFID, nthreads_WAVID, nthreads_ESPID, nthreads_IACID, & + pethreads_GLOID ) call t_initf(NLFileName, LogPrint=.true., mpicom=mpicom_GLOID, & MasterTask=iamroot_GLOID,MaxThreads=maxthreads) @@ -1000,6 +1041,7 @@ subroutine cime_pre_init2() rof_present=rof_present , & wav_present=wav_present , & esp_present=esp_present , & + iac_present=iac_present , & single_column=single_column , & aqua_planet=aqua_planet , & cpl_seq_option=cpl_seq_option , & @@ -1033,6 +1075,7 @@ subroutine cime_pre_init2() rof_gnam=rof_gnam , & glc_gnam=glc_gnam , & wav_gnam=wav_gnam , & + iac_gnam=iac_gnam , & tfreeze_option = tfreeze_option , & cpl_decomp=seq_mctext_decomp , & shr_map_dopole=shr_map_dopole , & @@ -1104,6 +1147,9 @@ subroutine cime_pre_init2() call seq_comm_setnthreads(nthreads_ESPID) if (iamroot_GLOID) write(logunit,'(2A,2I4)') subname,' nthreads_ESPID = ',& nthreads_ESPID,seq_comm_getnthreads() + call seq_comm_setnthreads(nthreads_IACID) + if (iamroot_GLOID) write(logunit,'(2A,2I4)') subname,' nthreads_IACID = ',& + nthreads_IACID,seq_comm_getnthreads() if (iamroot_GLOID) write(logunit,*) ' ' call seq_comm_setnthreads(nthreads_GLOID) @@ -1116,7 +1162,8 @@ subroutine cime_pre_init2() call seq_timemgr_clockInit(seq_SyncClock, nlfilename, & read_restart, rest_file, pioid, mpicom_gloid, & EClock_d, EClock_a, EClock_l, EClock_o, & - EClock_i, Eclock_g, Eclock_r, Eclock_w, Eclock_e) + EClock_i, Eclock_g, Eclock_r, Eclock_w, Eclock_e, & + EClock_z) if (iamroot_CPLID) then call seq_timemgr_clockPrint(seq_SyncClock) @@ -1194,6 +1241,7 @@ subroutine cime_pre_init2() ice_phase=1, & glc_phase=1, & wav_phase=1, & + iac_phase=1, & esp_phase=1) !---------------------------------------------------------- @@ -1257,7 +1305,7 @@ subroutine cime_init() call t_startf('CPL:init_comps') if (iamroot_CPLID )then write(logunit,*) ' ' - write(logunit,F00) 'Initialize each component: atm, lnd, rof, ocn, ice, glc, wav, esp' + write(logunit,F00) 'Initialize each component: atm, lnd, rof, ocn, ice, glc, wav, esp, iac' call shr_sys_flush(logunit) endif @@ -1270,6 +1318,8 @@ subroutine cime_init() call component_init_pre(glc, GLCID, CPLGLCID, CPLALLGLCID, infodata, ntype='glc') call component_init_pre(wav, WAVID, CPLWAVID, CPLALLWAVID, infodata, ntype='wav') call component_init_pre(esp, ESPID, CPLESPID, CPLALLESPID, infodata, ntype='esp') + call component_init_pre(iac, IACID, CPLIACID, CPLALLIACID, infodata, ntype='iac') + call t_stopf('CPL:comp_init_pre_all') call t_startf('CPL:comp_init_cc_atm') @@ -1321,6 +1371,12 @@ subroutine cime_init() call t_adj_detailf(-2) call t_stopf('CPL:comp_init_cc_esp') + call t_startf('comp_init_cc_iac') + call t_adj_detailf(+2) + call component_init_cc(Eclock_z, iac, iac_init, infodata, NLFilename) + call t_adj_detailf(-2) + call t_stopf('comp_init_cc_iac') + call t_startf('CPL:comp_init_cx_all') call t_adj_detailf(+2) call component_init_cx(atm, infodata) @@ -1330,6 +1386,7 @@ subroutine cime_init() call component_init_cx(ice, infodata) call component_init_cx(glc, infodata) call component_init_cx(wav, infodata) + call component_init_cx(iac, infodata) call t_adj_detailf(-2) call t_stopf('CPL:comp_init_cx_all') @@ -1383,6 +1440,14 @@ subroutine cime_init() endif enddo + do ezi = 1,num_inst_iac + iamin_ID = component_get_iamin_compid(iac(ezi)) + if (iamin_ID) then + compname = component_get_name(iac(ezi)) + complist = trim(complist)//' '//trim(compname) + endif + enddo + do eei = 1,num_inst_esp iamin_ID = component_get_iamin_compid(esp(eei)) if (iamin_ID) then @@ -1406,6 +1471,7 @@ subroutine cime_init() if (iamin_CPLALLGLCID) call seq_infodata_exchange(infodata,CPLALLGLCID,'cpl2glc_init') if (iamin_CPLALLROFID) call seq_infodata_exchange(infodata,CPLALLROFID,'cpl2rof_init') if (iamin_CPLALLWAVID) call seq_infodata_exchange(infodata,CPLALLWAVID,'cpl2wav_init') + if (iamin_CPLALLIACID) call seq_infodata_exchange(infodata,CPLALLIACID,'cpl2iac_init') if (iamroot_CPLID) then write(logunit,F00) 'Determine final settings for presence of surface components' @@ -1424,6 +1490,7 @@ subroutine cime_init() rof_present=rof_present, & rofice_present=rofice_present, & wav_present=wav_present, & + iac_present=iac_present, & esp_present=esp_present, & flood_present=flood_present, & atm_prognostic=atm_prognostic, & @@ -1435,6 +1502,7 @@ subroutine cime_init() glc_prognostic=glc_prognostic, & rof_prognostic=rof_prognostic, & wav_prognostic=wav_prognostic, & + iac_prognostic=iac_prognostic, & esp_prognostic=esp_prognostic, & dead_comps=dead_comps, & esmf_map_flag=esmf_map_flag, & @@ -1445,6 +1513,7 @@ subroutine cime_init() glc_nx=glc_nx, glc_ny=glc_ny, & ocn_nx=ocn_nx, ocn_ny=ocn_ny, & wav_nx=wav_nx, wav_ny=wav_ny, & + iac_nx=iac_nx, iac_ny=iac_ny, & atm_aero=atm_aero ) ! derive samegrid flags @@ -1498,6 +1567,9 @@ subroutine cime_init() glc_c2_ocn = .false. glc_c2_ice = .false. wav_c2_ocn = .false. + iac_c2_atm = .false. + iac_c2_lnd = .false. + lnd_c2_iac = .false. if (atm_present) then if (lnd_prognostic) atm_c2_lnd = .true. @@ -1510,6 +1582,7 @@ subroutine cime_init() if (atm_prognostic) lnd_c2_atm = .true. if (rof_prognostic) lnd_c2_rof = .true. if (glc_prognostic) lnd_c2_glc = .true. + if (iac_prognostic) lnd_c2_iac = .true. endif if (ocn_present) then if (atm_prognostic) ocn_c2_atm = .true. @@ -1535,6 +1608,10 @@ subroutine cime_init() if (wav_present) then if (ocn_prognostic) wav_c2_ocn = .true. endif + if (iac_present) then + if (lnd_prognostic) iac_c2_lnd = .true. + if (atm_prognostic) iac_c2_atm = .true. + endif !---------------------------------------------------------- ! Set domain check and other flag @@ -1580,6 +1657,7 @@ subroutine cime_init() write(logunit,F0L)'rof/ice present = ',rofice_present write(logunit,F0L)'rof/flood present = ',flood_present write(logunit,F0L)'wav model present = ',wav_present + write(logunit,F0L)'iac model present = ',iac_present write(logunit,F0L)'esp model present = ',esp_present write(logunit,F0L)'atm model prognostic = ',atm_prognostic @@ -1591,6 +1669,7 @@ subroutine cime_init() write(logunit,F0L)'rof model prognostic = ',rof_prognostic write(logunit,F0L)'ocn rof prognostic = ',ocnrof_prognostic write(logunit,F0L)'wav model prognostic = ',wav_prognostic + write(logunit,F0L)'iac model prognostic = ',iac_prognostic write(logunit,F0L)'esp model prognostic = ',esp_prognostic write(logunit,F0L)'atm_c2_lnd = ',atm_c2_lnd @@ -1613,6 +1692,8 @@ subroutine cime_init() write(logunit,F0L)'glc_c2_ocn = ',glc_c2_ocn write(logunit,F0L)'glc_c2_ice = ',glc_c2_ice write(logunit,F0L)'wav_c2_ocn = ',wav_c2_ocn + write(logunit,F0L)'iac_c2_lnd = ',iac_c2_lnd + write(logunit,F0L)'iac_c2_atm = ',iac_c2_atm write(logunit,F0L)'dead components = ',dead_comps write(logunit,F0L)'domain_check = ',domain_check @@ -1623,6 +1704,7 @@ subroutine cime_init() write(logunit,F01)'ocn_nx,ocn_ny = ',ocn_nx,ocn_ny,trim(ocn_gnam) write(logunit,F01)'glc_nx,glc_ny = ',glc_nx,glc_ny,trim(glc_gnam) write(logunit,F01)'wav_nx,wav_ny = ',wav_nx,wav_ny,trim(wav_gnam) + write(logunit,F01)'iac_nx,iac_ny = ',iac_nx,iac_ny,trim(iac_gnam) write(logunit,F0L)'samegrid_ao = ',samegrid_ao write(logunit,F0L)'samegrid_al = ',samegrid_al write(logunit,F0L)'samegrid_ro = ',samegrid_ro @@ -1667,6 +1749,9 @@ subroutine cime_init() if (esp_prognostic .and. .not.esp_present) then call shr_sys_abort(subname//' ERROR: if prognostic esp must also have esp present') endif + if (iac_prognostic .and. .not.iac_present) then + call shr_sys_abort(subname//' ERROR: if prognostic iac must also have iac present') + endif #ifndef CPL_BYPASS if ((ice_prognostic .or. ocn_prognostic .or. lnd_prognostic) .and. .not. atm_present) then call shr_sys_abort(subname//' ERROR: if prognostic surface model must also have atm present') @@ -1711,6 +1796,8 @@ subroutine cime_init() call shr_sys_abort(subname//' ERROR: rof_prognostic but num_inst_rof not num_inst_max') if (wav_prognostic .and. num_inst_wav /= num_inst_max) & call shr_sys_abort(subname//' ERROR: wav_prognostic but num_inst_wav not num_inst_max') + if (iac_prognostic .and. num_inst_iac /= num_inst_max) & + call shr_sys_abort(subname//' ERROR: iac_prognostic but num_inst_iac not num_inst_max') !---------------------------------------------------------- !| Initialize attribute vectors for prep_c2C_init_avs routines and fractions @@ -1723,9 +1810,9 @@ subroutine cime_init() call t_adj_detailf(+2) if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) - call prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm) + call prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_lnd) - call prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd) + call prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_lnd) call prep_ocn_init(infodata, atm_c2_ocn, atm_c2_ice, ice_c2_ocn, rof_c2_ocn, wav_c2_ocn, glc_c2_ocn) @@ -1737,6 +1824,8 @@ subroutine cime_init() call prep_wav_init(infodata, atm_c2_wav, ocn_c2_wav, ice_c2_wav) + call prep_iac_init(infodata, lnd_c2_iac) + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_adj_detailf(-2) call t_stopf('CPL:init_maps') @@ -1835,6 +1924,9 @@ subroutine cime_init() call mpi_barrier(mpicom_GLOID,ierr) if (wav_present) call component_init_areacor(wav, areafact_samegrid, seq_flds_w2x_fluxes) + call mpi_barrier(mpicom_GLOID,ierr) + if (iac_present) call component_init_areacor(iac, areafact_samegrid, seq_flds_z2x_fluxes) + call t_adj_detailf(-2) call t_stopf ('CPL:init_areacor') @@ -1875,6 +1967,10 @@ subroutine cime_init() call component_diag(infodata, wav, flow='c2x', comment='recv IC wav', & info_debug=info_debug) endif + if (iac_present) then + call component_diag(infodata, iac, flow='c2x', comment='recv IC iac', & + info_debug=info_debug) + endif if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_adj_detailf(-2) @@ -1896,6 +1992,7 @@ subroutine cime_init() allocate(fractions_gx(num_inst_frc)) allocate(fractions_rx(num_inst_frc)) allocate(fractions_wx(num_inst_frc)) + allocate(fractions_zx(num_inst_frc)) if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) do efi = 1,num_inst_frc @@ -1909,10 +2006,10 @@ subroutine cime_init() call seq_frac_init(infodata, & atm(ens1), ice(ens1), lnd(ens1), & ocn(ens1), glc(ens1), rof(ens1), & - wav(ens1), & + wav(ens1), iac(ens1), & fractions_ax(efi), fractions_ix(efi), fractions_lx(efi), & fractions_ox(efi), fractions_gx(efi), fractions_rx(efi), & - fractions_wx(efi)) + fractions_wx(efi), fractions_zx(efi)) if (iamroot_CPLID) then write(logunit,*) ' ' @@ -2103,9 +2200,9 @@ subroutine cime_init() call seq_diag_zero_mct(mode='all') if (read_restart .and. iamin_CPLID) then call seq_rest_read(rest_file, infodata, & - atm, lnd, ice, ocn, rof, glc, wav, esp, & + atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx) + fractions_rx, fractions_gx, fractions_wx, fractions_zx) endif call t_adj_detailf(-2) @@ -2152,9 +2249,9 @@ subroutine cime_init() call shr_sys_flush(logunit) endif call seq_hist_write(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, & + atm, lnd, ice, ocn, rof, glc, wav, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, trim(cpl_inst_tag)) + fractions_rx, fractions_gx, fractions_wx, fractions_zx, trim(cpl_inst_tag)) if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_adj_detailf(-2) @@ -2182,7 +2279,7 @@ subroutine cime_run() use shr_string_mod, only: shr_string_listGetIndexF use seq_comm_mct, only: atm_layout, lnd_layout, ice_layout use seq_comm_mct, only: glc_layout, rof_layout, ocn_layout - use seq_comm_mct, only: wav_layout, esp_layout, num_inst_driver + use seq_comm_mct, only: wav_layout, esp_layout, iac_layout, num_inst_driver use seq_comm_mct, only: seq_comm_inst use seq_pauseresume_mod, only: seq_resume_store_comp, seq_resume_get_files use seq_pauseresume_mod, only: seq_resume_free @@ -2262,6 +2359,7 @@ subroutine cime_run() esprun_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_esprun) ocnrun_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_ocnrun) ocnnext_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_ocnnext) + iacrun_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_iacrun) restart_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_restart) history_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_history) histavg_alarm = seq_timemgr_alarmIsOn(EClock_d,seq_timemgr_alarm_histavg) @@ -2350,7 +2448,7 @@ subroutine cime_run() write(logunit,102) ' Alarm_state: model date = ',ymd,tod, & ' aliogrw run alarms = ', atmrun_alarm, lndrun_alarm, & icerun_alarm, ocnrun_alarm, glcrun_alarm, & - rofrun_alarm, wavrun_alarm, esprun_alarm + rofrun_alarm, wavrun_alarm, esprun_alarm, iacrun_alarm write(logunit,102) ' Alarm_state: model date = ',ymd,tod, & ' 1.2.3.6.12.24 run alarms = ', t1hr_alarm, t2hr_alarm, & t3hr_alarm, t6hr_alarm, t12hr_alarm, t24hr_alarm @@ -2360,6 +2458,13 @@ subroutine cime_run() call t_stopf ('CPL:CLOCK_ADVANCE') + !---------------------------------------------------------- + !| IAC SETUP-SEND + !---------------------------------------------------------- + if (iac_present .and. iacrun_alarm) then + call cime_run_iac_setup_send() + endif + !---------------------------------------------------------- !| MAP ATM to OCN ! Set a2x_ox as a module variable in prep_ocn_mod @@ -2428,6 +2533,18 @@ subroutine cime_run() call cime_run_rof_setup_send() endif + !---------------------------------------------------------- + !| RUN IAC MODEL + !---------------------------------------------------------- + if (iac_present .and. iacrun_alarm) then + call component_run(Eclock_z, iac, iac_run, infodata, & + seq_flds_x2c_fluxes=seq_flds_x2z_fluxes, & + seq_flds_c2x_fluxes=seq_flds_z2x_fluxes, & + comp_prognostic=iac_prognostic, comp_num=comp_num_iac, & + timer_barrier= 'CPL:IAC_RUN_BARRIER', timer_comp_run='CPL:IAC_RUN', & + run_barriers=run_barriers, ymd=ymd, tod=tod,comp_layout=iac_layout) + endif + !---------------------------------------------------------- !| RUN ICE MODEL !---------------------------------------------------------- @@ -2490,6 +2607,13 @@ subroutine cime_run() endif end if + !---------------------------------------------------------- + !| IAC RECV-POST + !---------------------------------------------------------- + if (iac_present .and. iacrun_alarm) then + call cime_run_iac_recv_post() + endif + !---------------------------------------------------------- !| OCN RECV-POST (cesm1_mod_tight, nuopc_tight) !---------------------------------------------------------- @@ -2703,16 +2827,16 @@ subroutine cime_run() endif call seq_hist_write(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, & + atm, lnd, ice, ocn, rof, glc, wav, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, trim(cpl_inst_tag)) + fractions_rx, fractions_gx, fractions_wx, fractions_zx, trim(cpl_inst_tag)) if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) endif if (do_histavg) then call seq_hist_writeavg(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, histavg_alarm, & + atm, lnd, ice, ocn, rof, glc, wav, iac, histavg_alarm, & trim(cpl_inst_tag)) endif @@ -2986,9 +3110,9 @@ subroutine cime_run() end if if (iamin_CPLID) then call seq_rest_read(drv_resume, infodata, & - atm, lnd, ice, ocn, rof, glc, wav, esp, & + atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx) + fractions_rx, fractions_gx, fractions_wx, fractions_zx) end if ! Clear the resume file so we don't try to read it again drv_resume = ' ' @@ -3063,7 +3187,8 @@ subroutine cime_run() lnd(ens1)%iamroot_compid .or. & ice(ens1)%iamroot_compid .or. & glc(ens1)%iamroot_compid .or. & - wav(ens1)%iamroot_compid) then + wav(ens1)%iamroot_compid .or. & + iac(ens1)%iamroot_compid) then call shr_mem_getusage(msize,mrss,.true.) write(logunit,105) ' memory_write: model date = ',ymd,tod, & @@ -3169,6 +3294,7 @@ subroutine cime_final() call component_final(EClock_o, ocn, ocn_final) call component_final(EClock_g, glc, glc_final) call component_final(EClock_w, wav, wav_final) + call component_final(EClock_w, iac, iac_final) !------------------------------------------------------------------------ ! End the run cleanly @@ -3455,6 +3581,9 @@ subroutine cime_run_atm_setup_send() if (lnd_c2_atm) then call prep_atm_calc_l2x_ax(fractions_lx, timer='CPL:atmprep_lnd2atm') endif + if (iac_c2_atm) then + call prep_atm_calc_z2x_ax(fractions_zx, timer='CPL:atmprep_iac2atm') + endif if (associated(xao_ax)) then call prep_atm_mrg(infodata, fractions_ax, xao_ax=xao_ax, timer_mrg='CPL:atmprep_mrgx2a') endif @@ -3563,7 +3692,7 @@ subroutine cime_run_ocn_setup_send() end subroutine cime_run_ocn_setup_send -!---------------------------------------------------------------------------------- + !---------------------------------------------------------------------------------- subroutine cime_run_ocn_recv_post() @@ -3595,7 +3724,94 @@ subroutine cime_run_ocn_recv_post() end subroutine cime_run_ocn_recv_post -!---------------------------------------------------------------------------------- + !---------------------------------------------------------------------------------- + subroutine cime_run_iac_setup_send() + + !------------------------------------------------------- + ! | iac prep-merge + !------------------------------------------------------- + + if (iamin_CPLID .and. iac_prognostic) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:IACPREP_BARRIER') + + call t_drvstartf ('CPL:IACPREP', cplrun=.true., barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + ! Average our accumulators + call prep_iac_accum_avg(timer='CPL:iacprep_l2xavg') + + ! Setup lnd inputs on iac grid. Right now I think they will be the same + ! thing, but I'm trying to code for the general case + if (lnd_c2_iac) then + call prep_iac_calc_l2x_zx(timer='CPL:iacprep_lnd2iac') + endif + + + call prep_iac_mrg(infodata, fractions_zx, timer_mrg='CPL:iacprep_mrgx2z') + + call component_diag(infodata, iac, flow='x2c', comment= 'send iac', & + info_debug=info_debug, timer_diag='CPL:iacprep_diagav') + + if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) + call t_drvstopf ('CPL:IACPREP',cplrun=.true.) + endif + + !---------------------------------------------------- + !| cpl -> iac + !---------------------------------------------------- + + if (iamin_CPLALLIACID .and. iac_prognostic) then + call component_exch(iac, flow='x2c', & + infodata=infodata, infodata_string='cpl2iac_run', & + mpicom_barrier=mpicom_CPLALLLNDID, run_barriers=run_barriers, & + timer_barrier='CPL:C2Z_BARRIER', timer_comp_exch='CPL:C2Z', & + timer_map_exch='CPL:c2z_iacx2iacr', timer_infodata_exch='CPL:c2z_infoexch') + endif + + end subroutine cime_run_iac_setup_send + + !---------------------------------------------------------------------------------- + subroutine cime_run_iac_recv_post() + + !---------------------------------------------------------- + !| iac -> cpl + !---------------------------------------------------------- + + if (iamin_CPLALLIACID) then + call component_exch(rof, flow='c2x', & + infodata=infodata, infodata_string='iac2cpl_run', & + mpicom_barrier=mpicom_CPLALLIACID, run_barriers=run_barriers, & + timer_barrier='CPL:Z2C_BARRIER', timer_comp_exch='CPL:Z2C', & + timer_map_exch='CPL:z2c_iacr2iacx', timer_infodata_exch='CPL:z2c_infoexch') + endif + + !---------------------------------------------------------- + !| iac post + !---------------------------------------------------------- + + if (iamin_CPLID) then + call cime_comp_barriers(mpicom=mpicom_CPLID, timer='CPL:IACPOST_BARRIER') + call t_drvstartf ('CPL:IACPOST',cplrun=.true.,barrier=mpicom_CPLID) + if (drv_threading) call seq_comm_setnthreads(nthreads_CPLID) + + call component_diag(infodata, iac, flow='c2x', comment= 'recv iac', & + info_debug=info_debug, timer_diag='CPL:iacpost_diagav') + + ! TRS I think this is wrong - review these prep functions. I think it's more likely + if (iac_c2_lnd) then + call prep_lnd_calc_z2x_lx(timer='CPL:iacpost_iac2lnd') + endif + + if (iac_c2_atm) then + call prep_atm_calc_z2x_ax(fractions_zx, timer='CPL:iacpost_iac2atm') + endif + + call t_drvstopf ('CPL:IACPOST', cplrun=.true.) + endif + + end subroutine cime_run_iac_recv_post + + !---------------------------------------------------------------------------------- subroutine cime_run_atmocn_setup(hashint) integer, intent(inout) :: hashint(:) @@ -3668,6 +3884,11 @@ subroutine cime_run_lnd_setup_send() if (glc_c2_lnd) call prep_lnd_calc_g2x_lx(timer='CPL:glcpost_glc2lnd') end if + ! IAC export onto lnd grid + if (iac_c2_lnd) then + call prep_lnd_calc_z2x_lx(timer='CPL:lndprep_iac2lnd') + endif + if (lnd_prognostic) then call prep_lnd_mrg(infodata, timer_mrg='CPL:lndprep_mrgx2l') @@ -3719,7 +3940,8 @@ subroutine cime_run_lnd_recv_post() ! Accumulate rof and glc inputs (module variables in prep_rof_mod and prep_glc_mod) if (lnd_c2_rof) call prep_rof_accum(timer='CPL:lndpost_accl2r') - if (lnd_c2_glc) call prep_glc_accum(timer='CPL:lndpost_accl2g' ) + if (lnd_c2_glc) call prep_glc_accum(timer='CPL:lndpost_accl2g') + if (lnd_c2_iac) call prep_iac_accum(timer='CPL:lndpost_accl2z') if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) call t_drvstopf ('CPL:LNDPOST',cplrun=.true.) @@ -4180,16 +4402,16 @@ subroutine cime_run_write_history() endif call seq_hist_write(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, & + atm, lnd, ice, ocn, rof, glc, wav, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, trim(cpl_inst_tag)) + fractions_rx, fractions_gx, fractions_wx, fractions_zx, trim(cpl_inst_tag)) if (drv_threading) call seq_comm_setnthreads(nthreads_GLOID) endif if (do_histavg) then call seq_hist_writeavg(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, histavg_alarm, & + atm, lnd, ice, ocn, rof, glc, wav, iac, histavg_alarm, & trim(cpl_inst_tag)) endif @@ -4226,9 +4448,9 @@ subroutine cime_run_write_restart(drv_pause, write_restart, drv_resume) endif call seq_rest_write(EClock_d, seq_SyncClock, infodata, & - atm, lnd, ice, ocn, rof, glc, wav, esp, & + atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, & + fractions_rx, fractions_gx, fractions_wx, fractions_zx, & trim(cpl_inst_tag), drv_resume) if (iamroot_CPLID) then diff --git a/src/drivers/mct/main/component_mod.F90 b/src/drivers/mct/main/component_mod.F90 index 983b7af698d..3c9e6da2c33 100644 --- a/src/drivers/mct/main/component_mod.F90 +++ b/src/drivers/mct/main/component_mod.F90 @@ -123,7 +123,15 @@ subroutine component_init_pre(comp, compid, cplcompid, cplallcompid, & comp(eci)%suffix = seq_comm_suffix(comp(eci)%compid) comp(eci)%name = seq_comm_name (comp(eci)%compid) comp(eci)%ntype = ntype(1:3) - comp(eci)%oneletterid = ntype(1:1) + + select case(ntype) + case ('atm','cpl','ocn','wav','glc','ice','rof','lnd','esp') + comp(eci)%oneletterid = ntype(1:1) + case ('iac') + comp(eci)%oneletterid = 'z' + case default + call shr_sys_abort(subname//': ntype, "'//ntype//'" not recognized"') + end select if (eci == 1) then allocate(comp(1)%dom_cx) @@ -167,6 +175,9 @@ subroutine component_init_pre(comp, compid, cplcompid, cplallcompid, & if (comp(1)%oneletterid == 'e') then call seq_infodata_getData(infodata, esp_present=comp(eci)%present) end if + if (comp(1)%oneletterid == 'z') then + call seq_infodata_getData(infodata, iac_present=comp(eci)%present) + end if #else call seq_infodata_getData(comp(1)%oneletterid, infodata, comp_present=comp(eci)%present) #endif @@ -277,6 +288,7 @@ end subroutine comp_init if (comp(1)%oneletterid == 'g') call seq_infodata_getData(infodata, glc_present=comp(eci)%present) if (comp(1)%oneletterid == 'w') call seq_infodata_getData(infodata, wav_present=comp(eci)%present) if (comp(1)%oneletterid == 'e') call seq_infodata_getData(infodata, esp_present=comp(eci)%present) + if (comp(1)%oneletterid == 'z') call seq_infodata_getData(infodata, iac_present=comp(eci)%present) #else call seq_infodata_getData(comp(1)%oneletterid, infodata, comp_present=comp(eci)%present) #endif @@ -693,6 +705,7 @@ end subroutine comp_run if (comp(1)%oneletterid == 'g') call seq_infodata_putData(infodata, glc_phase=phase) if (comp(1)%oneletterid == 'w') call seq_infodata_putData(infodata, wav_phase=phase) if (comp(1)%oneletterid == 'e') call seq_infodata_putData(infodata, esp_phase=phase) + if (comp(1)%oneletterid == 'z') call seq_infodata_putData(infodata, iac_phase=phase) #else call seq_infodata_putData(comp(1)%oneletterid, infodata, comp_phase=phase) #endif diff --git a/src/drivers/mct/main/component_type_mod.F90 b/src/drivers/mct/main/component_type_mod.F90 index d1cd710946a..6d222c8a1d5 100644 --- a/src/drivers/mct/main/component_type_mod.F90 +++ b/src/drivers/mct/main/component_type_mod.F90 @@ -12,7 +12,7 @@ module component_type_mod use seq_comm_mct , only: seq_comm_namelen use seq_comm_mct , only: num_inst_atm, num_inst_lnd, num_inst_rof use seq_comm_mct , only: num_inst_ocn, num_inst_ice, num_inst_glc - use seq_comm_mct , only: num_inst_wav, num_inst_esp + use seq_comm_mct , only: num_inst_wav, num_inst_esp, num_inst_iac use mct_mod implicit none @@ -112,8 +112,9 @@ module component_type_mod type(component_type), target :: glc(num_inst_glc) type(component_type), target :: wav(num_inst_wav) type(component_type), target :: esp(num_inst_esp) + type(component_type), target :: iac(num_inst_iac) - public :: atm, lnd, rof, ocn, ice, glc, wav, esp + public :: atm, lnd, rof, ocn, ice, glc, wav, esp, iac !=============================================================================== diff --git a/src/drivers/mct/main/prep_atm_mod.F90 b/src/drivers/mct/main/prep_atm_mod.F90 index fdd2a713180..4fcf079b785 100644 --- a/src/drivers/mct/main/prep_atm_mod.F90 +++ b/src/drivers/mct/main/prep_atm_mod.F90 @@ -31,10 +31,12 @@ module prep_atm_mod public :: prep_atm_get_l2x_ax public :: prep_atm_get_i2x_ax public :: prep_atm_get_o2x_ax + public :: prep_atm_get_z2x_ax public :: prep_atm_calc_l2x_ax public :: prep_atm_calc_i2x_ax public :: prep_atm_calc_o2x_ax + public :: prep_atm_calc_z2x_ax public :: prep_atm_get_mapper_So2a public :: prep_atm_get_mapper_Fo2a @@ -65,6 +67,7 @@ module prep_atm_mod type(mct_aVect), pointer :: l2x_ax(:) ! Lnd export, atm grid, cpl pes - allocated in driver type(mct_aVect), pointer :: i2x_ax(:) ! Ice export, atm grid, cpl pes - allocated in driver type(mct_aVect), pointer :: o2x_ax(:) ! Ocn export, atm grid, cpl pes - allocated in driver + type(mct_aVect), pointer :: z2x_ax(:) ! Iac export, atm grid, cpl pes - allocated in driver ! other module variables integer :: mpicom_CPLID ! MPI cpl communicator @@ -75,7 +78,7 @@ module prep_atm_mod !================================================================================================ - subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm) + subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm, iac_c2_atm) !--------------------------------------------------------------- ! Description @@ -86,6 +89,7 @@ subroutine prep_atm_init(infodata, ocn_c2_atm, ice_c2_atm, lnd_c2_atm) logical , intent(in) :: ocn_c2_atm ! .true. => ocn to atm coupling on logical , intent(in) :: ice_c2_atm ! .true. => ice to atm coupling on logical , intent(in) :: lnd_c2_atm ! .true. => lnd to atm coupling on + logical , intent(in) :: iac_c2_atm ! .true. => iac to atm coupling on ! ! Local Variables integer :: lsize_a @@ -739,6 +743,21 @@ end subroutine prep_atm_calc_l2x_ax !================================================================================================ + subroutine prep_atm_calc_z2x_ax(fractions_zx, timer) + !--------------------------------------------------------------- + ! Description + ! Create z2x_ax (note that z2x_ax is a local module variable) + ! + ! Arguments + type(mct_aVect) , intent(in) :: fractions_zx(:) + character(len=*), intent(in) :: timer + ! + ! Local Variables + + end subroutine prep_atm_calc_z2x_ax + + !================================================================================================ + function prep_atm_get_l2x_ax() type(mct_aVect), pointer :: prep_atm_get_l2x_ax(:) prep_atm_get_l2x_ax => l2x_ax(:) @@ -754,6 +773,11 @@ function prep_atm_get_o2x_ax() prep_atm_get_o2x_ax => o2x_ax(:) end function prep_atm_get_o2x_ax + function prep_atm_get_z2x_ax() + type(mct_aVect), pointer :: prep_atm_get_z2x_ax(:) + prep_atm_get_z2x_ax => z2x_ax(:) + end function prep_atm_get_z2x_ax + function prep_atm_get_mapper_So2a() type(seq_map), pointer :: prep_atm_get_mapper_So2a prep_atm_get_mapper_So2a => mapper_So2a diff --git a/src/drivers/mct/main/prep_iac_mod.F90 b/src/drivers/mct/main/prep_iac_mod.F90 new file mode 100644 index 00000000000..1ab5f6d0284 --- /dev/null +++ b/src/drivers/mct/main/prep_iac_mod.F90 @@ -0,0 +1,168 @@ +module prep_iac_mod + +#include "shr_assert.h" + use shr_kind_mod, only: r8 => SHR_KIND_R8 + use shr_kind_mod, only: cs => SHR_KIND_CS + use shr_kind_mod, only: cl => SHR_KIND_CL + use shr_kind_mod, only: cxx => SHR_KIND_CXX + use shr_sys_mod, only: shr_sys_abort, shr_sys_flush + use seq_comm_mct, only: num_inst_lnd, num_inst_iac, num_inst_frc + use seq_comm_mct, only: CPLID, ROFID, logunit + use seq_comm_mct, only: seq_comm_getData=>seq_comm_setptrs + use seq_infodata_mod, only: seq_infodata_type, seq_infodata_getdata + use shr_log_mod , only: errMsg => shr_log_errMsg + use seq_map_type_mod + use seq_map_mod + use seq_flds_mod + use t_drv_timers_mod + use mct_mod + use perf_mod + use component_type_mod, only: component_get_x2c_cx, component_get_c2x_cx + use component_type_mod, only: iac, lnd + use prep_lnd_mod, only: prep_lnd_get_mapper_Fr2l + + implicit none + save + private + + !-------------------------------------------------------------------------- + ! Public interfaces + !-------------------------------------------------------------------------- + + public :: prep_iac_init + public :: prep_iac_mrg + + public :: prep_iac_accum + public :: prep_iac_accum_avg + + public :: prep_iac_calc_l2x_zx + + public :: prep_iac_get_l2zacc_lx + public :: prep_iac_get_l2zacc_lx_cnt + public :: prep_iac_get_mapper_Fl2z + + !-------------------------------------------------------------------------- + ! Private interfaces + !-------------------------------------------------------------------------- + + !-------------------------------------------------------------------------- + ! Private data + !-------------------------------------------------------------------------- + + ! mappers + type(seq_map), pointer :: mapper_Fl2z + + ! attribute vectors + type(mct_aVect), pointer :: l2x_zx(:) + + ! accumulation variables + type(mct_aVect), pointer :: l2zacc_lx(:) ! lnd export, lnd grid, cpl pes + integer , target :: l2zacc_lx_cnt ! l2racc_lx: number of time samples accumulated + + ! other module variables + integer :: mpicom_CPLID ! MPI cpl communicator + + !================================================================================================ + +contains + + !================================================================================================ + + subroutine prep_iac_init(infodata, lnd_c2_iac) + + !--------------------------------------------------------------- + ! Description + ! Initialize module attribute vectors and all other non-mapping + ! module variables + ! + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + logical , intent(in) :: lnd_c2_iac ! .true. => lnd to iac coupling on + ! + ! Local Variables + + end subroutine prep_iac_init + + !================================================================================================ + + subroutine prep_iac_accum(timer) + + !--------------------------------------------------------------- + ! Description + ! Accumulate land input to iac + ! + ! Arguments + character(len=*), intent(in) :: timer + ! + ! Local Variables + + end subroutine prep_iac_accum + + !================================================================================================ + + subroutine prep_iac_accum_avg(timer) + + !--------------------------------------------------------------- + ! Description + ! Finalize accumulation of land input to river component + ! + ! Arguments + character(len=*), intent(in) :: timer + ! + ! Local Variables + + end subroutine prep_iac_accum_avg + + !================================================================================================ + + subroutine prep_iac_mrg(infodata, fractions_zx, timer_mrg) + + !--------------------------------------------------------------- + ! Description + ! Merge iac inputs + ! + ! Arguments + type(seq_infodata_type) , intent(in) :: infodata + type(mct_aVect) , intent(in) :: fractions_zx(:) + character(len=*) , intent(in) :: timer_mrg + ! + ! Local Variables + + end subroutine prep_iac_mrg + + !================================================================================================ + + !================================================================================================ + + subroutine prep_iac_calc_l2x_zx(timer) + !--------------------------------------------------------------- + ! Description + ! Create l2x_zx (note that l2x_zx is a local module variable) + ! + ! Arguments + ! Don't know if we need these fractions just yet + ! type(mct_aVect) , intent(in) :: fractions_lx(:) + character(len=*), intent(in) :: timer + ! + ! Local Variables + + end subroutine prep_iac_calc_l2x_zx + + !================================================================================================ + + function prep_iac_get_l2zacc_lx() + type(mct_aVect), pointer :: prep_iac_get_l2zacc_lx(:) + prep_iac_get_l2zacc_lx => l2zacc_lx(:) + end function prep_iac_get_l2zacc_lx + + function prep_iac_get_l2zacc_lx_cnt() + integer, pointer :: prep_iac_get_l2zacc_lx_cnt + prep_iac_get_l2zacc_lx_cnt => l2zacc_lx_cnt + end function prep_iac_get_l2zacc_lx_cnt + + function prep_iac_get_mapper_Fl2z() + type(seq_map), pointer :: prep_iac_get_mapper_Fl2z + prep_iac_get_mapper_Fl2z => mapper_Fl2z + end function prep_iac_get_mapper_Fl2z + +end module prep_iac_mod diff --git a/src/drivers/mct/main/prep_lnd_mod.F90 b/src/drivers/mct/main/prep_lnd_mod.F90 index b65df6a4211..344637f3fdc 100644 --- a/src/drivers/mct/main/prep_lnd_mod.F90 +++ b/src/drivers/mct/main/prep_lnd_mod.F90 @@ -34,10 +34,12 @@ module prep_lnd_mod public :: prep_lnd_calc_a2x_lx public :: prep_lnd_calc_r2x_lx public :: prep_lnd_calc_g2x_lx + public :: prep_lnd_calc_z2x_lx public :: prep_lnd_get_a2x_lx public :: prep_lnd_get_r2x_lx public :: prep_lnd_get_g2x_lx + public :: prep_lnd_get_z2x_lx public :: prep_lnd_get_mapper_Sa2l public :: prep_lnd_get_mapper_Fa2l @@ -67,6 +69,7 @@ module prep_lnd_mod type(mct_aVect), pointer :: a2x_lx(:) ! Atm export, lnd grid, cpl pes - allocated in driver type(mct_aVect), pointer :: r2x_lx(:) ! Rof export, lnd grid, lnd pes - allocated in lnd gc type(mct_aVect), pointer :: g2x_lx(:) ! Glc export, lnd grid, cpl pes - allocated in driver + type(mct_aVect), pointer :: z2x_lx(:) ! Iac export, lnd grid, cpl pes - allocated in driver ! seq_comm_getData variables integer :: mpicom_CPLID ! MPI cpl communicator @@ -86,7 +89,7 @@ module prep_lnd_mod !================================================================================================ - subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd) + subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd, iac_c2_lnd) !--------------------------------------------------------------- ! Description @@ -98,6 +101,7 @@ subroutine prep_lnd_init(infodata, atm_c2_lnd, rof_c2_lnd, glc_c2_lnd) logical , intent(in) :: atm_c2_lnd ! .true. => atm to lnd coupling on logical , intent(in) :: rof_c2_lnd ! .true. => rof to lnd coupling on logical , intent(in) :: glc_c2_lnd ! .true. => glc to lnd coupling on + logical , intent(in) :: iac_c2_lnd ! .true. => iac to lnd coupling on ! ! Local Variables integer :: lsize_l @@ -477,6 +481,26 @@ end subroutine prep_lnd_calc_g2x_lx !================================================================================================ + subroutine prep_lnd_calc_z2x_lx(timer) + !--------------------------------------------------------------- + ! Description + ! Create z2x_lx (note that z2x_lx is a local module variable) + ! + ! Arguments + character(len=*) , intent(in) :: timer + ! + ! Local Variables + integer :: egi + type(mct_aVect), pointer :: z2x_gx + character(*), parameter :: subname = '(prep_lnd_calc_z2x_lx)' + !--------------------------------------------------------------- + + ! Stub + + end subroutine prep_lnd_calc_z2x_lx + + !================================================================================================ + function prep_lnd_get_a2x_lx() type(mct_aVect), pointer :: prep_lnd_get_a2x_lx(:) prep_lnd_get_a2x_lx => a2x_lx(:) @@ -492,6 +516,11 @@ function prep_lnd_get_g2x_lx() prep_lnd_get_g2x_lx => g2x_lx(:) end function prep_lnd_get_g2x_lx + function prep_lnd_get_z2x_lx() + type(mct_aVect), pointer :: prep_lnd_get_z2x_lx(:) + prep_lnd_get_z2x_lx => z2x_lx(:) + end function prep_lnd_get_z2x_lx + function prep_lnd_get_mapper_Sa2l() type(seq_map), pointer :: prep_lnd_get_mapper_Sa2l prep_lnd_get_mapper_Sa2l => mapper_Sa2l diff --git a/src/drivers/mct/main/seq_frac_mct.F90 b/src/drivers/mct/main/seq_frac_mct.F90 index 3793ca31e35..11985ab9a58 100644 --- a/src/drivers/mct/main/seq_frac_mct.F90 +++ b/src/drivers/mct/main/seq_frac_mct.F90 @@ -217,9 +217,10 @@ module seq_frac_mct ! !INTERFACE: ------------------------------------------------------------------ subroutine seq_frac_init( infodata, & - atm, ice, lnd, ocn, glc, rof, wav, & + atm, ice, lnd, ocn, glc, rof, wav, iac,& fractions_a, fractions_i, fractions_l, & - fractions_o, fractions_g, fractions_r, fractions_w) + fractions_o, fractions_g, fractions_r, & + fractions_w, fractions_z) ! !INPUT/OUTPUT PARAMETERS: type(seq_infodata_type) , intent(in) :: infodata @@ -230,6 +231,7 @@ subroutine seq_frac_init( infodata, & type(component_type) , intent(in) :: glc type(component_type) , intent(in) :: rof type(component_type) , intent(in) :: wav + type(component_type) , intent(in) :: iac type(mct_aVect) , intent(inout) :: fractions_a ! Fractions on atm grid/decomp type(mct_aVect) , intent(inout) :: fractions_i ! Fractions on ice grid/decomp type(mct_aVect) , intent(inout) :: fractions_l ! Fractions on lnd grid/decomp @@ -237,6 +239,7 @@ subroutine seq_frac_init( infodata, & type(mct_aVect) , intent(inout) :: fractions_g ! Fractions on glc grid/decomp type(mct_aVect) , intent(inout) :: fractions_r ! Fractions on rof grid/decomp type(mct_aVect) , intent(inout) :: fractions_w ! Fractions on wav grid/decomp + type(mct_aVect) , intent(inout) :: fractions_z ! Fractions on iac grid/decomp !EOP !----- local ----- @@ -247,6 +250,7 @@ subroutine seq_frac_init( infodata, & type(mct_ggrid), pointer :: dom_g type(mct_ggrid), pointer :: dom_r type(mct_ggrid), pointer :: dom_w + type(mct_ggrid), pointer :: dom_z logical :: atm_present ! .true. => atm is present logical :: ice_present ! .true. => ice is present @@ -255,6 +259,7 @@ subroutine seq_frac_init( infodata, & logical :: glc_present ! .true. => glc is present logical :: rof_present ! .true. => rof is present logical :: wav_present ! .true. => wav is present + logical :: iac_present ! .true. => iac is present logical :: dead_comps ! .true. => dead models present integer :: n ! indices @@ -270,6 +275,7 @@ subroutine seq_frac_init( infodata, & character(*),parameter :: fraclist_g = 'gfrac:lfrac' character(*),parameter :: fraclist_r = 'lfrac:rfrac' character(*),parameter :: fraclist_w = 'wfrac' + character(*),parameter :: fraclist_z = 'afrac:lfrac' !----- formats ----- character(*),parameter :: subName = '(seq_frac_init) ' @@ -286,6 +292,7 @@ subroutine seq_frac_init( infodata, & ocn_present=ocn_present, & glc_present=glc_present, & wav_present=wav_present, & + iac_present=iac_present, & dead_comps=dead_comps) dom_a => component_get_dom_cx(atm) @@ -295,6 +302,7 @@ subroutine seq_frac_init( infodata, & dom_r => component_get_dom_cx(rof) dom_g => component_get_dom_cx(glc) dom_w => component_get_dom_cx(wav) + dom_z => component_get_dom_cx(iac) debug_old = seq_frac_debug seq_frac_debug = 2 @@ -363,6 +371,15 @@ subroutine seq_frac_init( infodata, & fractions_w%rAttr(:,:) = 1.0_r8 end if + ! Initialize fractions on iac grid decomp, just an initial "guess", updated later + + if (iac_present) then + lSize = mct_aVect_lSize(dom_z%data) + call mct_aVect_init(fractions_z,rList=fraclist_z,lsize=lsize) + call mct_aVect_zero(fractions_z) + fractions_z%rAttr(:,:) = 1.0_r8 + end if + ! Initialize fractions on ice grid/decomp (initialize ice fraction to zero) if (ice_present) then @@ -471,6 +488,7 @@ subroutine seq_frac_init( infodata, & if (glc_present) call seq_frac_check(fractions_g,'glc init') if (rof_present) call seq_frac_check(fractions_r,'rof init') if (wav_present) call seq_frac_check(fractions_w,'wav init') + if (iac_present) call seq_frac_check(fractions_z,'iac init') if (ice_present) call seq_frac_check(fractions_i,'ice init') if (ocn_present) call seq_frac_check(fractions_o,'ocn init') if (atm_present .and. (lnd_present.or.ice_present.or.ocn_present)) & @@ -621,11 +639,12 @@ subroutine seq_frac_check(fractions,string) real(r8) :: gminval,gmaxval ! used for glc real(r8) :: rminval,rmaxval ! used for rof real(r8) :: wminval,wmaxval ! used for wav + real(r8) :: zminval,zmaxval ! used for iac real(r8) :: kminval,kmaxval ! used for lnd, lfrin real(r8) :: sminval,smaxval ! used for sum real(r8) :: tmpmin, tmpmax ! global tmps integer :: tmpsum ! global tmp - integer :: ka,kl,ki,ko,kg,kk,kr,kw + integer :: ka,kl,ki,ko,kg,kk,kr,kw,kz character(len=128) :: lstring logical :: error @@ -655,6 +674,7 @@ subroutine seq_frac_check(fractions,string) kg = -1 kr = -1 kw = -1 + kz = -1 aminval = 999.0_r8 amaxval = -999.0_r8 lminval = 999.0_r8 @@ -673,6 +693,8 @@ subroutine seq_frac_check(fractions,string) rmaxval = -999.0_r8 wminval = 999.0_r8 wmaxval = -999.0_r8 + zminval = 999.0_r8 + zmaxval = -999.0_r8 lsize = mct_avect_lsize(fractions) ka = mct_aVect_indexRA(fractions,"afrac",perrWith='quiet') @@ -682,6 +704,7 @@ subroutine seq_frac_check(fractions,string) kg = mct_aVect_indexRA(fractions,"gfrac",perrWith='quiet') kr = mct_aVect_indexRA(fractions,"rfrac",perrWith='quiet') kw = mct_aVect_indexRA(fractions,"wfrac",perrWith='quiet') + kz = mct_aVect_indexRA(fractions,"zfrac",perrWith='quiet') kk = mct_aVect_indexRA(fractions,"lfrin",perrWith='quiet') if (ka > 0) then @@ -712,6 +735,10 @@ subroutine seq_frac_check(fractions,string) wminval = minval(fractions%rAttr(kw,:)) wmaxval = maxval(fractions%rAttr(kw,:)) endif + if (kz > 0) then + zminval = minval(fractions%rAttr(kz,:)) + zmaxval = maxval(fractions%rAttr(kz,:)) + endif if (kk > 0) then kminval = minval(fractions%rAttr(kk,:)) kmaxval = maxval(fractions%rAttr(kk,:)) @@ -743,6 +770,7 @@ subroutine seq_frac_check(fractions,string) if (gminval < 0.0_r8-eps_fracval .or. gmaxval > 1.0_r8+eps_fracval) error = .true. if (rminval < 0.0_r8-eps_fracval .or. rmaxval > 1.0_r8+eps_fracval) error = .true. if (wminval < 0.0_r8-eps_fracval .or. wmaxval > 1.0_r8+eps_fracval) error = .true. + if (zminval < 0.0_r8-eps_fracval .or. zmaxval > 1.0_r8+eps_fracval) error = .true. if (kminval < 0.0_r8-eps_fracval .or. kmaxval > 1.0_r8+eps_fracval) error = .true. if (error .or. seq_frac_debug > 1) then @@ -781,6 +809,11 @@ subroutine seq_frac_check(fractions,string) call shr_mpi_max(wmaxval,tmpmax,mpicom,subname//':wfrac',all=.false.) if (iamroot) write(logunit,F02) trim(lstring),' wfrac min/max = ',tmpmin,tmpmax endif + if (kz > 0) then + call shr_mpi_min(kminval,tmpmin,mpicom,subname//':zfrac',all=.false.) + call shr_mpi_max(kmaxval,tmpmax,mpicom,subname//':zfrac',all=.false.) + if (iamroot) write(logunit,F02) trim(lstring),' zfrac min/max = ',tmpmin,tmpmax + endif if (kk > 0) then call shr_mpi_min(kminval,tmpmin,mpicom,subname//':lfrin',all=.false.) call shr_mpi_max(kmaxval,tmpmax,mpicom,subname//':lfrin',all=.false.) diff --git a/src/drivers/mct/main/seq_hist_mod.F90 b/src/drivers/mct/main/seq_hist_mod.F90 index 076d41819b2..43385493200 100644 --- a/src/drivers/mct/main/seq_hist_mod.F90 +++ b/src/drivers/mct/main/seq_hist_mod.F90 @@ -30,7 +30,7 @@ module seq_hist_mod use seq_comm_mct, only: CPLID, GLOID, logunit, loglevel use seq_comm_mct, only: num_inst_atm, num_inst_lnd, num_inst_ocn use seq_comm_mct, only: num_inst_ice, num_inst_glc, num_inst_wav - use seq_comm_mct, only: num_inst_rof, num_inst_xao + use seq_comm_mct, only: num_inst_rof, num_inst_xao, num_inst_iac use prep_ocn_mod, only: prep_ocn_get_r2x_ox use prep_ocn_mod, only: prep_ocn_get_x2oacc_ox @@ -81,6 +81,7 @@ module seq_hist_mod logical :: rof_present ! .true. => land runoff is present logical :: glc_present ! .true. => glc is present logical :: wav_present ! .true. => wav is present + logical :: iac_present ! .true. => iac is present logical :: atm_prognostic ! .true. => atm comp expects input logical :: lnd_prognostic ! .true. => lnd comp expects input @@ -90,6 +91,7 @@ module seq_hist_mod logical :: rof_prognostic ! .true. => rof comp expects input logical :: glc_prognostic ! .true. => glc comp expects input logical :: wav_prognostic ! .true. => wav comp expects input + logical :: iac_prognostic ! .true. => iac comp expects input logical :: histavg_atm ! .true. => write atm fields to average history file logical :: histavg_lnd ! .true. => write lnd fields to average history file @@ -98,6 +100,7 @@ module seq_hist_mod logical :: histavg_rof ! .true. => write rof fields to average history file logical :: histavg_glc ! .true. => write glc fields to average history file logical :: histavg_wav ! .true. => write wav fields to average history file + logical :: histavg_iac ! .true. => write iac fields to average history file logical :: histavg_xao ! .true. => write flux xao fields to average history file logical :: single_column @@ -110,6 +113,7 @@ module seq_hist_mod integer(IN) :: rof_nx, rof_ny ! nx,ny of 2d grid, if known integer(IN) :: glc_nx, glc_ny ! nx,ny of 2d grid, if known integer(IN) :: wav_nx, wav_ny ! nx,ny of 2d grid, if known + integer(IN) :: iac_nx, iac_ny ! nx,ny of 2d grid, if known !--- temporary pointers --- type(mct_aVect), pointer :: r2x_ox(:) @@ -124,9 +128,9 @@ module seq_hist_mod !=============================================================================== subroutine seq_hist_write(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, & + atm, lnd, ice, ocn, rof, glc, wav, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, fractions_rx, & - fractions_gx, fractions_wx, cpl_inst_tag) + fractions_gx, fractions_wx, fractions_zx, cpl_inst_tag) implicit none ! @@ -140,6 +144,7 @@ subroutine seq_hist_write(infodata, EClock_d, & type (component_type) , intent(inout) :: rof(:) type (component_type) , intent(inout) :: glc(:) type (component_type) , intent(inout) :: wav(:) + type (component_type) , intent(inout) :: iac(:) type(mct_aVect) , intent(inout) :: fractions_ax(:) ! Fractions on atm grid/decomp type(mct_aVect) , intent(inout) :: fractions_lx(:) ! Fractions on lnd grid/decomp type(mct_aVect) , intent(inout) :: fractions_ix(:) ! Fractions on ice grid/decomp @@ -147,6 +152,7 @@ subroutine seq_hist_write(infodata, EClock_d, & type(mct_aVect) , intent(inout) :: fractions_rx(:) ! Fractions on rof grid/decomp type(mct_aVect) , intent(inout) :: fractions_gx(:) ! Fractions on glc grid/decomp type(mct_aVect) , intent(inout) :: fractions_wx(:) ! Fractions on wav grid/decomp + type(mct_aVect) , intent(inout) :: fractions_zx(:) ! Fractions on iac grid/decomp character(len=*) , intent(in) :: cpl_inst_tag ! ! Local Variables @@ -187,6 +193,7 @@ subroutine seq_hist_write(infodata, EClock_d, & ocn_present=ocn_present, & glc_present=glc_present, & wav_present=wav_present, & + iac_present=iac_present, & atm_prognostic=atm_prognostic, & lnd_prognostic=lnd_prognostic, & ice_prognostic=ice_prognostic, & @@ -195,12 +202,14 @@ subroutine seq_hist_write(infodata, EClock_d, & rof_prognostic=rof_prognostic, & glc_prognostic=glc_prognostic, & wav_prognostic=wav_prognostic, & + iac_prognostic=iac_prognostic, & atm_nx=atm_nx, atm_ny=atm_ny, & lnd_nx=lnd_nx, lnd_ny=lnd_ny, & rof_nx=rof_nx, rof_ny=rof_ny, & ice_nx=ice_nx, ice_ny=ice_ny, & glc_nx=glc_nx, glc_ny=glc_ny, & wav_nx=wav_nx, wav_ny=wav_ny, & + iac_nx=iac_nx, iac_ny=iac_ny, & ocn_nx=ocn_nx, ocn_ny=ocn_ny, & single_column=single_column, & case_name=case_name, & @@ -381,6 +390,19 @@ subroutine seq_hist_write(infodata, EClock_d, & call seq_io_write(hist_file, wav, 'x2c', 'x2w_wx', & nx=wav_nx, ny=wav_ny, nt=1, whead=whead, wdata=wdata, pre='x2w') endif + + if (iac_present) then + gsmap => component_get_gsmap_cx(iac(1)) + dom => component_get_dom_cx(iac(1)) + call seq_io_write(hist_file, gsmap, dom%data, 'dom_zx', & + nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, pre='domz') + call seq_io_write(hist_file, gsmap, fractions_zx, 'fractions_zx', & + nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, pre='fracz') + call seq_io_write(hist_file, iac, 'c2x', 'z2x_zx', & + nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, pre='w2x') + call seq_io_write(hist_file, iac, 'x2c', 'x2z_zx', & + nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, pre='x2w') + endif enddo call seq_io_close(hist_file) @@ -392,7 +414,7 @@ end subroutine seq_hist_write !=============================================================================== subroutine seq_hist_writeavg(infodata, EClock_d, & - atm, lnd, ice, ocn, rof, glc, wav, write_now, cpl_inst_tag) + atm, lnd, ice, ocn, rof, glc, wav, iac, write_now, cpl_inst_tag) implicit none @@ -405,6 +427,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & type (component_type) , intent(in) :: rof(:) type (component_type) , intent(in) :: glc(:) type (component_type) , intent(in) :: wav(:) + type (component_type) , intent(in) :: iac(:) logical , intent(in) :: write_now ! write or accumulate character(len=*) , intent(in) :: cpl_inst_tag @@ -441,6 +464,8 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & type(mct_aVect), save :: x2g_gx_avg(num_inst_glc) type(mct_aVect), save :: w2x_wx_avg(num_inst_wav) type(mct_aVect), save :: x2w_wx_avg(num_inst_wav) + type(mct_aVect), save :: z2x_zx_avg(num_inst_iac) + type(mct_aVect), save :: x2z_zx_avg(num_inst_iac) type(mct_aVect), save, pointer :: xao_ox_avg(:) type(mct_aVect), save, pointer :: xao_ax_avg(:) @@ -477,6 +502,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & ocn_present=ocn_present, & glc_present=glc_present, & wav_present=wav_present, & + iac_present=iac_present, & atm_prognostic=atm_prognostic, & lnd_prognostic=lnd_prognostic, & ice_prognostic=ice_prognostic, & @@ -490,6 +516,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & ice_nx=ice_nx, ice_ny=ice_ny, & glc_nx=glc_nx, glc_ny=glc_ny, & wav_nx=wav_nx, wav_ny=wav_ny, & + iac_nx=iac_nx, iac_ny=iac_ny, & ocn_nx=ocn_nx, ocn_ny=ocn_ny, & histavg_atm=histavg_atm, & histavg_lnd=histavg_lnd, & @@ -498,6 +525,7 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & histavg_rof=histavg_rof, & histavg_glc=histavg_glc, & histavg_wav=histavg_wav, & + histavg_iac=histavg_iac, & histavg_xao=histavg_xao, & model_doi_url=model_doi_url) @@ -599,6 +627,19 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & call mct_aVect_zero(x2w_wx_avg(iidx)) enddo endif + if (iac_present .and. histavg_iac) then + do iidx = 1, num_inst_iac + c2x => component_get_c2x_cx(iac(iidx)) + lsize = mct_aVect_lsize(c2x) + call mct_aVect_init(z2x_zx_avg(iidx), c2x, lsize) + call mct_aVect_zero(z2x_zx_avg(iidx)) + + x2c => component_get_x2c_cx(iac(iidx)) + lsize = mct_aVect_lsize(x2c) + call mct_aVect_init(x2z_zx_avg(iidx), x2c, lsize) + call mct_aVect_zero(x2z_zx_avg(iidx)) + enddo + endif if (ocn_present .and. histavg_xao) then allocate(xao_ox_avg(num_inst_xao)) xao_ox => prep_aoflux_get_xao_ox() @@ -680,6 +721,14 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & x2w_wx_avg(iidx)%rAttr = x2w_wx_avg(iidx)%rAttr + x2c%rAttr enddo endif + if (iac_present .and. histavg_iac) then + do iidx = 1, num_inst_iac + c2x => component_get_c2x_cx(iac(iidx)) + x2c => component_get_x2c_cx(iac(iidx)) + z2x_zx_avg(iidx)%rAttr = z2x_zx_avg(iidx)%rAttr + c2x%rAttr + x2z_zx_avg(iidx)%rAttr = x2z_zx_avg(iidx)%rAttr + x2c%rAttr + enddo + endif if (ocn_present .and. histavg_xao) then xao_ox => prep_aoflux_get_xao_ox() do iidx = 1, num_inst_ocn @@ -753,6 +802,14 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & x2w_wx_avg(iidx)%rAttr = (x2w_wx_avg(iidx)%rAttr + x2c%rAttr) / (cnt * 1.0_r8) enddo endif + if (iac_present .and. histavg_iac) then + do iidx = 1, num_inst_iac + c2x => component_get_c2x_cx(iac(iidx)) + x2c => component_get_x2c_cx(iac(iidx)) + z2x_zx_avg(iidx)%rAttr = (z2x_zx_avg(iidx)%rAttr + c2x%rAttr) / (cnt * 1.0_r8) + x2z_zx_avg(iidx)%rAttr = (x2z_zx_avg(iidx)%rAttr + x2c%rAttr) / (cnt * 1.0_r8) + enddo + endif if (ocn_present .and. histavg_xao) then xao_ox => prep_aoflux_get_xao_ox() do iidx = 1, num_inst_ocn @@ -901,6 +958,18 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & nx=wav_nx, ny=wav_ny, nt=1, whead=whead, wdata=wdata, & pre='x2wavg', tavg=.true.) endif + if (iac_present .and. histavg_iac) then + gsmap => component_get_gsmap_cx(iac(1)) + dom => component_get_dom_cx(iac(1)) + call seq_io_write(hist_file, gsmap, dom%data, 'dom_zx', & + nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, pre='domw') + call seq_io_write(hist_file, gsmap, z2x_zx_avg, 'z2x_zx', & + nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, & + pre='z2xavg', tavg=.true.) + call seq_io_write(hist_file, gsmap, x2z_zx_avg, 'x2z_zx', & + nx=iac_nx, ny=iac_ny, nt=1, whead=whead, wdata=wdata, & + pre='x2zavg', tavg=.true.) + endif if (ocn_present .and. histavg_xao) then gsmap => component_get_gsmap_cx(ocn(1)) call seq_io_write(hist_file, gsmap, xao_ox_avg, 'xao_ox', & @@ -960,6 +1029,12 @@ subroutine seq_hist_writeavg(infodata, EClock_d, & call mct_aVect_zero(x2w_wx_avg(iidx)) enddo endif + if (iac_present .and. histavg_iac) then + do iidx = 1, num_inst_wav + call mct_aVect_zero(z2x_zx_avg(iidx)) + call mct_aVect_zero(x2z_zx_avg(iidx)) + enddo + endif if (ocn_present .and. histavg_xao) then do iidx = 1, num_inst_xao call mct_aVect_zero(xao_ox_avg(iidx)) diff --git a/src/drivers/mct/main/seq_rest_mod.F90 b/src/drivers/mct/main/seq_rest_mod.F90 index 258bea52773..f97b4ca5141 100644 --- a/src/drivers/mct/main/seq_rest_mod.F90 +++ b/src/drivers/mct/main/seq_rest_mod.F90 @@ -105,6 +105,7 @@ module seq_rest_mod logical :: glc_present ! .true. => glc is present logical :: wav_present ! .true. => wav is present logical :: esp_present ! .true. => esp is present + logical :: iac_present ! .true. => iac is present logical :: atm_prognostic ! .true. => atm comp expects input logical :: lnd_prognostic ! .true. => lnd comp expects input @@ -114,6 +115,7 @@ module seq_rest_mod logical :: glc_prognostic ! .true. => glc comp expects input logical :: wav_prognostic ! .true. => wav comp expects input logical :: esp_prognostic ! .true. => esp comp expects input + logical :: iac_prognostic ! .true. => iac comp expects input !--- temporary pointers --- type(mct_gsMap), pointer :: gsmap @@ -131,9 +133,9 @@ module seq_rest_mod !=============================================================================== subroutine seq_rest_read(rest_file, infodata, & - atm, lnd, ice, ocn, rof, glc, wav, esp, & + atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx) + fractions_rx, fractions_gx, fractions_wx, fractions_zx) implicit none @@ -147,6 +149,7 @@ subroutine seq_rest_read(rest_file, infodata, & type (component_type) , intent(inout) :: glc(:) type (component_type) , intent(inout) :: wav(:) type (component_type) , intent(inout) :: esp(:) + type (component_type) , intent(inout) :: iac(:) type(mct_aVect) , intent(inout) :: fractions_ax(:) ! Fractions on atm grid/decomp type(mct_aVect) , intent(inout) :: fractions_lx(:) ! Fractions on lnd grid/decomp type(mct_aVect) , intent(inout) :: fractions_ix(:) ! Fractions on ice grid/decomp @@ -154,6 +157,7 @@ subroutine seq_rest_read(rest_file, infodata, & type(mct_aVect) , intent(inout) :: fractions_rx(:) ! Fractions on rof grid/decomp type(mct_aVect) , intent(inout) :: fractions_gx(:) ! Fractions on glc grid/decomp type(mct_aVect) , intent(inout) :: fractions_wx(:) ! Fractions on wav grid/decomp + type(mct_aVect) , intent(inout) :: fractions_zx(:) ! Fractions on iac grid/decomp integer(IN) :: n,n1,n2,n3 real(r8),allocatable :: ds(:) ! for reshaping diag data for restart file @@ -184,6 +188,7 @@ subroutine seq_rest_read(rest_file, infodata, & glc_present=glc_present, & wav_present=wav_present, & esp_present=esp_present, & + iac_present=iac_present, & atm_prognostic=atm_prognostic, & lnd_prognostic=lnd_prognostic, & ice_prognostic=ice_prognostic, & @@ -192,6 +197,7 @@ subroutine seq_rest_read(rest_file, infodata, & ocnrof_prognostic=ocnrof_prognostic, & glc_prognostic=glc_prognostic, & wav_prognostic=wav_prognostic, & + iac_prognostic=iac_prognostic, & esp_prognostic=esp_prognostic) if (iamin_CPLID) then @@ -255,6 +261,11 @@ subroutine seq_rest_read(rest_file, infodata, & call seq_io_read(rest_file, gsmap, fractions_wx, 'fractions_wx') call seq_io_read(rest_file, wav, 'c2x', 'w2x_wx') endif + if (iac_present) then + gsmap => component_get_gsmap_cx(iac(1)) + call seq_io_read(rest_file, gsmap, fractions_zx, 'fractions_zx') + call seq_io_read(rest_file, iac, 'c2x', 'z2x_zx') + endif ! Add ESP restart read here n = size(budg_dataG) @@ -285,9 +296,10 @@ end subroutine seq_rest_read !=============================================================================== subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & - atm, lnd, ice, ocn, rof, glc, wav, esp, & + atm, lnd, ice, ocn, rof, glc, wav, esp, iac, & fractions_ax, fractions_lx, fractions_ix, fractions_ox, & - fractions_rx, fractions_gx, fractions_wx, tag, rest_file) + fractions_rx, fractions_gx, fractions_wx, fractions_zx, & + tag, rest_file) implicit none @@ -302,6 +314,7 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & type (component_type) , intent(inout) :: glc(:) type (component_type) , intent(inout) :: wav(:) type (component_type) , intent(inout) :: esp(:) + type (component_type) , intent(inout) :: iac(:) type(mct_aVect) , intent(inout) :: fractions_ax(:) ! Fractions on atm grid/decomp type(mct_aVect) , intent(inout) :: fractions_lx(:) ! Fractions on lnd grid/decomp type(mct_aVect) , intent(inout) :: fractions_ix(:) ! Fractions on ice grid/decomp @@ -309,6 +322,7 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & type(mct_aVect) , intent(inout) :: fractions_rx(:) ! Fractions on rof grid/decomp type(mct_aVect) , intent(inout) :: fractions_gx(:) ! Fractions on glc grid/decomp type(mct_aVect) , intent(inout) :: fractions_wx(:) ! Fractions on wav grid/decomp + type(mct_aVect) , intent(inout) :: fractions_zx(:) ! Fractions on iac grid/decomp character(len=*) , intent(in) :: tag character(len=CL) , intent(out) :: rest_file ! Restart filename @@ -356,6 +370,7 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & glc_present=glc_present, & wav_present=wav_present, & esp_present=esp_present, & + iac_present=iac_present, & atm_prognostic=atm_prognostic, & lnd_prognostic=lnd_prognostic, & ice_prognostic=ice_prognostic, & @@ -365,6 +380,7 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & glc_prognostic=glc_prognostic, & wav_prognostic=wav_prognostic, & esp_prognostic=esp_prognostic, & + iac_prognostic=iac_prognostic, & case_name=case_name, & model_doi_url=model_doi_url) @@ -527,6 +543,13 @@ subroutine seq_rest_write(EClock_d, seq_SyncClock, infodata, & call seq_io_write(rest_file, wav, 'c2x', 'w2x_wx', & whead=whead, wdata=wdata) endif + if (iac_present) then + gsmap => component_get_gsmap_cx(iac(1)) + call seq_io_write(rest_file, gsmap, fractions_zx, 'fractions_zx', & + whead=whead, wdata=wdata) + call seq_io_write(rest_file, iac, 'c2x', 'z2x_zx', & + whead=whead, wdata=wdata) + endif ! Write ESP restart data here enddo diff --git a/src/drivers/mct/shr/seq_comm_mct.F90 b/src/drivers/mct/shr/seq_comm_mct.F90 index 90efeb4f24b..4664143e0be 100644 --- a/src/drivers/mct/shr/seq_comm_mct.F90 +++ b/src/drivers/mct/shr/seq_comm_mct.F90 @@ -66,9 +66,9 @@ module seq_comm_mct integer, public :: global_mype = -1 !! To be initialized -!!! Note - NUM_COMP_INST_XXX are cpp variables set in buildlib.csm_share + !!! Note - NUM_COMP_INST_XXX are cpp variables set in buildlib.csm_share - integer, parameter :: ncomptypes = 8 ! total number of component types + integer, parameter :: ncomptypes = 9 ! total number of component types integer, parameter :: ncouplers = 1 ! number of couplers integer, parameter, public :: num_inst_atm = NUM_COMP_INST_ATM integer, parameter, public :: num_inst_lnd = NUM_COMP_INST_LND @@ -77,6 +77,7 @@ module seq_comm_mct integer, parameter, public :: num_inst_glc = NUM_COMP_INST_GLC integer, parameter, public :: num_inst_wav = NUM_COMP_INST_WAV integer, parameter, public :: num_inst_rof = NUM_COMP_INST_ROF + integer, parameter, public :: num_inst_iac = NUM_COMP_INST_IAC integer, parameter, public :: num_inst_esp = NUM_COMP_INST_ESP integer, parameter, public :: num_inst_total= num_inst_atm + & @@ -86,6 +87,7 @@ module seq_comm_mct num_inst_glc + & num_inst_wav + & num_inst_rof + & + num_inst_iac + & num_inst_esp + 1 integer, public :: num_inst_min, num_inst_max @@ -103,11 +105,13 @@ module seq_comm_mct integer, parameter, public :: num_inst_phys = num_inst_atm + num_inst_lnd + & num_inst_ocn + num_inst_ice + & num_inst_glc + num_inst_rof + & - num_inst_wav + num_inst_esp + num_inst_wav + num_inst_esp + & + num_inst_iac integer, parameter, public :: num_cpl_phys = num_inst_atm + num_inst_lnd + & num_inst_ocn + num_inst_ice + & num_inst_glc + num_inst_rof + & - num_inst_wav + num_inst_esp + num_inst_wav + num_inst_esp + & + num_inst_iac integer, parameter :: ncomps = (1 + ncouplers + 2*ncomptypes + num_inst_phys + num_cpl_phys) integer, public :: GLOID @@ -120,6 +124,7 @@ module seq_comm_mct integer, public :: ALLGLCID integer, public :: ALLROFID integer, public :: ALLWAVID + integer, public :: ALLIACID integer, public :: ALLESPID integer, public :: CPLALLATMID @@ -129,6 +134,7 @@ module seq_comm_mct integer, public :: CPLALLGLCID integer, public :: CPLALLROFID integer, public :: CPLALLWAVID + integer, public :: CPLALLIACID integer, public :: CPLALLESPID integer, public :: ATMID(num_inst_atm) @@ -138,6 +144,7 @@ module seq_comm_mct integer, public :: GLCID(num_inst_glc) integer, public :: ROFID(num_inst_rof) integer, public :: WAVID(num_inst_wav) + integer, public :: IACID(num_inst_iac) integer, public :: ESPID(num_inst_esp) integer, public :: CPLATMID(num_inst_atm) @@ -147,6 +154,7 @@ module seq_comm_mct integer, public :: CPLGLCID(num_inst_glc) integer, public :: CPLROFID(num_inst_rof) integer, public :: CPLWAVID(num_inst_wav) + integer, public :: CPLIACID(num_inst_iac) integer, public :: CPLESPID(num_inst_esp) integer, parameter, public :: seq_comm_namelen=16 @@ -198,7 +206,7 @@ module seq_comm_mct character(len=32), public :: & atm_layout, lnd_layout, ice_layout, glc_layout, rof_layout, & - ocn_layout, wav_layout, esp_layout + ocn_layout, wav_layout, esp_layout, iac_layout logical :: seq_comm_mct_initialized = .false. ! whether this module has been initialized @@ -244,6 +252,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) rof_ntasks, rof_rootpe, rof_pestride, rof_nthreads, & ocn_ntasks, ocn_rootpe, ocn_pestride, ocn_nthreads, & esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, & + iac_ntasks, iac_rootpe, iac_pestride, iac_nthreads, & cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads, & info_taskmap_model @@ -256,6 +265,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) rof_ntasks, rof_rootpe, rof_pestride, rof_nthreads, rof_layout, & ocn_ntasks, ocn_rootpe, ocn_pestride, ocn_nthreads, ocn_layout, & esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, esp_layout, & + iac_ntasks, iac_rootpe, iac_pestride, iac_nthreads, iac_layout, & cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads, & info_taskmap_model, info_taskmap_comp !---------------------------------------------------------- @@ -324,6 +334,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call comp_pelayout_init(numpes, wav_ntasks, wav_rootpe, wav_pestride, wav_nthreads, wav_layout) call comp_pelayout_init(numpes, glc_ntasks, glc_rootpe, glc_pestride, glc_nthreads, glc_layout) call comp_pelayout_init(numpes, esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, esp_layout) + call comp_pelayout_init(numpes, iac_ntasks, iac_rootpe, iac_pestride, iac_nthreads, iac_layout) call comp_pelayout_init(numpes, cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads) info_taskmap_model = 0 info_taskmap_comp = 0 @@ -351,6 +362,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call shr_mpi_bcast(wav_nthreads,DRIVER_COMM,'wav_nthreads') call shr_mpi_bcast(rof_nthreads,DRIVER_COMM,'rof_nthreads') call shr_mpi_bcast(esp_nthreads,DRIVER_COMM,'esp_nthreads') + call shr_mpi_bcast(iac_nthreads,DRIVER_COMM,'iac_nthreads') call shr_mpi_bcast(cpl_nthreads,DRIVER_COMM,'cpl_nthreads') call shr_mpi_bcast(atm_layout,DRIVER_COMM,'atm_layout') @@ -360,6 +372,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) call shr_mpi_bcast(glc_layout,DRIVER_COMM,'glc_layout') call shr_mpi_bcast(wav_layout,DRIVER_COMM,'wav_layout') call shr_mpi_bcast(rof_layout,DRIVER_COMM,'rof_layout') + call shr_mpi_bcast(iac_layout,DRIVER_COMM,'iac_layout') call shr_mpi_bcast(esp_layout,DRIVER_COMM,'esp_layout') call shr_mpi_bcast(info_taskmap_model,DRIVER_COMM,'info_taskmap_model') @@ -421,10 +434,10 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) error_state = .false. num_inst_min = min(num_inst_atm, num_inst_lnd, num_inst_ocn,& num_inst_ice, num_inst_glc, num_inst_wav, num_inst_rof,& - num_inst_esp) + num_inst_esp, num_inst_iac) num_inst_max = max(num_inst_atm, num_inst_lnd, num_inst_ocn,& num_inst_ice, num_inst_glc, num_inst_wav, num_inst_rof,& - num_inst_esp) + num_inst_esp, num_inst_iac) if (num_inst_min /= num_inst_max .and. num_inst_min /= 1) error_state = .true. if (num_inst_atm /= num_inst_min .and. num_inst_atm /= num_inst_max) error_state = .true. @@ -434,6 +447,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) if (num_inst_glc /= num_inst_min .and. num_inst_glc /= num_inst_max) error_state = .true. if (num_inst_wav /= num_inst_min .and. num_inst_wav /= num_inst_max) error_state = .true. if (num_inst_rof /= num_inst_min .and. num_inst_rof /= num_inst_max) error_state = .true. + if (num_inst_iac /= num_inst_min .and. num_inst_iac /= num_inst_max) error_state = .true. if (num_inst_esp /= num_inst_min .and. num_inst_esp /= num_inst_max) error_state = .true. if (error_state) then @@ -466,6 +480,7 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) pelist(2,1) = cpl_rootpe + (cpl_ntasks -1) * cpl_pestride pelist(3,1) = cpl_pestride end if + call mpi_bcast(pelist, size(pelist), MPI_INTEGER, 0, DRIVER_COMM, ierr) call seq_comm_setcomm(CPLID,pelist,nthreads=cpl_nthreads,iname='CPL') @@ -485,6 +500,8 @@ subroutine seq_comm_init(global_comm_in, driver_comm_in, nmlfile, drv_comm_id) CPLID, WAVID, CPLWAVID, ALLWAVID, CPLALLWAVID, 'WAV', count, drv_comm_id) call comp_comm_init(driver_comm, esp_rootpe, esp_nthreads, esp_layout, esp_ntasks, esp_pestride, num_inst_esp, & CPLID, ESPID, CPLESPID, ALLESPID, CPLALLESPID, 'ESP', count, drv_comm_id) + call comp_comm_init(driver_comm, iac_rootpe, iac_nthreads, iac_layout, iac_ntasks, iac_pestride, num_inst_iac, & + CPLID, IACID, CPLIACID, ALLIACID, CPLALLIACID, 'IAC', count, drv_comm_id) if (count /= ncomps) then write(logunit,*) trim(subname),' ERROR in ID count ',count,ncomps diff --git a/src/drivers/mct/shr/seq_flds_mod.F90 b/src/drivers/mct/shr/seq_flds_mod.F90 index 654a926cfb7..3a21de4824f 100644 --- a/src/drivers/mct/shr/seq_flds_mod.F90 +++ b/src/drivers/mct/shr/seq_flds_mod.F90 @@ -212,6 +212,11 @@ module seq_flds_mod character(CXX) :: seq_flds_r2o_liq_fluxes character(CXX) :: seq_flds_r2o_ice_fluxes + !character(CXX) :: seq_flds_x2z_states + !character(CXX) :: seq_flds_z2x_states + character(CXX) :: seq_flds_z2x_fluxes + character(CXX) :: seq_flds_x2z_fluxes + !---------------------------------------------------------------------------- ! combined state/flux fields !---------------------------------------------------------------------------- diff --git a/src/drivers/mct/shr/seq_infodata_mod.F90 b/src/drivers/mct/shr/seq_infodata_mod.F90 index 1249be4d8dc..12644e25870 100644 --- a/src/drivers/mct/shr/seq_infodata_mod.F90 +++ b/src/drivers/mct/shr/seq_infodata_mod.F90 @@ -27,7 +27,7 @@ MODULE seq_infodata_mod use seq_comm_mct, only: seq_comm_setptrs, seq_comm_iamroot, seq_comm_iamin use seq_comm_mct, only: num_inst_atm, num_inst_lnd, num_inst_rof use seq_comm_mct, only: num_inst_ocn, num_inst_ice, num_inst_glc - use seq_comm_mct, only: num_inst_wav + use seq_comm_mct, only: num_inst_wav, num_inst_iac use shr_orb_mod, only: SHR_ORB_UNDEF_INT, SHR_ORB_UNDEF_REAL, shr_orb_params implicit none @@ -118,6 +118,7 @@ MODULE seq_infodata_mod character(SHR_KIND_CL) :: rof_gnam ! rof grid character(SHR_KIND_CL) :: glc_gnam ! glc grid character(SHR_KIND_CL) :: wav_gnam ! wav grid + character(SHR_KIND_CL) :: iac_gnam ! iac grid logical :: shr_map_dopole ! pole corrections in shr_map_mod character(SHR_KIND_CL) :: vect_map ! vector mapping option, none, cart3d, cart3d_diag, cart3d_uvw, cart3d_uvw_diag character(SHR_KIND_CS) :: aoflux_grid ! grid for atm ocn flux calc @@ -150,6 +151,7 @@ MODULE seq_infodata_mod logical :: histavg_rof ! cpl writes rof fields in average history file logical :: histavg_glc ! cpl writes glc fields in average history file logical :: histavg_wav ! cpl writes wav fields in average history file + logical :: histavg_iac ! cpl writes iac fields in average history file logical :: histavg_xao ! cpl writes flux xao fields in average history file real(SHR_KIND_R8) :: eps_frac ! fraction error tolerance real(SHR_KIND_R8) :: eps_amask ! atm mask error tolerance @@ -197,6 +199,8 @@ MODULE seq_infodata_mod logical :: wav_prognostic ! does component model need input data from driver logical :: esp_present ! does component model exist logical :: esp_prognostic ! does component model need input data from driver + logical :: iac_present ! does component model exist + logical :: iac_prognostic ! does component model need input data from driver logical :: dead_comps ! do we have dead models integer(SHR_KIND_IN) :: atm_nx ! nx, ny of "2d" grid integer(SHR_KIND_IN) :: atm_ny ! nx, ny of "2d" grid @@ -212,6 +216,8 @@ MODULE seq_infodata_mod integer(SHR_KIND_IN) :: glc_ny ! nx, ny of "2d" grid integer(SHR_KIND_IN) :: wav_nx ! nx, ny of "2d" grid integer(SHR_KIND_IN) :: wav_ny ! nx, ny of "2d" grid + integer(SHR_KIND_IN) :: iac_nx ! nx, ny of "2d" grid + integer(SHR_KIND_IN) :: iac_ny ! nx, ny of "2d" grid !--- set via components and may be time varying --- real(SHR_KIND_R8) :: nextsw_cday ! calendar of next atm shortwave @@ -224,6 +230,7 @@ MODULE seq_infodata_mod integer(SHR_KIND_IN) :: rof_phase ! rof phase integer(SHR_KIND_IN) :: wav_phase ! wav phase integer(SHR_KIND_IN) :: esp_phase ! esp phase + integer(SHR_KIND_IN) :: iac_phase ! iac phase logical :: atm_aero ! atmosphere aerosols logical :: glc_g2lupdate ! update glc2lnd fields in lnd model real(shr_kind_r8) :: max_cplstep_time ! abort if cplstep time exceeds this value @@ -356,6 +363,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) character(SHR_KIND_CL) :: rof_gnam ! rof grid character(SHR_KIND_CL) :: glc_gnam ! glc grid character(SHR_KIND_CL) :: wav_gnam ! wav grid + character(SHR_KIND_CL) :: iac_gnam ! iac grid logical :: shr_map_dopole ! pole corrections in shr_map_mod character(SHR_KIND_CL) :: vect_map ! vector mapping option character(SHR_KIND_CS) :: aoflux_grid ! grid for atm ocn flux calc @@ -387,6 +395,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) logical :: histavg_rof ! cpl writes rof fields in average history file logical :: histavg_glc ! cpl writes glc fields in average history file logical :: histavg_wav ! cpl writes wav fields in average history file + logical :: histavg_iac ! cpl writes wav fields in average history file logical :: histavg_xao ! cpl writes flux xao fields in average history file logical :: drv_threading ! is threading control in driver turned on real(SHR_KIND_R8) :: eps_frac ! fraction error tolerance @@ -423,7 +432,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) wv_sat_use_tables, wv_sat_table_spacing, & tfreeze_option, glc_renormalize_smb, & ice_gnam, rof_gnam, glc_gnam, wav_gnam, & - atm_gnam, lnd_gnam, ocn_gnam, cpl_decomp, & + atm_gnam, lnd_gnam, ocn_gnam, iac_gnam, cpl_decomp, & shr_map_dopole, vect_map, aoflux_grid, do_histinit, & do_budgets, drv_threading, & budget_inst, budget_daily, budget_month, & @@ -434,6 +443,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) histaux_double_precision, & histavg_atm, histavg_lnd, histavg_ocn, histavg_ice, & histavg_rof, histavg_glc, histavg_wav, histavg_xao, & + histavg_iac, & histaux_l2x1yrg, cpl_seq_option, & eps_frac, eps_amask, & eps_agrid, eps_aarea, eps_omask, eps_ogrid, & @@ -506,6 +516,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) rof_gnam = 'undefined' glc_gnam = 'undefined' wav_gnam = 'undefined' + iac_gnam = 'undefined' shr_map_dopole = .true. vect_map = 'cart3d' aoflux_grid = 'ocn' @@ -536,6 +547,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) histavg_rof = .true. histavg_glc = .true. histavg_wav = .true. + histavg_iac = .true. histavg_xao = .true. drv_threading = .false. eps_frac = 1.0e-02_SHR_KIND_R8 @@ -631,6 +643,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%rof_gnam = rof_gnam infodata%glc_gnam = glc_gnam infodata%wav_gnam = wav_gnam + infodata%iac_gnam = iac_gnam infodata%shr_map_dopole = shr_map_dopole #ifdef COMPARE_TO_NUOPC infodata%vect_map = 'none' @@ -665,6 +678,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%histavg_rof = histavg_rof infodata%histavg_glc = histavg_glc infodata%histavg_wav = histavg_wav + infodata%histavg_iac = histavg_iac infodata%histavg_xao = histavg_xao infodata%drv_threading = drv_threading infodata%eps_frac = eps_frac @@ -698,6 +712,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%glcocn_present = .true. infodata%glcice_present = .true. infodata%esp_present = .true. + infodata%iac_present = .true. infodata%atm_prognostic = .false. infodata%lnd_prognostic = .false. @@ -712,6 +727,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) ! in all cases. infodata%glc_coupled_fluxes = .true. infodata%wav_prognostic = .false. + infodata%iac_prognostic = .false. infodata%iceberg_prognostic = .false. infodata%esp_prognostic = .false. infodata%dead_comps = .false. @@ -730,6 +746,8 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%glc_ny = 0 infodata%wav_nx = 0 infodata%wav_ny = 0 + infodata%iac_nx = 0 + infodata%iac_ny = 0 infodata%nextsw_cday = -1.0_SHR_KIND_R8 infodata%precip_fact = 1.0_SHR_KIND_R8 @@ -740,6 +758,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%glc_phase = 1 infodata%rof_phase = 1 infodata%wav_phase = 1 + infodata%iac_phase = 1 infodata%atm_aero = .false. infodata%glc_g2lupdate = .false. infodata%glc_valid_input = .true. @@ -859,6 +878,7 @@ SUBROUTINE seq_infodata_Init( infodata, nmlfile, ID, pioid, cpl_tag) infodata%ocn_present = .true. infodata%glc_present = .false. infodata%wav_present = .false. + infodata%iac_present = .false. infodata%glclnd_present = .false. infodata%glcocn_present = .false. infodata%glcice_present = .false. @@ -929,12 +949,13 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ atm_present, atm_prognostic, lnd_present, lnd_prognostic, rof_prognostic, & rof_present, ocn_present, ocn_prognostic, ocnrof_prognostic, & ice_present, ice_prognostic, glc_present, glc_prognostic, & + iac_present, iac_prognostic, & glc_coupled_fluxes, & flood_present, wav_present, wav_prognostic, rofice_present, & glclnd_present, glcocn_present, glcice_present, iceberg_prognostic,& esp_present, esp_prognostic, & bfbflag, lnd_gnam, cpl_decomp, cpl_seq_option, & - ice_gnam, rof_gnam, glc_gnam, wav_gnam, & + ice_gnam, rof_gnam, glc_gnam, wav_gnam, iac_gnam, & atm_gnam, ocn_gnam, info_debug, dead_comps, read_restart, & shr_map_dopole, vect_map, aoflux_grid, flux_epbalfact, & nextsw_cday, precip_fact, flux_epbal, flux_albav, & @@ -948,15 +969,15 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ histaux_a2x3hr, histaux_a2x3hrp , histaux_l2x1yrg, & histaux_a2x24hr, histaux_l2x , histaux_r2x , histaux_double_precision, & orb_obliq, histavg_atm, histavg_lnd, histavg_ocn, histavg_ice, & - histavg_rof, histavg_glc, histavg_wav, histavg_xao, & + histavg_rof, histavg_glc, histavg_wav, histavg_xao, histavg_iac, & orb_iyear, orb_iyear_align, orb_mode, orb_mvelp, & orb_eccen, orb_obliqr, orb_lambm0, orb_mvelpp, wv_sat_scheme, & wv_sat_transition_start, wv_sat_use_tables, wv_sat_table_spacing, & tfreeze_option, glc_renormalize_smb, & glc_phase, rof_phase, atm_phase, lnd_phase, ocn_phase, ice_phase, & - wav_phase, esp_phase, wav_nx, wav_ny, atm_nx, atm_ny, & + wav_phase, iac_phase, esp_phase, wav_nx, wav_ny, atm_nx, atm_ny, & lnd_nx, lnd_ny, rof_nx, rof_ny, ice_nx, ice_ny, ocn_nx, ocn_ny, & - glc_nx, glc_ny, eps_frac, eps_amask, & + iac_nx, iac_ny, glc_nx, glc_ny, eps_frac, eps_amask, & eps_agrid, eps_aarea, eps_omask, eps_ogrid, eps_oarea, & reprosum_use_ddpdd, reprosum_allow_infnan, & reprosum_diffmax, reprosum_recompute, & @@ -1024,6 +1045,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ character(len=*), optional, intent(OUT) :: rof_gnam ! rof grid character(len=*), optional, intent(OUT) :: glc_gnam ! glc grid character(len=*), optional, intent(OUT) :: wav_gnam ! wav grid + character(len=*), optional, intent(OUT) :: iac_gnam ! iac grid logical, optional, intent(OUT) :: shr_map_dopole ! pole corrections in shr_map_mod character(len=*), optional, intent(OUT) :: vect_map ! vector mapping option character(len=*), optional, intent(OUT) :: aoflux_grid ! grid for atm ocn flux calc @@ -1054,6 +1076,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(OUT) :: histavg_rof logical, optional, intent(OUT) :: histavg_glc logical, optional, intent(OUT) :: histavg_wav + logical, optional, intent(OUT) :: histavg_iac logical, optional, intent(OUT) :: histavg_xao logical, optional, intent(OUT) :: drv_threading ! driver threading control flag real(SHR_KIND_R8), optional, intent(OUT) :: eps_frac ! fraction error tolerance @@ -1097,6 +1120,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(OUT) :: glc_coupled_fluxes logical, optional, intent(OUT) :: wav_present logical, optional, intent(OUT) :: wav_prognostic + logical, optional, intent(OUT) :: iac_present + logical, optional, intent(OUT) :: iac_prognostic logical, optional, intent(OUT) :: esp_present logical, optional, intent(OUT) :: esp_prognostic integer(SHR_KIND_IN), optional, intent(OUT) :: atm_nx ! nx,ny 2d grid size global @@ -1113,6 +1138,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ integer(SHR_KIND_IN), optional, intent(OUT) :: glc_ny integer(SHR_KIND_IN), optional, intent(OUT) :: wav_nx integer(SHR_KIND_IN), optional, intent(OUT) :: wav_ny + integer(SHR_KIND_IN), optional, intent(OUT) :: iac_nx + integer(SHR_KIND_IN), optional, intent(OUT) :: iac_ny real(SHR_KIND_R8), optional, intent(OUT) :: nextsw_cday ! calendar of next atm shortwave real(SHR_KIND_R8), optional, intent(OUT) :: precip_fact ! precip factor @@ -1124,6 +1151,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ integer(SHR_KIND_IN), optional, intent(OUT) :: glc_phase ! glc phase integer(SHR_KIND_IN), optional, intent(OUT) :: rof_phase ! rof phase integer(SHR_KIND_IN), optional, intent(OUT) :: wav_phase ! wav phase + integer(SHR_KIND_IN), optional, intent(OUT) :: iac_phase ! wav phase integer(SHR_KIND_IN), optional, intent(OUT) :: esp_phase ! wav phase logical, optional, intent(OUT) :: atm_aero ! atmosphere aerosols logical, optional, intent(OUT) :: glc_g2lupdate ! update glc2lnd fields in lnd model @@ -1192,6 +1220,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(rof_gnam) ) rof_gnam = infodata%rof_gnam if ( present(glc_gnam) ) glc_gnam = infodata%glc_gnam if ( present(wav_gnam) ) wav_gnam = infodata%wav_gnam + if ( present(iac_gnam) ) iac_gnam = infodata%iac_gnam if ( present(shr_map_dopole) ) shr_map_dopole = infodata%shr_map_dopole if ( present(vect_map) ) vect_map = infodata%vect_map if ( present(aoflux_grid) ) aoflux_grid = infodata%aoflux_grid @@ -1222,6 +1251,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(histavg_rof) ) histavg_rof = infodata%histavg_rof if ( present(histavg_glc) ) histavg_glc = infodata%histavg_glc if ( present(histavg_wav) ) histavg_wav = infodata%histavg_wav + if ( present(histavg_iac) ) histavg_iac = infodata%histavg_iac if ( present(histavg_xao) ) histavg_xao = infodata%histavg_xao if ( present(drv_threading) ) drv_threading = infodata%drv_threading if ( present(eps_frac) ) eps_frac = infodata%eps_frac @@ -1267,6 +1297,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(wav_prognostic) ) wav_prognostic = infodata%wav_prognostic if ( present(esp_present) ) esp_present = infodata%esp_present if ( present(esp_prognostic) ) esp_prognostic = infodata%esp_prognostic + if ( present(iac_present) ) iac_present = infodata%iac_present + if ( present(iac_prognostic) ) iac_prognostic = infodata%iac_prognostic if ( present(atm_nx) ) atm_nx = infodata%atm_nx if ( present(atm_ny) ) atm_ny = infodata%atm_ny if ( present(lnd_nx) ) lnd_nx = infodata%lnd_nx @@ -1281,6 +1313,8 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(glc_ny) ) glc_ny = infodata%glc_ny if ( present(wav_nx) ) wav_nx = infodata%wav_nx if ( present(wav_ny) ) wav_ny = infodata%wav_ny + if ( present(iac_nx) ) iac_nx = infodata%iac_nx + if ( present(iac_ny) ) iac_ny = infodata%iac_ny if ( present(nextsw_cday) ) nextsw_cday = infodata%nextsw_cday if ( present(precip_fact) ) precip_fact = infodata%precip_fact @@ -1305,6 +1339,7 @@ SUBROUTINE seq_infodata_GetData_explicit( infodata, cime_model, case_name, case_ if ( present(rof_phase) ) rof_phase = infodata%rof_phase if ( present(wav_phase) ) wav_phase = infodata%wav_phase if ( present(esp_phase) ) esp_phase = infodata%esp_phase + if ( present(iac_phase) ) iac_phase = infodata%iac_phase if ( present(atm_aero) ) atm_aero = infodata%atm_aero if ( present(glc_g2lupdate) ) glc_g2lupdate = infodata%glc_g2lupdate if ( present(max_cplstep_time) ) max_cplstep_time = infodata%max_cplstep_time @@ -1383,6 +1418,11 @@ SUBROUTINE seq_infodata_GetData_bytype( component_firstletter, infodata, & wav_prognostic=comp_prognostic, wav_gnam=comp_gnam, & wav_phase=comp_phase, wav_nx=comp_nx, wav_ny=comp_ny, & histavg_wav=histavg_comp) + else if (component_firstletter == 'z') then + call seq_infodata_GetData(infodata, iac_present=comp_present, & + iac_prognostic=comp_prognostic, iac_gnam=comp_gnam, & + iac_phase=comp_phase, iac_nx=comp_nx, iac_ny=comp_ny, & + histavg_iac=histavg_comp) else if (component_firstletter == 'e') then if (present(comp_gnam)) then comp_gnam = '' @@ -1439,8 +1479,9 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ flood_present, wav_present, wav_prognostic, rofice_present, & glclnd_present, glcocn_present, glcice_present, iceberg_prognostic,& esp_present, esp_prognostic, & + iac_present, iac_prognostic, & bfbflag, lnd_gnam, cpl_decomp, cpl_seq_option, & - ice_gnam, rof_gnam, glc_gnam, wav_gnam, & + ice_gnam, rof_gnam, glc_gnam, wav_gnam, iac_gnam, & atm_gnam, ocn_gnam, info_debug, dead_comps, read_restart, & shr_map_dopole, vect_map, aoflux_grid, run_barriers, & nextsw_cday, precip_fact, flux_epbal, flux_albav, & @@ -1454,15 +1495,15 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ histaux_a2x3hr, histaux_a2x3hrp , histaux_l2x1yrg, & histaux_a2x24hr, histaux_l2x , histaux_r2x , histaux_double_precision, & orb_obliq, histavg_atm, histavg_lnd, histavg_ocn, histavg_ice, & - histavg_rof, histavg_glc, histavg_wav, histavg_xao, & + histavg_rof, histavg_glc, histavg_wav, histavg_xao, histavg_iac, & orb_iyear, orb_iyear_align, orb_mode, orb_mvelp, & orb_eccen, orb_obliqr, orb_lambm0, orb_mvelpp, wv_sat_scheme, & wv_sat_transition_start, wv_sat_use_tables, wv_sat_table_spacing, & tfreeze_option, glc_renormalize_smb, & glc_phase, rof_phase, atm_phase, lnd_phase, ocn_phase, ice_phase, & - wav_phase, esp_phase, wav_nx, wav_ny, atm_nx, atm_ny, & + wav_phase, iac_phase, esp_phase, wav_nx, wav_ny, atm_nx, atm_ny, & lnd_nx, lnd_ny, rof_nx, rof_ny, ice_nx, ice_ny, ocn_nx, ocn_ny, & - glc_nx, glc_ny, eps_frac, eps_amask, & + iac_nx, iac_ny, glc_nx, glc_ny, eps_frac, eps_amask, & eps_agrid, eps_aarea, eps_omask, eps_ogrid, eps_oarea, & reprosum_use_ddpdd, reprosum_allow_infnan, & reprosum_diffmax, reprosum_recompute, & @@ -1528,6 +1569,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ character(len=*), optional, intent(IN) :: rof_gnam ! rof grid character(len=*), optional, intent(IN) :: glc_gnam ! glc grid character(len=*), optional, intent(IN) :: wav_gnam ! wav grid + character(len=*), optional, intent(IN) :: iac_gnam ! iac grid logical, optional, intent(IN) :: shr_map_dopole ! pole corrections in shr_map_mod character(len=*), optional, intent(IN) :: vect_map ! vector mapping option character(len=*), optional, intent(IN) :: aoflux_grid ! grid for atm ocn flux calc @@ -1559,6 +1601,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(IN) :: histavg_glc logical, optional, intent(IN) :: histavg_wav logical, optional, intent(IN) :: histavg_xao + logical, optional, intent(IN) :: histavg_iac logical, optional, intent(IN) :: drv_threading ! driver threading control flag real(SHR_KIND_R8), optional, intent(IN) :: eps_frac ! fraction error tolerance real(SHR_KIND_R8), optional, intent(IN) :: eps_amask ! atm mask error tolerance @@ -1603,6 +1646,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ logical, optional, intent(IN) :: wav_prognostic logical, optional, intent(IN) :: esp_present logical, optional, intent(IN) :: esp_prognostic + logical, optional, intent(IN) :: iac_present + logical, optional, intent(IN) :: iac_prognostic integer(SHR_KIND_IN), optional, intent(IN) :: atm_nx ! nx,ny 2d grid size global integer(SHR_KIND_IN), optional, intent(IN) :: atm_ny ! nx,ny 2d grid size global integer(SHR_KIND_IN), optional, intent(IN) :: lnd_nx @@ -1617,6 +1662,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ integer(SHR_KIND_IN), optional, intent(IN) :: glc_ny integer(SHR_KIND_IN), optional, intent(IN) :: wav_nx integer(SHR_KIND_IN), optional, intent(IN) :: wav_ny + integer(SHR_KIND_IN), optional, intent(IN) :: iac_nx + integer(SHR_KIND_IN), optional, intent(IN) :: iac_ny real(SHR_KIND_R8), optional, intent(IN) :: nextsw_cday ! calendar of next atm shortwave real(SHR_KIND_R8), optional, intent(IN) :: precip_fact ! precip factor @@ -1627,6 +1674,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ integer(SHR_KIND_IN), optional, intent(IN) :: glc_phase ! glc phase integer(SHR_KIND_IN), optional, intent(IN) :: rof_phase ! rof phase integer(SHR_KIND_IN), optional, intent(IN) :: wav_phase ! wav phase + integer(SHR_KIND_IN), optional, intent(IN) :: iac_phase ! iac phase integer(SHR_KIND_IN), optional, intent(IN) :: esp_phase ! esp phase logical, optional, intent(IN) :: atm_aero ! atm aerosols logical, optional, intent(IN) :: glc_g2lupdate ! update glc2lnd fields in lnd model @@ -1694,6 +1742,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(rof_gnam) ) infodata%rof_gnam = rof_gnam if ( present(glc_gnam) ) infodata%glc_gnam = glc_gnam if ( present(wav_gnam) ) infodata%wav_gnam = wav_gnam + if ( present(iac_gnam) ) infodata%iac_gnam = iac_gnam if ( present(shr_map_dopole) ) infodata%shr_map_dopole = shr_map_dopole if ( present(vect_map) ) infodata%vect_map = vect_map if ( present(aoflux_grid) ) infodata%aoflux_grid = aoflux_grid @@ -1724,6 +1773,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(histavg_rof) ) infodata%histavg_rof = histavg_rof if ( present(histavg_glc) ) infodata%histavg_glc = histavg_glc if ( present(histavg_wav) ) infodata%histavg_wav = histavg_wav + if ( present(histavg_iac) ) infodata%histavg_iac = histavg_iac if ( present(histavg_xao) ) infodata%histavg_xao = histavg_xao if ( present(drv_threading) ) infodata%drv_threading = drv_threading if ( present(eps_frac) ) infodata%eps_frac = eps_frac @@ -1767,6 +1817,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(glc_coupled_fluxes)) infodata%glc_coupled_fluxes = glc_coupled_fluxes if ( present(wav_present) ) infodata%wav_present = wav_present if ( present(wav_prognostic) ) infodata%wav_prognostic = wav_prognostic + if ( present(iac_present) ) infodata%iac_present = iac_present + if ( present(iac_prognostic) ) infodata%iac_prognostic = iac_prognostic if ( present(esp_present) ) infodata%esp_present = esp_present if ( present(esp_prognostic) ) infodata%esp_prognostic = esp_prognostic if ( present(atm_nx) ) infodata%atm_nx = atm_nx @@ -1783,6 +1835,8 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(glc_ny) ) infodata%glc_ny = glc_ny if ( present(wav_nx) ) infodata%wav_nx = wav_nx if ( present(wav_ny) ) infodata%wav_ny = wav_ny + if ( present(iac_nx) ) infodata%iac_nx = iac_nx + if ( present(iac_ny) ) infodata%iac_ny = iac_ny if ( present(nextsw_cday) ) infodata%nextsw_cday = nextsw_cday if ( present(precip_fact) ) infodata%precip_fact = precip_fact @@ -1793,6 +1847,7 @@ SUBROUTINE seq_infodata_PutData_explicit( infodata, cime_model, case_name, case_ if ( present(glc_phase) ) infodata%glc_phase = glc_phase if ( present(rof_phase) ) infodata%rof_phase = rof_phase if ( present(wav_phase) ) infodata%wav_phase = wav_phase + if ( present(iac_phase) ) infodata%iac_phase = iac_phase if ( present(esp_phase) ) infodata%esp_phase = esp_phase if ( present(atm_aero) ) infodata%atm_aero = atm_aero if ( present(glc_g2lupdate) ) infodata%glc_g2lupdate = glc_g2lupdate @@ -1870,6 +1925,11 @@ SUBROUTINE seq_infodata_PutData_bytype( component_firstletter, infodata, & wav_prognostic=comp_prognostic, wav_gnam=comp_gnam, & wav_phase=comp_phase, wav_nx=comp_nx, wav_ny=comp_ny, & histavg_wav=histavg_comp) + else if (component_firstletter == 'z') then + call seq_infodata_PutData(infodata, iac_present=comp_present, & + iac_prognostic=comp_prognostic, iac_gnam=comp_gnam, & + iac_phase=comp_phase, iac_nx=comp_nx, iac_ny=comp_ny, & + histavg_iac=histavg_comp) else if (component_firstletter == 'e') then if ((loglevel > 1) .and. seq_comm_iamroot(1)) then if (present(comp_gnam)) then @@ -1980,6 +2040,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%rof_gnam, mpicom) call shr_mpi_bcast(infodata%glc_gnam, mpicom) call shr_mpi_bcast(infodata%wav_gnam, mpicom) + call shr_mpi_bcast(infodata%iac_gnam, mpicom) call shr_mpi_bcast(infodata%shr_map_dopole, mpicom) call shr_mpi_bcast(infodata%vect_map, mpicom) call shr_mpi_bcast(infodata%aoflux_grid, mpicom) @@ -2010,6 +2071,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%histavg_rof , mpicom) call shr_mpi_bcast(infodata%histavg_glc , mpicom) call shr_mpi_bcast(infodata%histavg_wav , mpicom) + call shr_mpi_bcast(infodata%histavg_iac , mpicom) call shr_mpi_bcast(infodata%histavg_xao , mpicom) call shr_mpi_bcast(infodata%drv_threading, mpicom) call shr_mpi_bcast(infodata%eps_frac, mpicom) @@ -2055,6 +2117,8 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%wav_prognostic, mpicom) call shr_mpi_bcast(infodata%esp_present, mpicom) call shr_mpi_bcast(infodata%esp_prognostic, mpicom) + call shr_mpi_bcast(infodata%iac_present, mpicom) + call shr_mpi_bcast(infodata%iac_prognostic, mpicom) call shr_mpi_bcast(infodata%atm_nx, mpicom) call shr_mpi_bcast(infodata%atm_ny, mpicom) @@ -2070,6 +2134,8 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%glc_ny, mpicom) call shr_mpi_bcast(infodata%wav_nx, mpicom) call shr_mpi_bcast(infodata%wav_ny, mpicom) + call shr_mpi_bcast(infodata%iac_nx, mpicom) + call shr_mpi_bcast(infodata%iac_ny, mpicom) call shr_mpi_bcast(infodata%nextsw_cday, mpicom) call shr_mpi_bcast(infodata%precip_fact, mpicom) @@ -2080,6 +2146,7 @@ subroutine seq_infodata_bcast(infodata,mpicom) call shr_mpi_bcast(infodata%glc_phase, mpicom) call shr_mpi_bcast(infodata%rof_phase, mpicom) call shr_mpi_bcast(infodata%wav_phase, mpicom) + call shr_mpi_bcast(infodata%iac_phase, mpicom) call shr_mpi_bcast(infodata%atm_aero, mpicom) call shr_mpi_bcast(infodata%glc_g2lupdate, mpicom) call shr_mpi_bcast(infodata%glc_valid_input, mpicom) @@ -2123,6 +2190,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) logical :: ice2cpli,ice2cplr logical :: glc2cpli,glc2cplr logical :: wav2cpli,wav2cplr + logical :: iac2cpli,iac2cplr logical :: esp2cpli logical :: cpl2i,cpl2r logical :: logset @@ -2151,6 +2219,8 @@ subroutine seq_infodata_Exchange(infodata,ID,type) glc2cplr = .false. wav2cpli = .false. wav2cplr = .false. + iac2cpli = .false. + iac2cplr = .false. esp2cpli = .false. cpl2i = .false. cpl2r = .false. @@ -2227,6 +2297,16 @@ subroutine seq_infodata_Exchange(infodata,ID,type) logset = .true. endif + if (trim(type) == 'iac2cpl_init') then + iac2cpli = .true. + iac2cplr = .true. + logset = .true. + endif + if (trim(type) == 'iac2cpl_run') then + iac2cplr = .true. + logset = .true. + endif + if (trim(type) == 'esp2cpl_init') then esp2cpli = .true. logset = .true. @@ -2238,6 +2318,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) trim(type) == 'cpl2ocn_init' .or. & trim(type) == 'cpl2glc_init' .or. & trim(type) == 'cpl2wav_init' .or. & + trim(type) == 'cpl2iac_init' .or. & trim(type) == 'cpl2esp_init' .or. & trim(type) == 'cpl2ice_init') then cpl2i = .true. @@ -2251,6 +2332,7 @@ subroutine seq_infodata_Exchange(infodata,ID,type) trim(type) == 'cpl2ocn_run' .or. & trim(type) == 'cpl2glc_run' .or. & trim(type) == 'cpl2wav_run' .or. & + trim(type) == 'cpl2iac_run' .or. & trim(type) == 'cpl2ice_run') then cpl2r = .true. logset = .true. @@ -2351,6 +2433,17 @@ subroutine seq_infodata_Exchange(infodata,ID,type) if (deads .or. infodata%dead_comps) infodata%dead_comps = .true. endif + if (iac2cpli) then + call shr_mpi_bcast(infodata%iac_present, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%iac_prognostic, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%iac_nx, mpicom, pebcast=cmppe) + call shr_mpi_bcast(infodata%iac_ny, mpicom, pebcast=cmppe) + ! dead_comps is true if it's ever set to true + deads = infodata%dead_comps + call shr_mpi_bcast(deads, mpicom, pebcast=cmppe) + if (deads .or. infodata%dead_comps) infodata%dead_comps = .true. + endif + if (esp2cpli) then call shr_mpi_bcast(infodata%esp_present, mpicom, pebcast=cmppe) call shr_mpi_bcast(infodata%esp_prognostic, mpicom, pebcast=cmppe) @@ -2379,6 +2472,8 @@ subroutine seq_infodata_Exchange(infodata,ID,type) call shr_mpi_bcast(infodata%glc_coupled_fluxes, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%wav_present, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%wav_prognostic, mpicom, pebcast=cplpe) + call shr_mpi_bcast(infodata%iac_present, mpicom, pebcast=cplpe) + call shr_mpi_bcast(infodata%iac_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%esp_present, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%esp_prognostic, mpicom, pebcast=cplpe) call shr_mpi_bcast(infodata%dead_comps, mpicom, pebcast=cplpe) @@ -2638,6 +2733,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0A) subname,'rof_gridname = ', trim(infodata%rof_gnam) write(logunit,F0A) subname,'glc_gridname = ', trim(infodata%glc_gnam) write(logunit,F0A) subname,'wav_gridname = ', trim(infodata%wav_gnam) + write(logunit,F0A) subname,'iac_gridname = ', trim(infodata%iac_gnam) write(logunit,F0L) subname,'shr_map_dopole = ', infodata%shr_map_dopole write(logunit,F0A) subname,'vect_map = ', trim(infodata%vect_map) write(logunit,F0A) subname,'aoflux_grid = ', trim(infodata%aoflux_grid) @@ -2668,6 +2764,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0L) subname,'histavg_rof = ', infodata%histavg_rof write(logunit,F0L) subname,'histavg_glc = ', infodata%histavg_glc write(logunit,F0L) subname,'histavg_wav = ', infodata%histavg_wav + write(logunit,F0L) subname,'histavg_iac = ', infodata%histavg_iac write(logunit,F0L) subname,'histavg_xao = ', infodata%histavg_xao write(logunit,F0L) subname,'drv_threading = ', infodata%drv_threading @@ -2715,6 +2812,8 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0L) subname,'glc_coupled_fluxes = ', infodata%glc_coupled_fluxes write(logunit,F0L) subname,'wav_present = ', infodata%wav_present write(logunit,F0L) subname,'wav_prognostic = ', infodata%wav_prognostic + write(logunit,F0L) subname,'iac_present = ', infodata%iac_present + write(logunit,F0L) subname,'iac_prognostic = ', infodata%iac_prognostic write(logunit,F0L) subname,'esp_present = ', infodata%esp_present write(logunit,F0L) subname,'esp_prognostic = ', infodata%esp_prognostic @@ -2732,6 +2831,8 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0I) subname,'glc_ny = ', infodata%glc_ny write(logunit,F0I) subname,'wav_nx = ', infodata%wav_nx write(logunit,F0I) subname,'wav_ny = ', infodata%wav_ny + write(logunit,F0I) subname,'iac_nx = ', infodata%iac_nx + write(logunit,F0I) subname,'iac_ny = ', infodata%iac_ny write(logunit,F0R) subname,'nextsw_cday = ', infodata%nextsw_cday write(logunit,F0R) subname,'precip_fact = ', infodata%precip_fact @@ -2744,6 +2845,7 @@ SUBROUTINE seq_infodata_print( infodata ) write(logunit,F0S) subname,'glc_phase = ', infodata%glc_phase write(logunit,F0S) subname,'rof_phase = ', infodata%rof_phase write(logunit,F0S) subname,'wav_phase = ', infodata%wav_phase + write(logunit,F0S) subname,'iac_phase = ', infodata%iac_phase write(logunit,F0L) subname,'glc_g2lupdate = ', infodata%glc_g2lupdate ! endif diff --git a/src/drivers/mct/shr/seq_timemgr_mod.F90 b/src/drivers/mct/shr/seq_timemgr_mod.F90 index 18ae5579c5a..e945f28367d 100644 --- a/src/drivers/mct/shr/seq_timemgr_mod.F90 +++ b/src/drivers/mct/shr/seq_timemgr_mod.F90 @@ -153,9 +153,10 @@ module seq_timemgr_mod seq_timemgr_nclock_glc = 6, & seq_timemgr_nclock_wav = 7, & seq_timemgr_nclock_rof = 8, & - seq_timemgr_nclock_esp = 9 + seq_timemgr_nclock_iac = 9, & + seq_timemgr_nclock_esp = 10 - integer(SHR_KIND_IN),private,parameter :: max_clocks = 9 + integer(SHR_KIND_IN),private,parameter :: max_clocks = 10 character(len=*),public,parameter :: & seq_timemgr_clock_drv = 'seq_timemgr_clock_drv' , & seq_timemgr_clock_atm = 'seq_timemgr_clock_atm' , & @@ -168,7 +169,8 @@ module seq_timemgr_mod seq_timemgr_clock_esp = 'seq_timemgr_clock_esp' character(len=8),private,parameter :: seq_timemgr_clocks(max_clocks) = & (/'drv ','atm ','lnd ','ocn ', & - 'ice ','glc ','wav ','rof ','esp '/) + 'ice ','glc ','wav ','rof ', & + 'iac ','esp '/) ! Alarms on both component clocks and driver clock integer(SHR_KIND_IN),private,parameter :: & @@ -188,9 +190,10 @@ module seq_timemgr_mod seq_timemgr_nalarm_histavg =14 , & ! driver and component clock alarm seq_timemgr_nalarm_rofrun =15 , & ! driver only clock alarm seq_timemgr_nalarm_wavrun =16 , & ! driver only clock alarm - seq_timemgr_nalarm_esprun =17 , & ! driver only clock alarm - seq_timemgr_nalarm_pause =18 , & - seq_timemgr_nalarm_barrier =19 , & ! driver and component clock alarm + seq_timemgr_nalarm_iacrun =17 , & ! driver only clock alarm + seq_timemgr_nalarm_esprun =18 , & ! driver only clock alarm + seq_timemgr_nalarm_pause =19 , & + seq_timemgr_nalarm_barrier =20 , & ! driver and component clock alarm max_alarms = seq_timemgr_nalarm_barrier character(len=*),public,parameter :: & @@ -210,6 +213,7 @@ module seq_timemgr_mod seq_timemgr_alarm_histavg = 'seq_timemgr_alarm_histavg ', & seq_timemgr_alarm_rofrun = 'seq_timemgr_alarm_rofrun ', & seq_timemgr_alarm_wavrun = 'seq_timemgr_alarm_wavrun ', & + seq_timemgr_alarm_iacrun = 'seq_timemgr_alarm_iacrun ', & seq_timemgr_alarm_esprun = 'seq_timemgr_alarm_esprun ', & seq_timemgr_alarm_pause = 'seq_timemgr_alarm_pause ', & seq_timemgr_alarm_barrier = 'seq_timemgr_alarm_barrier ' @@ -255,7 +259,7 @@ module seq_timemgr_mod subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioid, mpicom, & EClock_drv, EClock_atm, EClock_lnd, EClock_ocn, EClock_ice, Eclock_glc, & - Eclock_rof, EClock_wav, Eclock_esp) + Eclock_rof, EClock_wav, Eclock_esp, Eclock_iac) ! !USES: use pio, only : file_desc_T @@ -280,6 +284,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi type(ESMF_clock),target, intent(IN) :: EClock_glc ! glc clock type(ESMF_clock),target, intent(IN) :: EClock_rof ! rof clock type(ESMF_clock),target, intent(IN) :: EClock_wav ! wav clock + type(ESMF_clock),target, intent(IN) :: EClock_iac ! iac clock type(ESMF_clock),target, intent(IN) :: EClock_esp ! esp clock type(file_desc_t) :: pioid @@ -324,6 +329,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi logical :: pause_active_ice logical :: pause_active_rof logical :: pause_active_lnd + logical :: pause_active_iac logical :: data_assimilation_atm logical :: data_assimilation_cpl @@ -333,6 +339,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi logical :: data_assimilation_ice logical :: data_assimilation_rof logical :: data_assimilation_lnd + logical :: data_assimilation_iac character(SHR_KIND_CS) :: history_option ! History option units integer(SHR_KIND_IN) :: history_n ! Number until history interval @@ -360,6 +367,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi character(SHR_KIND_CS) :: glc_avg_period ! Glc avering coupling period integer(SHR_KIND_IN) :: rof_cpl_dt ! Runoff coupling interval integer(SHR_KIND_IN) :: wav_cpl_dt ! Wav coupling interval + integer(SHR_KIND_IN) :: iac_cpl_dt ! Iac coupling interval integer(SHR_KIND_IN) :: esp_cpl_dt ! Esp coupling interval integer(SHR_KIND_IN) :: atm_cpl_offset ! Atmosphere coupling interval integer(SHR_KIND_IN) :: lnd_cpl_offset ! Land coupling interval @@ -369,6 +377,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi integer(SHR_KIND_IN) :: wav_cpl_offset ! Wav coupling interval integer(SHR_KIND_IN) :: rof_cpl_offset ! Runoff coupling interval integer(SHR_KIND_IN) :: esp_cpl_offset ! Esp coupling interval + integer(SHR_KIND_IN) :: iac_cpl_offset ! Iac coupling interval logical :: esp_run_on_pause ! Run ESP on pause cycle logical :: end_restart ! Write restart at end of run integer(SHR_KIND_IN) :: ierr ! Return code @@ -386,6 +395,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi pause_active_cpl, & pause_active_ocn, & pause_active_wav, & + pause_active_iac, & pause_active_glc, & pause_active_ice, & pause_active_rof, & @@ -394,6 +404,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi data_assimilation_cpl, & data_assimilation_ocn, & data_assimilation_wav, & + data_assimilation_iac, & data_assimilation_glc, & data_assimilation_ice, & data_assimilation_rof, & @@ -407,6 +418,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi atm_cpl_offset, lnd_cpl_offset, ocn_cpl_offset, & ice_cpl_offset, glc_cpl_dt, glc_cpl_offset, glc_avg_period, & wav_cpl_dt, wav_cpl_offset, esp_cpl_dt, esp_cpl_offset, & + iac_cpl_dt, iac_cpl_offset, & rof_cpl_dt, rof_cpl_offset, esp_run_on_pause, end_restart !------------------------------------------------------------------------------- ! Notes: @@ -421,6 +433,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi SyncClock%ECP(seq_timemgr_nclock_rof)%EClock => EClock_rof SyncClock%ECP(seq_timemgr_nclock_wav)%EClock => EClock_wav SyncClock%ECP(seq_timemgr_nclock_esp)%EClock => EClock_esp + SyncClock%ECP(seq_timemgr_nclock_iac)%EClock => EClock_iac call mpi_comm_rank(mpicom,iam,ierr) @@ -451,6 +464,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi pause_active_ice = .false. pause_active_rof = .false. pause_active_lnd = .false. + pause_active_iac = .false. data_assimilation_atm = .false. data_assimilation_cpl = .false. data_assimilation_ocn = .false. @@ -459,6 +473,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi data_assimilation_ice = .false. data_assimilation_rof = .false. data_assimilation_lnd = .false. + data_assimilation_iac = .false. history_option = seq_timemgr_optNever history_n = -1 @@ -487,6 +502,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi rof_cpl_dt = 0 wav_cpl_dt = 0 esp_cpl_dt = 0 + iac_cpl_dt = 0 atm_cpl_offset = 0 lnd_cpl_offset = 0 ice_cpl_offset = 0 @@ -495,6 +511,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi rof_cpl_offset = 0 wav_cpl_offset = 0 esp_cpl_offset = 0 + iac_cpl_offset = 0 esp_run_on_pause = .true. end_restart = .true. @@ -550,6 +567,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi if (glc_cpl_dt == 0) glc_cpl_dt = atm_cpl_dt ! Copy atm coupling time into glc if (wav_cpl_dt == 0) wav_cpl_dt = atm_cpl_dt ! Copy atm coupling time into wav if (esp_cpl_dt == 0) esp_cpl_dt = atm_cpl_dt ! Copy atm coupling time into esp + if (iac_cpl_dt == 0) iac_cpl_dt = atm_cpl_dt ! Copy atm coupling time into iac if ( ref_ymd == 0 ) then ref_ymd = start_ymd @@ -632,6 +650,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi write(logunit,F0I) trim(subname),' rof_cpl_dt = ',rof_cpl_dt write(logunit,F0I) trim(subname),' wav_cpl_dt = ',wav_cpl_dt write(logunit,F0I) trim(subname),' esp_cpl_dt = ',esp_cpl_dt + write(logunit,F0I) trim(subname),' iac_cpl_dt = ',iac_cpl_dt write(logunit,F0I) trim(subname),' atm_cpl_offset = ',atm_cpl_offset write(logunit,F0I) trim(subname),' lnd_cpl_offset = ',lnd_cpl_offset write(logunit,F0I) trim(subname),' ice_cpl_offset = ',ice_cpl_offset @@ -640,6 +659,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi write(logunit,F0I) trim(subname),' rof_cpl_offset = ',rof_cpl_offset write(logunit,F0I) trim(subname),' wav_cpl_offset = ',wav_cpl_offset write(logunit,F0I) trim(subname),' esp_cpl_offset = ',esp_cpl_offset + write(logunit,F0I) trim(subname),' iac_cpl_offset = ',iac_cpl_offset write(logunit,F0A) ' ' !--------------------------------------------------------------------------- @@ -651,10 +671,10 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi lnd_cpl_dt /= atm_cpl_dt .or. & ice_cpl_dt /= atm_cpl_dt .or. & ocn_cpl_dt <= 0 .or. glc_cpl_dt <= 0 .or. rof_cpl_dt <=0 .or. & - wav_cpl_dt <=0 .or. esp_cpl_dt <=0) then + wav_cpl_dt <=0 .or. esp_cpl_dt <=0 .or. iac_cpl_dt <=0) then write(logunit,*) trim(subname),' ERROR: aliogrwe _cpl_dt = ', & atm_cpl_dt, lnd_cpl_dt, ice_cpl_dt, ocn_cpl_dt, glc_cpl_dt, & - rof_cpl_dt, wav_cpl_dt, esp_cpl_dt + rof_cpl_dt, wav_cpl_dt, esp_cpl_dt, iac_cpl_dt call shr_sys_abort( subname//': ERROR coupling intervals invalid' ) end if ! --- Coupling offsets -------------------------------------------------- @@ -665,10 +685,12 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi abs(rof_cpl_offset) > rof_cpl_dt .or. & abs(wav_cpl_offset) > wav_cpl_dt .or. & abs(esp_cpl_offset) > esp_cpl_dt .or. & + abs(iac_cpl_offset) > iac_cpl_dt .or. & abs(ocn_cpl_offset) > ocn_cpl_dt) then write(logunit,*) trim(subname),' ERROR: aliogrwe _cpl_offset = ', & atm_cpl_offset, lnd_cpl_offset, ice_cpl_offset, ocn_cpl_offset, & - glc_cpl_offset, rof_cpl_offset, wav_cpl_offset, esp_cpl_offset + glc_cpl_offset, rof_cpl_offset, wav_cpl_offset, esp_cpl_offset, & + iac_cpl_offset call shr_sys_abort( subname//': ERROR coupling offsets invalid' ) end if @@ -702,6 +724,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi call shr_mpi_bcast(pause_active_ice, mpicom ) call shr_mpi_bcast(pause_active_rof, mpicom ) call shr_mpi_bcast(pause_active_lnd, mpicom ) + call shr_mpi_bcast(pause_active_iac, mpicom ) call shr_mpi_bcast(data_assimilation_atm, mpicom ) call shr_mpi_bcast(data_assimilation_cpl, mpicom ) call shr_mpi_bcast(data_assimilation_ocn, mpicom ) @@ -710,6 +733,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi call shr_mpi_bcast(data_assimilation_ice, mpicom ) call shr_mpi_bcast(data_assimilation_rof, mpicom ) call shr_mpi_bcast(data_assimilation_lnd, mpicom ) + call shr_mpi_bcast(data_assimilation_iac, mpicom ) call shr_mpi_bcast( history_n, mpicom ) call shr_mpi_bcast( history_option, mpicom ) @@ -738,6 +762,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi call shr_mpi_bcast( rof_cpl_dt, mpicom ) call shr_mpi_bcast( wav_cpl_dt, mpicom ) call shr_mpi_bcast( esp_cpl_dt, mpicom ) + call shr_mpi_bcast( iac_cpl_dt, mpicom ) call shr_mpi_bcast( atm_cpl_offset, mpicom ) call shr_mpi_bcast( lnd_cpl_offset, mpicom ) call shr_mpi_bcast( ice_cpl_offset, mpicom ) @@ -746,6 +771,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi call shr_mpi_bcast( rof_cpl_offset, mpicom ) call shr_mpi_bcast( wav_cpl_offset, mpicom ) call shr_mpi_bcast( esp_cpl_offset, mpicom ) + call shr_mpi_bcast( iac_cpl_offset, mpicom ) call shr_mpi_bcast( esp_run_on_pause, mpicom ) call shr_mpi_bcast( end_restart, mpicom ) @@ -787,6 +813,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi pause_active(seq_timemgr_nclock_ice) = pause_active_ice pause_active(seq_timemgr_nclock_rof) = pause_active_rof pause_active(seq_timemgr_nclock_lnd) = pause_active_lnd + pause_active(seq_timemgr_nclock_iac) = pause_active_iac ! Figure out which compoments need to do post-data assimilation processing data_assimilation_active(seq_timemgr_nclock_atm) = data_assimilation_atm @@ -797,6 +824,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi data_assimilation_active(seq_timemgr_nclock_ice) = data_assimilation_ice data_assimilation_active(seq_timemgr_nclock_rof) = data_assimilation_rof data_assimilation_active(seq_timemgr_nclock_lnd) = data_assimilation_lnd + data_assimilation_active(seq_timemgr_nclock_iac) = data_assimilation_iac if ( ANY(pause_active) .and. & (trim(pause_option) /= seq_timemgr_optNONE) .and. & @@ -841,6 +869,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi dtime(seq_timemgr_nclock_rof ) = rof_cpl_dt dtime(seq_timemgr_nclock_wav ) = wav_cpl_dt dtime(seq_timemgr_nclock_esp ) = esp_cpl_dt + dtime(seq_timemgr_nclock_iac ) = iac_cpl_dt ! --- this finds the min of dtime excluding the driver value --- dtime(seq_timemgr_nclock_drv) = maxval(dtime) @@ -1003,6 +1032,7 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi offset(seq_timemgr_nclock_rof) = rof_cpl_offset offset(seq_timemgr_nclock_wav) = wav_cpl_offset offset(seq_timemgr_nclock_esp) = esp_cpl_offset + offset(seq_timemgr_nclock_iac) = iac_cpl_offset call seq_timemgr_alarmGet(SyncClock%EAlarm(seq_timemgr_nclock_drv, & seq_timemgr_nalarm_restart), IntSec=drvRestInterval) @@ -1084,6 +1114,15 @@ subroutine seq_timemgr_clockInit(SyncClock, nmlfile, restart, restart_file, pioi RefTime = OffsetTime, & alarmname = trim(seq_timemgr_alarm_wavrun)) + call ESMF_TimeIntervalSet( TimeStep, s=offset(seq_timemgr_nclock_iac), rc=rc ) + OffsetTime = CurrTime + TimeStep + call seq_timemgr_alarmInit(SyncClock%ECP(seq_timemgr_nclock_drv)%EClock, & + EAlarm = SyncClock%EAlarm(seq_timemgr_nclock_drv,seq_timemgr_nalarm_iacrun), & + option = seq_timemgr_optNSeconds, & + opt_n = dtime(seq_timemgr_nclock_iac), & + RefTime = OffsetTime, & + alarmname = trim(seq_timemgr_alarm_iacrun)) + call ESMF_TimeIntervalSet( TimeStep, s=offset(seq_timemgr_nclock_glc), rc=rc ) OffsetTime = CurrTime + TimeStep call ESMF_TimeIntervalSet( TimeStep, s=-offset(seq_timemgr_nclock_drv), rc=rc ) @@ -2244,6 +2283,8 @@ logical function seq_timemgr_data_assimilation_active(component_ntype) seq_timemgr_data_assimilation_active = data_assimilation_active(seq_timemgr_nclock_rof) case ('lnd') seq_timemgr_data_assimilation_active = data_assimilation_active(seq_timemgr_nclock_lnd) + case ('iac') + seq_timemgr_data_assimilation_active = data_assimilation_active(seq_timemgr_nclock_iac) case ('esp') seq_timemgr_data_assimilation_active = .FALSE. case default diff --git a/src/drivers/mct/unit_test/CMakeLists.txt b/src/drivers/mct/unit_test/CMakeLists.txt index fb27128d857..289a49c8599 100644 --- a/src/drivers/mct/unit_test/CMakeLists.txt +++ b/src/drivers/mct/unit_test/CMakeLists.txt @@ -9,6 +9,7 @@ add_definitions( -DNUM_COMP_INST_WAV=1 -DNUM_COMP_INST_ROF=1 -DNUM_COMP_INST_ESP=1 + -DNUM_COMP_INST_IAC=1 ) # The following definitions are needed when building with the mpi-serial library diff --git a/src/drivers/nuopc/cime_config/buildnml b/src/drivers/nuopc/cime_config/buildnml index 05e2c4f46e1..0acc9c4ea7d 100755 --- a/src/drivers/nuopc/cime_config/buildnml +++ b/src/drivers/nuopc/cime_config/buildnml @@ -304,6 +304,7 @@ def _create_runseq(case, coupling_times): # 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")) + logger.info("NUOPC run sequence: copying custom run sequence from case root") else: @@ -337,11 +338,14 @@ def _create_runseq(case, coupling_times): # for Q (aquaplanet) compsets runseq_input = os.path.join(input_dir, 'nuopc_runseq_Q') - elif ( (comp_atm == 'datm' and comp_ocn == "mom" and comp_ice == "dice") or - (comp_atm == 'datm' and comp_ocn == "mom" and comp_ice == "cice") or + elif ( (comp_atm == 'datm' and (comp_ocn == "mom" or comp_ocn == 'pop') and comp_ice == "dice") or + (comp_atm == 'datm' and (comp_ocn == "mom" or comp_ocn == 'pop') and comp_ice == "cice") or (comp_atm == 'datm' and comp_ocn == "docn" and comp_ice == "cice")): # for C, G and D compsets - runseq_input = os.path.join(input_dir, 'nuopc_runseq_C_G_D') + if comp_wav == 'ww': + runseq_input = os.path.join(input_dir, 'nuopc_runseq_C_G_D_ww3') + else: + runseq_input = os.path.join(input_dir, 'nuopc_runseq_C_G_D_swav') elif (comp_atm == 'datm' and comp_lnd == "clm"): # for I compsets @@ -358,8 +362,13 @@ def _create_runseq(case, coupling_times): runseq_input = os.path.join(input_dir, 'nuopc_runseq_B') elif (comp_atm == 'fv3gfs' and comp_ocn == "mom" and comp_ice == 'cice'): - # for NEMS fully coupled - runseq_input = os.path.join(input_dir, 'nuopc_runseq_NEMS') + # for NEMS fully coupled + if case.get_value("CONTINUE_RUN"): + logger.info("NUOPC run sequence: warm start (concurrent)") + runseq_input = os.path.join(input_dir, 'nuopc_runseq_NEMS.warm') + else: + logger.info("NUOPC run sequence: cold start (sequential)") + runseq_input = os.path.join(input_dir, 'nuopc_runseq_NEMS.cold') else: # default diff --git a/src/drivers/nuopc/cime_config/config_component.xml b/src/drivers/nuopc/cime_config/config_component.xml index b60f583f261..0ff2d12b7b0 100644 --- a/src/drivers/nuopc/cime_config/config_component.xml +++ b/src/drivers/nuopc/cime_config/config_component.xml @@ -1563,15 +1563,6 @@ wav2ocn state mapping file - - char - none,npfix,cart3d,cart3d_diag,cart3d_uvw,cart3d_uvw_diag - cart3d - run_domain - env_run.xml - vector mapping option - - char 1.0e-02 diff --git a/src/drivers/nuopc/cime_config/config_component_cesm.xml b/src/drivers/nuopc/cime_config/config_component_cesm.xml index 544da7e29af..fe281c4a324 100644 --- a/src/drivers/nuopc/cime_config/config_component_cesm.xml +++ b/src/drivers/nuopc/cime_config/config_component_cesm.xml @@ -201,7 +201,9 @@ 288 72 48 - 4 + + + 24 24 24 24 diff --git a/src/drivers/nuopc/cime_config/config_component_e3sm.xml b/src/drivers/nuopc/cime_config/config_component_e3sm.xml deleted file mode 100644 index df082c1dbaa..00000000000 --- a/src/drivers/nuopc/cime_config/config_component_e3sm.xml +++ /dev/null @@ -1,522 +0,0 @@ - - - - - - - - - 1972-2004 - 2002-2003 - Historic transient - Twentieth century transient - - CMIP5 rcp 2.6 forcing - CMIP5 rcp 4.5 forcing - CMIP5 rcp 6.0 forcing - CMIP5 rcp 8.5 forcing - Biogeochemistry intercomponent - with diagnostic CO2 - with prognostic CO2 - - - - char - https://doi.org/10.5065/D67H1H0V - run_metadata - env_case.xml - run DOI - - - - logical - TRUE,FALSE - FALSE - run_flags - env_run.xml - Turns on component varying thread control in the driver. - Used to set the driver namelist variable "drv_threading". - - - - logical - TRUE,FALSE - FALSE - run_flags - env_run.xml - logical to save timing files in rundir - - - - integer - 0 - run_flags - env_run.xml - Determines number of times profiler is called over the model run period. - This sets values for tprof_option and tprof_n that determine the timing output file frequency - - - - - integer - 2 - run_flags - env_run.xml - - integer indicating maximum detail level to profile. This xml - variable is used to set the namelist variable - timing_detail_limit. This namelist variable is used by perf_mod - (in $CIMEROOT/src/share/timing/perf_mod.F90) to turn timers off - and on depending on calls to the routine t_adj_detailf. If in the - code a statement appears like t_adj_detailf(+1), then the current - timer detail level is incremented by 1 and compared to the - time_detail_limit obtained from the namelist. If the limit is - exceeded then the timer is turned off. - - - - - integer - 12 - run_flags - env_run.xml - Maximum code stack depth of enabled timers. - - - - logical - TRUE,FALSE - FALSE - run_data_archive - 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. - 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. - This is for expert users ONLY and requires expert knowledge. - We will not document this further in this guide. - - - - logical - TRUE,FALSE - FALSE - run_flags - env_run.xml - turns on coupler bit-for-bit reproducibility with varying pe counts - - - - char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end - never - - ndays - - run_begin_stop_restart - env_run.xml - - sets frequency of full model barrier (same options as STOP_OPTION) for synchronization with BARRIER_N and BARRIER_DATE - - - - - char - none,CO2A,CO2B,CO2C - none - - CO2A - none - CO2A - CO2A - CO2A - CO2C - CO2C - - run_coupling - env_run.xml - Activates additional CO2-related fields to be exchanged between components. Possible values are: - - CO2A: sets the driver namelist variable flds_co2a = .true.; this adds - prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from - the atmosphere to the land and ocean. - - CO2B: sets the driver namelist variable flds_co2b = .true.; this adds - prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from - the atmosphere just to the land, and the surface upward flux of CO2 to be - sent from the land back to the atmosphere - - CO2C: sets the driver namelist variable flds_co2c = .true.; this adds - prognostic CO2 and diagnostic CO2 at the lowest model level to be sent from - the atmosphere to the land and ocean, and the surface upward flux of CO2 - to be sent from the land and the open ocean back to the atmosphere. - - The namelist variables flds_co2a, flds_co2b and flds_co2c are in the - namelist group cpl_flds_inparm. - - - - - char - - - - - - run_component_cpl - env_case.xml - User mods to apply to specific compset matches. - - - - char - hour,day,year,decade - run_coupling - env_run.xml - day - - year - hour - - Base period associated with NCPL coupling frequency. - This xml variable is only used to set the driver namelist variables, - atm_cpl_dt, lnd_cpl_dt, ocn_cpl_dt, ice_cpl_dt, glc_cpl_dt, rof_cpl_dt, wav_cpl_dt, and esp_dt. - - - - integer - 48 - - 144 - 288 - 288 - 72 - 48 - 4 - 24 - 24 - 24 - 48 - 1 - 96 - 96 - 96 - 96 - 192 - 192 - 192 - 192 - 384 - 384 - 384 - 144 - 72 - 144 - 288 - 48 - 48 - 24 - 24 - 1 - 4 - 4 - - run_coupling - env_run.xml - Number of atm coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist atm_cpl_dt, equal to basedt/ATM_NCPL, - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - integer - $ATM_NCPL - - 1 - - run_coupling - env_run.xml - Number of land coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist atm_cpl_dt, equal to basedt/LND_NCPL, - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - integer - $ATM_NCPL - - 1 - - run_coupling - env_run.xml - Number of ice coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist ice_cpl_dt, equal to basedt/ICE_NCPL - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - integer - $ATM_NCPL - - 1 - 4 - 24 - 24 - - - - - 1 - - run_coupling - env_run.xml - Number of ocn coupling intervals per NCPL_BASE_PERIOD. - Thisn is used to set the driver namelist ocn_cpl_dt, equal to basedt/OCN_NCPL - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - integer - 1 - - 1 - - run_coupling - env_run.xml - Number of glc coupling intervals per NCPL_BASE_PERIOD. - - - - char - glc_coupling_period,yearly - yearly - run_coupling - env_run.xml - Period at which coupler averages fields sent to GLC. - This supports doing the averaging to GLC less frequently than GLC is called - (i.e., separating the averaging frequency from the calling frequency). - This is useful because there are benefits to only averaging the GLC inputs - as frequently as they are really needed (yearly for CISM), but GLC needs to - still be called more frequently than that in order to support mid-year restarts. - - Setting GLC_AVG_PERIOD to 'glc_coupling_period' means that the averaging is - done exactly when the GLC is called (governed by GLC_NCPL). - - IMPORTANT: In order to restart mid-year when running with CISM, you MUST specify GLC_AVG_PERIOD = 'yearly'. - If using GLC_AVG_PERIOD = 'glc_coupling_period' with CISM, you can only restart on year boundaries. - - - - - integer - 8 - - $ATM_NCPL - $ATM_NCPL - $ATM_NCPL - 8 - $ATM_NCPL - 1 - - run_coupling - env_run.xml - Number of rof coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist rof_cpl_dt, equal to basedt/ROF_NCPL - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - integer - $ATM_NCPL - run_coupling - env_run.xml - Number of wav coupling intervals per NCPL_BASE_PERIOD. - This is used to set the driver namelist wav_cpl_dt, equal to basedt/WAV_NCPL - where basedt is equal to NCPL_BASE_PERIOD in seconds. - - - - - - logical - TRUE,FALSE - FALSE - - TRUE - TRUE - FALSE - - run_component_cpl - env_run.xml - - Only used for compsets with DATM and POP (currently C, G and J): - If true, compute albedos to work with daily avg SW down - If false (default), albedos are computed with the assumption that downward - solar radiation from the atm component has a diurnal cycle and zenith-angle - dependence. This is normally the case when using an active atm component - If true, albedos are computed with the assumption that downward - solar radiation from the atm component is a daily average quantity and - does not have a zenith-angle dependence. This is often the case when - using a data atm component. Only used for compsets with DATM and POP (currently C, G and J). - NOTE: This should really depend on the datm forcing and not the compset per se. - So, for example, whether it is set in a J compset should depend on - what datm forcing is used. - - - - - char - off,ocn - off - - ocn - off - - run_component_cpl - env_run.xml - - Only used for compsets with DATM and POP (currently C, G and J): - If ocn, ocn provides EP balance factor for precipitation. - Provides EP balance factor for precip for POP. A factor computed by - POP is applied to precipitation so that precipitation balances - evaporation and ocn global salinity does not drift. This is intended - for use when coupling POP to a DATM. Only used for C, G and J compsets. - Default is off - - - - - char - none,never,nsteps,nstep,nseconds,nsecond,nminutes,nminute,nhours,nhour,ndays,nday,nmonths,nmonth,nyears,nyear,date,ifdays0,end - never - - nmonths - - run_drv_history - env_run.xml - Sets driver average history file frequency (like REST_OPTION) - - - - char - - -999 - - 1 - - run_drv_history - env_run.xml - Sets driver average history file frequency (like REST_N) - - - - integer - - -999 - run_drv_history - env_run.xml - yyyymmdd format, sets driver average history date (like REST_DATE) - - - - logical - TRUE,FALSE - FALSE - - TRUE - TRUE - TRUE - - run_budgets - env_run.xml - logical that turns on diagnostic budgets for driver - - - - real - - 284.7 - - 367.0 - 284.7 - - run_co2 - env_run.xml - - Mechanism for setting the CO2 value in ppmv for - CLM if CLM_CO2_TYPE is constant or for - POP if OCN_CO2_TYPE is constant. - - - - - logical - TRUE,FALSE - FALSE - - TRUE - TRUE - - run_flags - env_run.xml - Turn on the passing of water isotope fields through the coupler - - - - integer - 0,1,3,5,10,36 - 10 - - 0 - - run_glc - env_run.xml - Number of glacier elevation classes used in CLM. - 0 implies no glacier_mec (glacier multiple elevation classes) - landunit in CLM. 0 is only valid for CLM40. - Used by both CLM and the coupler (even if CISM is not running, and only SGLC is used). - - - - logical - TRUE,FALSE - FALSE - - TRUE - TRUE - - TRUE - - run_glc - env_run.xml - Whether the glacier component feeds back to the rest of the system - This affects: - (1) Whether CLM updates its areas based on glacier areas sent from GLC - (2) Whether GLC sends fluxes (e.g., calving fluxes) to the coupler - Note that this is set to TRUE by default for TG compsets - even though there are - no feedbacks for TG compsets, this enables extra coupler diagnostics for these - compsets. - - - - char - minus1p8,linear_salt,mushy - mushy - run_physics - env_run.xml - Freezing point calculation for salt water. - - - - diff --git a/src/drivers/nuopc/cime_config/fd.yaml b/src/drivers/nuopc/cime_config/fd.yaml deleted file mode 100644 index bd8e8cf3c12..00000000000 --- a/src/drivers/nuopc/cime_config/fd.yaml +++ /dev/null @@ -1,2247 +0,0 @@ - field_dictionary: - version_number: 0.0.0 - institution: National ESPC, CSC & MCL Working Groups - source: automatically generated by the NUOPC Layer - description: Community-based dictionary for shared coupling fields - entries: - # - #----------------------------------- - # mediator export - #----------------------------------- - # - - standard_name: Faox_evap - canonical_units: kg m-2 s-1 - description: mediator export - atm/ocn evaporation water flux - # - - standard_name: Faox_evap_16O - canonical_units: kg m-2 s-1 - description: mediator export - atm/ocn evaporation water flux 16O - # - - standard_name: Faox_evap_18O - canonical_units: kg m-2 s-1 - description: mediator export - atm/ocn evaporation water flux 18O - # - - standard_name: Faox_evap_HDO - canonical_units: kg m-2 s-1 - description: mediator export - atm/ocn evaporation water flux HDO - # - - standard_name: Faox_lat - canonical_units: W m-2 - description: mediator export - atm/ocn surface latent heat flux - # - - standard_name: Faox_sen - canonical_units: W m-2 - description: mediator export - atm/ocn surface sensible heat flux - # - - standard_name: Faox_lwup - canonical_units: W m-2 - description: mediator export - long wave radiation flux over the ocean - # - - standard_name: Faox_swdn - canonical_units: W m-2 - description: mediator export - downward solar radiation flux over the ocean (sum of all four radiative fluxes) - # - - standard_name: Faox_swup - canonical_units: W m-2 - description: mediator export - upward solar radiation over the ocean (sum of all four radiative fluxes) - # - - standard_name: Faox_taux - canonical_units: N m-2 - description: mediator export - # - - standard_name: Faox_tauy - canonical_units: N m-2 - description: mediator export - # - #----------------------------------- - # land export - #----------------------------------- - # - - standard_name: Fall_evap - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_evap_16O - canonical_units: kg m-2 s-1 - # - - standard_name: Fall_evap_18O - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_evap_HDO - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_fco2_lnd - canonical_units: moles m-2 s-1 - description: land export - # - - standard_name: Fall_fire01 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes1 - # - - standard_name: Fall_fire02 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes2 - # - - standard_name: Fall_fire03 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes3 - # - - standard_name: Fall_fire04 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes4 - # - - standard_name: Fall_fire05 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes5 - # - - standard_name: Fall_fire06 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes6 - # - - standard_name: Fall_fire07 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes7 - # - - standard_name: Fall_fire08 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes8 - # - - standard_name: Fall_fire09 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes9 - # - - standard_name: Fall_fire10 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes10 - # - - standard_name: Fall_flxdst1 - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_flxdst2 - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_flxdst3 - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_flxdst4 - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_lat - canonical_units: W m-2 - description: land export - # - - standard_name: Fall_lwup - canonical_units: W m-2 - description: land export - # - - standard_name: Fall_sen - canonical_units: W m-2 - description: land export - # - - standard_name: Fall_swnet - canonical_units: W m-2 - description: land export - # - - standard_name: Fall_taux - canonical_units: N m-2 - description: land export - # - - standard_name: Fall_tauy - canonical_units: N m-2 - description: land export - # - - standard_name: Fall_voc001 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc002 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc003 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc004 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc005 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc006 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc007 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc008 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc009 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc010 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc011 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc012 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc013 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc014 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc015 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc016 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc017 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc018 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc019 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc020 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Sl_anidf - canonical_units: 1 - description: land export - # - - standard_name: Sl_anidr - canonical_units: 1 - description: land export - # - - standard_name: Sl_avsdf - canonical_units: 1 - description: land export - # - - standard_name: Sl_avsdr - canonical_units: 1 - description: land export - # - - standard_name: Sl_dd01 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd02 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd03 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd04 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd05 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd06 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd07 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd08 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd09 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd10 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd11 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd12 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd13 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd14 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd15 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd16 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd17 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd18 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd19 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd20 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd21 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd22 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd23 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd24 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd25 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd26 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd27 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd28 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd29 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd30 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd31 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd32 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd33 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd34 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd35 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd36 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd37 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd38 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd39 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd40 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd41 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd42 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd43 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd44 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd45 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd46 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd47 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd48 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd49 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd50 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd51 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd52 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd53 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd54 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd55 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd56 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd57 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd58 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd59 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd60 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd61 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd62 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd63 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd64 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd65 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd66 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd67 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd68 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd69 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd70 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd71 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd72 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd73 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd74 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd75 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd76 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd77 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd78 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd79 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd80 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_fv - canonical_units: m s-1 - description: land export - # - - standard_name: Sl_fztop - canonical_units: m - description: land export - # - - standard_name: Sl_lfrac - alias: land_mask - canonical_units: 1 - description: land export - # - - standard_name: Sl_lfrin - canonical_units: 1 - description: land export - # - - standard_name: Sl_qref - canonical_units: kg kg-1 - description: land export - # - - standard_name: Sl_qref_16O - canonical_units: kg kg-1 - description: land export - # - - standard_name: Sl_qref_18O - canonical_units: kg kg-1 - description: land export - # - - standard_name: Sl_qref_HDO - canonical_units: kg kg-1 - description: land export - # - - standard_name: Sl_ram1 - canonical_units: s/m - description: land export - # - - standard_name: Sl_snowh - canonical_units: m - description: land export - # - - standard_name: Sl_snowh_16O - canonical_units: m - description: land export - # - - standard_name: Sl_snowh_18O - canonical_units: m - description: land export - # - - standard_name: Sl_snowh_HDO - canonical_units: m - description: land export - # - - standard_name: Sl_t - canonical_units: K - description: land export - # - - standard_name: Sl_topo - canonical_units: m - description: land export - # - - standard_name: Sl_topo00 - canonical_units: m - description: land export - # - - standard_name: Sl_topo01 - canonical_units: m - description: land export - # - - standard_name: Sl_topo02 - canonical_units: m - description: land export - # - - standard_name: Sl_topo03 - canonical_units: m - description: land export - # - - standard_name: Sl_topo04 - canonical_units: m - description: land export - # - - standard_name: Sl_topo05 - canonical_units: m - description: land export - # - - standard_name: Sl_topo06 - canonical_units: m - description: land export - # - - standard_name: Sl_topo07 - canonical_units: m - description: land export - # - - standard_name: Sl_topo08 - canonical_units: m - description: land export - # - - standard_name: Sl_topo09 - canonical_units: m - description: land export - # - - standard_name: Sl_topo10 - canonical_units: m - description: land export - # - - standard_name: Sl_tref - canonical_units: K - description: land export - # - - standard_name: Sl_tsrf - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf00 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf01 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf02 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf03 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf04 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf05 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf06 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf07 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf08 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf09 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf10 - canonical_units: deg C - description: land export - # - - standard_name: Sl_u10 - canonical_units: m - description: land export - # - #----------------------------------- - # atmosphere export - #----------------------------------- - # - - standard_name: Faxa_bcphidry - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_bcphiwet - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_bcphodry - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstdry1 - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstdry2 - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstdry3 - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstdry4 - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstwet1 - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstwet2 - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstwet3 - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstwet4 - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_swdn - alias: mean_down_sw_flx - canonical_units: W m-2 - description: atmosphere export - mean downward SW heat flux - # - - standard_name: Faxa_lwdn - alias: mean_down_lw_flx - canonical_units: W m-2 - description: atmosphere export - mean downward SW heat flux - # - - standard_name: inst_down_lw_flx - canonical_units: W m-2 - description: atmosphere export - instantaneous downward long wave radiation flux (fv3 only) - # - - standard_name: inst_net_lw_flx - canonical_units: W m-2 - description: atmosphere export - instantaneous NET long wave radiation flux (fv3 only) - # - - standard_name: inst_down_sw_flx - canonical_units: W m-2 - description: atmosphere export - instantaneous downward solar radiation flux (fv3 only) - # - - standard_name: inst_net_sw_flx - canonical_units: W m-2 - description: atmosphere export - instantaneous NET solar radiation flux over the ocean (fv3 only) - # - - standard_name: inst_net_sw_ir_dir_flx - canonical_units: W m-2 - description: atmosphere export - Instataneous net sfc nir direct flux (fv3 only) - # - - standard_name: inst_net_sw_ir_dif_flx - canonical_units: W m-2 - description: atmosphere export - Instataneous net sfc nir diffuse flux (fv3 only) - # - - standard_name: inst_net_sw_vis_dir_flx - canonical_units: W m-2 - description: atmosphere export - Instataneous net sfc uv+vis direct flux (fv3 only) - # - - standard_name: inst_net_sw_vis_dif_flx - canonical_units: W m-2 - description: atmosphere export - Instataneous net sfc uv+vis diffuse flux (fv3 only) - # - - standard_name: Faxa_nhx - canonical_units: kg(N)/m2/sec - description: atmosphere export - # - - standard_name: Faxa_noy - canonical_units: kg(N)/m2/sec - description: atmosphere export - # - - standard_name: Faxa_ocphidry - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_ocphiwet - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_ocphodry - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_prec - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_prec_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_prec_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_prec_HDO - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rain - alias: mean_prec_rate - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rain_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rain_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rain_HDO - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rainc - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rainc_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rainc_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rainc_HDO - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rainl - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rainl_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rainl_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rainl_HDO - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snow - alias: mean_fprec_rate - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snow_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snow_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snow_HDO - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snowc - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snowc_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snowc_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snowc_HDO - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snowl - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snowl_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snowl_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snowl_HDO - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_swnet - canonical_units: W m-2 - description: atmosphere export - # - - standard_name: Faxa_swndf - alias: mean_down_sw_ir_dif_flx - canonical_units: W m-2 - description: atmosphere export - mean surface downward nir diffuse flux - # - - standard_name: Faxa_swndr - alias: mean_down_sw_ir_dir_flx - canonical_units: W m-2 - description: atmosphere export - mean surface downward nir direct flux - # - - standard_name: Faxa_swvdf - alias: mean_down_sw_vis_dif_flx - canonical_units: W m-2 - description: atmosphere export - mean surface downward uv+vis diffuse flux - # - - standard_name: Faxa_swvdr - alias: mean_down_sw_vis_dir_flx - canonical_units: W m-2 - description: atmosphere export - mean surface downward uv+visvdirect flux - # - - standard_name: inst_down_sw_ir_dif_flx - canonical_units: W m-2 - description: atmosphere export - instataneous downward nir diffuse flux (fv3 only) - # - - standard_name: inst_down_sw_ir_dir_flx - canonical_units: W m-2 - description: atmosphere export - instataneous downward nir directflux (fv3 only) - # - - standard_name: inst_down_sw_vis_dif_flx - canonical_units: W m-2 - description: atmosphere export - instataneous downward uv+vis diffuse flux (fv3 only) - # - - standard_name: inst_down_sw_vis_dir_flx - canonical_units: W m-2 - description: atmosphere export - instataneous downward uv+vis directflux (fv3 only) - # - - standard_name: Sa_co2diag - canonical_units: 1e-6 mol/mol - description: atmosphere export - Diagnostic CO2 at the lowest model level (cesm only) - # - - standard_name: Sa_co2prog - canonical_units: 1e-6 mol/mol - description: atmosphere export - prognostic CO2 at the lowest model level (cesm only) - # - - standard_name: Sa_topo - alias: inst_surface_height - canonical_units: m - description: atmosphere export - topographic height - # - - standard_name: Sa_dens - alias: air_density_height_lowest - canonical_units: kg m-3 - description: atmosphere export - density at the lowest model layer (cesm only) - # - - standard_name: Sa_pbot - alias: inst_pres_height_lowest - canonical_units: Pa - description: atmosphere export - pressure at lowest model layer - # - - standard_name: Sa_pslv - alias: inst_pres_height_surface - canonical_units: Pa - description: atmosphere export - instataneous pressure land and sea surface - # - - standard_name: Sa_ptem - canonical_units: K - description: atmosphere export - bottom layer potential temperature (cesm only) - # - - standard_name: Sa_shum - alias: inst_spec_humid_height_lowest - canonical_units: kg kg-1 - description: atmosphere export - bottom layer specific humidity - # - - standard_name: Sa_shum_16O - canonical_units: kg kg-1 - description: atmosphere export - bottom layer specific humidity 16O (cesm only) - # - - standard_name: Sa_shum_18O - canonical_units: kg kg-1 - description: atmosphere export - bottom layer specific humidity 18O (cesm only) - # - - standard_name: Sa_shum_HDO - canonical_units: kg kg-1 - description: atmosphere export - bottom layer specific humidity HDO (cesm only) - # - - standard_name: inst_spec_humid_height2m - canonical_units: K - description: atmosphere export - instantaneous specific humidity 2m above ground (fv3 only) - # - - standard_name: Sa_tbot - alias: inst_temp_height_lowest - canonical_units: K - description: atmosphere export - bottom layer temperature - # - - standard_name: inst_temp_height2m - canonical_units: K - description: atmosphere export - instantaneous temperature 2m above ground (fv3 only) - # - - standard_name: Sa_u - alias: inst_zonal_wind_height_lowest - canonical_units: m s-1 - description: atmosphere export - bottom layer zonal wind - # - - standard_name: Sa_v - alias: inst_merid_wind_height_lowest - canonical_units: m s-1 - description: atmosphere export - bottom layer meridional wind - # - - standard_name: Sa_z - alias: inst_height_lowest - canonical_units: m - description: atmosphere export - bottom layer height - # - - standard_name: inst_zonal_wind_height10m - canonical_units: m s-1 - description: atmosphere export - instataneous u wind (m/s) 10 m above ground (fv3 only) - # - - standard_name: inst_merid_wind_height10m - canonical_units: m s-1 - description: atmosphere export - instataneous v wind (m/s) 10 m above ground (fv3 only) - # - - standard_name: inst_zonal_moment_flx - canonical_units: N m-2 - description: atmosphere export - instataneous zonal compt of momentum flux (fv3 only) - # - - standard_name: inst_merid_moment_flx - canonical_units: N m-2 - description: atmosphere export - instataneous merid compt of momentum flux (fv3 only) - # - - standard_name: inst_sensi_heat_flx - canonical_units: N m-2 - description: atmosphere export - instataneous sensible heat flux (fv3 only) - # - - standard_name: inst_laten_heat_flx - canonical_units: N m-2 - description: atmosphere export - instataneous latent heat flux (fv3 only) - # - - standard_name: inst_tracer_mass_frac - canonical_units: 1 - description: atmosphere export (fv3 only) - # - - standard_name: inst_pres_interface - canonical_units: Pa - description: atmosphere export (fv3 only) - # - - standard_name: inst_pres_levels - canonical_units: Pa - description: atmosphere export (fv3 only) - # - - standard_name: inst_geop_interface - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: inst_geop_levels - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: inst_temp_interface - canonical_units: K - description: atmosphere export (fv3 only) - # - - standard_name: inst_temp_levels - canonical_units: K - description: atmosphere export (fv3 only) - # - - standard_name: inst_zonal_wind_levels - canonical_units: m s-1 - description: atmosphere export (fv3 only) - # - - standard_name: inst_merid_wind_levels - canonical_units: m s-1 - description: atmosphere export (fv3 only) - # - - standard_name: inst_omega_levels - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: inst_tracer_mass_frac - canonical_units: 1 - description: atmosphere export (fv3 only) - # - - standard_name: inst_soil_moisture_content - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: soil_type - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: inst_pbl_height - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: surface_cell_area - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: inst_convective_rainfall_amount - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: inst_exchange_coefficient_heat_levels - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: inst_friction_velocity - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: inst_rainfall_amount - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: inst_land_sea_mask - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: inst_temp_height_surface - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: inst_up_sensi_heat_flx - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: inst_lwe_snow_thickness - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: vegetation_type - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: inst_vegetation_area_frac - canonical_units: tbd - description: atmosphere export (fv3 only) - # - - standard_name: inst_surface_roughness - canonical_units: tbd - description: atmosphere export (fv3 only) - -######### fv3 work - - - standard_name: Faxa_taux - alias: mean_zonal_moment_flx_atm - canonical_units: N m-2 - description: atmosphere export - zonal component of momentum flux - # - - standard_name: Faxa_tauy - alias: mean_merid_moment_flx_atm - canonical_units: N m-2 - description: atmosphere export - meridional component of momentum flux - # - - standard_name: Faxa_lat - alias: mean_laten_heat_flx_atm - canonical_units: W m-2 - description: atmosphere export - # - - standard_name: Faxa_sen - alias: mean_sensi_heat_flx_atm - canonical_units: W m-2 - description: atmosphere export - # - - standard_name: inst_zonal_moment_flx_atm - canonical_units: N m-2 - description: atmosphere export - zonal component of momentum flux - # - - standard_name: inst_merid_moment_flx_atm - canonical_units: N m-2 - description: atmosphere export - meridional component of momentum flux - # - - standard_name: inst_laten_heat_flx_atm - canonical_units: W m-2 - description: atmosphere export - # - - standard_name: inst_sensi_heat_flx_atm - canonical_units: W m-2 - description: atmosphere export - - - -############ - - - - - # - #----------------------------------- - # atmosphere import - #----------------------------------- - # - - standard_name: Faxx_evap - canonical_units: kg m-2 s-1 - description: atmosphere import - # - - standard_name: Faxx_evap_16O - canonical_units: kg m-2 s-1 - description: atmosphere import - # - - standard_name: Faxx_evap_18O - canonical_units: kg m-2 s-1 - description: atmosphere import - # - - standard_name: Faxx_evap_HDO - canonical_units: kg m-2 s-1 - description: atmosphere import - # - - standard_name: Faxx_lat - alias: mean_laten_heat_flx - canonical_units: W m-2 - description: atmosphere import (cesm) or sent from atm (fv3) - # - - standard_name: Faxx_lwup - canonical_units: W m-2 - description: atmosphere import - # - - standard_name: Faxx_sen - alias: mean_sensi_heat_flx - canonical_units: W m-2 - description: atmosphere import - # - - standard_name: Faxx_taux - alias: mean_zonal_moment_flx - alias: mean_zonal_moment_flx_atm - canonical_units: N m-2 - description: atmosphere import - zonal component of momentum flux - for fv3, for sea ice covered area - for cesm, merged ice/ocn/land - - # - - standard_name: Faxx_tauy - alias: mean_merid_moment_flx - canonical_units: N m-2 - description: atmosphere import - meridional component of momentum flux - for fv3, for sea ice covered area - for cesm, merged ice/ocn/land - # - - standard_name: Sx_anidf - canonical_units: 1 - description: atmosphere import - # - - standard_name: Sx_anidr - canonical_units: 1 - description: atmosphere import - # - - standard_name: Sx_avsdf - canonical_units: 1 - description: atmosphere import - # - - standard_name: Sx_avsdr - canonical_units: 1 - description: atmosphere import - # - - standard_name: Sx_qref - canonical_units: kg kg-1 - description: atmosphere import - # - - standard_name: Sx_qref_16O - canonical_units: kg kg-1 - # - - standard_name: Sx_qref_18O - canonical_units: kg kg-1 - description: atmosphere import - # - - standard_name: Sx_qref_HDO - canonical_units: kg kg-1 - description: atmosphere import - # - - standard_name: Sx_t - alias: surface_temperature - canonical_units: K - description: atmosphere import - # - - standard_name: Sx_tref - canonical_units: K - description: atmosphere import - # - - standard_name: Sx_u10 - canonical_units: m - description: atmosphere import - # - #----------------------------------- - # land-ice export - # Note that the fields sent from glc->med do NOT have elevation classes, - # but the fields from med->lnd are broken into multiple elevation classes - #----------------------------------- - # - - standard_name: Figg_rofi - canonical_units: kg m-2 s-1 - description: land-ice export - glc frozen runoff_iceberg flux to ice - # - - standard_name: Flgg_hflx - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from glc - # - - standard_name: Flgg_hflx00 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 0 - # - - standard_name: Flgg_hflx01 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 1 - # - - standard_name: Flgg_hflx02 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 2 - # - - standard_name: Flgg_hflx03 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 3 - # - - standard_name: Flgg_hflx04 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 4 - # - - standard_name: Flgg_hflx05 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 5 - # - - standard_name: Flgg_hflx06 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 6 - # - - standard_name: Flgg_hflx07 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 7 - # - - standard_name: Flgg_hflx08 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 8 - # - - standard_name: Flgg_hflx09 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 8 - # - - standard_name: Flgg_hflx10 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 10 - - standard_name: Sg_ice_covered - canonical_units: 1 - # - - standard_name: Sg_ice_covered00 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered01 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered02 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered03 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered04 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered05 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered06 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered07 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered08 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered09 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered10 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_icemask - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_icemask_coupled_fluxes - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_topo - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo00 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo01 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo02 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo03 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo04 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo05 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo06 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo07 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo08 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo09 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo10 - canonical_units: m - description: land-ice export - # - - standard_name: Fogg_rofi - canonical_units: kg m-2 s-1 - description: land-ice export - glacier_frozen_runoff_flux_to_ocean - # - - standard_name: Fogg_rofl - canonical_units: kg m-2 s-1 - description: land-ice export - glacier liquid runoff flux to ocean - # - #----------------------------------- - # sea-ice export - #----------------------------------- - # - - standard_name: Faii_evap - alias: mean_evap_rate_atm_into_ice - canonical_units: kg m-2 s-1 - description: sea-ice export - # - - standard_name: Faii_evap_16O - canonical_units: kg m-2 s-1 - description: sea-ice export - # - - standard_name: Faii_evap_18O - canonical_units: kg m-2 s-1 - description: sea-ice export - # - - standard_name: Faii_evap_HDO - canonical_units: kg m-2 s-1 - description: sea-ice export - # - - standard_name: Faii_lat - alias: mean_laten_heat_flx_atm_into_ice - canonical_units: W m-2 - description: sea-ice export to atm - atm/ice latent heat flux - # - - standard_name: Faii_sen - alias: mean_sensi_heat_flx_atm_into_ice - canonical_units: W m-2 - description: sea-ice export to atm - atm/ice sensible heat flux - # - - standard_name: Faii_lwup - alias: mean_up_lw_flx_ice - canonical_units: W m-2 - description: sea-ice export - outgoing logwave radiation - # - - standard_name: Faii_swnet - canonical_units: W m-2 - description: sea-ice export to atm - # - - standard_name: Faii_taux - alias: stress_on_air_ice_zonal - canonical_units: N m-2 - description: sea-ice export to atm - air ice zonal stress - # - - standard_name: Faii_tauy - alias: stress_on_air_ice_merid - canonical_units: N m-2 - description: sea-ice export - air ice meridional stress - # - - standard_name: Fioi_bcphi - canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - hydrophilic black carbon flux to ocean - # - - standard_name: Fioi_bcpho - canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - hydrophobic black carbon flux to ocean - # - - standard_name: Fioi_flxdst - canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - dust aerosol flux to ocean - # - - standard_name: Fioi_melth - alias: net_heat_flx_to_ocn - canonical_units: W m-2 - description: sea-ice export to ocean - net heat flux to ocean - # - - standard_name: Fioi_melth_16O - canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - isotope head flux to ocean - # - - standard_name: Fioi_melth_18O - canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - isotope head flux to ocean - # - - standard_name: Fioi_melth_HDO - canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - isotope head flux to ocean - # - - standard_name: Fioi_meltw - alias: mean_fresh_water_to_ocean_rate - canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - fresh water to ocean (h2o flux from melting) - # - - standard_name: Fioi_meltw_16O - canonical_units: kg m-2 s-1 - description: sea-ice export - # - - standard_name: Fioi_meltw_18O - canonical_units: kg m-2 s-1 - description: sea-ice export - # - - standard_name: Fioi_meltw_HDO - canonical_units: kg m-2 s-1 - description: sea-ice export - # - - standard_name: Fioi_salt - alias: mean_salt_rate - canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - salt to ocean (salt flux from melting) - # - - standard_name: Fioi_swpen - alias: mean_sw_pen_to_ocn - canonical_units: W m-2 - description: sea-ice export to ocean - flux of shortwave through ice to ocean - # - # NOTE: the following alias requires a new name change for CICE export - - standard_name: Fioi_swpen_vdr - alias: mean_net_swpen_vis_dir_flx - canonical_units: W m-2 - description: sea-ice export to ocean - flux of vis dir shortwave through ice to ocean - # - # NOTE: the following alias requires a new name change for CICE export - - standard_name: Fioi_swpen_vdf - alias: mean_net_swpen_vis_dif_flx - canonical_units: W m-2 - description: sea-ice export to ocean - flux of vif dir shortwave through ice to ocean - # - # NOTE: the following alias requires a new name change for CICE export - - standard_name: Fioi_swpen_idr - alias: mean_net_swpen_ir_dir_flx - canonical_units: W m-2 - description: sea-ice export to ocean - flux of ir dir shortwave through ice to ocean - # - # NOTE: the following alias requires a new name change for CICE export - - standard_name: Fioi_swpen_idf - alias: mean_net_swpen_ir_dif_flx - canonical_units: W m-2 - description: sea-ice export to ocean - flux of ir dif shortwave through ice to ocean - # - - standard_name: Fioi_taux - alias: stress_on_ocn_ice_zonal - canonical_units: N m-2 - description: sea-ice export to ocean - ice ocean zonal stress - # - - standard_name: Fioi_tauy - alias: stress_on_ocn_ice_merid - canonical_units: N m-2 - description: sea-ice export to ocean - ice ocean meridional stress - # - - standard_name: Si_anidf - alias: inst_ice_ir_dif_albedo - canonical_units: 1 - description: sea-ice export to atm - # - - standard_name: Si_anidr - alias: inst_ice_ir_dir_albedo - canonical_units: 1 - description: sea-ice export to atm - # - - standard_name: Si_avsdf - alias: inst_ice_vis_dif_albedo - canonical_units: 1 - description: sea-ice export to atm - # - - standard_name: Si_avsdr - alias: inst_ice_vis_dir_albedo - canonical_units: 1 - description: sea-ice export to atm - # - - standard_name: Si_ifrac - alias: ice_fraction - canonical_units: 1 - description: sea-ice export to atm - ice fraction (varies with time) - # - - standard_name: Si_ifrac_n - canonical_units: 1 - description: sea-ice export - ice fraction per category (varies with time) (cesm only) - # - - standard_name: Si_imask - alias: ice_mask - canonical_units: 1 - description: sea-ice export - ice mask - # - - standard_name: Si_qref - canonical_units: kg kg-1 - description: sea-ice export to atm - cesm only - # - - standard_name: Si_qref_16O - canonical_units: kg kg-1 - description: sea-ice export to atm - cesm only - # - - standard_name: Si_qref_18O - canonical_units: kg kg-1 - description: sea-ice export to atm - cesm only - # - - standard_name: Si_qref_HDO - canonical_units: kg kg-1 - description: sea-ice export - cesm only - # - - standard_name: Si_snowh -# ambiguous with Si_vsno -# alias: mean_snow_volume - canonical_units: m - description: sea-ice export - volume of snow per unit area - # - - standard_name: Si_t - alias: sea_ice_temperature - canonical_units: K - description: sea-ice export - # - - standard_name: Si_tref - canonical_units: K - description: sea-ice export - # - - standard_name: Si_u10 - canonical_units: m - description: sea-ice export - # - - standard_name: Si_vice - alias: mean_ice_volume - canonical_units: m - description: sea-ice export - volume of ice per unit area - # - - standard_name: Si_vsno - alias: mean_snow_volume - canonical_units: m - description: sea-ice export - volume of snow per unit area - # - #----------------------------------- - # ocean export - #----------------------------------- - # - - standard_name: Fioo_q - alias: freezing_melting_potential - canonical_units: W m-2 - description: ocean export - # - - standard_name: Faoo_fco2_ocn - canonical_units: moles m-2 s-1 - description: ocean export - # - - standard_name: So_anidf - canonical_units: 1 - description: ocean export - # - - standard_name: So_anidr - canonical_units: 1 - description: ocean export - # - - standard_name: So_avsdf - canonical_units: 1 - description: ocean export - # - - standard_name: So_avsdr - canonical_units: 1 - description: ocean export - # - - standard_name: So_bldepth - alias: mixed_layer_depth - canonical_units: m - description: ocean export - # - - standard_name: So_dhdx - alias: sea_surface_slope_zonal - canonical_units: m m-1 - description: ocean export - # - - standard_name: So_dhdy - alias: sea_surface_slope_merid - canonical_units: m m-1 - description: ocean export - # - - standard_name: So_duu10n - canonical_units: m2 s-2 - description: ocean export - # - - standard_name: So_fswpen - canonical_units: 1 - description: ocean export - # - - standard_name: So_ofrac - canonical_units: 1 - description: ocean export - # - - standard_name: So_omask - canonical_units: 1 - description: ocean export - # - - standard_name: So_qref - canonical_units: kg kg-1 - description: ocean export - # - - standard_name: So_qref_16O - canonical_units: kg kg-1 - description: ocean export - # - - standard_name: So_qref_18O - canonical_units: kg kg-1 - description: ocean export - # - - standard_name: So_qref_HDO - canonical_units: kg kg-1 - description: ocean export - # - - standard_name: So_re - canonical_units: 1 - description: ocean export - # - - standard_name: So_roce_16O - canonical_units: 1 - description: ocean export - # - - standard_name: So_roce_HDO - canonical_units: 1 - description: ocean export - # - - standard_name: So_s - alias: s_surf - canonical_units: g kg-1 - description: ocean export - # - - standard_name: So_ssq - canonical_units: kg kg-1 - description: ocean export - # - - standard_name: So_t - alias: sea_surface_temperature - canonical_units: K - description: ocean export - # - - standard_name: So_tref - canonical_units: K - description: ocean export - # - - standard_name: So_u - alias: ocn_current_zonal - canonical_units: m s-1 - description: ocean export - # - - standard_name: So_u10 - canonical_units: m - description: ocean export - # - - standard_name: So_ustar - canonical_units: m s-1 - description: ocean export - # - - standard_name: So_v - alias: ocn_current_merid - canonical_units: m s-1 - description: ocean export - # - #----------------------------------- - # river export - #----------------------------------- - # - - standard_name: Firr_rofi - canonical_units: kg m-2 s-1 - description: river export - # - - standard_name: Fixx_rofi - canonical_units: kg m-2 s-1 - # - #----------------------------------- - # lnd export to glc - #----------------------------------- - # - - standard_name: Flgl_qice - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice00 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice01 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice02 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice03 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice04 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice05 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice06 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice07 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice08 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice09 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice10 - canonical_units: kg m-2 s-1 - description: land export to glc - # - #----------------------------------- - # lnd export to river - #----------------------------------- - # - - standard_name: Flrl_irrig - canonical_units: kg m-2 s-1 - description: land export to river - # - - standard_name: Flrl_rofdto - canonical_units: kg m-2 s-1 - description: land export to river - # - - standard_name: Flrl_rofgwl - canonical_units: kg m-2 s-1 - description: land export to river - # - - standard_name: Flrl_rofi - canonical_units: kg m-2 s-1 - description: land export to river - # - - standard_name: Flrl_rofsub - canonical_units: kg m-2 s-1 - description: land export to river - # - - standard_name: Flrl_rofsur - canonical_units: kg m-2 s-1 - description: land export to river - # - #----------------------------------- - # river export - #----------------------------------- - # - - standard_name: Flrr_flood - canonical_units: kg m-2 s-1 - description: river export to land - Water flux due to flooding - # - - standard_name: Flrr_volr - canonical_units: m - description: river export to land - River channel total water volume - # - - standard_name: Flrr_volrmch - canonical_units: m - description: river export to land - River channel main channel water volume - # - - standard_name: Forr_rofi - canonical_units: kg m-2 s-1 - description: river export to ocean - Water flux due to runoff (frozen) - # - - standard_name: Forr_rofl - canonical_units: kg m-2 s-1 - description: river export to ocean - Water flux due to runoff (liquid) - # - #----------------------------------- - # ocean import - #----------------------------------- - # - - standard_name: Foxx_evap - alias: mean_evap_rate - canonical_units: kg m-2 s-1 - description: ocean import - specific humidity flux - # - - standard_name: Foxx_evap_16O - canonical_units: kg m-2 s-1 - description: ocean import - specific humidity flux 16O - # - - standard_name: Foxx_evap_18O - canonical_units: kg m-2 s-1 - description: ocean import - specific humidity flux 18O - # - - standard_name: Foxx_evap_HDO - canonical_units: kg m-2 s-1 - description: ocean import - specific humidity flux HDO - # - - standard_name: Foxx_lat - canonical_units: W m-2 - description: ocean import - latent heat flux into ocean - cesm only - # - - standard_name: Foxx_sen - alias: mean_sensi_heat_flx - canonical_units: W m-2 - description: ocean import - sensible heat flux into ocean - # - - standard_name: Foxx_lwup - canonical_units: W m-2 - description: ocean import - surface upward longwave heat flux - # - - standard_name: Foxx_lwnet - alias: mean_net_lw_flx - canonical_units: W m-2 - description: ocean import - mean NET long wave radiation flux to ocean - # - - standard_name: Foxx_rofi - canonical_units: kg m-2 s-1 - description: ocean import - water flux due to runoff (frozen) - # - - standard_name: Foxx_rofl - canonical_units: kg m-2 s-1 - description: ocean import - water flux due to runoff (liquid) - # - - standard_name: Foxx_swnet - alias: mean_net_sw_flx - canonical_units: W m-2 - description: ocean import - net shortwave radiation to ocean - # - - standard_name: Foxx_swnet_vdr - alias: mean_net_sw_vis_dir_flx - canonical_units: W m-2 - description: ocean import - net shortwave visible direct radiation to ocean - # - - standard_name: Foxx_swnet_vdf - alias: mean_net_sw_vis_dif_flx - canonical_units: W m-2 - description: ocean import - net shortwave visible diffuse radiation to ocean - # - - standard_name: Foxx_swnet_idr - alias: mean_net_sw_ir_dir_flx - canonical_units: W m-2 - description: ocean import - net shortwave ir direct radiation to ocean - # - - standard_name: Foxx_swnet_idf - alias: mean_net_sw_ir_dif_flx - canonical_units: W m-2 - description: ocean import - net shortwave ir diffuse radiation to ocean - # - - standard_name: Foxx_swnet_afracr - canonical_units: W m-2 - description: ocean import - net shortwave radiation times atmosphere fraction (cesm only) - # - - standard_name: Foxx_taux - alias: mean_zonal_moment_flx - canonical_units: N m-2 - description: ocean import - zonal surface stress - # - - standard_name: Foxx_tauy - alias: mean_merid_moment_flx - canonical_units: N m-2 - description: ocean import - meridional surface stress - # - - standard_name: Fioi_swpen_ifrac_n - canonical_units: W m-2 - description: ocean import - net shortwave radiation penetrating into ice and ocean times ice fraction for thickness category 1 - cesm only - # - - standard_name: Sf_afrac - canonical_units: 1 - description: ocean import - fractional atmosphere coverage wrt ocean - cesm only - # - - standard_name: Sf_afracr - canonical_units: 1 - description: ocean import - fractional atmosphere coverage used in radiation computations wrt ocean - cesm only - # - - standard_name: Sw_hstokes - canonical_units: m - description: ocean import - Stokes drift depth - cesm only - # - - standard_name: Sw_lamult - canonical_units: 1 - description: ocean import - Langmuir multiplier - cesm only - # - - standard_name: Sw_ustokes - canonical_units: m/s - description: ocean import - Stokes drift u component - cesm only - # - - standard_name: Sw_vstokes - canonical_units: m/s - description: ocean import - Stokes drift v component - cesm only - # - #----------------------------------- - # mediator fields - #----------------------------------- - # - - standard_name: cpl_scalars - canonical_units: unitless - description: mediator field - # - - standard_name: frac - canonical_units: 1 - # - - standard_name: mask - canonical_units: 1 diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_A b/src/drivers/nuopc/cime_config/nuopc_runseq_A index 580f52152b7..de7e7932e14 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_A +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_A @@ -1,7 +1,6 @@ runSeq:: @ocn_cpl_dt #ocean coupling step MED med_phases_prep_ocn_accum_avg - MED med_connectors_prep_med2ocn MED -> OCN :remapMethod=redist @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_ocn_map @@ -10,31 +9,24 @@ runSeq:: MED med_phases_prep_ocn_accum_fast MED med_phases_ocnalb_run MED med_phases_prep_ice - MED med_connectors_prep_med2ice MED -> ICE :remapMethod=redist MED med_phases_prep_rof_accum_fast MED med_phases_prep_rof_avg - MED med_connectors_prep_med2rof MED -> ROF :remapMethod=redist ICE ROF ICE -> MED :remapMethod=redist - MED med_connectors_post_ice2med MED med_fraction_set ROF -> MED :remapMethod=redist - MED med_connectors_post_rof2med MED med_phases_prep_atm - MED med_connectors_prep_med2atm MED -> ATM :remapMethod=redist ATM ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_history_write MED med_phases_profile @ OCN OCN -> MED :remapMethod=redist - MED med_connectors_post_ocn2med MED med_phases_restart_write @ :: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_ADLND b/src/drivers/nuopc/cime_config/nuopc_runseq_ADLND index b59608892b1..2d19210b676 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_ADLND +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_ADLND @@ -3,7 +3,6 @@ runSeq:: LND LND -> MED :remapMethod=redist MED med_fraction_set - MED med_connectors_post_lnd2med MED med_phases_history_write MED med_phases_profile MED med_phases_restart_write diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_ADWAV b/src/drivers/nuopc/cime_config/nuopc_runseq_ADWAV index c582a6dc1b5..9685fea7974 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_ADWAV +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_ADWAV @@ -2,7 +2,6 @@ runSeq:: @wav_cpl_dt # wave coupling step WAV WAV -> MED :remapMethod=redist - MED med_connectors_post_wav2med MED med_fraction_set MED med_phases_history_write MED med_phases_profile diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_B b/src/drivers/nuopc/cime_config/nuopc_runseq_B index 79b4d8dd8e7..fac2c5ee207 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_B +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_B @@ -1,7 +1,6 @@ runSeq:: @ocn_cpl_dt # ocean coupling step MED med_phases_prep_ocn_accum_avg - MED med_connectors_prep_med2ocn MED -> OCN :remapMethod=redist @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_ocn_map @@ -10,30 +9,23 @@ runSeq:: MED med_phases_prep_ocn_accum_fast MED med_phases_ocnalb_run MED med_phases_prep_lnd - MED med_connectors_prep_med2lnd MED -> LND :remapMethod=redist MED med_phases_prep_ice - MED med_connectors_prep_med2ice MED -> ICE :remapMethod=redist ICE LND ICE -> MED :remapMethod=redist - MED med_connectors_post_ice2med MED med_fraction_set LND -> MED :remapMethod=redist - MED med_connectors_post_lnd2med MED med_phases_prep_atm - MED med_connectors_prep_med2atm MED -> ATM :remapMethod=redist ATM ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_history_write MED med_phases_profile @ OCN OCN -> MED :remapMethod=redist - MED med_connectors_post_ocn2med MED med_phases_restart_write @ :: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D b/src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_swav similarity index 76% rename from src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D rename to src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_swav index 1b1f1bca0ae..2992420480d 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_swav @@ -1,7 +1,6 @@ runSeq:: @ocn_cpl_dt #ocean coupling step MED med_phases_prep_ocn_accum_avg - MED med_connectors_prep_med2ocn MED -> OCN :remapMethod=redist @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_ocn_map @@ -10,24 +9,19 @@ runSeq:: MED med_phases_prep_ocn_accum_fast MED med_phases_ocnalb_run MED med_phases_prep_ice - MED med_connectors_prep_med2ice MED -> ICE :remapMethod=redist ICE ROF ATM ICE -> MED :remapMethod=redist - MED med_connectors_post_ice2med MED med_fraction_set ROF -> MED :remapMethod=redist - MED med_connectors_post_rof2med ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_history_write MED med_phases_profile @ OCN OCN -> MED :remapMethod=redist - MED med_connectors_post_ocn2med MED med_phases_restart_write @ :: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_ww3 b/src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_ww3 new file mode 100644 index 00000000000..a35989eaf51 --- /dev/null +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_ww3 @@ -0,0 +1,31 @@ +runSeq:: +@atm_cpl_dt # Assume that atm_cpl_dt >= ocn_cpl_dt + MED med_phases_prep_ocn_map # map to ocean (including wav) + MED med_phases_aofluxes_run # run atm/ocn flux calculation + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_prep_ocn_accum_avg + MED med_phases_ocnalb_run + MED -> OCN :remapMethod=redist + MED med_phases_prep_ice + MED -> ICE :remapMethod=redist + MED med_phases_prep_wav + MED -> WAV :remapMethod=redist + ICE + ROF + WAV + ATM + ICE -> MED :remapMethod=redist + MED med_fraction_set + ROF -> MED :remapMethod=redist + WAV -> MED :remapMethod=redist + ATM -> MED :remapMethod=redist + @ocn_cpl_dt #ocean coupling step + OCN + @ + OCN -> MED :remapMethod=redist + MED med_phases_restart_write + MED med_phases_history_write + MED med_phases_profile +@ +:: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_C_wav b/src/drivers/nuopc/cime_config/nuopc_runseq_C_wav new file mode 100644 index 00000000000..d4909acee67 --- /dev/null +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_C_wav @@ -0,0 +1,31 @@ +runSeq:: +@86400 #ocean coupling step + MED med_phases_prep_ocn_accum_avg + MED -> OCN :remapMethod=redist + @21600 # atmosphere coupling step + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_ocnalb_run + MED med_phases_prep_ice + MED med_phases_prep_wav + MED -> ICE :remapMethod=redist + MED -> WAV :remapMethod=redist + ICE + ROF + WAV + ATM + ICE -> MED :remapMethod=redist + MED med_fraction_set + ROF -> MED :remapMethod=redist + WAV -> MED :remapMethod=redist + ATM -> MED :remapMethod=redist + MED med_phases_history_write + MED med_phases_profile + @ + OCN + OCN -> MED :remapMethod=redist + MED med_phases_restart_write +@ +:: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_F b/src/drivers/nuopc/cime_config/nuopc_runseq_F index 2bd784fda2b..257180cb18e 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_F +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_F @@ -2,21 +2,16 @@ runSeq:: @ocn_cpl_dt #ocean coupling step @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_ocn_accum_avg - MED med_connectors_prep_med2ocn MED -> OCN :remapMethod=redist MED med_phases_prep_lnd - MED med_connectors_prep_med2lnd MED -> LND :remapMethod=redist MED med_phases_prep_ice - MED med_connectors_prep_med2ice MED -> ICE :remapMethod=redist ICE LND OCN OCN -> MED :remapMethod=redist - MED med_connectors_post_ocn2med ICE -> MED :remapMethod=redist - MED med_connectors_post_ice2med MED med_fraction_set MED med_phases_prep_ocn_map MED med_phases_aofluxes_run @@ -24,13 +19,10 @@ runSeq:: MED med_phases_prep_ocn_accum_fast MED med_phases_ocnalb_run LND -> MED :remapMethod=redist - MED med_connectors_post_lnd2med MED med_phases_prep_atm - MED med_connectors_prep_med2atm MED -> ATM :remapMethod=redist ATM ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_history_write MED med_phases_profile @ diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_I b/src/drivers/nuopc/cime_config/nuopc_runseq_I index c8b3d4cf1f5..38a0db1ac00 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_I +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_I @@ -1,15 +1,12 @@ runSeq:: @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_lnd - MED med_connectors_prep_med2lnd MED -> LND :remapMethod=redist LND LND -> MED :remapMethod=redist - MED med_connectors_post_lnd2med MED med_fraction_set ATM ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_history_write MED med_phases_profile MED med_phases_restart_write diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_I_mosart b/src/drivers/nuopc/cime_config/nuopc_runseq_I_mosart index 57cd78fe888..c9fe228db2b 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_I_mosart +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_I_mosart @@ -1,24 +1,19 @@ runSeq:: @rof_cpl_dt # rof coupling step MED med_phases_prep_rof_avg - MED med_connectors_prep_med2rof MED -> ROF :remapMethod=redist ROF - ROF -> MED :remapMethod=redist @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_lnd - MED med_connectors_prep_med2lnd MED -> LND :remapMethod=redist LND LND -> MED :remapMethod=redist - MED med_connectors_post_lnd2med MED med_phases_prep_rof_accum_fast ATM ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_profile @ - MED med_connectors_post_rof2med + ROF -> MED :remapMethod=redist MED med_phases_history_write MED med_phases_restart_write @ diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS b/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS index 63475e13191..433da286315 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS @@ -1,22 +1,17 @@ runSeq:: @ocn_cpl_dt #slow coupling step (ocean) MED med_phases_prep_ocn_accum_avg - MED med_connectors_prep_med2ocn MED -> OCN :remapMethod=redist OCN @atm_cpl_dt # fast coupling step (atm, ice) MED med_phases_prep_atm - MED med_connectors_prep_med2atm MED -> ATM :remapMethod=redist ATM ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_prep_ice - MED med_connectors_prep_med2ice MED -> ICE :remapMethod=redist ICE ICE -> MED :remapMethod=redist - MED med_connectors_post_ice2med MED med_fraction_set MED med_phases_prep_ocn_map MED med_phases_aofluxes_run @@ -26,7 +21,6 @@ runSeq:: MED med_phases_profile @ OCN -> MED :remapMethod=redist - MED med_connectors_post_ocn2med MED med_phases_restart_write @ :: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.cold b/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.cold new file mode 100644 index 00000000000..4027737e037 --- /dev/null +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.cold @@ -0,0 +1,26 @@ +runSeq:: +@ocn_cpl_dt #slow coupling step (ocean) + @atm_cpl_dt # fast coupling step (atm, ice) + MED med_phases_prep_atm + MED -> ATM :remapMethod=redist + ATM + ATM -> MED :remapMethod=redist + MED med_phases_prep_ice + MED -> ICE :remapMethod=redist + ICE + ICE -> MED :remapMethod=redist + MED med_fraction_set + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_history_write + MED med_phases_profile + @ + MED med_phases_prep_ocn_accum_avg + MED -> OCN :remapMethod=redist + OCN + OCN -> MED :remapMethod=redist + MED med_phases_restart_write +@ +:: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.warm b/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.warm new file mode 100644 index 00000000000..cbb0cf821ce --- /dev/null +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.warm @@ -0,0 +1,26 @@ +runSeq:: +@ocn_cpl_dt #slow coupling step (ocean) + MED med_phases_prep_ocn_accum_avg + MED -> OCN :remapMethod=redist + OCN + @atm_cpl_dt # fast coupling step (atm, ice) + MED med_phases_prep_atm + MED med_phases_prep_ice + MED -> ATM :remapMethod=redist + MED -> ICE :remapMethod=redist + ATM + ICE + ATM -> MED :remapMethod=redist + ICE -> MED :remapMethod=redist + MED med_fraction_set + MED med_phases_prep_ocn_map + MED med_phases_aofluxes_run + MED med_phases_prep_ocn_merge + MED med_phases_prep_ocn_accum_fast + MED med_phases_history_write + MED med_phases_profile + @ + OCN -> MED :remapMethod=redist + MED med_phases_restart_write +@ +:: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_Q b/src/drivers/nuopc/cime_config/nuopc_runseq_Q index 16a7ca3d739..e6df31da275 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_Q +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_Q @@ -2,11 +2,9 @@ runSeq:: @ocn_cpl_dt #ocean coupling step @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_ocn_accum_avg - MED med_connectors_prep_med2ocn MED -> OCN :remapMethod=redist OCN OCN -> MED :remapMethod=redist - MED med_connectors_post_ocn2med MED med_fraction_set MED med_phases_prep_ocn_map MED med_phases_aofluxes_run @@ -14,11 +12,9 @@ runSeq:: MED med_phases_prep_ocn_accum_fast MED med_phases_ocnalb_run MED med_phases_prep_atm - MED med_connectors_prep_med2atm MED -> ATM :remapMethod=redist ATM ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_history_write MED med_phases_profile @ diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_X b/src/drivers/nuopc/cime_config/nuopc_runseq_X index 48ec4588a89..20710a4791b 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_X +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_X @@ -1,7 +1,6 @@ runSeq:: @ocn_cpl_dt #ocean coupling step MED med_phases_prep_ocn_accum_avg - MED med_connectors_prep_med2ocn MED -> OCN :remapMethod=redist @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_ocn_map @@ -10,49 +9,36 @@ runSeq:: MED med_phases_prep_ocn_accum_fast MED med_phases_ocnalb_run MED med_phases_prep_lnd - MED med_connectors_prep_med2lnd MED -> LND :remapMethod=redist MED med_phases_prep_ice - MED med_connectors_prep_med2ice MED -> ICE :remapMethod=redist MED med_phases_prep_wav - MED med_connectors_prep_med2wav MED -> WAV :remapMethod=redist MED med_phases_prep_rof_accum_fast MED med_phases_prep_rof_avg - MED med_connectors_prep_med2rof MED -> ROF :remapMethod=redist ICE LND ROF WAV ICE -> MED :remapMethod=redist - MED med_connectors_post_ice2med MED med_fraction_set LND -> MED :remapMethod=redist - MED med_connectors_post_lnd2med ROF -> MED :remapMethod=redist - MED med_connectors_post_rof2med MED med_phases_prep_glc - MED med_connectors_prep_med2glc MED -> GLC :remapMethod=redist MED med_phases_prep_atm - MED med_connectors_prep_med2atm MED -> ATM :remapMethod=redist ATM GLC WAV -> MED :remapMethod=redist - MED med_connectors_post_wav2med GLC -> MED :remapMethod=redist - MED med_connectors_post_glc2med ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_history_write MED med_phases_profile @ OCN OCN -> MED :remapMethod=redist - MED med_connectors_post_ocn2med MED med_phases_restart_write @ :: diff --git a/src/drivers/nuopc/cime_config/nuopc_runseq_default b/src/drivers/nuopc/cime_config/nuopc_runseq_default index 1611e71268e..66ab62b7256 100644 --- a/src/drivers/nuopc/cime_config/nuopc_runseq_default +++ b/src/drivers/nuopc/cime_config/nuopc_runseq_default @@ -1,7 +1,6 @@ runSeq:: @ocn_cpl_dt #ocean coupling step MED med_phases_prep_ocn_accum_avg - MED med_connectors_prep_med2ocn MED -> OCN :remapMethod=redist @atm_cpl_dt # atmosphere coupling step MED med_phases_prep_ocn_map @@ -10,48 +9,35 @@ runSeq:: MED med_phases_prep_ocn_accum_fast MED med_phases_ocnalb_run MED med_phases_prep_lnd - MED med_connectors_prep_med2lnd MED -> LND :remapMethod=redist MED med_phases_prep_ice - MED med_connectors_prep_med2ice MED -> ICE :remapMethod=redist MED med_phases_prep_wav - MED med_connectors_prep_med2wav MED -> WAV :remapMethod=redist MED med_phases_prep_rof - MED med_connectors_prep_med2rof MED -> ROF :remapMethod=redist ICE LND ROF WAV ICE -> MED :remapMethod=redist - MED med_connectors_post_ice2med MED med_fraction_set LND -> MED :remapMethod=redist - MED med_connectors_post_lnd2med ROF -> MED :remapMethod=redist - MED med_connectors_post_rof2med MED med_phases_prep_glc - MED med_connectors_prep_med2glc MED -> GLC :remapMethod=redist MED med_phases_prep_atm - MED med_connectors_prep_med2atm MED -> ATM :remapMethod=redist ATM GLC WAV -> MED :remapMethod=redist - MED med_connectors_post_wav2med GLC -> MED :remapMethod=redist - MED med_connectors_post_glc2med ATM -> MED :remapMethod=redist - MED med_connectors_post_atm2med MED med_phases_history_write MED med_phases_profile @ OCN OCN -> MED :remapMethod=redist - MED med_connectors_post_ocn2med MED med_phases_restart_write @ :: \ No newline at end of file diff --git a/src/drivers/nuopc/cime_driver/esmApp.F90 b/src/drivers/nuopc/cime_driver/esmApp.F90 index 664c96e4532..2c38bbe098c 100644 --- a/src/drivers/nuopc/cime_driver/esmApp.F90 +++ b/src/drivers/nuopc/cime_driver/esmApp.F90 @@ -4,36 +4,52 @@ program esmApp ! Generic ESM application driver !----------------------------------------------------------------------------- - use ESMF, only : ESMF_Initialize, ESMF_CALKIND_GREGORIAN, ESMF_LOGKIND_MULTI - use ESMF, only : ESMF_END_ABORT, ESMF_LogFoundError, ESMF_Finalize, ESMF_LOGERR_PASSTHRU - use ESMF, only : ESMF_GridCompSetServices, ESMF_GridCompFinalize, ESMF_LogSet, ESMF_LogWrite - use ESMF, only : ESMF_GridCompDestroy, ESMF_LOGMSG_INFO, ESMF_GridComp, ESMF_GridCompRun - use ESMF, only : ESMF_GridCompFinalize, ESMF_GridCompCreate, ESMF_GridCompInitialize - use ESMF, only : ESMF_LOGKIND_MULTI_ON_ERROR - use mpi, only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE - use NUOPC, only : NUOPC_FieldDictionarySetup - use ensemble_driver, only : SetServices - use shr_pio_mod, only : shr_pio_init1, shr_pio_init2 + use ESMF, only : ESMF_Initialize, ESMF_CALKIND_GREGORIAN, ESMF_LOGKIND_MULTI + use ESMF, only : ESMF_END_ABORT, ESMF_LogFoundError, ESMF_Finalize, ESMF_LOGERR_PASSTHRU + use ESMF, only : ESMF_GridCompSetServices, ESMF_GridCompFinalize, ESMF_LogSet, ESMF_LogWrite + use ESMF, only : ESMF_GridCompDestroy, ESMF_LOGMSG_INFO, ESMF_GridComp, ESMF_GridCompRun + use ESMF, only : ESMF_GridCompFinalize, ESMF_GridCompCreate, ESMF_GridCompInitialize + use ESMF, only : ESMF_LOGKIND_MULTI_ON_ERROR + use mpi, only : MPI_COMM_WORLD, MPI_COMM_NULL, MPI_Init, MPI_FINALIZE + use NUOPC, only : NUOPC_FieldDictionarySetup + use ensemble_driver, only : SetServices + use shr_pio_mod, only : shr_pio_init1, shr_pio_init2 + implicit none + + ! local variables integer :: COMP_COMM integer :: rc, urc type(ESMF_GridComp) :: ensemble_driver_comp + !----------------------------------------------------------------------------- + ! Initiallize MPI + !----------------------------------------------------------------------------- + call MPI_init(rc) COMP_COMM = MPI_COMM_WORLD + + !----------------------------------------------------------------------------- + ! Initialize PIO + !----------------------------------------------------------------------------- + ! For planned future use of async io using pio2. The IO tasks are seperated from the compute tasks here ! and COMP_COMM will be MPI_COMM_NULL on the IO tasks which then call shr_pio_init2 and do not return until ! the model completes. All other tasks call ESMF_Initialize. 8 is the maximum number of component models ! supported + call shr_pio_init1(8, "drv_in", COMP_COMM) - if(COMP_COMM .eq. MPI_COMM_NULL) then -! call shr_pio_init2( + + if (COMP_COMM .eq. MPI_COMM_NULL) then + ! call shr_pio_init2( call mpi_finalize(ierror=rc) stop endif + !----------------------------------------------------------------------------- ! Initialize ESMF !----------------------------------------------------------------------------- + #ifdef DEBUG call ESMF_Initialize(mpiCommunicator=COMP_COMM, logkindflag=ESMF_LOGKIND_MULTI, logappendflag=.false., & defaultCalkind=ESMF_CALKIND_GREGORIAN, ioUnitLBound=5001, ioUnitUBound=5101, rc=rc) @@ -77,6 +93,7 @@ program esmApp !----------------------------------------------------------------------------- ! SetServices for the ensemble driver Component !----------------------------------------------------------------------------- + call ESMF_GridCompSetServices(ensemble_driver_comp, SetServices, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -118,6 +135,7 @@ program esmApp ! Call Finalize for the ensemble driver ! Destroy the ensemble driver !----------------------------------------------------------------------------- + call ESMF_GridCompFinalize(ensemble_driver_comp, userRc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & @@ -129,7 +147,7 @@ program esmApp call ESMF_Finalize(endflag=ESMF_END_ABORT) call ESMF_LogWrite("ESMF_GridCompDestroy called", ESMF_LOGMSG_INFO, rc=rc) -! call ESMF_LogSet(flush=.true., trace=.true., rc=rc) + ! call ESMF_LogSet(flush=.true., trace=.true., rc=rc) call ESMF_GridCompDestroy(ensemble_driver_comp, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, & diff --git a/src/drivers/nuopc/cime_flds/esmDict.F90 b/src/drivers/nuopc/cime_flds/esmDict.F90 deleted file mode 100644 index 0acafb03fa3..00000000000 --- a/src/drivers/nuopc/cime_flds/esmDict.F90 +++ /dev/null @@ -1,1234 +0,0 @@ -module esmDict - - ! Establish the NUOPC dictionary for field names - ! The call to the dictionary initialization needs to be done on all PETS - - implicit none - public - - public :: esmDict_Init - - character(*), parameter :: u_FILE_u = & - __FILE__ - -!================================================================================ -contains -!================================================================================ - - subroutine esmDict_Init(rc) - - use ESMF , only : ESMF_SUCCESS - use med_constants_mod , only : CS - use glc_elevclass_mod , only : glc_elevclass_as_string - use shr_nuopc_scalars_mod , only : flds_scalar_name - use shr_nuopc_fldlist_mod , only : shr_nuopc_fldList_AddMetadata - - ! input/output variables: - integer, intent(inout) :: rc - - ! local variables: - integer :: ice_ncat ! number of sea ice thickness categories - integer :: glc_nec ! number of land-ice elevation classes - integer :: max_megan - integer :: max_ddep - integer :: max_fire - logical :: flds_i2o_per_cat - integer :: n, num - character(len= 2) :: cnum - character(len=CS) :: units - character(len=CS) :: longname - character(len=CS) :: stdname - character(len=CS) :: name, fldname - character(len=*), parameter :: subname='(esmDict_Init)' - !-------------------------------------- - - rc = ESMF_SUCCESS - - !--------------------------- - ! For now hardwire these - !--------------------------- - - max_megan = 20 - max_ddep = 80 - max_fire = 10 - glc_nec = 10 - ice_ncat = 5 - flds_i2o_per_cat = .true. - - !--------------------------- - ! Create dictionary names - !--------------------------- - - longname = trim(flds_scalar_name) - stdname = trim(flds_scalar_name) - units = 'unitless' - call shr_nuopc_fldList_AddMetadata(trim(flds_scalar_name), longname, stdname, units) - - longname = 'latitude' - stdname = 'latitude' - units = 'degrees north' - call shr_nuopc_fldList_AddMetadata('lat', longname, stdname, units) - - longname = 'longitude' - stdname = 'longitude' - units = 'degrees east' - call shr_nuopc_fldList_AddMetadata('lon', longname, stdname, units) - - longname = 'height' - stdname = 'height, depth, or levels' - units = 'unitless' - call shr_nuopc_fldList_AddMetadata('hgt', longname, stdname, units) - - longname = 'cell_area_model' - stdname = 'cell area from model' - units = 'radian^2' - call shr_nuopc_fldList_AddMetadata('area', longname, stdname, units) - - longname = 'cell_area_mapping' - stdname = 'cell area from mapping file' - units = 'radian^2' - call shr_nuopc_fldList_AddMetadata('aream', longname, stdname, units) - - longname = 'mask' - stdname = 'mask' - units = '1' - call shr_nuopc_fldList_AddMetadata('mask', longname, stdname, units) - - longname = 'area_fraction' - stdname = 'area fraction' - units = '1' - call shr_nuopc_fldList_AddMetadata('frac', longname, stdname, units) - - !---------------------------------------------------------- - ! Masks from components - !---------------------------------------------------------- - - longname = 'Surface fraction in land' - stdname = 'land_fraction_from_land' - units = '1' - call shr_nuopc_fldList_AddMetadata("Sl_lfrin", longname, stdname, units) - - longname = 'Sea surface mask' - stdname = 'sea_surface_mask' - units = '1' - call shr_nuopc_fldList_AddMetadata("So_omask", longname, stdname, units) - - longname = 'Sea ice mask' - stdname = 'sea_ice_mask' - units = '1' - call shr_nuopc_fldList_AddMetadata("Si_imask", longname, stdname, units) - - !---------------------------------------------------------- - ! Fractions sent to atm - !---------------------------------------------------------- - - longname = 'Surface land fraction' - stdname = 'land_area_fraction' - units = '1' - call shr_nuopc_fldList_AddMetadata("Sl_lfrac", longname, stdname, units) - - longname = 'Surface ice fraction' - stdname = 'sea_ice_area_fraction' - call shr_nuopc_fldList_AddMetadata("Si_ifrac", longname, stdname, units) - - longname = 'Surface ocean fraction' - stdname = 'sea_area_fraction' - units = '1' - call shr_nuopc_fldList_AddMetadata("So_ofrac", longname, stdname, units) - - !---------------------------------------------------------- - ! Fractional ice coverage wrt ocean sent to ocn and wav - !---------------------------------------------------------- - - longname = 'Fractional ice coverage wrt ocean' - stdname = 'sea_ice_area_fraction' - units = '1' - call shr_nuopc_fldList_AddMetadata("Si_ifrac", longname, stdname, units) - - !---------------------------------------------------------- - ! Fields from atm - !---------------------------------------------------------- - - longname = 'Height at the lowest model level' - stdname = 'height' - units = 'm' - call shr_nuopc_fldList_AddMetadata('Sa_z', longname, stdname, units) - - longname = 'Surface height' - stdname = 'height' - units = 'm' - call shr_nuopc_fldList_AddMetadata('Sa_topo', longname, stdname, units) - - longname = 'Zonal wind at the lowest model level' - stdname = 'eastward_wind' - units = 'm s-1' - call shr_nuopc_fldList_AddMetadata('Sa_u', longname, stdname, units) - - longname = 'Meridional wind at the lowest model level' - stdname = 'northward_wind' - units = 'm s-1' - call shr_nuopc_fldList_AddMetadata('Sa_v', longname, stdname, units) - - longname = 'Temperature at the lowest model level' - stdname = 'air_temperature' - units = 'K' - call shr_nuopc_fldList_AddMetadata('Sa_tbot', longname, stdname, units) - - longname = 'Potential temperature at the lowest model level' - stdname = 'air_potential_temperature' - units = 'K' - call shr_nuopc_fldList_AddMetadata('Sa_ptem', longname, stdname, units) - - longname = 'Specific humidity at the lowest model level' - stdname = 'specific_humidity' - units = 'kg kg-1' - call shr_nuopc_fldList_AddMetadata('Sa_shum', longname, stdname, units) - - longname = 'Pressure at the lowest model level' - stdname = 'air_pressure' - units = 'Pa' - call shr_nuopc_fldList_AddMetadata('Sa_pbot', longname, stdname, units) - - longname = 'Density at the lowest model level' - stdname = 'air_density' - units = 'kg m-3' - call shr_nuopc_fldList_AddMetadata('Sa_dens', longname, stdname, units) - - longname = 'Convective precipitation rate' - stdname = 'convective_precipitation_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_rainc', longname, stdname, units) - - longname = 'Large-scale (stable) precipitation rate' ! water equivalent - stdname = 'large_scale_precipitation_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_rainl', longname, stdname, units) - - longname = 'Water flux due to rain' - stdname = 'rainfall_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_rain', longname, stdname, units) - - longname = 'Convective snow rate' - stdname = 'convective_snowfall_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_snowc', longname, stdname, units) - - longname = 'Large-scale (stable) snow rate' - stdname = 'large_scale_snowfall_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_snowl', longname, stdname, units) - - longname = 'Water flux due to snow' - stdname = 'surface_snow_melt_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_snow', longname, stdname, units) - - ! total precipitation to ocean (derived rain + snow, done AFTER mappings) - longname = 'Water flux (rain+snow)' - stdname = 'precipitation_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_prec', longname, stdname, units) - - longname = 'Downward longwave heat flux' - stdname = 'downwelling_longwave_flux' - units = 'W m-2' - call shr_nuopc_fldList_AddMetadata('Faxa_lwdn', longname, stdname, units) - - longname = 'Direct near-infrared incident solar radiation' - stdname = 'surface_downward_direct_shortwave_flux_due_to_near_infrared_radiation' - units = 'W m-2' - call shr_nuopc_fldList_AddMetadata("Faxa_swndr", longname, stdname, units) - - longname = 'Direct visible incident solar radiation' - stdname = 'surface_downward_direct_shortwave_flux_due_to_visible_radiation' - units = 'W m-2' - call shr_nuopc_fldList_AddMetadata("Faxa_swvdr", longname, stdname, units) - - longname = 'Diffuse near-infrared incident solar radiation' - stdname = 'surface_downward_diffuse_shortwave_flux_due_to_near_infrared_radiation' - units = 'W m-2' - call shr_nuopc_fldList_AddMetadata("Faxa_swndf", longname, stdname, units) - - longname = 'Diffuse visible incident solar radiation' - stdname = 'surface_downward_diffuse_shortwave_flux_due_to_visible_radiation' - units = 'W m-2' - call shr_nuopc_fldList_AddMetadata('Faxa_swvdf', longname, stdname, units) - - longname = 'Net shortwave radiation' - stdname = 'surface_net_shortwave_flux' - units = 'W m-2' - call shr_nuopc_fldList_AddMetadata("Faxa_swnet", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Fall_swnet", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faii_swnet", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Foxx_swnet", longname, stdname, units) - - longname = 'Net shortwave radiation penetrating into ice and ocean' - stdname = 'net_downward_shortwave_flux_in_sea_ice_due_to_penetration' - units = 'W m-2' - call shr_nuopc_fldList_AddMetadata('Fioi_swpen', longname, stdname, units) - - longname ='Hydrophylic black carbon dry deposition flux' - stdname = 'dry_deposition_flux_of_hydrophylic_black_carbon' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_bcphidry', longname, stdname, units) - - longname = 'Hydrophobic black carbon dry deposition flux' - stdname = 'dry_deposition_flux_of_hydrophobic_black_carbon' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Faxa_bcphodry", longname, stdname, units) - - longname = 'Hydrophylic black carbon wet deposition flux' - stdname = 'wet_deposition_flux_of_hydrophylic_black_carbon' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Faxa_bcphiwet", longname, stdname, units) - - longname = 'Hydrophylic organic carbon dry deposition flux' - stdname = 'dry_deposition_flux_of_hydrophylic_organic_carbon' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Faxa_ocphidry", longname, stdname, units) - - longname = 'Hydrophobic organic carbon dry deposition flux' - stdname = 'dry_deposition_flux_of_hydrophobic_organic_carbon' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Faxa_ocphodry", longname, stdname, units) - - longname = 'Hydrophylic organic carbon wet deposition flux' - stdname = 'wet_deposition_flux_of_hydrophylic_organic_carbon' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Faxa_ocphiwet", longname, stdname, units) - - longname = 'Dust wet deposition flux (size 1)' - stdname = 'wet_deposition_flux_of_dust' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Faxa_dstwet1", longname, stdname, units) - - longname = 'Dust wet deposition flux (size 2)' - stdname = 'wet_deposition_flux_of_dust' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Faxa_dstwet2", longname, stdname, units) - - longname = 'Dust wet deposition flux (size 3)' - stdname = 'wet_deposition_flux_of_dust' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Faxa_dstwet3", longname, stdname, units) - - longname = 'Dust wet deposition flux (size 4)' - stdname = 'wet_deposition_flux_of_dust' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Faxa_dstwet4", longname, stdname, units) - - longname = 'Dust dry deposition flux (size 1)' - stdname = 'dry_deposition_flux_of_dust' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Faxa_dstdry1", longname, stdname, units) - - longname = 'Dust dry deposition flux (size 2)' - stdname = 'dry_deposition_flux_of_dust' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Faxa_dstdry2", longname, stdname, units) - - longname = 'Dust dry deposition flux (size 3)' - stdname = 'dry_deposition_flux_of_dust' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Faxa_dstdry3", longname, stdname, units) - - longname = 'Dust dry deposition flux (size 4)' - stdname = 'dry_deposition_flux_of_dust' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Faxa_dstdry4", longname, stdname, units) - - !---------------------------------------------------------- - ! states/fluxes to atm (and ocean) - !---------------------------------------------------------- - - longname = 'Direct albedo (visible radiation)' - stdname = 'surface_direct_albedo_due_to_visible_radiation' - units = '1' - call shr_nuopc_fldList_AddMetadata("Si_avsdr", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Sl_avsdr", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("So_avsdr", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Sx_avsdr", longname, stdname, units) - - longname = 'Direct albedo (near-infrared radiation)' - stdname = 'surface_direct_albedo_due_to_near_infrared_radiation' - units = '1' - call shr_nuopc_fldList_AddMetadata("Si_anidr", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Sl_anidr", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("So_anidr", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Sx_anidr", longname, stdname, units) - - longname = 'Diffuse albedo (visible radiation)' - stdname = 'surface_diffuse_albedo_due_to_visible_radiation' - units = '1' - call shr_nuopc_fldList_AddMetadata("Si_avsdf", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Sl_avsdf", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("So_avsdf", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Sx_avsdf", longname, stdname, units) - - longname = 'Diffuse albedo (near-infrared radiation)' - stdname = 'surface_diffuse_albedo_due_to_near_infrared_radiation' - units = '1' - call shr_nuopc_fldList_AddMetadata("Si_anidf", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Sl_anidf", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("So_anidf", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Sx_anidf", longname, stdname, units) - - longname = 'Reference temperature at 2 meters' - stdname = 'air_temperature' - units = 'K' - call shr_nuopc_fldList_AddMetadata("Si_tref", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Sl_tref", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("So_tref", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Sx_tref", longname, stdname, units) - - longname = 'Reference specific humidity at 2 meters' - stdname = 'specific_humidity' - units = 'kg kg-1' - call shr_nuopc_fldList_AddMetadata("Si_qref", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Sl_qref", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("So_qref", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Sx_qref", longname, stdname, units) - - longname = 'Surface temperature' - stdname = 'surface_temperature' - units = 'K' - call shr_nuopc_fldList_AddMetadata("Si_t", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Sl_t", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("So_t", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Sx_t", longname, stdname, units) - - longname = 'Surface fraction velocity in land' - stdname = 'fraction_velocity' - units = 'm s-1' - call shr_nuopc_fldList_AddMetadata("Sl_fv", longname, stdname, units) - - longname = 'Aerodynamic resistance' - stdname = 'aerodynamic_resistance' - units = 's/m' - call shr_nuopc_fldList_AddMetadata("Sl_ram1", longname, stdname, units) - - longname = 'Surface snow water equivalent' - stdname = 'surface_snow_water_equivalent' - units = 'm' - call shr_nuopc_fldList_AddMetadata("Sl_snowh", longname, stdname, units) - - longname = 'Surface snow depth' - stdname = 'surface_snow_thickness' - units = 'm' - call shr_nuopc_fldList_AddMetadata("Si_snowh", longname, stdname, units) - - longname = 'Surface saturation specific humidity in ocean' - stdname = 'specific_humidity_at_saturation' - units = 'kg kg-1' - call shr_nuopc_fldList_AddMetadata("So_ssq", longname, stdname, units) - - longname = 'Square of exch. coeff (tracers)' - stdname = 'square_of_exch_coeff' - units = '1' - call shr_nuopc_fldList_AddMetadata("So_re", longname, stdname, units) - - longname = '10m wind' - stdname = '10m_wind' - units = 'm' - call shr_nuopc_fldList_AddMetadata("Sl_u10", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Si_u10", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("So_u10", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Sx_u10", longname, stdname, units) - - longname = 'Zonal surface stress' - stdname = 'surface_downward_eastward_stress' - units = 'N m-2' - call shr_nuopc_fldList_AddMetadata("Fall_taux", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faox_taux", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faii_taux", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Fioi_taux", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faxx_taux", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Foxx_taux", longname, stdname, units) - - longname = 'Meridional surface stress' - stdname = 'surface_downward_northward_stress' - units = 'N m-2' - call shr_nuopc_fldList_AddMetadata("Fall_tauy", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faox_tauy", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faii_tauy", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Fioi_tauy", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faxx_tauy", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Foxx_tauy", longname, stdname, units) - - longname = 'Surface latent heat flux' - stdname = 'surface_upward_latent_heat_flux' - units = 'W m-2' - call shr_nuopc_fldList_AddMetadata("Fall_lat", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faox_lat", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faii_lat", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faxx_lat", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Foxx_lat", longname, stdname, units) - - longname = 'Sensible heat flux' - stdname = 'surface_upward_sensible_heat_flux' - units = 'W m-2' - call shr_nuopc_fldList_AddMetadata("Fall_sen", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faox_sen", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faii_sen", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faxx_sen", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Foxx_sen", longname, stdname, units) - - longname = 'Surface upward longwave heat flux' - stdname = 'surface_net_upward_longwave_flux' - units = 'W m-2' - call shr_nuopc_fldList_AddMetadata("Fall_lwup", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faox_lwup", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faii_lwup", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faxx_lwup", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Foxx_lwup", longname, stdname, units) - - longname = 'Evaporation water flux' - stdname = 'water_evaporation_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Fall_evap", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faox_evap", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faii_evap", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Faxx_evap", longname, stdname, units) - call shr_nuopc_fldList_AddMetadata("Foxx_evap", longname, stdname, units) - - longname = 'Dust flux (particle bin number 1)' - stdname = 'dust_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Fall_flxdst1", longname, stdname, units) - - longname = 'Dust flux (particle bin number 2)' - stdname = 'dust_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Fall_flxdst2", longname, stdname, units) - - longname = 'Dust flux (particle bin number 3)' - stdname = 'dust_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Fall_flxdst3", longname, stdname, units) - - longname = 'Dust flux (particle bin number 4)' - stdname = 'dust_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Fall_flxdst4", longname, stdname, units) - - !----------------------------- - ! atm<->ocn only exchange - !----------------------------- - - longname = 'Sea level pressure' - stdname = 'air_pressure_at_sea_level' - units = 'Pa' - call shr_nuopc_fldList_AddMetadata("Sa_pslv", longname, stdname, units) - - longname = 'Wind speed squared at 10 meters' - stdname = 'square_of_wind_speed' - units = 'm2 s-2' - call shr_nuopc_fldList_AddMetadata("So_duu10n", longname, stdname, units) - - longname = 'Surface fraction velocity in ocean' - stdname = 'fraction_velocity' - units = 'm s-1' - call shr_nuopc_fldList_AddMetadata("So_ustar", longname, stdname, units) - - !----------------------------- - ! ice->ocn exchange - !----------------------------- - - longname = 'Heat flux from melting' - stdname = 'surface_snow_melt_heat_flux' - units = 'W m-2' - call shr_nuopc_fldList_AddMetadata("Fioi_melth", longname, stdname, units) - - longname = 'Water flux due to melting' - stdname = 'surface_snow_melt_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Fioi_meltw", longname, stdname, units) - - longname = 'Salt flux' - stdname = 'virtual_salt_flux_into_sea_water' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Fioi_salt", longname, stdname, units) - - longname = 'Hydrophylic black carbon deposition flux' - stdname = 'deposition_flux_of_hydrophylic_black_carbon' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Fioi_bcphi", longname, stdname, units) - - longname = 'Hydrophobic black carbon deposition flux' - stdname = 'deposition_flux_of_hydrophobic_black_carbon' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Fioi_bcpho", longname, stdname, units) - - longname = 'Dust flux' - stdname = 'dust_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Fioi_flxdst", longname, stdname, units) - - !----------------------------- - ! ocn -> ice exchange (some of these fields are also used in the atm/ocn flux computation) - !----------------------------- - - longname = 'Sea surface salinity' - stdname = 'sea_surface_salinity' - units = 'g kg-1' - call shr_nuopc_fldList_AddMetadata("So_s", longname, stdname, units) - - longname = 'Zonal sea water velocity' - stdname = 'eastward_sea_water_velocity' - units = 'm s-1' - call shr_nuopc_fldList_AddMetadata("So_u", longname, stdname, units) - - longname = 'Fraction of sw penetrating surface layer for diurnal cycle' - stdname = 'Fraction_of_sw_penetrating_surface_layer' - units = '1' - call shr_nuopc_fldList_AddMetadata("So_fswpen", longname, stdname, units) - - longname = 'Meridional sea water velocity' - stdname = 'northward_sea_water_velocity' - units = 'm s-1' - call shr_nuopc_fldList_AddMetadata("So_v", longname, stdname, units) - - longname = 'Zonal sea surface slope' - stdname = 'sea_surface_eastward_slope' - units = 'm m-1' - call shr_nuopc_fldList_AddMetadata("So_dhdx", longname, stdname, units) - - longname = 'Meridional sea surface slope' - stdname = 'sea_surface_northward_slope' - units = 'm m-1' - call shr_nuopc_fldList_AddMetadata("So_dhdy", longname, stdname, units) - - longname = 'Ocean Boundary Layer Depth' - stdname = 'ocean_boundary_layer_depth' - units = 'm' - call shr_nuopc_fldList_AddMetadata("So_bldepth", longname, stdname, units) - - longname = 'Ocean melt and freeze potential' - stdname = 'surface_snow_and_ice_melt_heat_flux' - units = 'W m-2' - call shr_nuopc_fldList_AddMetadata("Fioo_q", longname, stdname, units) - - !----------------------------- - ! lnd->rof exchange - !----------------------------- - - longname = 'Water flux from land (liquid surface)' - stdname = 'water_flux_into_runoff_surface' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Flrl_rofsur", longname, stdname, units) - - longname = 'Water flux from land (liquid glacier, wetland, and lake)' - stdname = 'water_flux_into_runoff_from_gwl' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Flrl_rofgwl", longname, stdname, units) - - longname = 'Water flux from land (liquid subsurface)' - stdname = 'water_flux_into_runoff_subsurface' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Flrl_rofsub", longname, stdname, units) - - longname = 'Water flux from land direct to ocean' - stdname = 'water_flux_direct_to_ocean' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Flrl_rofdto", longname, stdname, units) - - longname = 'Water flux from land (frozen)' - stdname = 'frozen_water_flux_into_runoff' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Flrl_rofi", longname, stdname, units) - - ! Irrigation flux (land/rof only) - longname = 'Irrigation flux (withdrawal from rivers)' - stdname = 'irrigation' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Flrl_irrig", longname, stdname, units) - - !----------------------------- - ! rof->lnd - !----------------------------- - - longname = 'Waterflux back to land due to flooding' - stdname = 'flooding_water_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Flrr_flood", longname, stdname, units) - - longname = 'River channel total water volume' - stdname = 'rtm_volr' - units = 'm' - call shr_nuopc_fldList_AddMetadata("Flrr_volr", longname, stdname, units) - - longname = 'River channel main channel water volume' - stdname = 'rtm_volrmch' - units = 'm' - call shr_nuopc_fldList_AddMetadata("Flrr_volrmch", longname, stdname, units) - - !----------------------------- - ! rof->ocn (liquid and frozen) and glc->ocn - !----------------------------- - - longname = 'glc liquid runoff flux to ocean' - stdname = 'glacier_liquid_runoff_flux_to_ocean' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Fogg_rofl', longname, stdname, units) - - longname = 'Water flux into sea water due to runoff (liquid)' - stdname = 'water_flux_into_sea_water' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Forr_rofl", longname, stdname, units) - - longname = 'Total Water flux into sea water due to runoff (liquid)' - stdname = 'total_water_flux_into_sea_water' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Foxx_rofl", longname, stdname, units) - - longname = 'glc frozen runoff flux to ocean' - stdname = 'glacier_frozen_runoff_flux_to_ocean' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Fogg_rofi', longname, stdname, units) - - longname = 'Water flux into sea water due to runoff (frozen)' - stdname = 'frozen_water_flux_into_sea_water' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Forr_rofi", longname, stdname, units) - - longname = 'Total Water flux into sea water due to runoff (frozen)' - stdname = 'total_frozen_water_flux_into_sea_water' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Foxx_rofi", longname, stdname, units) - - !----------------------------- - ! rof(frozen)->ice and glc->ice - !----------------------------- - - longname = 'Water flux into sea ice due to runoff (frozen)' - stdname = 'frozen_water_flux_into_sea_ice' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Firr_rofi", longname, stdname, units) - - longname = 'glc frozen runoff_iceberg flux to ice' - stdname = 'glacier_frozen_runoff_flux_to_seaice' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Figg_rofi', longname, stdname, units) - - longname = 'Total frozen water flux into sea ice ' - stdname = 'total_frozen_water_flux_into_sea_ice' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata("Fixx_rofi", longname, stdname, units) - - !----------------------------- - ! wav->ocn - !----------------------------- - - longname = 'Langmuir multiplier' - stdname = 'wave_model_langmuir_multiplier' - units = '1' - call shr_nuopc_fldList_AddMetadata('Sw_lamult', longname, stdname, units) - - longname = 'Stokes drift u component' - stdname = 'wave_model_stokes_drift_eastward_velocity' - units = 'm/s' - call shr_nuopc_fldList_AddMetadata('Sw_ustokes', longname, stdname, units) - - longname = 'Stokes drift v component' - stdname = 'wave_model_stokes_drift_northward_velocity' - units = 'm/s' - call shr_nuopc_fldList_AddMetadata('Sw_vstokes', longname, stdname, units) - - longname = 'Stokes drift depth' - stdname = 'wave_model_stokes_drift_depth' - units = 'm' - call shr_nuopc_fldList_AddMetadata('Sw_hstokes', longname, stdname, units) - - longname = 'Downward solar radiation' - stdname = 'surface_downward_shortwave_flux' - units = 'W m-2' - call shr_nuopc_fldList_AddMetadata("Faox_swdn", longname, stdname, units) - - longname = 'Upward solar radiation' - stdname = 'surface_upward_shortwave_flux' - units = 'W m-2' - call shr_nuopc_fldList_AddMetadata("Faox_swup", longname, stdname, units) - - !----------------------------- - ! glc -> ocn - !----------------------------- - - !----------------------------- - ! glc -> lnd - !----------------------------- - - longname = 'Ice sheet grid coverage on global grid' - stdname = 'ice_sheet_grid_mask' - units = '1' - call shr_nuopc_fldList_AddMetadata("Sg_icemask", longname, stdname, units) - - longname = 'Ice sheet mask where we are potentially sending non-zero fluxes' - stdname = 'icemask_coupled' - units = '1' - call shr_nuopc_fldList_AddMetadata("Sg_icemask_coupled_fluxes", longname, stdname, units) - - longname = 'Fraction of glacier area' - stdname = 'glacier_area_fraction' - units = '1' - call shr_nuopc_fldList_AddMetadata('Sg_ice_covered', longname, stdname, units) - if (glc_nec > 0) then - name = 'Sg_ice_covered' - do num = 0, glc_nec - cnum = glc_elevclass_as_string(num) - call shr_nuopc_fldList_AddMetadata( 'Sg_ice_covered'//trim(cnum), & - trim(longname)//' of elevation class '//trim(cnum), stdname , units) - end do - end if - - longname = 'Surface height of glacier' - stdname = 'height' - units = 'm' - call shr_nuopc_fldList_AddMetadata('Sg_topo', longname, stdname, units) - if (glc_nec > 0) then - name = 'Sg_topo' - do num = 0, glc_nec - cnum = glc_elevclass_as_string(num) - call shr_nuopc_fldList_AddMetadata( 'Sg_topo'//trim(cnum), & - trim(longname)//' of elevation class '//trim(cnum), stdname , units) - end do - end if - - longname = 'Downward heat flux from glacier interior' - stdname = 'downward_heat_flux_in_glacier' - units = 'W m-2' - call shr_nuopc_fldList_AddMetadata('Flgg_hflx', longname, stdname, units) - if (glc_nec > 0) then - name = 'Flgg_hflx' - do num = 0, glc_nec - cnum = glc_elevclass_as_string(num) - call shr_nuopc_fldList_AddMetadata( 'Flgg_hflx'//trim(cnum), & - trim(longname)//' of elevation class '//trim(cnum), stdname, units) - end do - end if - - !----------------------------- - ! lnd -> glc - !----------------------------- - - ! glc fields with multiple elevation classes: lnd->glc - ! - fields sent from lnd->med are in multiple elevation classes - ! - fields sent from med->glc do NOT have elevation classes - ! - need to keep track of the l2x fields destined for glc in the - ! additional variables, l2x_to_glc. This is needed so that can set up - ! additional fields holding accumulated quantities of just these fields. - - ! Sets a coupling field for all glc elevation classes (1:glc_nec) plus bare land (index 0). - ! Note that, if glc_nec = 0, then we don't create any coupling fields (not even the bare land (0) fldindex) - - longname = 'New glacier ice flux' - stdname = 'ice_flux_out_of_glacier' - units = 'kg m-2 s-1' - if (glc_nec > 0) then - do num = 0, glc_nec - cnum = glc_elevclass_as_string(num) - call shr_nuopc_fldList_AddMetadata('Flgl_qice'//trim(cnum), & - trim(longname)//' of elevation class '//trim(cnum), stdname, units) - end do - end if - call shr_nuopc_fldList_AddMetadata( 'Flgl_qice', longname, stdname, units) - - longname = 'Surface temperature of glacier' - stdname = 'surface_temperature' - units = 'deg C' - if (glc_nec > 0) then - do num = 0, glc_nec - cnum = glc_elevclass_as_string(num) - call shr_nuopc_fldList_AddMetadata('Sl_tsrf'//trim(cnum), & - trim(longname)//' of elevation class '//trim(cnum), stdname, units) - end do - end if - call shr_nuopc_fldList_AddMetadata( 'Sl_tsrf', longname, stdname, units) - - ! Sl_topo is sent from lnd -> med, but is NOT sent to glc (it is only used for the - ! remapping in the mediator) - - longname = 'Surface height' - stdname = 'height' - units = 'm' - if (glc_nec > 0) then - do num = 0, glc_nec - cnum = glc_elevclass_as_string(num) - call shr_nuopc_fldList_AddMetadata('Sl_topo'//trim(cnum), & - trim(longname)//' of elevation class '//trim(cnum), stdname, units) - end do - end if - call shr_nuopc_fldList_AddMetadata( 'Sl_topo', longname, stdname, units) - - longname = 'Surface flux of CO2 from land' - stdname = 'surface_upward_flux_of_carbon_dioxide_where_land' - units = 'moles m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Fall_fco2_lnd', longname, stdname, units) - - longname = 'Prognostic CO2 at the lowest model level' - stdname = 'prognostic_CO2_lowest_level' - units = '1e-6 mol/mol' - call shr_nuopc_fldList_AddMetadata('Sa_co2prog', longname, stdname, units) - - longname = 'Diagnostic CO2 at the lowest model level' - stdname = 'diagnostic_CO2_lowest_level' - units = '1e-6 mol/mol' - call shr_nuopc_fldList_AddMetadata('Sa_co2diag', longname, stdname, units) - - longname = 'Surface flux of CO2 from land' - stdname = 'surface_upward_flux_of_carbon_dioxide_where_land' - units = 'moles m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Fall_fco2_lnd', longname, stdname, units) - - longname = 'Surface flux of CO2 from ocean' - stdname = 'surface_upward_flux_of_carbon_dioxide_where_open_sea' - units = 'moles m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faoo_fco2_ocn', longname, stdname, units) - - !----------------------------- - ! water isotope fields - !----------------------------- - - longname = 'Ratio of ocean surface level abund. H2_16O/H2O/Rstd' - stdname = 'ratio_ocean_surface_16O_abund' - units = '1' - call shr_nuopc_fldList_AddMetadata('So_roce_16O', longname, stdname, units) - - longname = 'Ratio of ocean surface level abund. HDO/H2O/Rstd' - stdname = 'ratio_ocean_surface_HDO_abund' - call shr_nuopc_fldList_AddMetadata('So_roce_HDO', longname, stdname, units) - - !------------------------ - ! Atmospheric specific humidty at lowest level: - !------------------------ - - longname = 'Specific humidty of H216O at the lowest model level' - stdname = 'H216OV' - units = 'kg kg-1' - call shr_nuopc_fldList_AddMetadata('Sa_shum_16O', longname, stdname, units) - longname = 'Specific humidty of H218O at the lowest model level' - stdname = 'H218OV' - call shr_nuopc_fldList_AddMetadata('Sa_shum_18O', longname, stdname, units) - longname = 'Specific humidty of HD16O at the lowest model level' - stdname = 'HD16OV' - call shr_nuopc_fldList_AddMetadata('Sa_shum_HDO', longname, stdname, units) - - !------------------------ - ! Isotopic surface snow water equivalent (land/atm only) - !------------------------ - - longname = 'Isotopic surface snow water equivalent' - stdname = 'surface_snow_water_equivalent' - units = 'm' - call shr_nuopc_fldList_AddMetadata('Sl_snowh_16O', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Sl_snowh_HDO', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Sl_snowh_18O', longname, stdname, units) - - !------------------------ - ! Isotopic Precipitation Fluxes: - !------------------------ - - longname = 'H216O Convective precipitation rate' - stdname = 'H2_16O_convective_precipitation_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_rainc_16O', longname, stdname, units) - longname = 'H216O Large-scale (stable) precipitation rate' - stdname = 'H2_16O_large_scale_precipitation_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_rainl_16O', longname, stdname, units) - longname = 'Water flux due to H216O rain' !equiv. to bulk - stdname = 'H2_16O_rainfall_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_rain_16O', longname, stdname, units) - - longname = 'H218O Convective precipitation rate' - stdname = 'H2_18O_convective_precipitation_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_rainc_18O', longname, stdname, units) - longname = 'H218O Large-scale (stable) precipitation rate' - stdname = 'H2_18O_large_scale_precipitation_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_rainl_18O', longname, stdname, units) - longname = 'Water flux due to H218O rain' - stdname = 'h2_18o_rainfall_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_rain_18O', longname, stdname, units) - - longname = 'HDO Convective precipitation rate' - stdname = 'HDO_convective_precipitation_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_rainc_HDO', longname, stdname, units) - longname = 'HDO Large-scale (stable) precipitation rate' - stdname = 'HDO_large_scale_precipitation_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_rainl_HDO', longname, stdname, units) - longname = 'Water flux due to HDO rain' - stdname = 'hdo_rainfall_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_rain_HDO', longname, stdname, units) - - !------------------------ - ! Isotopic Snow Fluxes: - !------------------------ - - longname = 'H216O Convective snow rate (water equivalent)' - stdname = 'H2_16O_convective_snowfall_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_snowc_16O', longname, stdname, units) - longname = 'H216O Large-scale (stable) snow rate' - stdname = 'H2_16O_large_scale_snowfall_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_snowl_16O', longname, stdname, units) - longname = 'Water flux due to H216O snow' !equiv. to bulk - stdname = 'H2_16O_snowfall_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_snow_16O', longname, stdname, units) - - longname = 'H218O Convective snow rate' - stdname = 'H2_18O_convective_snowfall_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_snowc_18O', longname, stdname, units) - longname = 'H218O Large-scale (stable) snow rate' - stdname = 'H2_18O_large_scale_snowfall_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_snowl_18O', longname, stdname, units) - longname = 'Water flux due to H218O snow' - stdname = 'h2_18o_snowfall_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_snow_18O', longname, stdname, units) - - longname = 'HDO Convective snow rate' - stdname = 'HDO_convective_snowfall_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_snowc_HDO', longname, stdname, units) - longname = 'HDO Large-scale (stable) snow rate' - stdname = 'HDO_large_scale_snowfall_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_snowl_HDO', longname, stdname, units) - longname = 'Water flux due to HDO snow' - stdname = 'hdo_snowfall_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_snow_HDO', longname, stdname, units) - - !------------------------ - ! Isotopic precipitation (rain + snow) - !------------------------ - - longname = 'Isotopic Water flux (rain+snow) for H2_16O' - stdname = 'h2_16o_precipitation_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_prec_16O', longname, stdname, units) - longname = 'Isotopic Water flux (rain+snow) for H2_18O' - stdname = 'h2_18o_precipitation_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_prec_18O', longname, stdname, units) - longname = 'Isotopic Water flux (rain+snow) for H2_HDO' - stdname = 'h2_HDo_precipitation_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Faxa_prec_HDO', longname, stdname, units) - - !------------------------------------- - ! Isotopic two meter reference humidity: - !------------------------------------- - - longname = 'Reference H216O specific humidity at 2 meters' - stdname = 'H216O_specific_humidity' - units = 'kg kg-1' - call shr_nuopc_fldList_AddMetadata('Sl_qref_16O', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Si_qref_16O', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('So_qref_16O', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Sx_qref_16O', longname, stdname, units) - - longname = 'Reference H218O specific humidity at 2 meters' - stdname = 'H218O_specific_humidity' - units = 'kg kg-1' - call shr_nuopc_fldList_AddMetadata('Sl_qref_18O', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Si_qref_18O', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('So_qref_18O', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Sx_qref_18O', longname, stdname, units) - - longname = 'Reference H2HDO specific humidity at 2 meters' - stdname = 'H2HDO_specific_humidity' - units = 'kg kg-1' - call shr_nuopc_fldList_AddMetadata('Sl_qref_HDO', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Si_qref_HDO', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('So_qref_HDO', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Sx_qref_HDO', longname, stdname, units) - - !------------------------- - ! Isotopic Evaporation flux: - !------------------------- - - longname = 'Evaporation H216O flux' - stdname = 'H216O_evaporation_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Fall_evap_16O', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Faii_evap_16O', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Faox_evap_16O', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Faxx_evap_16O', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Foxx_evap_16O', longname, stdname, units) - - longname = 'Evaporation H216O flux' - stdname = 'H216O_evaporation_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Fall_evap_18O', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Faii_evap_18O', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Faox_evap_18O', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Faxx_evap_18O', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Foxx_evap_18O', longname, stdname, units) - - longname = 'Evaporation H2HDO flux' - stdname = 'H2HDO_evaporation_flux' - units = 'kg m-2 s-1' - call shr_nuopc_fldList_AddMetadata('Fall_evap_HDO', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Faii_evap_HDO', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Faox_evap_HDO', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Faxx_evap_HDO', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Foxx_evap_HDO', longname, stdname, units) - - !------------------------- - ! Isotopic sea ice melting flux - !------------------------- - - ! 'Heat flux from melting' - units = 'kg m-2 s-1' - longname = 'H2_16O heat flux due to melting' - stdname = 'h2_16o_surface_snow_melt_hflux' - call shr_nuopc_fldList_AddMetadata('Fioi_melth_16O', longname, stdname, units) - units = 'kg m-2 s-1' - longname = 'H2_18O heat flux due to melting' - stdname = 'h2_18o_surface_snow_melt_hflux' - call shr_nuopc_fldList_AddMetadata('Fioi_melth_18O', longname, stdname, units) - units = 'kg m-2 s-1' - longname = 'H2_18O heat flux due to melting' - stdname = 'h2_HDo_surface_snow_melt_hflux' - call shr_nuopc_fldList_AddMetadata('Fioi_melth_HDO', longname, stdname, units) - - ! 'Water flux from melting' - units = 'kg m-2 s-1' - longname = 'H2_16O water flux due to melting' - stdname = 'h2_16o_surface_snow_melt_wflux' - call shr_nuopc_fldList_AddMetadata('Fioi_meltw_16O', longname, stdname, units) - units = 'kg m-2 s-1' - longname = 'H2_18O water flux due to melting' - stdname = 'h2_18o_surface_snow_melt_wflux' - call shr_nuopc_fldList_AddMetadata('Fioi_meltw_18O', longname, stdname, units) - units = 'kg m-2 s-1' - longname = 'H2_18O water flux due to melting' - stdname = 'h2_HDo_surface_snow_melt_wflux' - call shr_nuopc_fldList_AddMetadata('Fioi_meltw_HDO', longname, stdname, units) - - !----------------------------------------------------------------------------- - ! optional per thickness category fields - !----------------------------------------------------------------------------- - - if (flds_i2o_per_cat) then - - do num = 1, ice_ncat - write(cnum,'(i2.2)') num - - ! Fractional ice coverage wrt ocean - longname = 'fractional ice coverage wrt ocean for thickness category ' // cnum - stdname = 'sea_ice_area_fraction' - units = '1' - name = 'Si_ifrac_' // cnum - call shr_nuopc_fldList_AddMetadata(trim(name), longname, stdname, units) - - ! Net shortwave radiation - longname = 'net shortwave radiation penetrating into ice and ocean times ice fraction for thickness category ' // cnum - stdname = 'product_of_net_downward_shortwave_flux_at_sea_water_surface_and_sea_ice_area_fraction' - units = 'W m-2' - name = 'PFioi_swpen_ifrac_' // cnum - call shr_nuopc_fldList_AddMetadata(trim(name), longname, stdname, units) - end do - - longname = 'fractional atmosphere coverage wrt ocean' - stdname = 'atmosphere_area_fraction' - units = '1' - call shr_nuopc_fldList_AddMetadata('Sf_afrac', longname, stdname, units) - - longname = 'fractional atmosphere coverage used in radiation computations wrt ocean' - stdname = 'atmosphere_area_fraction' - units = '1' - call shr_nuopc_fldList_AddMetadata('Sf_afracr', longname, stdname, units) - - longname = 'net shortwave radiation times atmosphere fraction' - stdname = 'product_of_net_downward_shortwave_flux_at_sea_water_surface_and_atmosphere_area_fraction' - units = 'W m-2' - call shr_nuopc_fldList_AddMetadata('Foxx_swnet_afracr', longname, stdname, units) - - end if - - !----------------------------------------------------------------------------- - ! CARMA fields - ! if carma_flds are specified then setup fields for CLM to CAM communication - !----------------------------------------------------------------------------- - - ! TODO: fill this in - ! longname = 'Volumetric soil water' - ! stdname = 'soil_water' - ! units = 'm3/m3' - ! carma_fields = - ! do n = 1,shr_string_listGetNum(carma_fields) - ! call shr_string_listGetName(carma_fields, n, fldname) - ! call shr_nuopc_fldList_AddMetadata(trim(fldname), longname, stdname, units) - ! endif - - !----------------------------------------------------------------------------- - ! MEGAN emissions fluxes fields - ! if MEGAN emission are specified then setup fields for CLM to CAM communication - !----------------------------------------------------------------------------- - - longname = 'MEGAN emission fluxes' - stdname = 'megan' - units = 'molecules/m2/sec' - do num = 1, max_megan - write(cnum,'(i2.2)') num - fldname = 'Fall_voc' // cnum - call shr_nuopc_fldList_AddMetadata(trim(fldname), longname, stdname, units) - end do - - !----------------------------------------------------------------------------- - ! Fire emissions fluxes fields - !----------------------------------------------------------------------------- - - longname = 'wild fire emission fluxes' - stdname = 'fire_emis' - units = 'kg/m2/sec' - do num = 1, max_fire - write(cnum,'(i2.2)') num - fldname = 'Fall_fire' // cnum - call shr_nuopc_fldList_AddMetadata(trim(fldname), longname, stdname, units) - enddo - - longname = 'wild fire plume height' - stdname = 'fire_plume_top' - units = 'm' - call shr_nuopc_fldList_AddMetadata('Sl_fztop', longname, stdname, units) - - !----------------------------------------------------------------------------- - ! Dry Deposition fields - !----------------------------------------------------------------------------- - - longname = 'dry deposition velocity' - stdname = 'drydep_vel' - units = 'cm/sec' - do num = 1, max_ddep - write(cnum,'(i2.2)') num - fldname = 'Sl_dd' // cnum - call shr_nuopc_fldList_AddMetadata(trim(fldname), longname, stdname, units) - end do - - !----------------------------------------------------------------------------- - ! Nitrogen Deposition fields - !----------------------------------------------------------------------------- - - longname = 'nitrogen deposition flux' - stdname = 'nitrogen_deposition' - units = 'kg(N)/m2/sec' - call shr_nuopc_fldList_AddMetadata('Faxa_noy', longname, stdname, units) - call shr_nuopc_fldList_AddMetadata('Faxa_nhx', longname, stdname, units) - - end subroutine esmDict_Init - -end module esmDict diff --git a/src/drivers/nuopc/cime_flds/esmFlds.F90 b/src/drivers/nuopc/cime_flds/esmFlds.F90 index 3fd26000493..bb9e348a1b6 100644 --- a/src/drivers/nuopc/cime_flds/esmFlds.F90 +++ b/src/drivers/nuopc/cime_flds/esmFlds.F90 @@ -33,14 +33,13 @@ module esmflds integer , public, parameter :: mapconsd = 3 integer , public, parameter :: mappatch = 4 integer , public, parameter :: mapfcopy = 5 - integer , public, parameter :: mapfiler = 6 - integer , public, parameter :: mapnstod = 7 ! nearest source to destination - integer , public, parameter :: mapnstod_consd = 8 ! nearest source to destination followed by conservative dst - integer , public, parameter :: mapnstod_consf = 9 ! nearest source to destination followed by conservative frac - integer , public, parameter :: nmappers = 9 + integer , public, parameter :: mapnstod = 6 ! nearest source to destination + integer , public, parameter :: mapnstod_consd = 7 ! nearest source to destination followed by conservative dst + integer , public, parameter :: mapnstod_consf = 8 ! nearest source to destination followed by conservative frac + integer , public, parameter :: nmappers = 8 character(len=*) , public, parameter :: mapnames(nmappers) = & - (/'bilnr', 'consf', 'consd', 'patch', 'fcopy', 'filer', 'nstod', 'nstod_consd', 'nstod_consf'/) + (/'bilnr', 'consf', 'consd', 'patch', 'fcopy', 'nstod', 'nstod_consd', 'nstod_consf'/) !----------------------------------------------- ! Set coupling mode @@ -803,7 +802,7 @@ subroutine shr_nuopc_fldList_Document_Mapping(logunit, med_coupling_active) !----------------------------------------------------------- !--------------------------------------- - ! Document mapping (also add albedo and aoflux) - move this routine to esmFlds.F90 + ! Document mapping (also add albedo and aoflux) !--------------------------------------- ! Loop over src components diff --git a/src/drivers/nuopc/cime_flds/esmFldsExchange.F90 b/src/drivers/nuopc/cime_flds/esmFldsExchange.F90 index 33b6b611263..e5892360ce6 100644 --- a/src/drivers/nuopc/cime_flds/esmFldsExchange.F90 +++ b/src/drivers/nuopc/cime_flds/esmFldsExchange.F90 @@ -27,7 +27,6 @@ subroutine esmFldsExchange(gcomp, phase, rc) use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_chkerr use shr_nuopc_methods_mod , only : fldchk => shr_nuopc_methods_FB_FldChk use med_internalstate_mod , only : InternalState - use glc_elevclass_mod , only : glc_elevclass_as_string use shr_sys_mod , only : shr_sys_abort use esmFlds , only : shr_nuopc_fldList_type use esmFlds , only : addfld => shr_nuopc_fldList_AddFld @@ -36,7 +35,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) use esmflds , only : compmed, compatm, complnd, compocn use esmflds , only : compice, comprof, compwav, compglc, ncomps use esmflds , only : mapbilnr, mapconsf, mapconsd, mappatch - use esmflds , only : mapfcopy, mapfiler, mapnstod, mapnstod_consd, mapnstod_consf + use esmflds , only : mapfcopy, mapnstod, mapnstod_consd, mapnstod_consf use esmflds , only : fldListTo, fldListFr, fldListMed_aoflux, fldListMed_ocnalb use esmFlds , only : coupling_mode @@ -47,44 +46,43 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! local variables: type(InternalState) :: is_local - integer :: ice_ncat ! number of sea ice thickness categories - integer :: glc_nec ! number of land-ice elevation classes - integer :: max_megan - integer :: max_ddep - integer :: max_fire logical :: flds_i2o_per_cat integer :: dbrc integer :: num, i, n integer :: n1, n2, n3, n4 - character(len=4) :: iso(4) - character(len=3) :: cnum + logical :: isPresent + character(len=5) :: iso(2) character(len=CL) :: cvalue character(len=CS) :: name, fldname - character(len=CX) :: atm2ice_fmap, atm2ice_smap, atm2ice_vmap - character(len=CX) :: atm2ocn_fmap, atm2ocn_smap, atm2ocn_vmap - character(len=CX) :: atm2lnd_fmap, atm2lnd_smap - character(len=CX) :: glc2lnd_smap, glc2lnd_fmap - character(len=CX) :: glc2ice_rmap - character(len=CX) :: glc2ocn_liq_rmap, glc2ocn_ice_rmap - character(len=CX) :: ice2atm_fmap, ice2atm_smap - character(len=CX) :: ocn2atm_fmap, ocn2atm_smap - character(len=CX) :: lnd2atm_fmap, lnd2atm_smap - character(len=CX) :: lnd2glc_fmap, lnd2glc_smap - character(len=CX) :: lnd2rof_fmap - character(len=CX) :: rof2lnd_fmap - character(len=CX) :: rof2ocn_fmap, rof2ocn_ice_rmap, rof2ocn_liq_rmap - character(len=CX) :: atm2wav_smap, ice2wav_smap, ocn2wav_smap - character(len=CX) :: wav2ocn_smap + character(len=CX) :: atm2ice_fmap='unset', atm2ice_smap='unset', atm2ice_vmap='unset' + character(len=CX) :: atm2ocn_fmap='unset', atm2ocn_smap='unset', atm2ocn_vmap='unset' + character(len=CX) :: atm2lnd_fmap='unset', atm2lnd_smap='unset' + character(len=CX) :: glc2lnd_smap='unset', glc2lnd_fmap='unset' + character(len=CX) :: glc2ice_rmap='unset' + character(len=CX) :: glc2ocn_liq_rmap='unset', glc2ocn_ice_rmap='unset' + character(len=CX) :: ice2atm_fmap='unset', ice2atm_smap='unset' + character(len=CX) :: ocn2atm_fmap='unset', ocn2atm_smap='unset' + character(len=CX) :: lnd2atm_fmap='unset', lnd2atm_smap='unset' + character(len=CX) :: lnd2glc_fmap='unset', lnd2glc_smap='unset' + character(len=CX) :: lnd2rof_fmap='unset' + character(len=CX) :: rof2lnd_fmap='unset' + character(len=CX) :: rof2ocn_fmap='unset', rof2ocn_ice_rmap='unset', rof2ocn_liq_rmap='unset' + character(len=CX) :: atm2wav_smap='unset', ice2wav_smap='unset', ocn2wav_smap='unset' + character(len=CX) :: wav2ocn_smap='unset' logical :: flds_co2a ! use case logical :: flds_co2b ! use case logical :: flds_co2c ! use case character(len=64), allocatable :: flds(:) character(len=64), allocatable :: suffix(:) - character(len=*), parameter :: subname='(esmFldsExchange)' + character(len=*) , parameter :: subname='(esmFldsExchange)' !-------------------------------------- rc = ESMF_SUCCESS + iso(1) = '' + iso(2) = '_wiso' + + !--------------------------------------- ! Get the internal state !--------------------------------------- @@ -146,22 +144,10 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! mappings between the atm and ocn needed for these computations. !-------------------------------------- - !--------------------------- - ! For now hardwire these - !--------------------------- - - ! these must be less than or equal to the values in fd.yaml - max_megan = 20 - max_ddep = 80 - max_fire = 10 - glc_nec = 10 - ice_ncat = 5 - flds_i2o_per_cat = .true. - - iso(1) = '' - iso(2) = '_16O' - iso(3) = '_18O' - iso(4) = '_HDO' + call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) flds_i2o_per_cat + call ESMF_LogWrite('flds_i2o_per_cat = '// trim(cvalue), ESMF_LOGMSG_INFO) !---------------------------------------------------------- ! Initialize mapping file names @@ -169,137 +155,197 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to atm - call NUOPC_CompAttributeGet(gcomp, name='ice2atm_fmapname', value=ice2atm_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='ice2atm_fmapname', value=ice2atm_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('ice2atm_fmapname = '// trim(ice2atm_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('ice2atm_fmapname = '// trim(ice2atm_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='ice2atm_smapname', value=ice2atm_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='ice2atm_smapname', value=ice2atm_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('ice2atm_smapname = '// trim(ice2atm_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('ice2atm_smapname = '// trim(ice2atm_smap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_fmapname', value=lnd2atm_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_fmapname', value=lnd2atm_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('lnd2atm_fmapname = '// trim(lnd2atm_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('lnd2atm_fmapname = '// trim(lnd2atm_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_smapname', value=ocn2atm_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_smapname', value=ocn2atm_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('ocn2atm_smapname = '// trim(ocn2atm_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('ocn2atm_smapname = '// trim(ocn2atm_smap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_fmapname', value=ocn2atm_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='ocn2atm_fmapname', value=ocn2atm_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('ocn2atm_fmapname = '// trim(ocn2atm_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('ocn2atm_fmapname = '// trim(ocn2atm_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_smapname', value=lnd2atm_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='lnd2atm_smapname', value=lnd2atm_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('lnd2atm_smapname = '// trim(lnd2atm_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('lnd2atm_smapname = '// trim(lnd2atm_smap), ESMF_LOGMSG_INFO) + end if ! to lnd - call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_fmapname', value=atm2lnd_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_fmapname', value=atm2lnd_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2lnd_fmapname = '// trim(atm2lnd_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2lnd_fmapname = '// trim(atm2lnd_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_smapname', value=atm2lnd_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2lnd_smapname', value=atm2lnd_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2lnd_smapname = '// trim(atm2lnd_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2lnd_smapname = '// trim(atm2lnd_smap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='rof2lnd_fmapname', value=rof2lnd_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='rof2lnd_fmapname', value=rof2lnd_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('rof2lnd_fmapname = '// trim(rof2lnd_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('rof2lnd_fmapname = '// trim(rof2lnd_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='glc2lnd_fmapname', value=glc2lnd_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='glc2lnd_fmapname', value=glc2lnd_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('glc2lnd_smapname = '// trim(glc2lnd_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('glc2lnd_smapname = '// trim(glc2lnd_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='glc2lnd_smapname', value=glc2lnd_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='glc2lnd_smapname', value=glc2lnd_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('glc2lnd_smapname = '// trim(glc2lnd_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('glc2lnd_smapname = '// trim(glc2lnd_smap), ESMF_LOGMSG_INFO) + end if ! to ice - call NUOPC_CompAttributeGet(gcomp, name='atm2ice_fmapname', value=atm2ice_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2ice_fmapname', value=atm2ice_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2ice_fmapname = '// trim(atm2ice_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2ice_fmapname = '// trim(atm2ice_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='atm2ice_smapname', value=atm2ice_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2ice_smapname', value=atm2ice_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2ice_smapname = '// trim(atm2ice_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2ice_smapname = '// trim(atm2ice_smap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='atm2ice_vmapname', value=atm2ice_vmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2ice_vmapname', value=atm2ice_vmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2ice_vmapname = '// trim(atm2ice_vmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2ice_vmapname = '// trim(atm2ice_vmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='glc2ice_rmapname', value=glc2ice_rmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='glc2ice_rmapname', value=glc2ice_rmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('glc2ice_rmapname = '// trim(glc2ice_rmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('glc2ice_rmapname = '// trim(glc2ice_rmap), ESMF_LOGMSG_INFO) + end if ! to ocn - call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_fmapname', value=atm2ocn_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_fmapname', value=atm2ocn_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2ocn_fmapname = '// trim(atm2ocn_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2ocn_fmapname = '// trim(atm2ocn_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_smapname', value=atm2ocn_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_smapname', value=atm2ocn_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2ocn_smapname = '// trim(atm2ocn_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2ocn_smapname = '// trim(atm2ocn_smap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_vmapname', value=atm2ocn_vmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2ocn_vmapname', value=atm2ocn_vmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2ocn_vmapname = '// trim(atm2ocn_vmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2ocn_vmapname = '// trim(atm2ocn_vmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_liq_rmapname', value=glc2ocn_liq_rmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_liq_rmapname', value=glc2ocn_liq_rmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('glc2ocn_liq_rmapname = '// trim(glc2ocn_liq_rmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('glc2ocn_liq_rmapname = '// trim(glc2ocn_liq_rmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_ice_rmapname', value=glc2ocn_ice_rmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='glc2ocn_ice_rmapname', value=glc2ocn_ice_rmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('glc2ocn_ice_rmapname = '// trim(glc2ocn_ice_rmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('glc2ocn_ice_rmapname = '// trim(glc2ocn_ice_rmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', value=wav2ocn_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='wav2ocn_smapname', value=wav2ocn_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('wav2ocn_smapname = '// trim(wav2ocn_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('wav2ocn_smapname = '// trim(wav2ocn_smap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_fmapname', value=rof2ocn_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_fmapname', value=rof2ocn_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('rof2ocn_fmapname = '// trim(rof2ocn_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('rof2ocn_fmapname = '// trim(rof2ocn_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_liq_rmapname', value=rof2ocn_liq_rmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_liq_rmapname', value=rof2ocn_liq_rmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('rof2ocn_liq_rmapname = '// trim(rof2ocn_liq_rmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('rof2ocn_liq_rmapname = '// trim(rof2ocn_liq_rmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_ice_rmapname', value=rof2ocn_ice_rmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='rof2ocn_ice_rmapname', value=rof2ocn_ice_rmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('rof2ocn_ice_rmapname = '// trim(rof2ocn_ice_rmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('rof2ocn_ice_rmapname = '// trim(rof2ocn_ice_rmap), ESMF_LOGMSG_INFO) + end if ! to rof - call NUOPC_CompAttributeGet(gcomp, name='lnd2rof_fmapname', value=lnd2rof_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='lnd2rof_fmapname', value=lnd2rof_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('lnd2rof_fmapname = '// trim(lnd2rof_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('lnd2rof_fmapname = '// trim(lnd2rof_fmap), ESMF_LOGMSG_INFO) + end if ! to glc - call NUOPC_CompAttributeGet(gcomp, name='lnd2glc_fmapname', value=lnd2glc_fmap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='lnd2glc_fmapname', value=lnd2glc_fmap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('lnd2glc_fmapname = '// trim(lnd2glc_fmap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('lnd2glc_fmapname = '// trim(lnd2glc_fmap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='lnd2glc_smapname', value=lnd2glc_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='lnd2glc_smapname', value=lnd2glc_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('lnd2glc_smapname = '// trim(lnd2glc_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('lnd2glc_smapname = '// trim(lnd2glc_smap), ESMF_LOGMSG_INFO) + end if ! to wav - call NUOPC_CompAttributeGet(gcomp, name='atm2wav_smapname', value=atm2wav_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='atm2wav_smapname', value=atm2wav_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('atm2wav_smapname = '// trim(atm2wav_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('atm2wav_smapname = '// trim(atm2wav_smap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='ice2wav_smapname', value=ice2wav_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='ice2wav_smapname', value=ice2wav_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('ice2wav_smapname = '// trim(ice2wav_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('ice2wav_smapname = '// trim(ice2wav_smap), ESMF_LOGMSG_INFO) + end if - call NUOPC_CompAttributeGet(gcomp, name='ocn2wav_smapname', value=ocn2wav_smap, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name='ocn2wav_smapname', value=ocn2wav_smap, isPresent=isPresent, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite('ocn2wav_smapname = '// trim(ocn2wav_smap), ESMF_LOGMSG_INFO, rc=dbrc) + if (isPresent) then + call ESMF_LogWrite('ocn2wav_smapname = '// trim(ocn2wav_smap), ESMF_LOGMSG_INFO) + end if !===================================================================== ! scalar information @@ -332,7 +378,6 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! --------------------------------------------------------------------- if (phase /= 'advertise') then if (trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'nems_orig') then - call addfld(fldListFr(compatm)%flds, 'Sa_u') call addmap(fldListFr(compatm)%flds, 'Sa_u' , compocn, mappatch, 'one', atm2ocn_vmap) @@ -348,10 +393,13 @@ subroutine esmFldsExchange(gcomp, phase, rc) call addfld(fldListFr(compatm)%flds, 'Sa_pbot') call addmap(fldListFr(compatm)%flds, 'Sa_pbot', compocn, mapbilnr, 'one', atm2ocn_smap) - do n = 1,size(iso) - call addfld(fldListFr(compatm)%flds, 'Sa_shum'//iso(n)) - call addmap(fldListFr(compatm)%flds, 'Sa_shum'//iso(n), compocn, mapbilnr, 'one', atm2ocn_smap) - end do + call addfld(fldListFr(compatm)%flds, 'Sa_shum') + call addmap(fldListFr(compatm)%flds, 'Sa_shum', compocn, mapbilnr, 'one', atm2ocn_smap) + + if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_shum_wiso', rc=rc)) then + call addfld(fldListFr(compatm)%flds, 'Sa_shum_wiso') + call addmap(fldListFr(compatm)%flds, 'Sa_shum_wiso', compocn, mapbilnr, 'one', atm2ocn_smap) + end if if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ptem', rc=rc)) then call addfld(fldListFr(compatm)%flds, 'Sa_ptem') @@ -399,9 +447,9 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to lnd: specific humidity at the lowest model level from atm ! --------------------------------------------------------------------- - allocate(flds(11)) - flds = (/'Sa_z', 'Sa_topo', 'Sa_u', 'Sa_v', 'Sa_tbot', 'Sa_ptem', & - 'Sa_pbot', 'Sa_shum', 'Sa_shum_16O', 'Sa_shum_18O', 'Sa_shum_HDO'/) + allocate(flds(9)) + flds = (/'Sa_z', 'Sa_topo', 'Sa_u', 'Sa_v', 'Sa_tbot', & + 'Sa_ptem', 'Sa_pbot', 'Sa_shum', 'Sa_shum_wiso'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -427,34 +475,27 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to lnd: downward direct visible incident solar radiation from atm ! to lnd: downward diffuse near-infrared incident solar radiation from atm ! to lnd: downward Diffuse visible incident solar radiation from atm - ! to lnd: hydrophylic black carbon dry deposition flux from atm - ! to lnd: hydrophobic black carbon dry deposition flux from atm - ! to lnd: hydrophylic black carbon wet deposition flux from atm - ! to lnd: hydrophylic organic carbon dry deposition flux from atm - ! to lnd: hydrophobic organic carbon dry deposition flux from atm - ! to lnd: hydrophylic organic carbon wet deposition flux from atm - ! to lnd: dust wet deposition flux (size 1) from atm - ! to lnd: dust wet deposition flux (size 2) from atm - ! to lnd: dust wet deposition flux (size 3) from atm - ! to lnd: dust wet deposition flux (size 4) from atm - ! to lnd: dust dry deposition flux (size 1) from atm - ! to lnd: dust dry deposition flux (size 2) from atm - ! to lnd: dust dry deposition flux (size 3) from atm - ! to lnd: dust dry deposition flux (size 4) from atm + ! to lnd: black carbon deposition fluxes from atm + ! - hydrophylic black carbon dry deposition flux + ! - hydrophobic black carbon dry deposition flux + ! - hydrophylic black carbon wet deposition flux + ! to lnd: organic carbon deposition fluxes from atm + ! - hydrophylic organic carbon dry deposition flux + ! - hydrophobic organic carbon dry deposition flux + ! - hydrophylic organic carbon wet deposition flux + ! to lnd: dust wet deposition flux (sizes 1-4) from atm + ! to lnd: dust dry deposition flux (sizes 1-4) from atm ! to lnd: nitrogen deposition fields from atm ! --------------------------------------------------------------------- - ! TODO (mvertens, 2019-12-13): the nitrogen deposition fluxes here + ! TODO (mvertens, 2018-12-13): the nitrogen deposition fluxes here ! are not treated the same was as in cesm2.0 release + ! TODO (mvertens, 2019-03-10): add water isotopes from atm - allocate(flds(25)) - flds = (/'Faxa_rainc' , 'Faxa_rainl' , 'Faxa_snowc' , 'Faxa_snowl', & - 'Faxa_lwdn' , 'Faxa_swndr' , 'Faxa_swvdr' , 'Faxa_swndf', 'Faxa_swvdf', & - 'Faxa_bcphidry' , 'Faxa_bcphodry', 'Faxa_bcphiwet', & - 'Faxa_ocphidry' , 'Faxa_ocphodry', 'Faxa_ocphiwet', & - 'Faxa_dstwet1' , 'Faxa_dstwet2' , 'Faxa_dstwet3' , 'Faxa_dstwet4', & - 'Faxa_dstdry1' , 'Faxa_dstdry2' , 'Faxa_dstdry3' , 'Faxa_dstdry4', & - 'Faxa_noy' , 'Faxa_nhx'/) + allocate(flds(14)) + flds = (/'Faxa_rainc' , 'Faxa_rainl' , 'Faxa_snowc' , 'Faxa_snowl' , & + 'Faxa_lwdn' , 'Faxa_swndr' , 'Faxa_swvdr' , 'Faxa_swndf' , 'Faxa_swvdf', & + 'Faxa_bcph' , 'Faxa_ocph' , 'Faxa_dstwet' , 'Faxa_dstdry', 'Faxa_ndep' /) do n = 1,size(flds) fldname = trim(flds(n)) @@ -477,10 +518,8 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to lnd: river channel main channel water volume from rof ! to lnd: river water flux back to land due to flooding ! --------------------------------------------------------------------- - allocate(flds(12)) - flds = (/'Flrr_volr' , 'Flrr_volr_16O' , 'Flrr_volr_18O' , 'Flrr_volr_HDO' , & - 'Flrr_volrmch', 'Flrr_volrmch_16O', 'Flrr_volrmch_18O', 'Flrr_volrmch_HDO', & - 'Flrr_flood' , 'Flrr_flood_16O' , 'Flrr_flood_18O' , 'Flrr_flood_HDO' /) + allocate(flds(6)) + flds = (/'Flrr_volr', 'Flrr_volr_wiso', 'Flrr_volrmch', 'Flrr_volrmch_wiso', 'Flrr_flood', 'Flrr_flood_wiso'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -526,39 +565,29 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! fields from glc->med do NOT have elevation classes ! fields from med->lnd are BROKEN into multiple elevation classes - if (glc_nec > 0) then - if (phase == 'advertise') then - call addfld(fldListFr(compglc)%flds, 'Sg_ice_covered') ! fraction of glacier area - call addfld(fldListFr(compglc)%flds, 'Sg_topo') ! surface height of glacer - call addfld(fldListFr(compglc)%flds, 'Flgg_hflx') ! downward heat flux from glacier interior - do num = 0, glc_nec - cnum = glc_elevclass_as_string(num) - call addfld(fldListTo(complnd)%flds, 'Sg_ice_covered'//trim(cnum)) - call addfld(fldListTo(complnd)%flds, 'Sg_topo'//trim(cnum)) - call addfld(fldListTo(complnd)%flds, 'Flgg_hflx'//trim(cnum)) - end do - else - do num = 0, glc_nec - cnum = glc_elevclass_as_string(num) - if ( fldchk(is_local%wrap%FBExp(complnd) , 'Sg_ice_covered'//trim(cnum), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(complnd) , 'Sg_topo'//trim(cnum) , rc=rc) .and. & - fldchk(is_local%wrap%FBExp(complnd) , 'Flgg_hflx'//trim(cnum) , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Sg_ice_covered' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Sg_topo' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Flgg_hflx' , rc=rc)) then - if (num == 0) then - call addmap(FldListFr(compglc)%flds, 'Sg_ice_covered' , complnd, mapconsf, 'unset' , glc2lnd_fmap) - call addmap(FldListFr(compglc)%flds, 'Sg_topo' , compglc, mapconsf, 'custom', glc2lnd_fmap) - call addmap(FldListFr(compglc)%flds, 'Flgg_hflx' , compglc, mapconsf, 'custom', glc2lnd_fmap) - end if - call addmrg(fldListTo(complnd)%flds, 'Sg_ice_covered'//trim(cnum), & - mrg_from1=compglc, mrg_fld1='Sg_ice_covered'//trim(cnum), mrg_type1='copy') - call addmrg(fldListTo(complnd)%flds, 'Sg_topo' //trim(cnum), & - mrg_from1=compglc, mrg_fld1='Sg_topo'//trim(cnum), mrg_type1='copy') - call addmrg(fldListTo(complnd)%flds, 'Flgg_hflx'//trim(cnum), & - mrg_from1=compglc, mrg_fld1='Flgg_hflx'//trim(cnum), mrg_type1='copy') - end if - end do + if (phase == 'advertise') then + call addfld(fldListFr(compglc)%flds, 'Sg_ice_covered') ! fraction of glacier area + call addfld(fldListFr(compglc)%flds, 'Sg_topo') ! surface height of glacer + call addfld(fldListFr(compglc)%flds, 'Flgg_hflx') ! downward heat flux from glacier interior + + call addfld(fldListTo(complnd)%flds, 'Sg_ice_covered_elev') + call addfld(fldListTo(complnd)%flds, 'Sg_topo_elev') + call addfld(fldListTo(complnd)%flds, 'Flgg_hflx_elev') + else + if ( fldchk(is_local%wrap%FBExp(complnd) , 'Sg_ice_covered_elev', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(complnd) , 'Sg_topo_elev' , rc=rc) .and. & + fldchk(is_local%wrap%FBExp(complnd) , 'Flgg_hflx_elev' , rc=rc) .and. & + + fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Sg_ice_covered' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Sg_topo' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Flgg_hflx' , rc=rc)) then + + ! Custom merges will be done here + call addmap(FldListFr(compglc)%flds, 'Sg_ice_covered' , complnd, mapconsf, 'unset' , glc2lnd_fmap) + call addmap(FldListFr(compglc)%flds, 'Sg_topo' , compglc, mapconsf, 'custom', glc2lnd_fmap) + call addmap(FldListFr(compglc)%flds, 'Flgg_hflx' , compglc, mapconsf, 'custom', glc2lnd_fmap) + + ! Custom merge in med_phases_prep_lnd end if end if @@ -622,8 +651,8 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to atm: merged reference specific humidity at 2 meters ! to atm: merged reference specific water isoptope humidity at 2 meters ! --------------------------------------------------------------------- - allocate(suffix(6)) - suffix = (/'tref', 'u10', 'qref', 'qref_16O', 'qref_18O', 'qref_HDO'/) + allocate(suffix(4)) + suffix = (/'tref', 'u10', 'qref', 'qref_wiso'/) do n = 1,size(suffix) if (phase == 'advertise') then @@ -675,8 +704,8 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to atm: evaporation water flux from water ! to atm: evaporation water flux from water isotopes ! --------------------------------------------------------------------- - allocate(suffix(9)) - suffix = (/'taux', 'tauy', 'lat', 'sen', 'lwup', 'evap', 'evap_16O', 'evap_18O', 'evap_HDO' /) + allocate(suffix(7)) + suffix = (/'taux', 'tauy', 'lat', 'sen', 'lwup', 'evap', 'evap_wiso'/) do n = 1,size(suffix) if (phase == 'advertise') then @@ -818,11 +847,11 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to atm: square of exch. coeff (tracers) from med aoflux ! to atm: surface fraction velocity from med aoflux ! --------------------------------------------------------------------- - allocate(suffix(3)) - suffix = (/'ssq', 're', 'ustar'/) + allocate(flds(3)) + flds = (/'So_ssq', 'So_re', 'So_ustar'/) - do n = 1,size(suffix) - fldname = 'So_'//trim(suffix(n)) + do n = 1,size(flds) + fldname = trim(flds(n)) if (phase == 'advertise') then call addfld(fldListMed_aoflux%flds , trim(fldname)) call addfld(fldListTo(compatm)%flds , trim(fldname)) @@ -835,18 +864,18 @@ subroutine esmFldsExchange(gcomp, phase, rc) end if end if end do - deallocate(suffix) + deallocate(flds) ! --------------------------------------------------------------------- ! to atm: surface fraction velocity from land ! to atm: aerodynamic resistance from land ! to atm: surface snow water equivalent from land ! --------------------------------------------------------------------- - allocate(suffix(3)) - suffix = (/'fv', 'ram1', 'snowh'/) + allocate(flds(3)) + flds = (/'Sl_fv', 'Sl_ram1', 'Sl_snowh'/) - do n = 1,size(suffix) - fldname = 'Sl_'//trim(suffix(n)) + do n = 1,size(flds) + fldname = trim(flds(n)) if (phase == 'advertise') then call addfld(fldListFr(complnd)%flds, trim(fldname)) call addfld(fldListTo(compatm)%flds, trim(fldname)) @@ -859,76 +888,55 @@ subroutine esmFldsExchange(gcomp, phase, rc) end if end if end do - deallocate(suffix) + deallocate(flds) ! --------------------------------------------------------------------- - ! to atm: dust fluxes from land + ! to atm: dust fluxes from land (4 sizes) ! --------------------------------------------------------------------- - allocate(suffix(4)) - suffix = (/'flxdst1', 'flxdst2', 'flxdst3', 'flxdst4'/) - - do n = 1,size(suffix) - fldname = 'Fall_'//trim(suffix(n)) - if (phase == 'advertise') then - call addfld(fldListFr(complnd)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) - else - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'lfrin', lnd2atm_fmap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='lfrac') - end if + fldname = 'Fall_flxdst' + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then + call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'lfrin', lnd2atm_fmap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='lfrac') end if - end do - deallocate(suffix) + end if !----------------------------------------------------------------------------- ! to atm: MEGAN emissions fluxes from land !----------------------------------------------------------------------------- + fldname = 'Fall_voc' if (phase == 'advertise') then - do num = 1, max_megan - write(cnum,'(i3.3)') num - fldname = 'Fall_voc' // cnum - call addfld(fldListFr(complnd)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) - end do + call addfld(fldListFr(complnd)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) else - do num = 1, max_megan - write(cnum,'(i3.3)') num - fldname = 'Fall_voc' // cnum - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', atm2lnd_fmap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='merge', mrg_fracname1='lfrac') - end if - end do + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then + call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', atm2lnd_fmap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='merge', mrg_fracname1='lfrac') + end if end if !----------------------------------------------------------------------------- ! to atm: fire emissions fluxes from land !----------------------------------------------------------------------------- - ! 'wild fire emission fluxes' + fldname = 'Fall_fire' if (phase == 'advertise') then - do num = 1, max_fire - write(cnum,'(i2.2)') num - fldname = 'Fall_fire' // cnum - call addfld(fldListFr(complnd)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) - end do + call addfld(fldListFr(complnd)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) else - do num = 1, max_fire - write(cnum,'(i2.2)') num - fldname = 'Fall_fire' // cnum - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', lnd2atm_fmap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='merge', mrg_fracname1='lfrac') - end if - end do + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then + call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', lnd2atm_fmap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='merge', mrg_fracname1='lfrac') + end if end if ! 'wild fire plume height' @@ -945,26 +953,19 @@ subroutine esmFldsExchange(gcomp, phase, rc) end if !----------------------------------------------------------------------------- - ! to atm: dry deposition from land + ! to atm: dry deposition velocities from land !----------------------------------------------------------------------------- + fldname = 'Sl_ddvel' if (phase == 'advertise') then - do num = 1, max_ddep - write(cnum,'(i2.2)') num - fldname = 'Sl_dd' // cnum - call addfld(fldListFr(complnd)%flds, trim(fldname)) - call addfld(fldListTo(compatm)%flds, trim(fldname)) - end do + call addfld(fldListFr(complnd)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) else - do num = 1, max_ddep - write(cnum,'(i2.2)') num - fldname = 'Sl_dd' // cnum - if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', lnd2atm_smap) - call addmrg(fldListTo(compatm)%flds, trim(fldname), & - mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy') - end if - end do + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , trim(fldname), rc=rc)) then + call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one', lnd2atm_smap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy') + end if end if !===================================================================== @@ -1126,24 +1127,26 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ocn: per ice thickness fraction and sw penetrating into ocean from ice ! --------------------------------------------------------------------- - if (phase == 'advertise') then - if (flds_i2o_per_cat) then + if (flds_i2o_per_cat) then + if (phase == 'advertise') then ! 'fractional ice coverage wrt ocean for each thickness category ' call addfld(fldListFr(compice)%flds, 'Si_ifrac_n') + call addfld(fldListTo(compocn)%flds, 'Si_ifrac_n') + ! net shortwave radiation penetrating into ocean for each thickness category call addfld(fldListFr(compice)%flds, 'Fioi_swpen_ifrac_n') - ! 'fractional atmosphere coverage wrt ocean' + call addfld(fldListTo(compocn)%flds, 'Fioi_swpen_ifrac_n') + + ! 'fractional atmosphere coverage wrt ocean' (computed in med_phases_prep_ocn) call addfld(fldListTo(compocn)%flds, 'Sf_afrac') - ! 'net shortwave radiation times atmosphere fraction' - call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_afracr') - ! 'fractional atmosphere coverage used in radiation computations wrt ocean' + ! 'fractional atmosphere coverage used in radiation computations wrt ocean' (computed in med_phases_prep_ocn) call addfld(fldListTo(compocn)%flds, 'Sf_afracr') - end if - else - if (flds_i2o_per_cat) then - call addmap(fldListFr(compice)%flds, 'Si_ifrac_n', compocn, mapfcopy, 'unset', 'unset') + ! 'net shortwave radiation times atmosphere fraction' (computed in med_phases_prep_ocn) + call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_afracr') + else + call addmap(fldListFr(compice)%flds, 'Si_ifrac_n' , compocn, mapfcopy, 'unset', 'unset') call addmap(fldListFr(compice)%flds, 'Fioi_swpen_ifrac_n', compocn, mapfcopy, 'unset', 'unset') - ! TODO (mvertens, 2018-12-21): add mapping and merging + ! Note that 'Sf_afrac, 'Sf_afracr' and 'Foxx_swnet_afracr' will have explicit merging in med_phases_prep_ocn end if end if @@ -1151,20 +1154,29 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to ocn: precipitation rate water equivalent from atm ! to ocn: snow rate water equivalent from atm ! --------------------------------------------------------------------- + if (phase == 'advertise') then - do n = 1,size(iso) - call addfld(fldListFr(compatm)%flds, 'Faxa_rainc'//iso(n)) - call addfld(fldListFr(compatm)%flds, 'Faxa_rainl'//iso(n)) - call addfld(fldListFr(compatm)%flds, 'Faxa_rain' //iso(n)) - call addfld(fldListTo(compocn)%flds, 'Faxa_rain' //iso(n)) - - call addfld(fldListFr(compatm)%flds, 'Faxa_snowc'//iso(n)) - call addfld(fldListFr(compatm)%flds, 'Faxa_snowl'//iso(n)) - call addfld(fldListFr(compatm)%flds, 'Faxa_snow' //iso(n)) - call addfld(fldListTo(compocn)%flds, 'Faxa_snow' //iso(n)) - end do + call addfld(fldListFr(compatm)%flds, 'Faxa_rainc') + call addfld(fldListFr(compatm)%flds, 'Faxa_rainl') + call addfld(fldListFr(compatm)%flds, 'Faxa_rain' ) + call addfld(fldListTo(compocn)%flds, 'Faxa_rain' ) + + call addfld(fldListFr(compatm)%flds, 'Faxa_rainc_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_rainl_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_rain_wiso' ) + call addfld(fldListTo(compocn)%flds, 'Faxa_rain_wiso' ) + + call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') + call addfld(fldListFr(compatm)%flds, 'Faxa_snowl') + call addfld(fldListFr(compatm)%flds, 'Faxa_snow' ) + call addfld(fldListTo(compocn)%flds, 'Faxa_snow' ) + + call addfld(fldListFr(compatm)%flds, 'Faxa_snowc_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_snowl_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_snow_wiso' ) + call addfld(fldListTo(compocn)%flds, 'Faxa_snow_wiso' ) else - do n = 1,size(iso) + do n = 1,2 ! Note that the mediator atm/ocn flux calculation needs Faxa_rainc for the gustiness parameterization ! which by default is not actually used if ( fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl'//iso(n), rc=rc) .and. & @@ -1247,39 +1259,48 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! --------------------------------------------------------------------- ! to ocn: surface latent heat flux and evaporation water flux ! --------------------------------------------------------------------- - do n = 1,size(iso) - if (phase == 'advertise') then - call addfld(fldListMed_aoflux%flds , 'Faxa_lat' //iso(n)) - call addfld(fldListMed_aoflux%flds , 'Faox_lat' //iso(n)) - call addfld(fldListMed_aoflux%flds , 'Faox_evap'//iso(n)) - call addfld(fldListTo(compocn)%flds, 'Foxx_lat' //iso(n)) - call addfld(fldListTo(compocn)%flds, 'Foxx_evap'//iso(n)) - else - ! CESM - if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lat'//iso(n), rc=rc)) then - call addmrg(fldListTo(compocn)%flds, 'Foxx_lat'//iso(n), & - mrg_from1=compmed, mrg_fld1='Faox_lat'//iso(n), mrg_type1='merge', mrg_fracname1='ofrac') - end if - 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(fldListTo(compocn)%flds, 'Foxx_evap', & - mrg_from1=compmed, mrg_fld1='Faox_evap', mrg_type1='merge', mrg_fracname1='ofrac') - end if - ! NEMS orig - if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_lat' , rc=rc) .and. & - fldchk(is_local%wrap%FBMed_aoflux_o , 'Foax_evap' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_lat' , rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapconsf, 'one', atm2ocn_fmap) - end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_lat' ) + call addfld(fldListMed_aoflux%flds , 'Faox_lat' ) + call addfld(fldListMed_aoflux%flds , 'Faox_evap') + call addfld(fldListTo(compocn)%flds, 'Foxx_lat' ) + call addfld(fldListTo(compocn)%flds, 'Foxx_evap') + else + ! CESM + if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lat', rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'Foxx_lat', & + mrg_from1=compmed, mrg_fld1='Faox_lat', mrg_type1='merge', mrg_fracname1='ofrac') + end if + 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(fldListTo(compocn)%flds, 'Foxx_evap', & + mrg_from1=compmed, mrg_fld1='Faox_evap', mrg_type1='merge', mrg_fracname1='ofrac') + end if + ! NEMS orig + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_lat' , rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Foax_evap' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_lat' , rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lat', compocn, mapconsf, 'one', atm2ocn_fmap) + end if + + ! NEMS-frac and NEMS-orig + ! Foxx_evap is passed to mom6 but but not the latent heat flux and mom6 then computes + ! the latent heat flux from the imported evaporative flux. However, the evap passed to mom6 + ! in med_phases_prep_ocn is in fact derived from the latent heat flux obtained from the atm (fv3). + ! TODO (mvertens, 2019-10-01): Can we unify this and have MOM6 use latent heat flux? + end if - ! NEMS-frac and NEMS-orig - ! Foxx_evap is passed to mom6 but but not the latent heat flux and mom6 then computes - ! the latent heat flux from the imported evaporative flux. However, the evap passed to mom6 - ! in med_phases_prep_ocn is in fact derived from the latent heat flux obtained from the atm (fv3). - ! TODO (mvertens, 2019-10-01): Can we unify this and have MOM6 use latent heat flux? + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds , 'Faox_lat_wiso' ) + call addfld(fldListTo(compocn)%flds, 'Foxx_lat_wiso' ) + else + if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_lat_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lat_wiso', rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'Foxx_lat_wiso', & + mrg_from1=compmed, mrg_fld1='Faox_lat_wiso', mrg_type1='merge', mrg_fracname1='ofrac') end if - end do + end if ! --------------------------------------------------------------------- ! to ocn: wind speed squared at 10 meters from med @@ -1316,29 +1337,23 @@ subroutine esmFldsExchange(gcomp, phase, rc) end if ! --------------------------------------------------------------------- - ! to ocn: hydrophylic black carbon dry deposition flux from atm - ! to ocn: hydrophobic black carbon dry deposition flux from atm - ! to ocn: hydrophylic black carbon wet deposition flux from atm - ! to ocn: hydrophylic organic carbon dry deposition flux from atm - ! to ocn: hydrophobic organic carbon dry deposition flux from atm - ! to ocn: hydrophylic organic carbon wet deposition flux to ice from atm - ! to ocn: dust wet deposition flux (size 1) from atm - ! to ocn: dust wet deposition flux (size 2) from atm - ! to ocn: dust wet deposition flux (size 3) from atm - ! to ocn: dust wet deposition flux (size 4) from atm - ! to ocn: dust dry deposition flux (size 1) from atm - ! to ocn: dust dry deposition flux (size 2) from atm - ! to ocn: dust dry deposition flux (size 3) from atm - ! to ocn: dust dry deposition flux (size 4) from atm - ! --------------------------------------------------------------------- - allocate(suffix(14)) - suffix = (/'bcphidry', 'bcphodry', 'bcphiwet', & - 'ocphidry', 'ocphodry', 'ocphiwet', & - 'dstwet1' , 'dstwet2' , 'dstwet3', 'dstwet4', & - 'dstdry1' , 'dstdry2' , 'dstdry3', 'dstdry4' /) + ! to ocn: black carbon deposition fluxes from atm + ! - hydrophylic black carbon dry deposition flux + ! - hydrophobic black carbon dry deposition flux + ! - hydrophylic black carbon wet deposition flux + ! to ocn: organic carbon deposition fluxes from atm + ! - hydrophylic organic carbon dry deposition flux + ! - hydrophobic organic carbon dry deposition flux + ! - hydrophylic organic carbon wet deposition flux + ! to ocn: dust wet deposition flux (sizes 1-4) from atm + ! to ocn: dust dry deposition flux (sizes 1-4) from atm + ! to ocn: nitrogen deposition fields (2) from atm + ! --------------------------------------------------------------------- + allocate(flds(5)) + flds = (/'Faxa_bcph', 'Faxa_ocph', 'Faxa_dstwet' , 'Faxa_dstdry', 'Faxa_ndep' /) - do n = 1,size(suffix) - fldname = 'Faxa_'//trim(suffix(n)) + do n = 1,size(flds) + fldname = trim(flds(n)) if (phase == 'advertise') then call addfld(fldListFr(compatm)%flds, trim(fldname)) call addfld(fldListTo(compocn)%flds, trim(fldname)) @@ -1351,30 +1366,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) end if end if end do - deallocate(suffix) - - !----------------------------------------------------------------------------- - ! to ocn: nitrogen deposition fields from atm - !----------------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_noy') - call addfld(fldListFr(compatm)%flds, 'Faxa_nhx') - call addfld(fldListTo(compocn)%flds, 'Faxa_noy') - call addfld(fldListTo(compocn)%flds, 'Faxa_nhx') - else - if ( fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_noy', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_noy', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_noy', compocn, mapbilnr, 'one', atm2ocn_smap) - call addmrg(fldListTo(compocn)%flds, 'Faxa_noy', & - mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='ofrac') - end if - if ( fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_nhx', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_nhx', rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_nhx', compocn, mapbilnr, 'one', atm2ocn_smap) - call addmrg(fldListTo(compocn)%flds, 'Faxa_nhx', & - mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='ofrac') - end if - end if + deallocate(flds) ! --------------------------------------------------------------------- ! to ocn: merge zonal surface stress from ice and (atm or med) @@ -1478,14 +1470,12 @@ subroutine esmFldsExchange(gcomp, phase, rc) end do else do n = 1,size(iso) - ! liquid runoff from both rof and glc to ocn - if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofl' //iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' //iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compglc, compglc), 'Fogg_rofl' //iso(n), rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Flrr_flood'//iso(n), compocn, mapfiler, 'none', rof2ocn_fmap) - call addmap(fldListFr(comprof)%flds, 'Forr_rofl' //iso(n), compocn, mapfiler, 'none', rof2ocn_liq_rmap) - call addmap(fldListFr(compglc)%flds, 'Fogg_rofl' //iso(n), compocn, mapfiler, 'one' , glc2ocn_liq_rmap) + ! from both rof and glc to con + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofl'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc, compglc), 'Fogg_rofl'//iso(n), rc=rc)) then + call addmap(fldListFr(comprof)%flds, 'Forr_rofl'//iso(n), compocn, mapconsf, 'none', rof2ocn_liq_rmap) + call addmap(fldListFr(compglc)%flds, 'Fogg_rofl'//iso(n), compocn, mapconsf, 'one' , glc2ocn_liq_rmap) call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl'//iso(n), & mrg_from1=comprof, mrg_fld1='Forr_rofl:Flrr_flood', mrg_type1='sum', & mrg_from2=compglc, mrg_fld2='Fogg_rofl'//iso(n) , mrg_type2='sum') @@ -1494,22 +1484,22 @@ subroutine esmFldsExchange(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofl' //iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl' //iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Flrr_flood'//iso(n), rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Flrr_flood'//iso(n), compocn, mapfiler, 'none', rof2ocn_fmap) - call addmap(fldListFr(comprof)%flds, 'Forr_rofl' //iso(n), compocn, mapfiler, 'none', rof2ocn_liq_rmap) + call addmap(fldListFr(comprof)%flds, 'Flrr_flood'//iso(n), compocn, mapconsf, 'none', rof2ocn_fmap) + call addmap(fldListFr(comprof)%flds, 'Forr_rofl' //iso(n), compocn, mapconsf, 'none', rof2ocn_liq_rmap) call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl' //iso(n), & mrg_from1=comprof, mrg_fld1='Forr_rofl:Flrr_flood', mrg_type1='sum') ! liquid from just rof to ocn else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofl'//iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofl'//iso(n), rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Forr_rofl'//iso(n), compocn, mapfiler, 'none', rof2ocn_liq_rmap) + call addmap(fldListFr(comprof)%flds, 'Forr_rofl'//iso(n), compocn, mapconsf, 'none', rof2ocn_liq_rmap) call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl'//iso(n), & - mrg_from1=comprof, mrg_fld1='Forr_rofl:Flrr_flood', mrg_type1='sum') + mrg_from1=comprof, mrg_fld1='Forr_rofl', mrg_type1='copy') ! liquid runoff from just glc to ocn else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofl'//iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compglc, compglc), 'Fogg_rofl'//iso(n), rc=rc)) then - call addmap(fldListFr(compglc)%flds, 'Fogg_rofl'//iso(n), compocn, mapfiler, 'one', glc2ocn_liq_rmap) + call addmap(fldListFr(compglc)%flds, 'Fogg_rofl'//iso(n), compocn, mapconsf, 'one', glc2ocn_liq_rmap) call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl'//iso(n), & mrg_from1=compglc, mrg_fld1='Fogg_rofl'//iso(n), mrg_type1='copy') end if @@ -1518,8 +1508,8 @@ subroutine esmFldsExchange(gcomp, phase, rc) if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofi'//iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi'//iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compglc, compglc), 'Fogg_rofi'//iso(n), rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compocn, mapfiler, 'none', rof2ocn_ice_rmap) - call addmap(fldListFr(compglc)%flds, 'Fogg_rofi'//iso(n), compocn, mapfiler, 'one' , glc2ocn_ice_rmap) + call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compocn, mapconsf, 'none', rof2ocn_ice_rmap) + call addmap(fldListFr(compglc)%flds, 'Fogg_rofi'//iso(n), compocn, mapconsf, 'one' , glc2ocn_ice_rmap) call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi'//iso(n), & mrg_from1=comprof, mrg_fld1='Forr_rofi'//iso(n), mrg_type1='sum', & mrg_from2=compglc, mrg_fld2='Fogg_rofi'//iso(n), mrg_type2='sum') @@ -1527,14 +1517,14 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! ice runoff from just rof to ocn else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofi'//iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi'//iso(n), rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compocn, mapfiler, 'none', rof2ocn_ice_rmap) + call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compocn, mapconsf, 'none', rof2ocn_ice_rmap) call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi'//iso(n), & mrg_from1=comprof, mrg_fld1='Forr_rofi', mrg_type1='copy') ! ice runoff from just glc to ocn else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_rofi'//iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compglc, compglc), 'Fogg_rofi'//iso(n), rc=rc)) then - call addmap(fldListFr(compglc)%flds, 'Fogg_rofi'//iso(n), compocn, mapfiler, 'one', glc2ocn_ice_rmap) + call addmap(fldListFr(compglc)%flds, 'Fogg_rofi'//iso(n), compocn, mapconsf, 'one', glc2ocn_ice_rmap) call addmrg(fldListTo(compocn)%flds, 'Foxx_rofi'//iso(n), & mrg_from1=compglc, mrg_fld1='Fogg_rofi'//iso(n), mrg_type1='copy') end if @@ -1566,7 +1556,6 @@ subroutine esmFldsExchange(gcomp, phase, rc) end do deallocate(flds) - !===================================================================== ! FIELDS TO ICE (compice) !===================================================================== @@ -1592,12 +1581,9 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to ice: dust dry deposition flux (size 3) from atm ! to ice: dust dry deposition flux (size 4) from atm ! --------------------------------------------------------------------- - allocate(flds(19)) + allocate(flds(9)) flds = (/'Faxa_lwdn' , 'Faxa_swndr' , 'Faxa_swvdr' , 'Faxa_swndf' , 'Faxa_swvdf', & - 'Faxa_bcphidry', 'Faxa_bcphodry', 'Faxa_bcphiwet', & - 'Faxa_ocphidry', 'Faxa_ocphodry', 'Faxa_ocphiwet', & - 'Faxa_dstwet1' , 'Faxa_dstwet2' , 'Faxa_dstwet3' , 'Faxa_dstwet4', & - 'Faxa_dstdry1' , 'Faxa_dstdry2' , 'Faxa_dstdry3' , 'Faxa_dstdry4'/) + 'Faxa_bcph' , 'Faxa_ocph' , 'Faxa_dstwet' , 'Faxa_dstdry' /) do n = 1,size(flds) fldname = trim(flds(n)) @@ -1619,57 +1605,83 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to ice: convective and large scale precipitation rate water equivalent from atm ! to ice: rain and snow rate from atm ! --------------------------------------------------------------------- - do n = 1,size(iso) - if (phase == 'advertise') then - call addfld(fldListFr(compatm)%flds, 'Faxa_rainc'//iso(n)) - call addfld(fldListFr(compatm)%flds, 'Faxa_rainl'//iso(n)) - call addfld(fldListFr(compatm)%flds, 'Faxa_rain' //iso(n)) - call addfld(fldListTo(compice)%flds, 'Faxa_rain' //iso(n)) - - call addfld(fldListFr(compatm)%flds, 'Faxa_snowc'//iso(n)) - call addfld(fldListFr(compatm)%flds, 'Faxa_snowl'//iso(n)) - call addfld(fldListFr(compatm)%flds, 'Faxa_snow' //iso(n)) - call addfld(fldListTo(compice)%flds, 'Faxa_snow' //iso(n)) - else - if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain' //iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc'//iso(n), rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rainc'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) - call addmap(fldListFr(compatm)%flds, 'Faxa_rainl'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) - if (iso(n) == ' ') then - fldname = 'Faxa_rainc:Faxa_rainl' - else - fldname = trim('Faxa_rainc'//iso(n))//':'//trim('Faxa_rainl'//iso(n)) - end if - call addmrg(fldListTo(compice)%flds, 'Faxa_rain' //iso(n) , & - mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='sum') - else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain'//iso(n), rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_rain'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) - call addmrg(fldListTo(compice)%flds, 'Faxa_rain'//iso(n), & - mrg_from1=compatm, mrg_fld1='Faxa_rain'//iso(n), mrg_type1='copy') - end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_rainc') + call addfld(fldListFr(compatm)%flds, 'Faxa_rainl') + call addfld(fldListFr(compatm)%flds, 'Faxa_rain' ) + call addfld(fldListTo(compice)%flds, 'Faxa_rain' ) + + call addfld(fldListFr(compatm)%flds, 'Faxa_rainc_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_rainl_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_rain_wiso' ) + call addfld(fldListTo(compice)%flds, 'Faxa_rain_wiso' ) + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rainc', compice, mapconsf, 'one', atm2ice_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_rainl', compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_rain' , & + mrg_from1=compatm, mrg_fld1='Faxa_rainc:Faxa_rainl', mrg_type1='sum') + else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rain', compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_rain', & + mrg_from1=compatm, mrg_fld1='Faxa_rain', mrg_type1='copy') + end if + if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainl_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rainc_wiso', compice, mapconsf, 'one', atm2ice_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_rainl_wiso', compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_rain_wiso' , & + mrg_from1=compatm, mrg_fld1='Faxa_rainc_wiso:Faxa_rainl_wiso', mrg_type1='sum') + else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_rain_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rain_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rain_wiso', compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_rain_wiso', & + mrg_from1=compatm, mrg_fld1='Faxa_rain_wiso', mrg_type1='copy') + end if + end if - if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow' //iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc'//iso(n), rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snowc'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) - call addmap(fldListFr(compatm)%flds, 'Faxa_snowl'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) - if (iso(n) == ' ') then - fldname = 'Faxa_snowc:Faxa_snowl' - else - fldname = trim('Faxa_snowc'//iso(n))//':'//trim('Faxa_snowl'//iso(n)) - end if - call addmrg(fldListTo(compice)%flds, 'Faxa_snow' //iso(n) , & - mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='sum') - else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow'//iso(n), rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow'//iso(n), rc=rc)) then - call addmap(fldListFr(compatm)%flds, 'Faxa_snow'//iso(n), compice, mapconsf, 'one', atm2ice_fmap) - call addmrg(fldListTo(compice)%flds, 'Faxa_snow'//iso(n), & - mrg_from1=compatm, mrg_fld1='Faxa_snow'//iso(n), mrg_type1='copy') - end if + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_snowc') + call addfld(fldListFr(compatm)%flds, 'Faxa_snowl') + call addfld(fldListFr(compatm)%flds, 'Faxa_snow' ) + call addfld(fldListTo(compice)%flds, 'Faxa_snow' ) + + call addfld(fldListFr(compatm)%flds, 'Faxa_snowc_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_snowl_wiso') + call addfld(fldListFr(compatm)%flds, 'Faxa_snow_wiso' ) + call addfld(fldListTo(compice)%flds, 'Faxa_snow_wiso' ) + else + if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snowc', compice, mapconsf, 'one', atm2ice_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_snowl', compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_snow' , & + mrg_from1=compatm, mrg_fld1='Faxa_snowc:Faxa_snowl', mrg_type1='sum') + else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snow', compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_snow', & + mrg_from1=compatm, mrg_fld1='Faxa_snow', mrg_type1='copy') end if - end do + if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowl_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snowc_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snowc_wiso', compice, mapconsf, 'one', atm2ice_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_snowl_wiso', compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_snow_wiso' , & + mrg_from1=compatm, mrg_fld1='Faxa_snowc_wiso:Faxa_snowl_wiso', mrg_type1='sum') + else if ( fldchk(is_local%wrap%FBexp(compice) , 'Faxa_snow_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_snow_wiso', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_snow_wiso', compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, 'Faxa_snow_wiso', & + mrg_from1=compatm, mrg_fld1='Faxa_snow_wiso', mrg_type1='copy') + end if + end if ! --------------------------------------------------------------------- ! to ice: height at the lowest model level from atm @@ -1682,9 +1694,8 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to ice: specific humidity at the lowest model level from atm ! to ice: specific humidity for water isotopes at the lowest model level from atm ! --------------------------------------------------------------------- - allocate(flds(11)) - flds = (/'Sa_z', 'Sa_pbot', 'Sa_tbot', 'Sa_ptem', 'Sa_dens', 'Sa_u', 'Sa_v', & - 'Sa_shum', 'Sa_shum_16O', 'Sa_shum_18O', 'Sa_shum_HDO'/) + allocate(flds(9)) + flds = (/'Sa_z', 'Sa_pbot', 'Sa_tbot', 'Sa_ptem', 'Sa_dens', 'Sa_u', 'Sa_v', 'Sa_shum', 'Sa_shum_wiso'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -1747,6 +1758,20 @@ subroutine esmFldsExchange(gcomp, phase, rc) end if end if + !----------------------------- + ! to ice: Ratio of ocean surface level abund. H2_16O/H2O/Rstd from ocean + !----------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'So_roce_wiso') + call addfld(fldListTo(compice)%flds, 'So_roce_wiso') + else + if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_roce_wiso', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compice) , 'So_roce_wiso', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'So_roce_wiso', compice, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compice)%flds, 'So_roce_wiso', mrg_from1=compocn, mrg_fld1='So_roce_wiso', mrg_type1='copy') + end if + end if + ! --------------------------------------------------------------------- ! to ice: frozen runoff from rof and glc ! --------------------------------------------------------------------- @@ -1760,8 +1785,8 @@ subroutine esmFldsExchange(gcomp, phase, rc) fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi'//iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(compglc, compglc), 'Figg_rofi'//iso(n), rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compice, mapfiler, 'none', rof2ocn_ice_rmap) - call addmap(fldListFr(compglc)%flds, 'Figg_rofi'//iso(n), compice, mapfiler, 'one' , glc2ice_rmap) + call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compice, mapconsf, 'none', rof2ocn_ice_rmap) + call addmap(fldListFr(compglc)%flds, 'Figg_rofi'//iso(n), compice, mapconsf, 'one' , glc2ice_rmap) call addmrg(fldListTo(compice)%flds, 'Fixx_rofi'//iso(n), & mrg_from1=comprof, mrg_fld1='Firr_rofi'//iso(n), mrg_type1='sum', & mrg_from2=compglc, mrg_fld2='Figg_rofi'//iso(n), mrg_type2='sum') @@ -1769,7 +1794,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBExp(compice) , 'Fixx_rofi'//iso(n), rc=rc) .and. & fldchk(is_local%wrap%FBImp(comprof, comprof), 'Forr_rofi'//iso(n), rc=rc)) then - call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compice, mapfiler, 'none', rof2ocn_ice_rmap) + call addmap(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n), compice, mapconsf, 'none', rof2ocn_ice_rmap) call addmrg(fldListTo(compice)%flds, 'Fixx_rofi'//iso(n), & mrg_from1=comprof, mrg_fld1='Firr_rofi'//iso(n), mrg_type1='sum') end if @@ -1784,31 +1809,48 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to wav: fractional ice coverage wrt ocean from ice !---------------------------------------------------------- if (phase == 'advertise') then - ! the following is computed in med_phases_prep_wav call addfld(fldListFr(compice)%flds, 'Si_ifrac') call addfld(fldListTo(compwav)%flds, 'Si_ifrac') + else + if ( fldchk(is_local%wrap%FBexp(compwav) , 'Si_ifrac', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_ifrac', rc=rc)) then + ! By default will be using a custom map - but if one is not available, use a generated bilinear instead + call addmap(fldListFr(compice)%flds, 'Si_ifrac', compwav, mapbilnr, 'one', ice2wav_smap) + call addmrg(fldListTo(compwav)%flds, 'Si_ifrac', & + mrg_from1=compice, mrg_fld1='Si_ifrac', mrg_type1='copy') + end if end if ! --------------------------------------------------------------------- ! to wav: ocean boundary layer depth from ocn + ! to wav: ocean currents from ocn + ! to wav: ocean surface temperature from ocn ! --------------------------------------------------------------------- - if (phase == 'advertise') then - call addfld(fldListFr(compocn)%flds, 'So_bldepth') - call addfld(fldListTo(compwav)%flds, 'So_bldepth') - else - if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'So_bldepth', rc=rc) .and. & - fldchk(is_local%wrap%FBExp(compwav) , 'So_bldepth', rc=rc)) then - call addmap(fldListFr(compocn)%flds, 'So_bldepth', compwav, mapbilnr, 'one', ocn2wav_smap) - call addmrg(fldListTo(compwav)%flds, 'So_bldepth', mrg_from1=compocn, mrg_fld1='So_bldepth', mrg_type1='copy') + allocate(flds(4)) + flds = (/'So_t', 'So_u', 'So_v', 'So_bldepth'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, trim(fldname)) + call addfld(fldListTo(compwav)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBImp(compocn, compocn), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compwav) , trim(fldname), rc=rc)) then + ! By default will be using a custom map - but if one is not available, use a generated bilinear instead + call addmap(fldListFr(compocn)%flds, trim(fldname), compwav, mapbilnr, 'one', ocn2wav_smap) + call addmrg(fldListTo(compwav)%flds, trim(fldname), mrg_from1=compocn, mrg_fld1=trim(fldname), mrg_type1='copy') + end if end if - end if + end do + deallocate(flds) ! --------------------------------------------------------------------- ! to wav: zonal wind at the lowest model level from atm ! to wav: meridional wind at the lowest model level from atm ! --------------------------------------------------------------------- - allocate(flds(2)) - flds = (/'Sa_u', 'Sa_v'/) + allocate(flds(3)) + flds = (/'Sa_u', 'Sa_v', 'Sa_tbot'/) do n = 1,size(flds) fldname = trim(flds(n)) @@ -1838,13 +1880,10 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! to rof: irrigation flux from land (withdrawal from rivers) ! --------------------------------------------------------------------- ! TODO (mvertens, 2019-01-13): the following isotopes have not yet been defined in the NUOPC field dict - ! allocate(flds(30)) - ! flds = (/'Flrl_rofsur', 'Flrl_rofsur_16O', 'Flrl_rofsur_18O', 'Flrl_rofsur_HDO', & - ! 'Flrl_rofgwl', 'Flrl_rofgwl_16O', 'Flrl_rofgwl_18O', 'Flrl_rofgwl_HDO', & - ! 'Flrl_rofsub', 'Flrl_rofsub_16O', 'Flrl_rofsub_18O', 'Flrl_rofsub_HDO', & - ! 'Flrl_rofdto', 'Flrl_rofdto_16O', 'Flrl_rofdto_18O', 'Flrl_rofdto_HDO', & - ! 'Flrl_rofi' , 'Flrl_rofi_16O' , 'Flrl_rofi_18O' , 'Flrl_rofi_HDO' , & - ! 'Flrl_irrig' , 'Flrl_irrig_16O' , 'Flrl_irrig_18O' , 'Flrl_irrig_HDO' /) + ! allocate(flds(12)) + ! flds = (/'Flrl_rofsur', 'Flrl_rofsur_wiso', 'Flrl_rofgwl', 'Flrl_rofgwl_wiso', & + ! 'Flrl_rofsub', 'Flrl_rofsub_wiso', 'Flrl_rofdto', 'Flrl_rofdto_wiso', & + ! 'Flrl_rofi' , 'Flrl_rofi_wiso' , 'Flrl_irrig' , 'Flrl_irrig_wiso' /) allocate(flds(6)) flds = (/'Flrl_rofsur', 'Flrl_rofgwl', 'Flrl_rofsub', 'Flrl_rofdto', 'Flrl_rofi', 'Flrl_irrig'/) @@ -1857,7 +1896,7 @@ subroutine esmFldsExchange(gcomp, phase, rc) else if ( fldchk(is_local%wrap%FBImp(complnd, complnd), trim(fldname), rc=rc) .and. & fldchk(is_local%wrap%FBExp(comprof) , trim(fldname), rc=rc)) then - call addmap(fldListFr(complnd)%flds, trim(fldname), comprof, mapconsd, 'lfrin', lnd2rof_fmap) + call addmap(fldListFr(complnd)%flds, trim(fldname), comprof, mapconsd, 'lfrac', lnd2rof_fmap) call addmrg(fldListTo(comprof)%flds, trim(fldname), & mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='lfrac') end if @@ -1872,7 +1911,6 @@ subroutine esmFldsExchange(gcomp, phase, rc) !----------------------------- ! to glc: from land !----------------------------- - ! - fields sent from lnd->med ARE in multiple elevation classes ! - fields sent from med->glc do NOT have elevation classes @@ -1880,32 +1918,26 @@ subroutine esmFldsExchange(gcomp, phase, rc) ! Note that, if glc_nec = 0, then we don't create any coupling fields (not even the bare land (0) fldindex) ! Note : Sl_topo is sent from lnd -> med, but is NOT sent to glc (only used for the remapping in the mediator) - if (glc_nec > 0) then - if (phase == 'advertise') then - do num = 0, glc_nec - cnum = glc_elevclass_as_string(num) - call addfld(fldListFr(complnd)%flds, 'Flgl_qice'//trim(cnum)) ! glacier ice flux' - call addfld(fldListFr(complnd)%flds, 'Sl_tsrf' //trim(cnum)) ! surface temperature of glacier' - call addfld(fldListFr(complnd)%flds, 'Sl_topo' //trim(cnum)) ! surface height of glacier - end do - call addfld(fldListTo(compglc)%flds, 'Flgl_qice') - call addfld(fldListTo(compglc)%flds, 'Sl_tsrf') - call addfld(fldListTo(compglc)%flds, 'Sl_topo') - else - if ( fldchk(is_local%wrap%FBExp(complnd) , 'Flgl_qice'//trim(cnum), rc=rc) .and. & - fldchk(is_local%wrap%FBExp(complnd) , 'Sl_tsrf'//trim(cnum) , rc=rc) .and. & - fldchk(is_local%wrap%FBExp(complnd) , 'Sl_topo'//trim(cnum) , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Sg_ice_covered' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Sg_topo' , rc=rc) .and. & - fldchk(is_local%wrap%FBImp(compglc,compglc) , 'Flgg_hflx' , rc=rc)) then - - do num = 0, glc_nec - cnum = glc_elevclass_as_string(num) - call addmap(FldListFr(complnd)%flds, 'Flgl_qice'//trim(cnum), compglc, mapconsf, 'none', lnd2glc_fmap) - call addmap(FldListFr(complnd)%flds, 'Sl_tsrf'//trim(cnum) , compglc, mapbilnr, 'none', lnd2glc_smap) - call addmap(FldListFr(complnd)%flds, 'Sl_topo'//trim(cnum) , compglc, mapbilnr, 'none', lnd2glc_smap) - end do - end if + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_tsrf_elev') ! surface temperature of glacier (1->glc_nec+1) + call addfld(fldListFr(complnd)%flds, 'Sl_topo_elev') ! surface heights of glacier (1->glc_nec+1) + call addfld(fldListFr(complnd)%flds, 'Flgl_qice_elev') ! glacier ice flux (1->glc_nec+1) + + call addfld(fldListTo(compglc)%flds, 'Sl_tsrf') + call addfld(fldListTo(compglc)%flds, 'Sl_topo') + call addfld(fldListTo(compglc)%flds, 'Flgl_qice') + else + if ( fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Flgl_qice_elev', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_tsrf_elev' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd) , 'Sl_topo_elev' , rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compglc) , 'Sg_ice_covered', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compglc) , 'Sg_topo' , rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compglc) , 'Flgg_hflx' , rc=rc)) then + + ! custom merging will be done here + call addmap(FldListFr(complnd)%flds, 'Flgl_qice_elev', compglc, mapconsf, 'none', lnd2glc_fmap) + call addmap(FldListFr(complnd)%flds, 'Sl_tsrf_elev' , compglc, mapbilnr, 'none', lnd2glc_smap) + call addmap(FldListFr(complnd)%flds, 'Sl_topo_elev' , compglc, mapbilnr, 'none', lnd2glc_smap) end if end if @@ -1916,17 +1948,17 @@ subroutine esmFldsExchange(gcomp, phase, rc) call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2a - call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('flds_co2a = '// trim(cvalue), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeGet(gcomp, name='flds_co2b', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2b - call ESMF_LogWrite('flds_co2b = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('flds_co2b = '// trim(cvalue), ESMF_LOGMSG_INFO) call NUOPC_CompAttributeGet(gcomp, name='flds_co2c', value=cvalue, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2c - call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite('flds_co2c = '// trim(cvalue), ESMF_LOGMSG_INFO) if (flds_co2a) then ! --------------------------------------------------------------------- @@ -2061,16 +2093,6 @@ subroutine esmFldsExchange(gcomp, phase, rc) end if endif - !----------------------------- - ! water isotope fields - TODO: add these to dictionary first - !----------------------------- - ! 'Ratio of ocean surface level abund. H2_16O/H2O/Rstd' - ! call fld_add(flds_o2x, "So_roce_16O") - ! call fld_add(flds_x2i, "So_roce_16O") - ! 'Ratio of ocean surface level abund. HDO/H2O/Rstd' - ! call fld_add(flds_o2x, "So_roce_HDO") - ! call fld_add(flds_x2i, "So_roce_HDO") - !----------------------------------------------------------------------------- ! CARMA fields (volumetric soil water) !----------------------------------------------------------------------------- diff --git a/src/drivers/nuopc/cime_flds/fd.yaml b/src/drivers/nuopc/cime_flds/fd.yaml index 49ab5eaaacc..3936273fcda 100644 --- a/src/drivers/nuopc/cime_flds/fd.yaml +++ b/src/drivers/nuopc/cime_flds/fd.yaml @@ -15,577 +15,114 @@ description: mediator export atm/ocn evaporation water flux # - - standard_name: Faox_lat - alias: mean_laten_heat_flx_atm_into_ocn - canonical_units: W m-2 - description: mediator export - atm/ocn surface latent heat flux - # - - standard_name: Faox_sen - alias: mean_sensi_heat_flx_atm_into_ocn - canonical_units: W m-2 - description: mediator export - atm/ocn surface sensible heat flux - # - - standard_name: Faox_lwup - alias: mean_up_lw_flx_ocn - canonical_units: W m-2 - description: mediator export - long wave radiation flux over the ocean - # - - standard_name: Faox_taux - alias: stress_on_air_ocn_zonal - canonical_units: N m-2 - description: mediator export - # - - standard_name: Faox_tauy - alias: stress_on_air_ocn_merid - canonical_units: N m-2 - description: mediator export - # - - standard_name: Faox_evap_16O - canonical_units: kg m-2 s-1 - description: mediator export - atm/ocn evaporation water flux 16O - # - - standard_name: Faox_evap_18O - canonical_units: kg m-2 s-1 - description: mediator export - atm/ocn evaporation water flux 18O - # - - standard_name: Faox_evap_HDO - canonical_units: kg m-2 s-1 - description: mediator export - atm/ocn evaporation water flux HDO - # - #----------------------------------- - # section: land export - #----------------------------------- - # - - standard_name: Fall_evap - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_evap_16O - canonical_units: kg m-2 s-1 - # - - standard_name: Fall_evap_18O - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_evap_HDO - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_fco2_lnd - canonical_units: moles m-2 s-1 - description: land export - # - - standard_name: Fall_fire01 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes1 - # - - standard_name: Fall_fire02 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes2 - # - - standard_name: Fall_fire03 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes3 - # - - standard_name: Fall_fire04 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes4 - # - - standard_name: Fall_fire05 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes5 - # - - standard_name: Fall_fire06 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes6 - # - - standard_name: Fall_fire07 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes7 - # - - standard_name: Fall_fire08 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes8 - # - - standard_name: Fall_fire09 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes9 - # - - standard_name: Fall_fire10 - canonical_units: kg/m2/sec - description: land export - wild fire emission fluxes10 - # - - standard_name: Fall_flxdst1 - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_flxdst2 - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_flxdst3 - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_flxdst4 - canonical_units: kg m-2 s-1 - description: land export - # - - standard_name: Fall_lat - canonical_units: W m-2 - description: land export - # - - standard_name: Fall_lwup - canonical_units: W m-2 - description: land export - # - - standard_name: Fall_sen - canonical_units: W m-2 - description: land export - # - - standard_name: Fall_swnet - canonical_units: W m-2 - description: land export - # - - standard_name: Fall_taux - canonical_units: N m-2 - description: land export - # - - standard_name: Fall_tauy - canonical_units: N m-2 - description: land export - # - - standard_name: Fall_voc001 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc002 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc003 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc004 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc005 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc006 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc007 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc008 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc009 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc010 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc011 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc012 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc013 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc014 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc015 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc016 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc017 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc018 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc019 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Fall_voc020 - canonical_units: molecules/m2/sec - description: land export - # - - standard_name: Sl_anidf - canonical_units: 1 - description: land export - # - - standard_name: Sl_anidr - canonical_units: 1 - description: land export - # - - standard_name: Sl_avsdf - canonical_units: 1 - description: land export - # - - standard_name: Sl_avsdr - canonical_units: 1 - description: land export - # - - standard_name: Sl_dd01 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd02 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd03 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd04 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd05 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd06 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd07 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd08 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd09 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd10 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd11 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd12 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd13 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd14 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd15 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd16 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd17 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd18 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd19 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd20 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd21 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd22 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd23 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd24 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd25 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd26 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd27 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd28 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd29 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd30 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd31 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd32 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd33 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd34 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd35 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd36 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd37 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd38 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd39 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd40 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd41 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd42 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd43 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd44 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd45 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd46 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd47 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd48 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd49 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd50 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd51 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd52 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd53 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd54 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd55 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd56 - canonical_units: cm/sec - description: land export - # - - standard_name: Sl_dd57 - canonical_units: cm/sec - description: land export + - standard_name: Faox_evap_wiso + canonical_units: kg m-2 s-1 + description: mediator export + atm/ocn evaporation water flux 16O, 18O, HDO # - - standard_name: Sl_dd58 - canonical_units: cm/sec - description: land export + - standard_name: Faox_lat + alias: mean_laten_heat_flx_atm_into_ocn + canonical_units: W m-2 + description: mediator export + atm/ocn surface latent heat flux # - - standard_name: Sl_dd59 - canonical_units: cm/sec - description: land export + - standard_name: Faox_sen + alias: mean_sensi_heat_flx_atm_into_ocn + canonical_units: W m-2 + description: mediator export + atm/ocn surface sensible heat flux # - - standard_name: Sl_dd60 - canonical_units: cm/sec - description: land export + - standard_name: Faox_lwup + alias: mean_up_lw_flx_ocn + canonical_units: W m-2 + description: mediator export + long wave radiation flux over the ocean # - - standard_name: Sl_dd61 - canonical_units: cm/sec - description: land export + - standard_name: Faox_taux + alias: stress_on_air_ocn_zonal + canonical_units: N m-2 + description: mediator export # - - standard_name: Sl_dd62 - canonical_units: cm/sec - description: land export + - standard_name: Faox_tauy + alias: stress_on_air_ocn_merid + canonical_units: N m-2 + description: mediator export # - - standard_name: Sl_dd63 - canonical_units: cm/sec - description: land export + #----------------------------------- + # section: land export + #----------------------------------- # - - standard_name: Sl_dd64 - canonical_units: cm/sec + - standard_name: Fall_evap + canonical_units: kg m-2 s-1 description: land export # - - standard_name: Sl_dd65 - canonical_units: cm/sec - description: land export + - standard_name: Fall_evap_wiso + canonical_units: kg m-2 s-1 + description: land export # - - standard_name: Sl_dd66 - canonical_units: cm/sec + - standard_name: Fall_fco2_lnd + canonical_units: moles m-2 s-1 description: land export # - - standard_name: Sl_dd67 - canonical_units: cm/sec + - standard_name: Fall_fire + canonical_units: kg/m2/sec description: land export + wild fire emission fluxes (1->10) # - - standard_name: Sl_dd68 - canonical_units: cm/sec + - standard_name: Fall_flxdst + canonical_units: kg m-2 s-1 description: land export + dust fluxes from land (sizes 1->4) # - - standard_name: Sl_dd69 - canonical_units: cm/sec + - standard_name: Fall_lat + canonical_units: W m-2 description: land export # - - standard_name: Sl_dd70 - canonical_units: cm/sec + - standard_name: Fall_lwup + canonical_units: W m-2 description: land export # - - standard_name: Sl_dd71 - canonical_units: cm/sec + - standard_name: Fall_sen + canonical_units: W m-2 description: land export # - - standard_name: Sl_dd72 - canonical_units: cm/sec + - standard_name: Fall_swnet + canonical_units: W m-2 description: land export # - - standard_name: Sl_dd73 - canonical_units: cm/sec + - standard_name: Fall_taux + canonical_units: N m-2 description: land export # - - standard_name: Sl_dd74 - canonical_units: cm/sec + - standard_name: Fall_tauy + canonical_units: N m-2 description: land export # - - standard_name: Sl_dd75 - canonical_units: cm/sec + - standard_name: Fall_voc + canonical_units: molecules/m2/sec description: land export + MEGAN voc emission fluxes from land (1->20) # - - standard_name: Sl_dd76 - canonical_units: cm/sec + - standard_name: Sl_anidf + canonical_units: 1 description: land export # - - standard_name: Sl_dd77 - canonical_units: cm/sec + - standard_name: Sl_anidr + canonical_units: 1 description: land export # - - standard_name: Sl_dd78 - canonical_units: cm/sec + - standard_name: Sl_avsdf + canonical_units: 1 description: land export # - - standard_name: Sl_dd79 - canonical_units: cm/sec + - standard_name: Sl_avsdr + canonical_units: 1 description: land export # - - standard_name: Sl_dd80 + - standard_name: Sl_ddvel canonical_units: cm/sec - description: land export + description: land export + dry deposition velocities from (1->80) # - standard_name: Sl_fv canonical_units: m s-1 @@ -608,15 +145,7 @@ canonical_units: kg kg-1 description: land export # - - standard_name: Sl_qref_16O - canonical_units: kg kg-1 - description: land export - # - - standard_name: Sl_qref_18O - canonical_units: kg kg-1 - description: land export - # - - standard_name: Sl_qref_HDO + - standard_name: Sl_qref_wiso canonical_units: kg kg-1 description: land export # @@ -628,15 +157,7 @@ canonical_units: m description: land export # - - standard_name: Sl_snowh_16O - canonical_units: m - description: land export - # - - standard_name: Sl_snowh_18O - canonical_units: m - description: land export - # - - standard_name: Sl_snowh_HDO + - standard_name: Sl_snowh_wiso canonical_units: m description: land export # @@ -644,105 +165,25 @@ canonical_units: K description: land export # - - standard_name: Sl_topo - canonical_units: m - description: land export - # - - standard_name: Sl_topo00 - canonical_units: m - description: land export - # - - standard_name: Sl_topo01 - canonical_units: m - description: land export - # - - standard_name: Sl_topo02 - canonical_units: m - description: land export - # - - standard_name: Sl_topo03 - canonical_units: m - description: land export - # - - standard_name: Sl_topo04 - canonical_units: m - description: land export - # - - standard_name: Sl_topo05 - canonical_units: m - description: land export - # - - standard_name: Sl_topo06 - canonical_units: m - description: land export - # - - standard_name: Sl_topo07 - canonical_units: m - description: land export - # - - standard_name: Sl_topo08 + - standard_name: Sl_topo_elev canonical_units: m - description: land export - # - - standard_name: Sl_topo09 - canonical_units: m - description: land export + description: land export to mediator in elevation classes (1->glc_nec) # - - standard_name: Sl_topo10 + - standard_name: Sl_topo canonical_units: m - description: land export - # - - standard_name: Sl_tref - canonical_units: K - description: land export - # - - standard_name: Sl_tsrf - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf00 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf01 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf02 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf03 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf04 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf05 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf06 - canonical_units: deg C - description: land export - # - - standard_name: Sl_tsrf07 - canonical_units: deg C - description: land export + description: mediator export to glc - no levation classes # - - standard_name: Sl_tsrf08 + - standard_name: Sl_tsrf_elev canonical_units: deg C - description: land export + description: land export to mediator in elevation classes (1->glc_nec) # - - standard_name: Sl_tsrf09 + - standard_name: Sl_tsrf canonical_units: deg C - description: land export + description: mediator export to gcl with no elevation classes # - - standard_name: Sl_tsrf10 - canonical_units: deg C - description: land export + - standard_name: Sl_tref + canonical_units: K + description: mediator export to glc - no levation classes # - standard_name: Sl_u10 canonical_units: m @@ -752,47 +193,19 @@ # section: atmosphere export #----------------------------------- # - - standard_name: Faxa_bcphidry - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_bcphiwet - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_bcphodry - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstdry1 - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstdry2 - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstdry3 + - standard_name: Faxa_bcph canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_dstdry4 + - standard_name: Faxa_ocph canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_dstwet1 + - standard_name: Faxa_dstdry canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_dstwet2 - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstwet3 - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_dstwet4 + - standard_name: Faxa_dstwet canonical_units: kg m-2 s-1 description: atmosphere export # @@ -854,39 +267,12 @@ description: atmosphere export Instataneous net sfc uv+vis diffuse flux (fv3 only) # - - standard_name: Faxa_nhx - canonical_units: kg(N)/m2/sec - description: atmosphere export - # - - standard_name: Faxa_noy + - standard_name: Faxa_ndep canonical_units: kg(N)/m2/sec - description: atmosphere export - # - - standard_name: Faxa_ocphidry - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_ocphiwet - canonical_units: kg m-2 s-1 - description: atmosphere export + description: atmosphere export to land and ocean + currently nhx and noy # - - standard_name: Faxa_ocphodry - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_prec - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_prec_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_prec_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_prec_HDO + - standard_name: Faxa_prec_wiso canonical_units: kg m-2 s-1 description: atmosphere export # @@ -895,15 +281,8 @@ canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_rain_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rain_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rain_HDO + - standard_name: Faxa_rain_wiso + alias: mean_prec_rate_wiso canonical_units: kg m-2 s-1 description: atmosphere export # @@ -911,15 +290,7 @@ canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_rainc_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rainc_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rainc_HDO + - standard_name: Faxa_rainc_wiso canonical_units: kg m-2 s-1 description: atmosphere export # @@ -927,15 +298,7 @@ canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_rainl_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rainl_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_rainl_HDO + - standard_name: Faxa_rainl_wiso canonical_units: kg m-2 s-1 description: atmosphere export # @@ -944,15 +307,7 @@ canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_snow_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snow_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snow_HDO + - standard_name: Faxa_snow_wiso canonical_units: kg m-2 s-1 description: atmosphere export # @@ -960,15 +315,7 @@ canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_snowc_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snowc_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snowc_HDO + - standard_name: Faxa_snowc_wiso canonical_units: kg m-2 s-1 description: atmosphere export # @@ -976,15 +323,7 @@ canonical_units: kg m-2 s-1 description: atmosphere export # - - standard_name: Faxa_snowl_16O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snowl_18O - canonical_units: kg m-2 s-1 - description: atmosphere export - # - - standard_name: Faxa_snowl_HDO + - standard_name: Faxa_snowl_wiso canonical_units: kg m-2 s-1 description: atmosphere export # @@ -1081,20 +420,11 @@ description: atmosphere export bottom layer specific humidity # - - standard_name: Sa_shum_16O + - standard_name: Sa_shum_wiso + alias: inst_spec_humid_height_lowest_wiso canonical_units: kg kg-1 description: atmosphere export - bottom layer specific humidity 16O (cesm only) - # - - standard_name: Sa_shum_18O - canonical_units: kg kg-1 - description: atmosphere export - bottom layer specific humidity 18O (cesm only) - # - - standard_name: Sa_shum_HDO - canonical_units: kg kg-1 - description: atmosphere export - bottom layer specific humidity HDO (cesm only) + bottom layer specific humidity 16O, 18O, HDO (cesm only) # - standard_name: inst_spec_humid_height2m canonical_units: K @@ -1323,15 +653,7 @@ canonical_units: kg m-2 s-1 description: atmosphere import # - - standard_name: Faxx_evap_16O - canonical_units: kg m-2 s-1 - description: atmosphere import - # - - standard_name: Faxx_evap_18O - canonical_units: kg m-2 s-1 - description: atmosphere import - # - - standard_name: Faxx_evap_HDO + - standard_name: Faxx_evap_wiso canonical_units: kg m-2 s-1 description: atmosphere import # @@ -1385,14 +707,7 @@ canonical_units: kg kg-1 description: atmosphere import # - - standard_name: Sx_qref_16O - canonical_units: kg kg-1 - # - - standard_name: Sx_qref_18O - canonical_units: kg kg-1 - description: atmosphere import - # - - standard_name: Sx_qref_HDO + - standard_name: Sx_qref_wiso canonical_units: kg kg-1 description: atmosphere import # @@ -1420,126 +735,28 @@ description: land-ice export glc frozen runoff_iceberg flux to ice # - - standard_name: Figg_rofi_16O - canonical_units: kg m-2 s-1 - description: land-ice export - glc frozen runoff_iceberg flux to ice for 16O - # - - standard_name: Figg_rofi_18O + - standard_name: Figg_rofi_wiso canonical_units: kg m-2 s-1 description: land-ice export - glc frozen runoff_iceberg flux to ice for 18O - # - - standard_name: Figg_rofi_HDO - canonical_units: kg m-2 s-1 - description: land-ice export - glc frozen runoff_iceberg flux to ice for HDO + glc frozen runoff_iceberg flux to ice for 16O, 18O, HDO # - standard_name: Flgg_hflx canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from glc - # - - standard_name: Flgg_hflx00 - canonical_units: W m-2 - description: land-ice export + description: land-ice export to mediator (no elevatino classes) Downward heat flux from glacier interior, from mediator, elev class 0 # - - standard_name: Flgg_hflx01 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 1 - # - - standard_name: Flgg_hflx02 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 2 - # - - standard_name: Flgg_hflx03 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 3 - # - - standard_name: Flgg_hflx04 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 4 - # - - standard_name: Flgg_hflx05 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 5 - # - - standard_name: Flgg_hflx06 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 6 - # - - standard_name: Flgg_hflx07 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 7 - # - - standard_name: Flgg_hflx08 + - standard_name: Flgg_hflx_elev canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 8 - # - - standard_name: Flgg_hflx09 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 8 + description: mediator land-ice export to lnd (elevation classes 1->glc_nec) + Downward heat flux from glacier interior, from mediator, elev class 1->glc_nec # - - standard_name: Flgg_hflx10 - canonical_units: W m-2 - description: land-ice export - Downward heat flux from glacier interior, from mediator, elev class 10 - standard_name: Sg_ice_covered canonical_units: 1 + description: land-ice export to mediator (no elevation classes) # - - standard_name: Sg_ice_covered00 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered01 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered02 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered03 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered04 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered05 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered06 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered07 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered08 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered09 - canonical_units: 1 - description: land-ice export - # - - standard_name: Sg_ice_covered10 + - standard_name: Sg_ice_covered_elev canonical_units: 1 - description: land-ice export + description: mediator land-ice export to lnd (elevation classes 1->glc_nec) # - standard_name: Sg_icemask canonical_units: 1 @@ -1551,91 +768,31 @@ # - standard_name: Sg_topo canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo00 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo01 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo02 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo03 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo04 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo05 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo06 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo07 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo08 - canonical_units: m - description: land-ice export - # - - standard_name: Sg_topo09 - canonical_units: m - description: land-ice export + description: land-ice export to mediator (no elevation classes) # - - standard_name: Sg_topo10 + - standard_name: Sg_topo_elev canonical_units: m - description: land-ice export + description: mediator land-ice export to lnd (elevation classes 1->glc_nec) # - standard_name: Fogg_rofi canonical_units: kg m-2 s-1 description: land-ice export glacier_frozen_runoff_flux_to_ocean # - - standard_name: Fogg_rofi_16O - canonical_units: kg m-2 s-1 - description: land-ice export - glacier_frozen_runoff_flux_to_ocean for 16O - # - - standard_name: Fogg_rofi_18O + - standard_name: Fogg_rofi_wiso canonical_units: kg m-2 s-1 description: land-ice export - glacier_frozen_runoff_flux_to_ocean for 18O - # - - standard_name: Fogg_rofi_HDO - canonical_units: kg m-2 s-1 - description: land-ice export - glacier_frozen_runoff_flux_to_ocean for HDO + glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO # - standard_name: Fogg_rofl canonical_units: kg m-2 s-1 description: land-ice export glacier liquid runoff flux to ocean # - - standard_name: Fogg_rofl_16O - canonical_units: kg m-2 s-1 - description: land-ice export - glacier_frozen_runoff_flux_to_ocean for 16O - # - - standard_name: Fogg_rofl_18O - canonical_units: kg m-2 s-1 - description: land-ice export - glacier_frozen_runoff_flux_to_ocean for 18O - # - - standard_name: Fogg_rofl_HDO + - standard_name: Fogg_rofl_wiso canonical_units: kg m-2 s-1 description: land-ice export - glacier_frozen_runoff_flux_to_ocean for HDO + glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO # #----------------------------------- # section: sea-ice export @@ -1646,17 +803,9 @@ canonical_units: kg m-2 s-1 description: sea-ice export # - - standard_name: Faii_evap_16O - canonical_units: kg m-2 s-1 - description: sea-ice export - # - - standard_name: Faii_evap_18O + - standard_name: Faii_evap_wiso canonical_units: kg m-2 s-1 - description: sea-ice export - # - - standard_name: Faii_evap_HDO - canonical_units: kg m-2 s-1 - description: sea-ice export + description: sea-ice export for 16O, 18O, HDO # - standard_name: Faii_lat alias: mean_laten_heat_flx_atm_into_ice @@ -1713,15 +862,10 @@ description: sea-ice export to ocean net heat flux to ocean # - - standard_name: Fioi_melth_16O + - standard_name: Fioi_melth_wiso canonical_units: kg m-2 s-1 description: sea-ice export to ocean - isotope head flux to ocean - # - - standard_name: Fioi_melth_18O - canonical_units: kg m-2 s-1 - description: sea-ice export to ocean - isotope head flux to ocean + isotope head flux to ocean for 16O, 18O, HDO # - standard_name: Fioi_melth_HDO canonical_units: kg m-2 s-1 @@ -1734,17 +878,11 @@ description: sea-ice export to ocean fresh water to ocean (h2o flux from melting) # - - standard_name: Fioi_meltw_16O - canonical_units: kg m-2 s-1 - description: sea-ice export - # - - standard_name: Fioi_meltw_18O + - standard_name: Fioi_meltw_wiso + alias: mean_fresh_water_to_ocean_rate_wiso canonical_units: kg m-2 s-1 - description: sea-ice export - # - - standard_name: Fioi_meltw_HDO - canonical_units: kg m-2 s-1 - description: sea-ice export + description: sea-ice export to ocean + fresh water to ocean (h2o flux from melting) for 16O, 18O, HDO # - standard_name: Fioi_salt alias: mean_salt_rate @@ -1760,28 +898,28 @@ # # NOTE: the following alias requires a new name change for CICE export - standard_name: Fioi_swpen_vdr - alias: mean_net_swpen_vis_dir_flx + alias: mean_net_sw_vis_dir_flx canonical_units: W m-2 description: sea-ice export to ocean flux of vis dir shortwave through ice to ocean # # NOTE: the following alias requires a new name change for CICE export - standard_name: Fioi_swpen_vdf - alias: mean_net_swpen_vis_dif_flx + alias: mean_net_sw_vis_dif_flx canonical_units: W m-2 description: sea-ice export to ocean flux of vif dir shortwave through ice to ocean # # NOTE: the following alias requires a new name change for CICE export - standard_name: Fioi_swpen_idr - alias: mean_net_swpen_ir_dir_flx + alias: mean_net_sw_ir_dir_flx canonical_units: W m-2 description: sea-ice export to ocean flux of ir dir shortwave through ice to ocean # # NOTE: the following alias requires a new name change for CICE export - standard_name: Fioi_swpen_idf - alias: mean_net_swpen_ir_dif_flx + alias: mean_net_sw_ir_dif_flx canonical_units: W m-2 description: sea-ice export to ocean flux of ir dif shortwave through ice to ocean @@ -1825,6 +963,7 @@ ice fraction (varies with time) # - standard_name: Si_ifrac_n + alias: ice_fraction_n canonical_units: 1 description: sea-ice export ice fraction per category (varies with time) (cesm only) @@ -1840,21 +979,11 @@ description: sea-ice export to atm cesm only # - - standard_name: Si_qref_16O - canonical_units: kg kg-1 - description: sea-ice export to atm - cesm only - # - - standard_name: Si_qref_18O + - standard_name: Si_qref_wiso canonical_units: kg kg-1 description: sea-ice export to atm cesm only # - - standard_name: Si_qref_HDO - canonical_units: kg kg-1 - description: sea-ice export - cesm only - # - standard_name: Si_snowh # ambiguous with Si_vsno # alias: mean_snow_volume @@ -1888,7 +1017,7 @@ volume of snow per unit area # #----------------------------------- - # section: ocean export + # section: ocean export to mediator #----------------------------------- # - standard_name: Fioo_q @@ -1898,23 +1027,23 @@ # - standard_name: Faoo_fco2_ocn canonical_units: moles m-2 s-1 - description: ocean export + description: ocean export (cesm only) # - standard_name: So_anidf canonical_units: 1 - description: ocean export + description: ocean export (cesm only) # - standard_name: So_anidr canonical_units: 1 - description: ocean export + description: ocean export (cesm only) # - standard_name: So_avsdf canonical_units: 1 - description: ocean export + description: ocean export (cesm only) # - standard_name: So_avsdr canonical_units: 1 - description: ocean export + description: ocean export (cesm only) # - standard_name: So_bldepth alias: mixed_layer_depth @@ -1944,6 +1073,7 @@ description: ocean export # - standard_name: So_omask + alias: ocean_mask canonical_units: 1 description: ocean export # @@ -1951,15 +1081,7 @@ canonical_units: kg kg-1 description: ocean export # - - standard_name: So_qref_16O - canonical_units: kg kg-1 - description: ocean export - # - - standard_name: So_qref_18O - canonical_units: kg kg-1 - description: ocean export - # - - standard_name: So_qref_HDO + - standard_name: So_qref_wiso canonical_units: kg kg-1 description: ocean export # @@ -1967,12 +1089,12 @@ canonical_units: 1 description: ocean export # - - standard_name: So_roce_16O - canonical_units: 1 + - standard_name: So_qref_wiso + canonical_units: kg kg-1 description: ocean export # - - standard_name: So_roce_HDO - canonical_units: 1 + - standard_name: So_roce_wiso + canonical_units: unitless description: ocean export # - standard_name: So_s @@ -2020,36 +1142,18 @@ description: river export water flux into sea ice due to runoff (frozen) # - - standard_name: Firr_rofi_16O + - standard_name: Firr_rofi_wiso canonical_units: kg m-2 s-1 description: river export - water flux into sea ice due to runoff (frozen) for 16O - # - - standard_name: Firr_rofi_18O - canonical_units: kg m-2 s-1 - description: river export - water flux into sea ice due to runoff (frozen) for 18O - # - - standard_name: Firr_rofi_HDO - canonical_units: kg m-2 s-1 - description: river export - water flux into sea ice due to runoff (frozen) for HDO + water flux into sea ice due to runoff (frozen) for 16O, 18O, HDO # - standard_name: Fixx_rofi canonical_units: kg m-2 s-1 description: frozen runoff to ice from river and land-ice # - - standard_name: Fixx_rofi_16O - canonical_units: kg m-2 s-1 - description: frozen runoff to ice from river and land-ice for 16O - # - - standard_name: Fixx_rofi_18O + - standard_name: Fixx_rofi_wiso canonical_units: kg m-2 s-1 - description: frozen runoff to ice from river and land-ice for 18O - # - - standard_name: Fixx_rofi_HDO - canonical_units: kg m-2 s-1 - description: frozen runoff to ice from river and land-ice for HDO + description: frozen runoff to ice from river and land-ice for 16O, 18O, HDO # #----------------------------------- # section: lnd export to glc @@ -2057,51 +1161,11 @@ # - standard_name: Flgl_qice canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice00 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice01 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice02 - canonical_units: kg m-2 s-1 - description: land export to glc + description: mediator export to glc no elevation classes # - - standard_name: Flgl_qice03 + - standard_name: Flgl_qice_elev canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice04 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice05 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice06 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice07 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice08 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice09 - canonical_units: kg m-2 s-1 - description: land export to glc - # - - standard_name: Flgl_qice10 - canonical_units: kg m-2 s-1 - description: land export to glc + description: land export to mediator in elevation classes (1->glc_nec) # #----------------------------------- # section: lnd export to river @@ -2140,100 +1204,50 @@ description: river export to land Water flux due to flooding # - - standard_name: Flrr_flood_16O - canonical_units: kg m-2 s-1 - description: river export to land - Water flux due to flooding for 16O - # - - standard_name: Flrr_flood_18O - canonical_units: kg m-2 s-1 - description: river export to land - Water flux due to flooding for 18O - # - - standard_name: Flrr_flood_HDO + - standard_name: Flrr_flood_wiso canonical_units: kg m-2 s-1 description: river export to land - Water flux due to flooding for HDO + Water flux due to flooding for 16O, 18O, HDO # - standard_name: Flrr_volr canonical_units: m description: river export to land River channel total water volume # - - standard_name: Flrr_volr_16O - canonical_units: m - description: river export to land - River channel total water volume from 16O - # - - standard_name: Flrr_volr_18O - canonical_units: m - description: river export to land - River channel total water volume from 18O - # - - standard_name: Flrr_volr_HDO + - standard_name: Flrr_volr_wiso canonical_units: m description: river export to land - River channel total water olume from HDO + River channel total water volume from 16O, 18O, HDO # - standard_name: Flrr_volrmch canonical_units: m description: river export to land River channel main channel water volume # - - standard_name: Flrr_volrmch_16O - canonical_units: m - description: river export to land - River channel main channel water volume from 16O - # - - standard_name: Flrr_volrmch_18O - canonical_units: m - description: river export to land - River channel main channel water volume from 18O - # - - standard_name: Flrr_volrmch_HDO + - standard_name: Flrr_volrmch_wiso canonical_units: m description: river export to land - River channel main channel water volume from HDO + River channel main channel water volume from 16O, 18O, HDO # - standard_name: Forr_rofi canonical_units: kg m-2 s-1 description: river export to ocean Water flux due to runoff (frozen) # - - standard_name: Forr_rofi_16O + - standard_name: Forr_rofi_wiso canonical_units: kg m-2 s-1 description: river export to ocean - Water flux due to runoff (frozen) for 16O - # - - standard_name: Forr_rofi_18O - canonical_units: kg m-2 s-1 - description: river export to ocean - Water flux due to runoff (frozen) for 18O - # - - standard_name: Forr_rofi_HDO - canonical_units: kg m-2 s-1 - description: river export to ocean - Water flux due to runoff (frozen) for HDO + Water flux due to runoff (frozen) for 16O, 18O, HDO # - standard_name: Forr_rofl canonical_units: kg m-2 s-1 description: river export to ocean Water flux due to runoff (liquid) # - - standard_name: Forr_rofl_16O - canonical_units: kg m-2 s-1 - description: river export to ocean - Water flux due to runoff (frozen) for 16O - # - - standard_name: Forr_rofl_18O - canonical_units: kg m-2 s-1 - description: river export to ocean - Water flux due to runoff (frozen) for 18O - # - - standard_name: Forr_rofl_HDO + - standard_name: Forr_rofl_wiso canonical_units: kg m-2 s-1 description: river export to ocean - Water flux due to runoff (frozen) for HDO + Water flux due to runoff (frozen) for 16O, 18O, HDO # #----------------------------------- # section: ocean import @@ -2245,40 +1259,21 @@ description: ocean import specific humidity flux # - - standard_name: Foxx_evap_16O - canonical_units: kg m-2 s-1 - description: ocean import - specific humidity flux 16O - # - - standard_name: Foxx_evap_18O - canonical_units: kg m-2 s-1 - description: ocean import - specific humidity flux 18O - # - - standard_name: Foxx_evap_HDO + - standard_name: Foxx_evap_wiso + alias: mean_evap_rate_wiso canonical_units: kg m-2 s-1 description: ocean import - specific humidity flux HDO + specific humidity flux 16O, 18O, HDO # - standard_name: Foxx_lat canonical_units: W m-2 description: ocean import latent heat flux into ocean (cesm only) # - - standard_name: Foxx_lat_16O - canonical_units: W m-2 - description: ocean import - latent heat flux into ocean for 16O (cesm only) - # - - standard_name: Foxx_lat_18O - canonical_units: W m-2 - description: ocean import - latent heat flux into ocean for 16O (cesm only) - # - - standard_name: Foxx_lat_HDO + - standard_name: Foxx_lat_wiso canonical_units: W m-2 description: ocean import - latent heat flux into ocean for 18O (cesm only) + latent heat flux into ocean for 16O, 18O, HDO (cesm only) # - standard_name: Foxx_lat canonical_units: W m-2 @@ -2302,45 +1297,46 @@ description: ocean import mean NET long wave radiation flux to ocean # - - standard_name: Foxx_rofi + - standard_name: mean_runoff_rate canonical_units: kg m-2 s-1 description: ocean import - water flux due to runoff (frozen) + total runoff to ocean # - - standard_name: Foxx_rofi_16O + - standard_name: mean_runoff_heat_flux canonical_units: kg m-2 s-1 description: ocean import - water flux due to runoff (frozen) for 16O + heat content of runoff # - - standard_name: Foxx_rofi_18O + - standard_name: mean_calving_rate canonical_units: kg m-2 s-1 description: ocean import - water flux due to runoff (frozen) for 18O + total calving to ocean # - - standard_name: Foxx_rofi_HDO + - standard_name: mean_calving_heat_flux canonical_units: kg m-2 s-1 description: ocean import - water flux due to runoff (frozen) for HDO + heat content of calving # - - standard_name: Foxx_rofl + - standard_name: Foxx_rofi canonical_units: kg m-2 s-1 description: ocean import - water flux due to runoff (liquid) + water flux due to runoff (frozen) # - - standard_name: Foxx_rofl_16O + - standard_name: Foxx_rofi_wiso canonical_units: kg m-2 s-1 description: ocean import - water flux due to runoff (liquid) for 16O + water flux due to runoff (frozen) for 16O, 18O, HDO # - - standard_name: Foxx_rofl_18O + - standard_name: Foxx_rofl + alias: mean_runoff_rate canonical_units: kg m-2 s-1 description: ocean import - water flux due to runoff (liquid) for 18O + water flux due to runoff (liquid) # - - standard_name: Foxx_rofl_HDO + - standard_name: Foxx_rofl_wiso canonical_units: kg m-2 s-1 description: ocean import - water flux due to runoff (liquid) for HDO + water flux due to runoff (liquid) for 16O, 18O, HDO # - standard_name: Foxx_swnet alias: mean_net_sw_flx @@ -2390,6 +1386,7 @@ meridional surface stress # - standard_name: Fioi_swpen_ifrac_n + alias: mean_sw_pen_to_ocn_ifrac_n canonical_units: W m-2 description: ocean import net shortwave radiation penetrating into ice and ocean times ice fraction for thickness category 1 diff --git a/src/drivers/nuopc/cime_flds/glc_elevclass_mod.F90 b/src/drivers/nuopc/cime_flds/glc_elevclass_mod.F90 deleted file mode 100644 index 4df66246564..00000000000 --- a/src/drivers/nuopc/cime_flds/glc_elevclass_mod.F90 +++ /dev/null @@ -1,431 +0,0 @@ -module glc_elevclass_mod - - !--------------------------------------------------------------------- - ! - ! Purpose: - ! - ! This module contains data and routines for operating on GLC elevation classes. - !--------------------------------------------------------------------- - -#include "shr_assert.h" - use med_constants_mod , only : R8 - use shr_sys_mod , only : shr_sys_abort - - implicit none - private - - !-------------------------------------------------------------------------- - ! Public interfaces - !-------------------------------------------------------------------------- - - public :: glc_elevclass_init ! initialize GLC elevation class data - public :: glc_elevclass_clean ! deallocate memory allocated here - public :: glc_get_num_elevation_classes ! get the number of elevation classes - public :: glc_get_elevation_class ! get the elevation class index for a given elevation - public :: glc_get_elevclass_bounds ! get the boundaries of all elevation classes - public :: glc_mean_elevation_virtual ! get the mean elevation of a virtual elevation class - public :: glc_elevclass_as_string ! returns a string corresponding to a given elevation class - public :: glc_all_elevclass_strings ! returns an array of strings for all elevation classes - public :: glc_errcode_to_string ! convert an error code into a string describing the error - - interface glc_elevclass_init - module procedure glc_elevclass_init_default - module procedure glc_elevclass_init_override - end interface glc_elevclass_init - - - !-------------------------------------------------------------------------- - ! Public data - !-------------------------------------------------------------------------- - - ! Possible error code values - integer, parameter, public :: GLC_ELEVCLASS_ERR_NONE = 0 ! err_code indicating no error - integer, parameter, public :: GLC_ELEVCLASS_ERR_UNDEFINED = 1 ! err_code indicating elevation classes have not been defined - integer, parameter, public :: GLC_ELEVCLASS_ERR_TOO_LOW = 2 ! err_code indicating topo below lowest elevation class - integer, parameter, public :: GLC_ELEVCLASS_ERR_TOO_HIGH = 3 ! err_code indicating topo above highest elevation class - - ! String length for glc elevation classes represented as strings - integer, parameter, public :: GLC_ELEVCLASS_STRLEN = 2 - - !-------------------------------------------------------------------------- - ! Private data - !-------------------------------------------------------------------------- - - ! number of elevation classes - integer :: glc_nec - - ! upper elevation limit of each class (m) - ! indexing starts at 0, with topomax(0) giving the lower elevation limit of EC 1 - real(r8), allocatable :: topomax(:) - - -contains - - !----------------------------------------------------------------------- - subroutine glc_elevclass_init_default(my_glc_nec, logunit) - ! - ! !DESCRIPTION: - ! Initialize GLC elevation class data to default boundaries, based on given glc_nec - ! - ! !USES: - ! - ! !ARGUMENTS: - integer, intent(in) :: my_glc_nec ! number of GLC elevation classes - integer, intent(in), optional :: logunit - ! - ! !LOCAL VARIABLES: - character(len=*), parameter :: subname = 'glc_elevclass_init' - !----------------------------------------------------------------------- - - glc_nec = my_glc_nec - allocate(topomax(0:glc_nec)) - - select case (glc_nec) - case(0) - ! do nothing - case(1) - topomax = [0._r8, 10000._r8] - case(3) - topomax = [0._r8, 1000._r8, 2000._r8, 10000._r8] - case(5) - topomax = [0._r8, 500._r8, 1000._r8, 1500._r8, 2000._r8, 10000._r8] - case(10) - topomax = [0._r8, 200._r8, 400._r8, 700._r8, 1000._r8, 1300._r8, & - 1600._r8, 2000._r8, 2500._r8, 3000._r8, 10000._r8] - case(36) - topomax = [ 0._r8, 200._r8, 400._r8, 600._r8, 800._r8, & - 1000._r8, 1200._r8, 1400._r8, 1600._r8, 1800._r8, & - 2000._r8, 2200._r8, 2400._r8, 2600._r8, 2800._r8, & - 3000._r8, 3200._r8, 3400._r8, 3600._r8, 3800._r8, & - 4000._r8, 4200._r8, 4400._r8, 4600._r8, 4800._r8, & - 5000._r8, 5200._r8, 5400._r8, 5600._r8, 5800._r8, & - 6000._r8, 6200._r8, 6400._r8, 6600._r8, 6800._r8, & - 7000._r8, 10000._r8] - case default - if (present(logunit)) then - write(logunit,*) subname,' ERROR: unknown glc_nec: ', glc_nec - end if - call shr_sys_abort(subname//' ERROR: unknown glc_nec') - end select - - end subroutine glc_elevclass_init_default - - !----------------------------------------------------------------------- - subroutine glc_elevclass_init_override(my_glc_nec, my_topomax) - ! - ! !DESCRIPTION: - ! Initialize GLC elevation class data to the given elevation class boundaries. - ! - ! The input, my_topomax, should have (my_glc_nec + 1) elements. - ! - ! !USES: - ! - ! !ARGUMENTS: - integer, intent(in) :: my_glc_nec ! number of GLC elevation classes - real(r8), intent(in) :: my_topomax(0:) ! elevation class boundaries (m) - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'glc_elevclass_init_override' - !----------------------------------------------------------------------- - - SHR_ASSERT_ALL_FL((ubound(my_topomax) == (/my_glc_nec/)), __FILE__, __LINE__) - - glc_nec = my_glc_nec - allocate(topomax(0:glc_nec)) - topomax = my_topomax - - end subroutine glc_elevclass_init_override - - !----------------------------------------------------------------------- - subroutine glc_elevclass_clean() - ! - ! !DESCRIPTION: - ! Deallocate memory allocated in this module - - character(len=*), parameter :: subname = 'glc_elevclass_clean' - !----------------------------------------------------------------------- - - if (allocated(topomax)) then - deallocate(topomax) - end if - glc_nec = 0 - - end subroutine glc_elevclass_clean - - !----------------------------------------------------------------------- - function glc_get_num_elevation_classes() result(num_elevation_classes) - ! - ! !DESCRIPTION: - ! Get the number of GLC elevation classes - ! - ! !ARGUMENTS: - integer :: num_elevation_classes ! function result - integer :: rc - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'glc_get_num_elevation_classes' - !----------------------------------------------------------------------- - - num_elevation_classes = glc_nec - - end function glc_get_num_elevation_classes - - !----------------------------------------------------------------------- - subroutine glc_get_elevation_class(topo, elevation_class, err_code) - ! - ! !DESCRIPTION: - ! Get the elevation class index associated with a given topographic height. - ! - ! The returned elevation_class will be between 1 and num_elevation_classes, if this - ! topographic height is contained in an elevation class. In this case, err_code will - ! be GLC_ELEVCLASS_ERR_NONE (no error). - ! - ! If there are no elevation classes defined, the returned value will be 0, and - ! err_code will be GLC_ELEVCLASS_ERR_UNDEFINED - ! - ! If this topographic height is below the lowest elevation class, the returned value - ! will be 1, and err_code will be GLC_ELEVCLASS_ERR_TOO_LOW. - ! - ! If this topographic height is above the highest elevation class, the returned value - ! will be (num_elevation_classes), and err_code will be GLC_ELEVCLASS_ERR_TOO_HIGH. - ! - ! !USES: - ! - ! !ARGUMENTS: - real(r8), intent(in) :: topo ! topographic height (m) - integer, intent(out) :: elevation_class ! elevation class index - integer, intent(out) :: err_code ! error code (see above for possible codes) - ! - ! !LOCAL VARIABLES: - integer :: ec ! temporary elevation class - - character(len=*), parameter :: subname = 'glc_get_elevation_class' - !----------------------------------------------------------------------- - - if (glc_nec < 1) then - elevation_class = 0 - err_code = GLC_ELEVCLASS_ERR_UNDEFINED - else if (topo < topomax(0)) then - elevation_class = 1 - err_code = GLC_ELEVCLASS_ERR_TOO_LOW - else if (topo >= topomax(glc_nec)) then - elevation_class = glc_nec - err_code = GLC_ELEVCLASS_ERR_TOO_HIGH - else - err_code = GLC_ELEVCLASS_ERR_NONE - elevation_class = 0 - do ec = 1, glc_nec - if (topo >= topomax(ec - 1) .and. topo < topomax(ec)) then - elevation_class = ec - exit - end if - end do - - SHR_ASSERT(elevation_class > 0, subname//' elevation class was not assigned') - end if - - end subroutine glc_get_elevation_class - - !----------------------------------------------------------------------- - function glc_get_elevclass_bounds() result(elevclass_bounds) - ! - ! !DESCRIPTION: - ! Get the boundaries of all elevation classes. - ! - ! This returns an array of size glc_nec+1, since it contains both the lower and upper - ! bounds of each elevation class. - ! - ! !USES: - ! - ! !ARGUMENTS: - real(r8) :: elevclass_bounds(0:glc_nec) ! function result - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'glc_get_elevclass_bounds' - !----------------------------------------------------------------------- - - elevclass_bounds(:) = topomax(:) - - end function glc_get_elevclass_bounds - - - !----------------------------------------------------------------------- - function glc_mean_elevation_virtual(elevation_class, logunit) result(mean_elevation) - ! - ! !DESCRIPTION: - ! Returns the mean elevation of a virtual elevation class - ! - ! !ARGUMENTS: - real(r8) :: mean_elevation ! function result - integer, intent(in) :: elevation_class - integer, optional, intent(in) :: logunit - ! - ! !LOCAL VARIABLES: - integer :: resulting_elevation_class - integer :: err_code - - character(len=*), parameter :: subname = 'glc_mean_elevation_virtual' - !----------------------------------------------------------------------- - - if (elevation_class == 0) then - ! Bare land "elevation class" - mean_elevation = 0._r8 - else - if (elevation_class < glc_nec) then - ! Normal case - mean_elevation = (topomax(elevation_class - 1) + topomax(elevation_class)) / 2._r8 - else if (elevation_class == glc_nec) then - ! In the top elevation class; in this case, assignment of a "mean" elevation is - ! somewhat arbitrary (because we expect the upper bound of the top elevation - ! class to be very high). - - if (glc_nec > 1) then - mean_elevation = 2._r8 * topomax(elevation_class - 1) - topomax(elevation_class - 2) - else - ! entirely arbitrary - mean_elevation = 1000._r8 - end if - else - if (present(logunit)) then - write(logunit,*) subname,' ERROR: elevation class out of bounds: ', elevation_class - end if - call shr_sys_abort(subname // ' ERROR: elevation class out of bounds') - end if - end if - - ! Ensure that the resulting elevation is within the given elevation class - if (elevation_class > 0) then - call glc_get_elevation_class(mean_elevation, resulting_elevation_class, err_code) - if (err_code /= GLC_ELEVCLASS_ERR_NONE) then - if (present(logunit)) then - write(logunit,*) subname, ' ERROR: generated elevation that results in an error' - write(logunit,*) 'when trying to determine the resulting elevation class' - write(logunit,*) glc_errcode_to_string(err_code) - write(logunit,*) 'elevation_class, mean_elevation = ', elevation_class, mean_elevation - end if - call shr_sys_abort(subname // ' ERROR: generated elevation that results in an error') - else if (resulting_elevation_class /= elevation_class) then - if (present(logunit)) then - write(logunit,*) subname, ' ERROR: generated elevation outside the given elevation class' - write(logunit,*) 'elevation_class, mean_elevation, resulting_elevation_class = ', & - elevation_class, mean_elevation, resulting_elevation_class - end if - call shr_sys_abort(subname // ' ERROR: generated elevation outside the given elevation class') - end if - end if - - end function glc_mean_elevation_virtual - - - !----------------------------------------------------------------------- - function glc_elevclass_as_string(elevation_class) result(ec_string) - ! - ! !DESCRIPTION: - ! Returns a string corresponding to a given elevation class. - ! - ! This string can be used as a suffix for fields in MCT attribute vectors. - ! - ! ! NOTE(wjs, 2015-01-19) This function doesn't fully belong in this module, since it - ! doesn't refer to the data stored in this module. However, I can't think of a more - ! appropriate place for it. - ! - ! !USES: - ! - ! !ARGUMENTS: - character(len=GLC_ELEVCLASS_STRLEN) :: ec_string ! function result - integer, intent(in) :: elevation_class - ! - ! !LOCAL VARIABLES: - character(len=16) :: format_string - - character(len=*), parameter :: subname = 'glc_elevclass_as_string' - !----------------------------------------------------------------------- - - ! e.g., for GLC_ELEVCLASS_STRLEN = 2, format_string will be '(i2.2)' - write(format_string,'(a,i0,a,i0,a)') '(i', GLC_ELEVCLASS_STRLEN, '.', GLC_ELEVCLASS_STRLEN, ')' - - write(ec_string,trim(format_string)) elevation_class - end function glc_elevclass_as_string - - !----------------------------------------------------------------------- - function glc_all_elevclass_strings(include_zero) result(ec_strings) - ! - ! !DESCRIPTION: - ! Returns an array of strings corresponding to all elevation classes from 1 to glc_nec - ! - ! If include_zero is present and true, then includes elevation class 0 - so goes from - ! 0 to glc_nec - ! - ! These strings can be used as suffixes for fields in MCT attribute vectors. - ! - ! !USES: - ! - ! !ARGUMENTS: - character(len=GLC_ELEVCLASS_STRLEN), allocatable :: ec_strings(:) ! function result - logical, intent(in), optional :: include_zero ! if present and true, include elevation class 0 (default is false) - ! - ! !LOCAL VARIABLES: - logical :: l_include_zero ! local version of optional include_zero argument - integer :: lower_bound - integer :: i - - character(len=*), parameter :: subname = 'glc_all_elevclass_strings' - !----------------------------------------------------------------------- - - if (present(include_zero)) then - l_include_zero = include_zero - else - l_include_zero = .false. - end if - - if (l_include_zero) then - lower_bound = 0 - else - lower_bound = 1 - end if - - allocate(ec_strings(lower_bound:glc_nec)) - do i = lower_bound, glc_nec - ec_strings(i) = glc_elevclass_as_string(i) - end do - - end function glc_all_elevclass_strings - - - !----------------------------------------------------------------------- - function glc_errcode_to_string(err_code) result(err_string) - ! - ! !DESCRIPTION: - ! - ! - ! !USES: - ! - ! !ARGUMENTS: - character(len=256) :: err_string ! function result - integer, intent(in) :: err_code ! error code (one of the GLC_ELEVCLASS_ERR* values) - ! - ! !LOCAL VARIABLES: - - character(len=*), parameter :: subname = 'glc_errcode_to_string' - !----------------------------------------------------------------------- - - select case (err_code) - case (GLC_ELEVCLASS_ERR_NONE) - err_string = '(no error)' - case (GLC_ELEVCLASS_ERR_UNDEFINED) - err_string = 'Elevation classes have not yet been defined' - case (GLC_ELEVCLASS_ERR_TOO_LOW) - err_string = 'Topographic height below the lower bound of the lowest elevation class' - case (GLC_ELEVCLASS_ERR_TOO_HIGH) - err_string = 'Topographic height above the upper bound of the highest elevation class' - case default - err_string = 'UNKNOWN ERROR' - end select - - end function glc_errcode_to_string - -end module glc_elevclass_mod - diff --git a/src/drivers/nuopc/cime_flds/seq_drydep_mod.F90 b/src/drivers/nuopc/cime_flds/seq_drydep_mod.F90 deleted file mode 100644 index 225b561c91f..00000000000 --- a/src/drivers/nuopc/cime_flds/seq_drydep_mod.F90 +++ /dev/null @@ -1,923 +0,0 @@ -module seq_drydep_mod - - !======================================================================== - ! Module for handling dry depostion of tracers. - ! This module is shared by land and atmosphere models for the computations of - ! dry deposition of tracers - ! - ! !REVISION HISTORY: - ! 2008-Nov-12 - F. Vitt - creation. - ! 2009-Feb-19 - E. Kluzek - merge shr_drydep_tables module in. - ! 2009-Feb-20 - E. Kluzek - use shr_ coding standards, and check for namelist file. - ! 2009-Feb-20 - E. Kluzek - Put _r8 on all constants, remove namelist read out. - ! 2009-Mar-23 - F. Vitt - Some corrections/cleanup and addition of drydep_method. - ! 2009-Mar-27 - E. Kluzek - Get description and units from J.F. Lamarque. - !======================================================================== - - ! !USES: - - use shr_sys_mod, only : shr_sys_abort - use shr_log_mod, only : s_loglev => shr_log_Level - use shr_kind_mod, only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX - use shr_const_mod, only : SHR_CONST_G, SHR_CONST_RDAIR, & - SHR_CONST_CPDAIR, SHR_CONST_MWWV - - implicit none - save - - private - - ! !PUBLIC MEMBER FUNCTIONS - - public :: seq_drydep_readnl ! Read namelist - public :: seq_drydep_init ! Initialization of drydep data - public :: seq_drydep_setHCoeff ! Calculate Henry's law coefficients - - ! !PRIVATE ARRAY SIZES - - integer, private, parameter :: maxspc = 100 ! Maximum number of species - integer, public, parameter :: n_species_table = 77 ! Number of species to work with - integer, private, parameter :: NSeas = 5 ! Number of seasons - integer, private, parameter :: NLUse = 11 ! Number of land-use types - - ! !PUBLIC DATA MEMBERS: - - ! method specification - character(16),public,parameter :: DD_XATM = 'xactive_atm'! dry-dep atmosphere - character(16),public,parameter :: DD_XLND = 'xactive_lnd'! dry-dep land - character(16),public,parameter :: DD_TABL = 'table' ! dry-dep table (atm and lnd) - character(16),public :: drydep_method = DD_XLND ! Which option choosen - - real(r8), public, parameter :: ph = 1.e-5_r8 ! measure of the acidity (dimensionless) - - logical, public :: lnd_drydep ! If dry-dep fields passed - integer, public :: n_drydep = 0 ! Number in drypdep list - character(len=CS), public, dimension(maxspc) :: drydep_list = '' ! List of dry-dep species - - character(len=CS), public :: drydep_fields_token = '' ! First drydep fields token - - real(r8), public, allocatable, dimension(:) :: foxd ! reactivity factor for oxidation (dimensioness) - real(r8), public, allocatable, dimension(:) :: drat ! ratio of molecular diffusivity (D_H2O/D_species; dimensionless) - integer, public, allocatable, dimension(:) :: mapping ! mapping to species table - ! --- Indices for each species --- - integer, public :: h2_ndx, ch4_ndx, co_ndx, pan_ndx, mpan_ndx, so2_ndx, o3_ndx, o3a_ndx, xpan_ndx - - !--------------------------------------------------------------------------- - ! Table 1 from Wesely, Atmos. Environment, 1989, p1293 - ! Table 2 from Sheih, microfiche PB86-218104 and Walcek, Atmos. Environment, 1986, p949 - ! Table 3-5 compiled by P. Hess - ! - ! index #1 : season - ! 1 -> midsummer with lush vegetation - ! 2 -> autumn with unharvested cropland - ! 3 -> late autumn after frost, no snow - ! 4 -> winter, snow on ground, and subfreezing - ! 5 -> transitional spring with partially green short annuals - ! - ! index #2 : landuse type - ! 1 -> urban land - ! 2 -> agricultural land - ! 3 -> range land - ! 4 -> deciduous forest - ! 5 -> coniferous forest - ! 6 -> mixed forest including wetland - ! 7 -> water, both salt and fresh - ! 8 -> barren land, mostly desert - ! 9 -> nonforested wetland - ! 10 -> mixed agricultural and range land - ! 11 -> rocky open areas with low growing shrubs - ! - ! JFL August 2000 - !--------------------------------------------------------------------------- - - !--------------------------------------------------------------------------- - ! table to parameterize the impact of soil moisture on the deposition of H2 and - ! CO on soils (from Sanderson et al., J. Atmos. Chem., 46, 15-28, 2003). - !--------------------------------------------------------------------------- - - !--- deposition of h2 and CO on soils --- - real(r8), parameter, public :: h2_a(NLUse) = & - (/ 0.000_r8, 0.000_r8, 0.270_r8, 0.000_r8, 0.000_r8, & - 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8, 0.000_r8/) - !--- deposition of h2 and CO on soils --- - real(r8), parameter, public :: h2_b(NLUse) = & - (/ 0.000_r8,-41.390_r8, -0.472_r8,-41.900_r8,-41.900_r8, & - -41.900_r8, 0.000_r8, 0.000_r8, 0.000_r8,-41.390_r8, 0.000_r8/) - !--- deposition of h2 and CO on soils --- - real(r8), parameter, public :: h2_c(NLUse) = & - (/ 0.000_r8, 16.850_r8, 1.235_r8, 19.700_r8, 19.700_r8, & - 19.700_r8, 0.000_r8, 0.000_r8, 0.000_r8, 17.700_r8, 1.000_r8/) - - !--- deposition of h2 and CO on soils - ! - !--- ri: Richardson number (dimensionless) - !--- rlu: Resistance of leaves in upper canopy (s.m-1) - !--- rac: Aerodynamic resistance to lower canopy (s.m-1) - !--- rgss: Ground surface resistance for SO2 (s.m-1) - !--- rgso: Ground surface resistance for O3 (s.m-1) - !--- rcls: Lower canopy resistance for SO2 (s.m-1) - !--- rclo: Lower canopy resistance for O3 (s.m-1) - ! - real(r8), public, dimension(NSeas,NLUse) :: ri, rlu, rac, rgss, rgso, rcls, rclo - - data ri (1,1:NLUse) & - /1.e36_r8, 60._r8, 120._r8, 70._r8, 130._r8, 100._r8,1.e36_r8,1.e36_r8, 80._r8, 100._r8, 150._r8/ - data rlu (1,1:NLUse) & - /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ - data rac (1,1:NLUse) & - / 100._r8, 200._r8, 100._r8,2000._r8,2000._r8,2000._r8, 0._r8, 0._r8, 300._r8, 150._r8, 200._r8/ - data rgss(1,1:NLUse) & - / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 220._r8, 400._r8/ - data rgso(1,1:NLUse) & - / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ - data rcls(1,1:NLUse) & - /1.e36_r8,2000._r8,2000._r8,2000._r8,2000._r8,2000._r8,1.e36_r8,1.e36_r8,2500._r8,2000._r8,4000._r8/ - data rclo(1,1:NLUse) & - /1.e36_r8,1000._r8,1000._r8,1000._r8,1000._r8,1000._r8,1.e36_r8,1.e36_r8,1000._r8,1000._r8,1000._r8/ - - data ri (2,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ - data rlu (2,1:NLUse) & - /1.e36_r8,9000._r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rac (2,1:NLUse) & - / 100._r8, 150._r8, 100._r8,1500._r8,2000._r8,1700._r8, 0._r8, 0._r8, 200._r8, 120._r8, 140._r8/ - data rgss(2,1:NLUse) & - / 400._r8, 200._r8, 350._r8, 500._r8, 500._r8, 100._r8, 0._r8,1000._r8, 0._r8, 300._r8, 400._r8/ - data rgso(2,1:NLUse) & - / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8, 800._r8, 180._r8, 200._r8/ - data rcls(2,1:NLUse) & - /1.e36_r8,9000._r8,9000._r8,9000._r8,2000._r8,4000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rclo(2,1:NLUse) & - /1.e36_r8, 400._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 400._r8, 400._r8, 400._r8/ - - data ri (3,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 250._r8, 500._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ - data rlu (3,1:NLUse) & - /1.e36_r8,1.e36_r8,9000._r8,9000._r8,4000._r8,8000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rac (3,1:NLUse) & - / 100._r8, 10._r8, 100._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 100._r8, 50._r8, 120._r8/ - data rgss(3,1:NLUse) & - / 400._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 200._r8, 400._r8/ - data rgso(3,1:NLUse) & - / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ - data rcls(3,1:NLUse) & - /1.e36_r8,1.e36_r8,9000._r8,9000._r8,3000._r8,6000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rclo(3,1:NLUse) & - /1.e36_r8,1000._r8, 400._r8, 400._r8,1000._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8, 600._r8, 600._r8/ - - data ri (4,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8, 400._r8, 800._r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8/ - data rlu (4,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,1.e36_r8,6000._r8,9000._r8,1.e36_r8,1.e36_r8,9000._r8,9000._r8,9000._r8/ - data rac (4,1:NLUse) & - / 100._r8, 10._r8, 10._r8,1000._r8,2000._r8,1500._r8, 0._r8, 0._r8, 50._r8, 10._r8, 50._r8/ - data rgss(4,1:NLUse) & - / 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 100._r8, 0._r8,1000._r8, 100._r8, 100._r8, 50._r8/ - data rgso(4,1:NLUse) & - / 600._r8,3500._r8,3500._r8,3500._r8,3500._r8,3500._r8,2000._r8, 400._r8,3500._r8,3500._r8,3500._r8/ - data rcls(4,1:NLUse) & - /1.e36_r8,1.e36_r8,1.e36_r8,9000._r8, 200._r8, 400._r8,1.e36_r8,1.e36_r8,9000._r8,1.e36_r8,9000._r8/ - data rclo(4,1:NLUse) & - /1.e36_r8,1000._r8,1000._r8, 400._r8,1500._r8, 600._r8,1.e36_r8,1.e36_r8, 800._r8,1000._r8, 800._r8/ - - data ri (5,1:NLUse) & - /1.e36_r8, 120._r8, 240._r8, 140._r8, 250._r8, 190._r8,1.e36_r8,1.e36_r8, 160._r8, 200._r8, 300._r8/ - data rlu (5,1:NLUse) & - /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ - data rac (5,1:NLUse) & - / 100._r8, 50._r8, 80._r8,1200._r8,2000._r8,1500._r8, 0._r8, 0._r8, 200._r8, 60._r8, 120._r8/ - data rgss(5,1:NLUse) & - / 500._r8, 150._r8, 350._r8, 500._r8, 500._r8, 200._r8, 0._r8,1000._r8, 0._r8, 250._r8, 400._r8/ - data rgso(5,1:NLUse) & - / 300._r8, 150._r8, 200._r8, 200._r8, 200._r8, 300._r8,2000._r8, 400._r8,1000._r8, 180._r8, 200._r8/ - data rcls(5,1:NLUse) & - /1.e36_r8,4000._r8,4000._r8,4000._r8,2000._r8,3000._r8,1.e36_r8,1.e36_r8,4000._r8,4000._r8,8000._r8/ - data rclo(5,1:NLUse) & - /1.e36_r8,1000._r8, 500._r8, 500._r8,1500._r8, 700._r8,1.e36_r8,1.e36_r8, 600._r8, 800._r8, 800._r8/ - - !--------------------------------------------------------------------------- - ! ... roughness length - !--------------------------------------------------------------------------- - real(r8), public, dimension(NSeas,NLUse) :: z0 - - data z0 (1,1:NLUse) & - /1.000_r8,0.250_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.150_r8,0.100_r8,0.100_r8/ - data z0 (2,1:NLUse) & - /1.000_r8,0.100_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.080_r8,0.080_r8/ - data z0 (3,1:NLUse) & - /1.000_r8,0.005_r8,0.050_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.100_r8,0.020_r8,0.060_r8/ - data z0 (4,1:NLUse) & - /1.000_r8,0.001_r8,0.001_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.001_r8,0.001_r8,0.040_r8/ - data z0 (5,1:NLUse) & - /1.000_r8,0.030_r8,0.020_r8,1.000_r8,1.000_r8,1.000_r8,0.0006_r8,0.002_r8,0.010_r8,0.030_r8,0.060_r8/ - - !real(r8), private, dimension(11,5), parameter :: z0xxx = reshape ( & - ! (/ 1.000,0.250,0.050,1.000,1.000,1.000,0.0006,0.002,0.150,0.100,0.100 , & - ! 1.000,0.100,0.050,1.000,1.000,1.000,0.0006,0.002,0.100,0.080,0.080 , & - ! 1.000,0.005,0.050,1.000,1.000,1.000,0.0006,0.002,0.100,0.020,0.060 , & - ! 1.000,0.001,0.001,1.000,1.000,1.000,0.0006,0.002,0.001,0.001,0.040 , & - ! 1.000,0.030,0.020,1.000,1.000,1.000,0.0006,0.002,0.010,0.030,0.060 /), (/11,5/) ) - - !--------------------------------------------------------------------------- - ! public chemical data - !--------------------------------------------------------------------------- - - !--- data for foxd (reactivity factor for oxidation) ---- - real(r8), public, parameter :: dfoxd(n_species_table) = & - (/ 1._r8 & - ,1._r8 & - ,1._r8 & - ,.1_r8 & - ,1.e-36_r8 & - ,1.e-36_r8 & - ,1._r8 & - ,.1_r8 & - ,1.e-36_r8 & - ,0._r8 & - ,0._r8 & - ,.1_r8 & - ,1.e-36_r8 & - ,1.e-36_r8 & - ,1.e-36_r8 & - ,.1_r8 & - ,1._r8 & - ,1.e-36_r8 & - ,.1_r8 & - ,1._r8 & - ,1.e-36_r8 & - ,.1_r8 & - ,.1_r8 & - ,.1_r8 & - ,.1_r8 & - ,1.e-36_r8 & - ,1.e-36_r8 & - ,.1_r8 & - ,1.e-36_r8 & - ,.1_r8 & - ,1.e-36_r8 & - ,.1_r8 & - ,.1_r8 & - ,1.e-36_r8 & - ,1.e-36_r8 & - ,1.e-36_r8 & - ,1.e-36_r8 & - ,.1_r8 & - ,1.e-36_r8 & - ,.1_r8 & - ,1.e-36_r8 & - ,.1_r8 & - ,.1_r8 & - ,.1_r8 & - ,1.e-36_r8 & - ,1.e-36_r8 & - ,1.e-36_r8 & - ,1.e-36_r8 & - ,1.e-36_r8 & - ,.1_r8 & - ,.1_r8 & - ,.1_r8 & - ,1.e-36_r8 & - ,1.e-36_r8 & ! HCN - ,1.e-36_r8 & ! CH3CN - ,1.e-36_r8 & ! SO2 - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - ,0.1_r8 & - /) - - ! PRIVATE DATA: - - Interface seq_drydep_setHCoeff ! overload subroutine - Module Procedure set_hcoeff_scalar - Module Procedure set_hcoeff_vector - End Interface - - real(r8), private, parameter :: small_value = 1.e-36_r8 !--- smallest value to use --- - - !--------------------------------------------------------------------------- - ! private chemical data - !--------------------------------------------------------------------------- - - !--- Names of species that can work with --- - character(len=20), public, parameter :: species_name_table(n_species_table) = & - (/ 'OX ' & - ,'H2O2 ' & - ,'OH ' & - ,'HO2 ' & - ,'CO ' & - ,'CH4 ' & - ,'CH3O2 ' & - ,'CH3OOH ' & - ,'CH2O ' & - ,'CHOOH ' & - ,'NO ' & - ,'NO2 ' & - ,'HNO3 ' & - ,'CO2 ' & - ,'NH3 ' & - ,'N2O5 ' & - ,'NO3 ' & - ,'CH3OH ' & - ,'HO2NO2 ' & - ,'O1D ' & - ,'C2H6 ' & - ,'C2H5O2 ' & - ,'PO2 ' & - ,'MACRO2 ' & - ,'ISOPO2 ' & - ,'C4H10 ' & - ,'CH3CHO ' & - ,'C2H5OOH ' & - ,'C3H6 ' & - ,'POOH ' & - ,'C2H4 ' & - ,'PAN ' & - ,'CH3COOOH' & - ,'C10H16 ' & - ,'CHOCHO ' & - ,'CH3COCHO' & - ,'GLYALD ' & - ,'CH3CO3 ' & - ,'C3H8 ' & - ,'C3H7O2 ' & - ,'CH3COCH3' & - ,'C3H7OOH ' & - ,'RO2 ' & - ,'ROOH ' & - ,'Rn ' & - ,'ISOP ' & - ,'MVK ' & - ,'MACR ' & - ,'C2H5OH ' & - ,'ONITR ' & - ,'ONIT ' & - ,'ISOPNO3 ' & - ,'HYDRALD ' & - ,'HCN ' & - ,'CH3CN ' & - ,'SO2 ' & - ,'SOAGff0 ' & - ,'SOAGff1 ' & - ,'SOAGff2 ' & - ,'SOAGff3 ' & - ,'SOAGff4 ' & - ,'SOAGbg0 ' & - ,'SOAGbg1 ' & - ,'SOAGbg2 ' & - ,'SOAGbg3 ' & - ,'SOAGbg4 ' & - ,'SOAG0 ' & - ,'SOAG1 ' & - ,'SOAG2 ' & - ,'SOAG3 ' & - ,'SOAG4 ' & - ,'IVOC ' & - ,'SVOC ' & - ,'IVOCbb ' & - ,'IVOCff ' & - ,'SVOCbb ' & - ,'SVOCff ' & - /) - - !--- data for effective Henry's Law coefficient --- - real(r8), public, parameter :: dheff(n_species_table*6) = & - (/1.15e-02_r8, 2560._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,8.33e+04_r8, 7379._r8,2.2e-12_r8,-3730._r8,0._r8 , 0._r8 & - ,3.00e+01_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,2.00e+03_r8, 6600._r8,3.5e-05_r8, 0._r8,0._r8 , 0._r8 & - ,1.00e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,7.47e+00_r8, 5241._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,3.11e+02_r8, 5241._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,6.30e+03_r8, 6425._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,5.53e+03_r8, 5700._r8,1.8e-04_r8,-1510._r8,0._r8 , 0._r8 & - ,1.90e-03_r8, 1480._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,6.40e-03_r8, 2500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,0._r8 , 0._r8,2.6e+06_r8, 8700._r8,0._r8 , 0._r8 & - ,3.40e-02_r8, 2420._r8,4.5e-07_r8,-1000._r8,3.6e-11_r8,-1760._r8 & - ,7.40e+01_r8, 3400._r8,1.7e-05_r8, -450._r8,1.0e-14_r8,-6716._r8 & - ,2.14e+00_r8, 3362._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,0.65e+00_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,2.20e+02_r8, 4934._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,0._r8 , 0._r8,3.2e+01_r8, 0._r8,0._r8 , 0._r8 & - ,1.00e-16_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,7.47e+00_r8, 5241._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,7.47e+00_r8, 5241._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,7.47e+00_r8, 5241._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,7.47e+00_r8, 5241._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.14e+01_r8, 6267._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,2.20e+02_r8, 5653._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,5.00e+00_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,8.37e+02_r8, 5308._r8,1.8e-04_r8,-1510._r8,0._r8 , 0._r8 & - ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,3.00e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,3.71e+03_r8, 7541._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,4.14e+04_r8, 4630._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,7.47e+00_r8, 5241._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.45e-03_r8, 2700._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,3.00e+06_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,2.70e+01_r8, 5300._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,7.47e+00_r8, 5241._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,3.36e+02_r8, 5995._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,0.00e+00_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.70e-03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,2.00e+02_r8, 6500._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,7.51e+03_r8, 6485._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.00e+03_r8, 6000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.00e+01_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,7.00e+01_r8, 6000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.20e+01_r8, 5000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,5.00e+01_r8, 4000._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.23e+00_r8, 3120._r8,1.23e-02_r8,1960._r8,0._r8 , 0._r8 & - ,1.3e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,3.2e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,4.0e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.3e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.6e+05_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,7.9e+11_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,6.3e+10_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,3.2e+09_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,6.3e+08_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,3.2e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,4.0e+11_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,3.2e+10_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.6e+09_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,3.2e+08_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.6e+07_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - ,1.e+03_r8, 0._r8,0._r8 , 0._r8,0._r8 , 0._r8 & - /) - - real(r8), private, parameter :: wh2o = SHR_CONST_MWWV - real(r8), private, parameter :: mol_wgts(n_species_table) = & - (/ 47.9981995_r8, 34.0135994_r8, 17.0067997_r8, 33.0061989_r8, 28.0104008_r8, & - 16.0405998_r8, 47.0320015_r8, 48.0393982_r8, 30.0251999_r8, 46.0246010_r8, & - 30.0061398_r8, 46.0055389_r8, 63.0123405_r8, 44.0098000_r8, 17.0289402_r8, & - 108.010483_r8, 62.0049400_r8, 32.0400009_r8, 79.0117416_r8, 15.9994001_r8, & - 30.0664005_r8, 61.0578003_r8, 91.0830002_r8, 119.093399_r8, 117.119797_r8, & - 58.1180000_r8, 44.0509987_r8, 62.0652008_r8, 42.0774002_r8, 92.0904007_r8, & - 28.0515995_r8, 121.047943_r8, 76.0497971_r8, 136.228394_r8, 58.0355988_r8, & - 72.0614014_r8, 60.0503998_r8, 75.0423965_r8, 44.0922012_r8, 75.0836029_r8, & - 58.0768013_r8, 76.0910034_r8, 31.9988003_r8, 33.0061989_r8, 222.000000_r8, & - 68.1141968_r8, 70.0877991_r8, 70.0877991_r8, 46.0657997_r8, 147.125946_r8, & - 119.074341_r8, 162.117935_r8, 100.112999_r8, 27.0256_r8 , 41.0524_r8 , & - 64.064800_r8, 250._r8, 250._r8, 250._r8, 250._r8, & - 250._r8, 250._r8, 250._r8, 250._r8, 250._r8, & - 250._r8, 250._r8, 250._r8, 250._r8, 250._r8, & - 250._r8, 170.3_r8, 170.3_r8, 170.3_r8, 170.3_r8, & - 170.3_r8, 170.3_r8 /) - - -!=============================================================================== -CONTAINS -!=============================================================================== - -!==================================================================================== - - subroutine seq_drydep_readnl(NLFilename, seq_drydep_fields, seq_drydep_nflds) - - !======================================================================== - ! reads drydep_inparm namelist and sets up CCSM driver list of fields for - ! land-atmosphere communications. - ! - ! !REVISION HISTORY: - ! 2009-Feb-20 - E. Kluzek - Separate out as subroutine from previous input_init - !======================================================================== - use ESMF, only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast - use shr_file_mod,only : shr_file_getUnit, shr_file_freeUnit - use shr_log_mod, only : s_logunit => shr_log_Unit - use shr_mpi_mod, only : shr_mpi_bcast - use shr_nl_mod, only : shr_nl_find_group_name - implicit none - - character(len=*), intent(in) :: NLFilename ! Namelist filename - character(len=*), intent(out) :: seq_drydep_fields - integer, intent(out) :: seq_drydep_nflds - !----- local ----- - integer :: i ! Indices - integer :: unitn ! namelist unit number - integer :: ierr ! error code - logical :: exists ! if file exists or not - character(len=8) :: token ! dry dep field name to add - type(ESMF_VM) :: vm - integer :: localPet - integer :: tmp(1) - integer :: rc - !----- formats ----- - character(*),parameter :: subName = '(seq_drydep_read) ' - character(*),parameter :: F00 = "('(seq_drydep_read) ',8a)" - character(*),parameter :: FI1 = "('(seq_drydep_init) ',a,I2)" - - namelist /drydep_inparm/ drydep_list, drydep_method - - !----------------------------------------------------------------------------- - ! Read namelist and figure out the drydep field list to pass - ! First check if file exists and if not, n_drydep will be zero - !----------------------------------------------------------------------------- - - !--- Open and read namelist --- - if ( len_trim(NLFilename) == 0 )then - call shr_sys_abort( subName//'ERROR: nlfilename not set' ) - end if - call ESMF_VMGetCurrent(vm, rc=rc) - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - seq_drydep_nflds=0 - if (localPet==0) then - inquire( file=trim(NLFileName), exist=exists) - if ( exists ) then - unitn = shr_file_getUnit() - open( unitn, file=trim(NLFilename), status='old' ) - if ( s_loglev > 0 ) write(s_logunit,F00) & - 'Read in drydep_inparm namelist from: ', trim(NLFilename) - call shr_nl_find_group_name(unitn, 'drydep_inparm', ierr) - if (ierr == 0) then - ierr = 1 - do while ( ierr /= 0 ) - read(unitn, drydep_inparm, iostat=ierr) - if (ierr < 0) then - call shr_sys_abort( subName//'ERROR: encountered end-of-file on namelist read' ) - endif - end do - else - write(s_logunit,*) 'seq_drydep_read: no drydep_inparm namelist found in ',NLFilename - endif - close( unitn ) - call shr_file_freeUnit( unitn ) - do i=1,maxspc - if(len_trim(drydep_list(i)) > 0) then - seq_drydep_nflds=seq_drydep_nflds+1 - endif - enddo - - end if - end if - tmp = seq_drydep_nflds - call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc) - seq_drydep_nflds = tmp(1) - if(seq_drydep_nflds > 0) then - call ESMF_VMBroadcast(vm, drydep_list, CS*seq_drydep_nflds, 0, rc=rc) - call ESMF_VMBroadcast(vm, drydep_method, 16, 0, rc=rc) - endif - - !--- Loop over species to fill list of fields to communicate for drydep --- - seq_drydep_fields = ' ' - do i=1,seq_drydep_nflds - write(token,333) i - seq_drydep_fields = trim(seq_drydep_fields)//':'//trim(token) - if ( i == 1 ) then - seq_drydep_fields = trim(token) - drydep_fields_token = trim(token) - endif - enddo - - !--- Make sure method is valid and determine if land is passing drydep fields --- - lnd_drydep = seq_drydep_nflds>0 .and. drydep_method == DD_XLND - - if (localpet==0) then - if ( s_loglev > 0 ) then - write(s_logunit,*) 'seq_drydep_read: drydep_method: ', trim(drydep_method) - if ( seq_drydep_nflds == 0 )then - write(s_logunit,F00) 'No dry deposition fields will be transfered' - else - write(s_logunit,FI1) 'Number of dry deposition fields transfered is ', seq_drydep_nflds - end if - end if - end if - - if ( trim(drydep_method)/=trim(DD_XATM) .and. & - trim(drydep_method)/=trim(DD_XLND) .and. & - trim(drydep_method)/=trim(DD_TABL) ) then - if ( s_loglev > 0 ) then - write(s_logunit,*) 'seq_drydep_read: drydep_method : ', trim(drydep_method) - write(s_logunit,*) 'seq_drydep_read: drydep_method must be set to : ', & - DD_XATM,', ', DD_XLND,', or ', DD_TABL - end if - call shr_sys_abort('seq_drydep_read: incorrect dry deposition method specification') - endif - - ! Need to explicitly add Sl_ based on naming convention -333 format ('Sl_dd',i3.3) - - end subroutine seq_drydep_readnl - -!==================================================================================== - - subroutine seq_drydep_init( ) - - !======================================================================== - ! Initialization of dry deposition fields - ! reads drydep_inparm namelist and sets up CCSM driver list of fields for - ! land-atmosphere communications. - ! !REVISION HISTORY: - ! 2008-Nov-12 - F. Vitt - first version - ! 2009-Feb-20 - E. Kluzek - Check for existance of file if not return, set n_drydep=0 - ! 2009-Feb-20 - E. Kluzek - Move namelist read to separate subroutine - !======================================================================== - - use shr_log_mod, only : s_logunit => shr_log_Unit - use shr_infnan_mod, only: shr_infnan_posinf, assignment(=) - - implicit none - - !----- local ----- - integer :: i, l ! Indices - character(len=32) :: test_name ! field test name - !----- formats ----- - character(*),parameter :: subName = '(seq_drydep_init) ' - character(*),parameter :: F00 = "('(seq_drydep_init) ',8a)" - - !----------------------------------------------------------------------------- - ! Allocate and fill foxd, drat and mapping as well as species indices - !----------------------------------------------------------------------------- - - if ( n_drydep > 0 ) then - - allocate( foxd(n_drydep) ) - allocate( drat(n_drydep) ) - allocate( mapping(n_drydep) ) - - ! This initializes these variables to infinity. - foxd = shr_infnan_posinf - drat = shr_infnan_posinf - - mapping(:) = 0 - - end if - - h2_ndx=-1; ch4_ndx=-1; co_ndx=-1; mpan_ndx = -1; pan_ndx = -1; so2_ndx=-1; o3_ndx=-1; xpan_ndx=-1 - - !--- Loop over drydep species that need to be worked with --- - do i=1,n_drydep - if ( len_trim(drydep_list(i))==0 ) exit - - test_name = drydep_list(i) - - if( trim(test_name) == 'O3' ) then - test_name = 'OX' - end if - - !--- Figure out if species maps to a species in the species table --- - do l = 1,n_species_table - if( trim( test_name ) == trim( species_name_table(l) ) ) then - mapping(i) = l - exit - end if - end do - - !--- If it doesn't map to a species in the species table find species close enough --- - if( mapping(i) < 1 ) then - select case( trim(test_name) ) - case( 'H2' ) - test_name = 'CO' - case( 'HYAC', 'CH3COOH', 'EOOH', 'IEPOX' ) - test_name = 'CH2O' - case( 'O3S', 'O3INERT', 'MPAN' ) - test_name = 'OX' - case( 'ISOPOOH', 'MACROOH', 'Pb', 'XOOH', 'H2SO4' ) - test_name = 'HNO3' - case( 'ALKOOH', 'MEKOOH', 'TOLOOH', 'BENOOH', 'XYLOOH', 'SOGM','SOGI','SOGT','SOGB','SOGX' ) - test_name = 'CH3OOH' - case( 'SOA', 'SO4', 'CB1', 'CB2', 'OC1', 'OC2', 'NH3', 'NH4', 'SA1', 'SA2', 'SA3', 'SA4','HCN','CH3CN','HCOOH' ) - test_name = 'OX' ! this is just a place holder. values are explicitly set below - case( 'SOAM', 'SOAI', 'SOAT', 'SOAB', 'SOAX' ) - test_name = 'OX' ! this is just a place holder. values are explicitly set below - case( 'SOAGbb0' ) - test_name = 'SOAGff0' - case( 'SOAGbb1' ) - test_name = 'SOAGff1' - case( 'SOAGbb2' ) - test_name = 'SOAGff2' - case( 'SOAGbb3' ) - test_name = 'SOAGff3' - case( 'SOAGbb4' ) - test_name = 'SOAGff4' - case( 'NOA', 'ALKNIT', 'ISOPNITA', 'ISOPNITB', 'HONITR', 'ISOPNOOH', 'NC4CHO', 'NC4CH2OH', 'TERPNIT', 'NTERPOOH' ) - test_name = 'H2O2' - case( 'PHENOOH', 'BENZOOH', 'C6H5OOH', 'BZOOH', 'XYLOLOOH', 'XYLENOOH', 'HPALD' ) - test_name = 'CH3OOH' - case( 'TERPOOH', 'TERP2OOH', 'MBOOOH' ) - test_name = 'HNO3' - case( 'TERPROD1', 'TERPROD2' ) - test_name = 'CH2O' - case( 'HMPROP' ) - test_name = 'GLYALD' - case( 'O3A', 'XMPAN' ) - test_name = 'OX' - case( 'XPAN' ) - test_name = 'PAN' - case( 'XNO' ) - test_name = 'NO' - case( 'XNO2' ) - test_name = 'NO2' - case( 'XHNO3' ) - test_name = 'HNO3' - case( 'XONIT' ) - test_name = 'ONIT' - case( 'XONITR' ) - test_name = 'ONITR' - case( 'XHO2NO2') - test_name = 'HO2NO2' - case( 'XNH4NO3' ) - test_name = 'HNO3' - case( 'COhc','COme') - test_name = 'CO' ! this is just a place holder. values are set in drydep_fromlnd - case( 'CO01','CO02','CO03','CO04','CO05','CO06','CO07','CO08','CO09','CO10' ) - test_name = 'CO' ! this is just a place holder. values are set in drydep_fromlnd - case( 'CO11','CO12','CO13','CO14','CO15','CO16','CO17','CO18','CO19','CO20' ) - test_name = 'CO' ! this is just a place holder. values are set in drydep_fromlnd - case( 'CO21','CO22','CO23','CO24','CO25','CO26','CO27','CO28','CO29','CO30' ) - test_name = 'CO' ! this is just a place holder. values are set in drydep_fromlnd - case( 'CO31','CO32','CO33','CO34','CO35','CO36','CO37','CO38','CO39','CO40' ) - test_name = 'CO' ! this is just a place holder. values are set in drydep_fromlnd - case( 'CO41','CO42','CO43','CO44','CO45','CO46','CO47','CO48','CO49','CO50' ) - test_name = 'CO' ! this is just a place holder. values are set in drydep_fromlnd - case( 'NH4NO3' ) - test_name = 'HNO3' - case default - test_name = 'blank' - end select - - !--- If found a match check the species table again --- - if( trim(test_name) /= 'blank' ) then - do l = 1,n_species_table - if( trim( test_name ) == trim( species_name_table(l) ) ) then - mapping(i) = l - exit - end if - end do - else - if ( s_loglev > 0 ) write(s_logunit,F00) trim(drydep_list(i)), & - ' not in tables; will have dep vel = 0' - call shr_sys_abort( subName//': '//trim(drydep_list(i))//' is not in tables' ) - end if - end if - - !--- Figure out the specific species indices --- - if ( trim(drydep_list(i)) == 'H2' ) h2_ndx = i - if ( trim(drydep_list(i)) == 'CO' ) co_ndx = i - if ( trim(drydep_list(i)) == 'CH4' ) ch4_ndx = i - if ( trim(drydep_list(i)) == 'MPAN' ) mpan_ndx = i - if ( trim(drydep_list(i)) == 'PAN' ) pan_ndx = i - if ( trim(drydep_list(i)) == 'SO2' ) so2_ndx = i - if ( trim(drydep_list(i)) == 'OX' .or. trim(drydep_list(i)) == 'O3' ) o3_ndx = i - if ( trim(drydep_list(i)) == 'O3A' ) o3a_ndx = i - if ( trim(drydep_list(i)) == 'XPAN' ) xpan_ndx = i - - if( mapping(i) > 0) then - l = mapping(i) - foxd(i) = dfoxd(l) - drat(i) = sqrt(mol_wgts(l)/wh2o) - endif - - enddo - - where( rgss < 1._r8 ) - rgss = 1._r8 - endwhere - - where( rac < small_value) - rac = small_value - endwhere - - end subroutine seq_drydep_init - -!==================================================================================== - - subroutine set_hcoeff_scalar( sfc_temp, heff ) - - !======================================================================== - ! Interface to seq_drydep_setHCoeff when input is scalar - ! wrapper routine used when surface temperature is a scalar (single column) rather - ! than an array (multiple columns). - ! - ! !REVISION HISTORY: - ! 2008-Nov-12 - F. Vitt - first version - !======================================================================== - - implicit none - - real(r8), intent(in) :: sfc_temp ! Input surface temperature - real(r8), intent(out) :: heff(n_drydep) ! Output Henry's law coefficients - - !----- local ----- - real(r8) :: sfc_temp_tmp(1) ! surface temp - - sfc_temp_tmp(:) = sfc_temp - call set_hcoeff_vector( 1, sfc_temp_tmp, heff(:n_drydep) ) - - end subroutine set_hcoeff_scalar - -!==================================================================================== - - subroutine set_hcoeff_vector( ncol, sfc_temp, heff ) - - !======================================================================== - ! Interface to seq_drydep_setHCoeff when input is vector - ! sets dry depositions coefficients -- used by both land and atmosphere models - ! !REVISION HISTORY: - ! 2008-Nov-12 - F. Vitt - first version - !======================================================================== - - use shr_log_mod, only : s_logunit => shr_log_Unit - - implicit none - - integer, intent(in) :: ncol ! Input size of surface-temp vector - real(r8), intent(in) :: sfc_temp(ncol) ! Surface temperature - real(r8), intent(out) :: heff(ncol,n_drydep) ! Henry's law coefficients - - !----- local ----- - real(r8), parameter :: t0 = 298._r8 ! Standard Temperature - real(r8), parameter :: ph_inv = 1._r8/ph ! Inverse of PH - integer :: m, l, id ! indices - real(r8) :: e298 ! Henry's law coefficient @ standard temperature (298K) - real(r8) :: dhr ! temperature dependence of Henry's law coefficient - real(r8) :: dk1s(ncol) ! DK Work array 1 - real(r8) :: dk2s(ncol) ! DK Work array 2 - real(r8) :: wrk(ncol) ! Work array - - !----- formats ----- - character(*),parameter :: subName = '(seq_drydep_set_hcoeff) ' - character(*),parameter :: F00 = "('(seq_drydep_set_hcoeff) ',8a)" - - !------------------------------------------------------------------------------- - ! notes: - !------------------------------------------------------------------------------- - - wrk(:) = (t0 - sfc_temp(:))/(t0*sfc_temp(:)) - do m = 1,n_drydep - l = mapping(m) - id = 6*(l - 1) - e298 = dheff(id+1) - dhr = dheff(id+2) - heff(:,m) = e298*exp( dhr*wrk(:) ) - !--- Calculate coefficients based on the drydep tables --- - if( dheff(id+3) /= 0._r8 .and. dheff(id+5) == 0._r8 ) then - e298 = dheff(id+3) - dhr = dheff(id+4) - dk1s(:) = e298*exp( dhr*wrk(:) ) - where( heff(:,m) /= 0._r8 ) - heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv) - elsewhere - heff(:,m) = dk1s(:)*ph_inv - endwhere - end if - !--- For coefficients that are non-zero AND CO2 or NH3 handle things this way --- - if( dheff(id+5) /= 0._r8 ) then - if( trim( drydep_list(m) ) == 'CO2' .or. trim( drydep_list(m) ) == 'NH3' ) then - e298 = dheff(id+3) - dhr = dheff(id+4) - dk1s(:) = e298*exp( dhr*wrk(:) ) - e298 = dheff(id+5) - dhr = dheff(id+6) - dk2s(:) = e298*exp( dhr*wrk(:) ) - !--- For Carbon dioxide --- - if( trim(drydep_list(m)) == 'CO2' ) then - heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph_inv)*(1._r8 + dk2s(:)*ph_inv) - !--- For NH3 --- - else if( trim( drydep_list(m) ) == 'NH3' ) then - heff(:,m) = heff(:,m)*(1._r8 + dk1s(:)*ph/dk2s(:)) - !--- This can't happen --- - else - write(s_logunit,F00) 'Bad species ',drydep_list(m) - call shr_sys_abort( subName//'ERROR: in assigning coefficients' ) - end if - end if - end if - end do - - end subroutine set_hcoeff_vector - -!=============================================================================== - -end module seq_drydep_mod diff --git a/src/drivers/nuopc/cime_flds/shr_carma_mod.F90 b/src/drivers/nuopc/cime_flds/shr_carma_mod.F90 deleted file mode 100644 index d6d0e543ac5..00000000000 --- a/src/drivers/nuopc/cime_flds/shr_carma_mod.F90 +++ /dev/null @@ -1,82 +0,0 @@ -!================================================================================ -! This reads the carma_inparm 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 and how to assimble the fluxes. -! CAM needs to know what specific VOC fluxes to expect from CLM. -! -! Mariana Vertenstein -- 24 Sep 2012 -!================================================================================ -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 : loglev => shr_log_Level - use shr_log_mod , only : logunit => shr_log_Unit - use shr_nl_mod , only : shr_nl_find_group_name - use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit - - implicit none - save - private - - public :: shr_carma_readnl ! reads carma_inparm namelist - -contains - - !------------------------------------------------------------------------- - ! This reads the carma_emis_nl namelist group in drv_flds_in and parses the - ! namelist information for the driver, CLM, and CAM. - !------------------------------------------------------------------------- - subroutine shr_carma_readnl( NLFileName, carma_fields) - use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadcast - character(len=*) , intent(in) :: NLFileName - character(len=CX), intent(out) :: carma_fields - - type(ESMF_VM) :: vm - integer :: localPet - integer :: rc - integer :: unitn ! namelist unit number - integer :: ierr ! error code - logical :: exists ! if file exists or not - integer :: i, tmp(1) - character(*),parameter :: F00 = "('(shr_carma_readnl) ',2a)" - - namelist /carma_inparm/ carma_fields - - carma_fields = ' ' - call ESMF_VMGetCurrent(vm, rc=rc) - call ESMF_VMGet(vm, localpet=localpet, rc=rc) - tmp = 0 - if (localpet==0) then - inquire( file=trim(NLFileName), exist=exists) - if ( exists ) then - unitn = shr_file_getUnit() - open( unitn, file=trim(NLFilename), status='old' ) - if ( loglev > 0) then - write(logunit,F00) 'Read in carma_inparm namelist from: ', trim(NLFilename) - end if - call shr_nl_find_group_name(unitn, 'carma_inparm', status=ierr) - if (ierr == 0) then - read(unitn, carma_inparm, iostat=ierr) - if (ierr > 0) then - call shr_sys_abort( 'problem on read of carma_inparm namelist in shr_carma_readnl' ) - endif - else - write(logunit,*) 'shr_carma_readnl: no carma_inparm namelist found in ',NLFilename - end if - close( unitn ) - call shr_file_freeUnit( unitn ) - else - write(logunit,*) 'shr_carma_readnl: no file ',NLFilename, ' found' - end if - if (len_trim(carma_fields) > 0) tmp(1)=1 - end if - call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc) - if(tmp(1) == 1) then - call ESMF_VMBroadcast(vm, carma_fields, CX, 0, rc=rc) - endif - - end subroutine shr_carma_readnl - -endmodule shr_carma_mod diff --git a/src/drivers/nuopc/cime_flds/shr_fire_emis_mod.F90 b/src/drivers/nuopc/cime_flds/shr_fire_emis_mod.F90 deleted file mode 100644 index ae4220d281f..00000000000 --- a/src/drivers/nuopc/cime_flds/shr_fire_emis_mod.F90 +++ /dev/null @@ -1,307 +0,0 @@ -!================================================================================ -! Coordinates carbon emissions fluxes from CLM fires for use as sources of -! chemical constituents in CAM -! -! This module reads fire_emis_nl namelist which specifies the compound fluxes -! that are to be passed through the model coupler. -!================================================================================ -module shr_fire_emis_mod - - use shr_kind_mod , only : r8 => shr_kind_r8 - use shr_kind_mod , only : 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 : loglev => shr_log_Level - use shr_log_mod , only : logunit => shr_log_Unit - - implicit none - save - private - - public :: shr_fire_emis_readnl ! reads fire_emis_nl namelist - public :: shr_fire_emis_mechcomps ! points to an array of chemical compounds (in CAM-Chem mechanism) than have fire emissions - public :: shr_fire_emis_mechcomps_n ! number of unique compounds in the CAM chemical mechanism that have fire emissions - public :: shr_fire_emis_comps_n ! number of unique emissions components - public :: shr_fire_emis_linkedlist ! points to linked list of shr_fire_emis_comp_t objects - public :: shr_fire_emis_elevated ! elevated emissions in ATM - public :: shr_fire_emis_comp_ptr ! user defined type that points to fire emis data obj (shr_fire_emis_comp_t) - public :: shr_fire_emis_comp_t ! emission component data type - public :: shr_fire_emis_mechcomp_t ! data type for chemical compound in CAM mechanism than has fire emissions - - logical :: shr_fire_emis_elevated = .true. - - character(len=CS), public :: shr_fire_emis_fields_token = '' ! emissions fields token - character(len=CL), public :: shr_fire_emis_factors_file = '' ! a table of basic fire emissions compounds - character(len=CS), public :: shr_fire_emis_ztop_token = 'Sl_fztop' ! token for emissions top of vertical distribution - integer, parameter :: name_len=16 - - ! fire emissions component data structure (or user defined type) - type shr_fire_emis_comp_t - character(len=name_len) :: name ! emissions component name (in fire emissions input table) - integer :: index - real(r8), pointer :: emis_factors(:) ! function of plant-function-type (PFT) - real(r8) :: coeff ! emissions component coeffecient - real(r8) :: molec_weight ! molecular weight of the fire emissions compound (g/mole) - type(shr_fire_emis_comp_t), pointer :: next_emiscomp ! points to next member in the linked list - endtype shr_fire_emis_comp_t - - type shr_fire_emis_comp_ptr - type(shr_fire_emis_comp_t), pointer :: ptr ! points to fire emis data obj (shr_fire_emis_comp_t) - endtype shr_fire_emis_comp_ptr - - ! chemical compound in CAM mechanism that has fire emissions - type shr_fire_emis_mechcomp_t - character(len=16) :: name ! compound name - type(shr_fire_emis_comp_ptr), pointer :: emis_comps(:) ! an array of pointers to fire emis components - integer :: n_emis_comps ! number of fire emis compounds that make up the emissions for this mechanis compound - end type shr_fire_emis_mechcomp_t - - type(shr_fire_emis_mechcomp_t), pointer :: shr_fire_emis_mechcomps(:) ! array of chemical compounds (in CAM mechanism) that have fire emissions - type(shr_fire_emis_comp_t), pointer :: shr_fire_emis_linkedlist ! points to linked list top - - integer :: shr_fire_emis_comps_n = 0 ! number of unique fire components - integer :: shr_fire_emis_mechcomps_n = 0 ! number of unique compounds in the CAM chemical mechanism that have fire emissions - -contains - - !------------------------------------------------------------------------- - ! - ! This reads the fire_emis_nl namelist group in drv_flds_in and parses the - ! namelist information for the driver, CLM, and CAM. - ! - ! Namelist variables: - ! fire_emis_specifier, fire_emis_factors_file, fire_emis_elevated - ! - ! fire_emis_specifier (array of strings) -- Each array element specifies - ! how CAM-Chem constituents are mapped to basic smoke compounds in - ! the fire emissions factors table (fire_emis_factors_file). Each - ! chemistry constituent name (left of '=' sign) is mapped to one or more - ! smoke compound (separated by + sign if more than one), which can be - ! proceeded by a multiplication factor (separated by '*'). - ! Example: - ! fire_emis_specifier = 'bc_a1 = BC','pom_a1 = 1.4*OC','SO2 = SO2' - ! - ! fire_emis_factors_file (string) -- Input file that contains the table - ! of basic compounds that make up the smoke from the CLM fires. This is - ! used in CLM module FireEmisFactorsMod. - ! - ! fire_emis_elevated (locical) -- If true then CAM-Chem treats the fire - ! emission sources as 3-D vertically distributed forcings for the - ! corresponding chemical tracers. - ! - !------------------------------------------------------------------------- - subroutine shr_fire_emis_readnl( NLFileName, emis_fields, emis_nflds ) - use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadcast - use shr_nl_mod, only : shr_nl_find_group_name - use shr_file_mod, only : shr_file_getUnit, shr_file_freeUnit - - - character(len=*), intent(in) :: NLFileName ! name of namelist file - character(len=*), intent(out) :: emis_fields ! emis flux fields - integer, intent(out) :: emis_nflds - - type(ESMF_VM) :: vm - integer :: localPet - integer :: rc - integer :: unitn ! namelist unit number - integer :: ierr ! error code - logical :: exists ! if file exists or not - integer, parameter :: maxspc = 100 - character(len=2*CX) :: fire_emis_specifier(maxspc) = ' ' - character(len=CL) :: fire_emis_factors_file = ' ' - logical :: fire_emis_elevated = .true. - integer :: i, tmp(1) - character(*),parameter :: F00 = "('(shr_fire_emis_readnl) ',2a)" - - namelist /fire_emis_nl/ fire_emis_specifier, fire_emis_factors_file, fire_emis_elevated - - call ESMF_VMGetCurrent(vm, rc=rc) - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - emis_nflds=0 - if (localPet==0) then - inquire( file=trim(NLFileName), exist=exists) - - if ( exists ) then - unitn = shr_file_getUnit() - open( unitn, file=trim(NLFilename), status='old' ) - if ( loglev > 0 ) write(logunit,F00) 'Read in fire_emis_readnl namelist from: ', trim(NLFilename) - call shr_nl_find_group_name(unitn, 'fire_emis_nl', status=ierr) - ! If ierr /= 0, no namelist present. - if (ierr == 0) then - read(unitn, fire_emis_nl, iostat=ierr) - if (ierr > 0) then - call shr_sys_abort( 'problem on read of fire_emis_nl namelist in shr_fire_emis_readnl' ) - endif - endif - close( unitn ) - call shr_file_freeUnit( unitn ) - do i=1,maxspc - if(len_trim(fire_emis_specifier(i))>0) then - emis_nflds=emis_nflds+1 - endif - enddo - end if - end if - tmp = emis_nflds - call ESMF_VMBroadcast( vm, tmp, 1, 0, rc=rc) - emis_nflds = tmp(1) - if (emis_nflds > 0) then - call ESMF_VMBroadcast( vm, fire_emis_specifier, 2*CX*emis_nflds, 0, rc=rc) - call ESMF_VMBroadcast( vm, fire_emis_factors_file, CL, 0, rc=rc) - tmp = 0 - if (fire_emis_elevated) tmp = 1 - call ESMF_VMBroadcast( vm, tmp, 1, 0, rc=rc) - if(tmp(1) == 1) fire_emis_elevated = .true. - endif - - shr_fire_emis_factors_file = fire_emis_factors_file - shr_fire_emis_elevated = fire_emis_elevated - - ! parse the namelist info and initialize the module data - call shr_fire_emis_init( fire_emis_specifier, emis_fields ) - - end subroutine shr_fire_emis_readnl - - !----------------------------------------------------------------------- - ! module data initializer - !------------------------------------------------------------------------ - subroutine shr_fire_emis_init( specifier, emis_fields ) - - use shr_expr_parser_mod, only : shr_exp_parse, shr_exp_item_t, shr_exp_list_destroy - - character(len=*), intent(in) :: specifier(:) - character(len=*), intent(out) :: emis_fields - - integer :: n_entries - integer :: i, j, k - - type(shr_exp_item_t), pointer :: items_list, item - character(len=12) :: token ! fire emis field name to add - - nullify(shr_fire_emis_linkedlist) - - items_list => shr_exp_parse( specifier, nitems=n_entries ) - - allocate(shr_fire_emis_mechcomps(n_entries)) - shr_fire_emis_mechcomps(:)%n_emis_comps = 0 - - emis_fields = '' - - item => items_list - i = 1 - do while(associated(item)) - - do k=1,shr_fire_emis_mechcomps_n - if ( trim(shr_fire_emis_mechcomps(k)%name) == trim(item%name) ) then - call shr_sys_abort( 'shr_fire_emis_init : multiple emissions definitions specified for : '//trim(item%name)) - endif - enddo - if (len_trim(item%name) .le. name_len) then - shr_fire_emis_mechcomps(i)%name = item%name(1:name_len) - else - call shr_sys_abort("shr_file_emis_init : name too long for data structure :"//trim(item%name)) - endif - shr_fire_emis_mechcomps(i)%n_emis_comps = item%n_terms - allocate(shr_fire_emis_mechcomps(i)%emis_comps(item%n_terms)) - - do j = 1,item%n_terms - shr_fire_emis_mechcomps(i)%emis_comps(j)%ptr => add_emis_comp( item%vars(j), item%coeffs(j) ) - enddo - shr_fire_emis_mechcomps_n = shr_fire_emis_mechcomps_n+1 - - write(token,333) shr_fire_emis_mechcomps_n - - if ( shr_fire_emis_mechcomps_n == 1 ) then - ! do not prepend ":" to the string for the first token - emis_fields = trim(token) - shr_fire_emis_fields_token = token - else - emis_fields = trim(emis_fields)//':'//trim(token) - endif - - item => item%next_item - i = i+1 - enddo - if (associated(items_list)) call shr_exp_list_destroy(items_list) - - ! Need to explicitly add Fl_ based on naming convention -333 format ('Fall_fire',i3.3) - - end subroutine shr_fire_emis_init - - !------------------------------------------------------------------------- - ! private methods... - - - !------------------------------------------------------------------------- - !------------------------------------------------------------------------- - function add_emis_comp( name, coeff ) result(emis_comp) - - character(len=*), intent(in) :: name - real(r8), intent(in) :: coeff - type(shr_fire_emis_comp_t), pointer :: emis_comp - - emis_comp => get_emis_comp_by_name(shr_fire_emis_linkedlist, name) - if(associated(emis_comp)) then - ! already in the list so return... - return - endif - - ! create new emissions component and add it to the list - allocate(emis_comp) - - ! element%index = lookup_element( name ) - ! element%emis_factors = get_factors( list_elem%index ) - - emis_comp%index = shr_fire_emis_comps_n+1 - - emis_comp%name = trim(name) - emis_comp%coeff = coeff - nullify(emis_comp%next_emiscomp) - - call add_emis_comp_to_list(emis_comp) - - end function add_emis_comp - - !------------------------------------------------------------------------- - !------------------------------------------------------------------------- - recursive function get_emis_comp_by_name(list_comp, name) result(emis_comp) - - type(shr_fire_emis_comp_t), pointer :: list_comp - character(len=*), intent(in) :: name ! variable name - type(shr_fire_emis_comp_t), pointer :: emis_comp ! returned object - - if(associated(list_comp)) then - if(list_comp%name .eq. name) then - emis_comp => list_comp - else - emis_comp => get_emis_comp_by_name(list_comp%next_emiscomp, name) - end if - else - nullify(emis_comp) - end if - - end function get_emis_comp_by_name - - !------------------------------------------------------------------------- - !------------------------------------------------------------------------- - subroutine add_emis_comp_to_list( new_emis_comp ) - - type(shr_fire_emis_comp_t), target, intent(in) :: new_emis_comp - - type(shr_fire_emis_comp_t), pointer :: list_comp - - if(associated(shr_fire_emis_linkedlist)) then - list_comp => shr_fire_emis_linkedlist - do while(associated(list_comp%next_emiscomp)) - list_comp => list_comp%next_emiscomp - end do - list_comp%next_emiscomp => new_emis_comp - else - shr_fire_emis_linkedlist => new_emis_comp - end if - - shr_fire_emis_comps_n = shr_fire_emis_comps_n + 1 - - end subroutine add_emis_comp_to_list - -endmodule shr_fire_emis_mod diff --git a/src/drivers/nuopc/cime_flds/shr_flds_mod.F90 b/src/drivers/nuopc/cime_flds/shr_flds_mod.F90 deleted file mode 100644 index b4263e9bfa3..00000000000 --- a/src/drivers/nuopc/cime_flds/shr_flds_mod.F90 +++ /dev/null @@ -1,8 +0,0 @@ -module shr_flds_mod - - use shr_nuopc_fldList_mod , only : shr_nuopc_fldList_type - - implicit none - public - -end module shr_flds_mod diff --git a/src/drivers/nuopc/cime_flds/shr_megan_mod.F90 b/src/drivers/nuopc/cime_flds/shr_megan_mod.F90 deleted file mode 100644 index 659719f01bb..00000000000 --- a/src/drivers/nuopc/cime_flds/shr_megan_mod.F90 +++ /dev/null @@ -1,334 +0,0 @@ -!================================================================================ -! Handles MEGAN VOC emissions metadata for CLM produced chemical emissions -! 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 and how to assimble the fluxes. -! CAM needs to know what specific VOC fluxes to expect from CLM. -! -! Francis Vitt -- 26 Oct 2011 -!================================================================================ -module shr_megan_mod - - use shr_kind_mod,only : r8 => shr_kind_r8 - use shr_kind_mod,only : 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 : loglev => shr_log_Level - use shr_log_mod, only : logunit => shr_log_Unit - - implicit none - save - private - - public :: shr_megan_readnl ! reads megan_emis_nl namelist - public :: shr_megan_mechcomps ! points to an array of chemical compounds (in CAM-Chem mechanism) that have MEGAN emissions - public :: shr_megan_mechcomps_n ! number of unique compounds in the CAM chemical mechanism that have MEGAN emissions - public :: shr_megan_megcomps_n ! number of unique MEGAN compounds - public :: shr_megan_megcomp_t ! MEGAN compound data type - public :: shr_megan_mechcomp_t ! data type for chemical compound in CAM mechanism that has MEGAN emissions - public :: shr_megan_linkedlist ! points to linked list of shr_megan_comp_t objects - public :: shr_megan_mapped_emisfctrs ! switch to use mapped emission factors - public :: shr_megan_comp_ptr - - logical , public :: megan_initialized = .false. ! true => shr_megan_readnl alreay called - character(len=CS), public :: shr_megan_fields_token = '' ! First drydep fields token - character(len=CL), public :: shr_megan_factors_file = '' - character(len=CX), public :: shr_megan_fields = '' - - ! MEGAN compound data structure (or user defined type) - type shr_megan_megcomp_t - character(len=16) :: name ! MEGAN compound name (in MEGAN input table) - integer :: index - real(r8), pointer :: emis_factors(:) ! function of plant-function-type (PFT) - integer :: class_number ! MEGAN class number - real(r8) :: coeff ! emissions component coeffecient - real(r8) :: molec_weight ! molecular weight of the MEGAN compound (g/mole) - type(shr_megan_megcomp_t), pointer :: next_megcomp ! points to next member in the linked list - endtype shr_megan_megcomp_t - - type shr_megan_comp_ptr - type(shr_megan_megcomp_t), pointer :: ptr - endtype shr_megan_comp_ptr - - ! chemical compound in CAM mechanism that has MEGAN emissions - type shr_megan_mechcomp_t - character(len=16) :: name ! compound name - type(shr_megan_comp_ptr), pointer :: megan_comps(:) ! an array of pointers to megan emis compounds - integer :: n_megan_comps ! number of megan emis compounds that make up the emissions for this mechanis compound - end type shr_megan_mechcomp_t - - type(shr_megan_mechcomp_t), pointer :: shr_megan_mechcomps(:) ! array of chemical compounds (in CAM mechanism) that have MEGAN emissions - type(shr_megan_megcomp_t), pointer :: shr_megan_linkedlist ! points to linked list top - - integer :: shr_megan_megcomps_n = 0 ! number of unique megan compounds - integer :: shr_megan_mechcomps_n = 0 ! number of unique compounds in the CAM chemical mechanism that have MEGAN emissions - - ! switch to use mapped emission factors - logical :: shr_megan_mapped_emisfctrs = .false. - -contains - - !------------------------------------------------------------------------- - ! - ! This reads the megan_emis_nl namelist group in drv_flds_in and parses the - ! namelist information for the driver, CLM, and CAM. - ! - ! Namelist variables: - ! megan_specifier, megan_mapped_emisfctrs, megan_factors_file - ! - ! megan_specifier is a series of strings where each string contains one - ! CAM chemistry constituent name (left of = sign) and one or more MEGAN - ! compound (separated by + sign if more than one). Each MEGAN compound - ! can be proceeded by a multiplication factor (separated by *). The - ! specification of the MEGAN compounds to the right of the = signs tells - ! the MEGAN VOC model within CLM how to construct the VOC fluxes using - ! the factors in megan_factors_file and land surface state. - ! - ! megan_factors_file read by CLM contains valid MEGAN compound names, - ! MEGAN class groupings and scalar emission factors - ! - ! megan_mapped_emisfctrs switch is used to tell the MEGAN model to use - ! mapped emission factors read in from the CLM surface data input file - ! rather than the scalar factors from megan_factors_file - ! - ! Example: - ! &megan_emis_nl - ! megan_specifier = 'ISOP = isoprene', - ! 'C10H16 = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + ...', - ! 'CH3OH = methanol', - ! 'C2H5OH = ethanol', - ! 'CH2O = formaldehyde', - ! 'CH3CHO = acetaldehyde', - ! ... - ! megan_factors_file = '$datapath/megan_emis_factors.nc' - ! / - !------------------------------------------------------------------------- - subroutine shr_megan_readnl( NLFileName, megan_fields, megan_nflds ) - use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMBroadcast, ESMF_VMGet - use shr_nl_mod, only : shr_nl_find_group_name - use shr_file_mod, only : shr_file_getUnit, shr_file_freeUnit - - character(len=*), intent(in) :: NLFileName - character(len=*), intent(out) :: megan_fields - integer, intent(out) :: megan_nflds - - type(ESMF_VM) :: vm - integer :: localPet - 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) = ' ' - logical :: megan_mapped_emisfctrs = .false. - character(len=CL) :: megan_factors_file = ' ' - integer :: rc - integer :: i, tmp(1) - character(*),parameter :: F00 = "('(shr_megan_readnl) ',2a)" - - namelist /megan_emis_nl/ megan_specifier, megan_factors_file, megan_mapped_emisfctrs - - ! If other processes have already initialized megan - then just return - ! the megan_fields that have already been set - if (megan_initialized) then - megan_fields = trim(shr_megan_fields) - megan_nflds = shr_megan_mechcomps_n - return - end if - call ESMF_VMGetCurrent(vm, rc=rc) - call ESMF_VMGet(vm, localpet=localpet, rc=rc) - megan_nflds = 0 - if (localPet==0) then - inquire( file=trim(NLFileName), exist=exists) - if ( exists ) then - unitn = shr_file_getUnit() - open( unitn, file=trim(NLFilename), status='old' ) - if ( loglev > 0 ) write(logunit,F00) & - 'Read in megan_emis_readnl namelist from: ', trim(NLFilename) - - call shr_nl_find_group_name(unitn, 'megan_emis_nl', status=ierr) - ! If ierr /= 0, no namelist present. - - if (ierr == 0) then - read(unitn, megan_emis_nl, iostat=ierr) - - if (ierr > 0) then - call shr_sys_abort( 'problem on read of megan_emis_nl namelist in shr_megan_readnl' ) - endif - endif - - close( unitn ) - call shr_file_freeUnit( unitn ) - do i=1,maxspc - if(len_trim(megan_specifier(i)) > 0) then - megan_nflds=megan_nflds+1 - endif - enddo - end if - end if - tmp = megan_nflds - call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc) - megan_nflds = tmp(1) - if(megan_nflds > 0) then - call ESMF_VMBroadcast(vm, megan_specifier, 2*CX*megan_nflds, 0, rc=rc) - call ESMF_VMBroadcast(vm, megan_factors_file, CL, 0, rc=rc) - tmp = 0 - if(megan_mapped_emisfctrs) tmp=1 - call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc) - if(tmp(1)==1) megan_mapped_emisfctrs=.true. - endif - - shr_megan_factors_file = megan_factors_file - shr_megan_mapped_emisfctrs = megan_mapped_emisfctrs - - ! parse the namelist info and initialize the module data - call shr_megan_init( megan_specifier, megan_fields ) - end subroutine shr_megan_readnl - - !------------------------------------------------------------------------- - ! module data initializer - !------------------------------------------------------------------------- - subroutine shr_megan_init( specifier, megan_fields ) - - use shr_expr_parser_mod, only : shr_exp_parse, shr_exp_item_t, shr_exp_list_destroy - - character(len=*), intent(in) :: specifier(:) - character(len=*), intent(out) :: megan_fields - - integer :: n_entries - integer :: i, j, k - - type(shr_exp_item_t), pointer :: items_list, item - character(len=12) :: token ! megan field name to add - - nullify(shr_megan_linkedlist) - - items_list => shr_exp_parse( specifier, nitems=n_entries ) - - allocate(shr_megan_mechcomps(n_entries)) - shr_megan_mechcomps(:)%n_megan_comps = 0 - - megan_fields = '' - - item => items_list - i = 1 - do while(associated(item)) - - do k=1,shr_megan_mechcomps_n - if ( trim(shr_megan_mechcomps(k)%name) == trim(item%name) ) then - call shr_sys_abort( 'shr_megan_init : duplicate compound names : '//trim(item%name)) - endif - enddo - if (len_trim(item%name) .le. len(shr_megan_mechcomps(i)%name)) then - shr_megan_mechcomps(i)%name = item%name(1:len(shr_megan_mechcomps(i)%name)) - else - call shr_sys_abort( 'shr_megan_init : name too long for data structure : '//trim(item%name)) - endif - shr_megan_mechcomps(i)%n_megan_comps = item%n_terms - allocate(shr_megan_mechcomps(i)%megan_comps(item%n_terms)) - - do j = 1,item%n_terms - 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 - - write(token,333) shr_megan_mechcomps_n - - if ( shr_megan_mechcomps_n == 1 ) then - ! do not prepend ":" to the string for the first token - megan_fields = trim(token) - shr_megan_fields_token = token - else - megan_fields = trim(megan_fields)//':'//trim(token) - endif - - item => item%next_item - i = i+1 - enddo - if (associated(items_list)) call shr_exp_list_destroy(items_list) - - megan_initialized = .true. - shr_megan_fields = trim(megan_fields) - - ! Need to explicitly add Fl_ based on naming convention -333 format ('Fall_voc',i3.3) - - end subroutine shr_megan_init - - !------------------------------------------------------------------------- - ! private methods... - - !------------------------------------------------------------------------- - !------------------------------------------------------------------------- - function add_megan_comp( name, coeff ) result(megan_comp) - - character(len=16), intent(in) :: name - real(r8), intent(in) :: coeff - type(shr_megan_megcomp_t), pointer :: megan_comp - - megan_comp => get_megan_comp_by_name(shr_megan_linkedlist, name) - if(associated(megan_comp)) then - ! already in the list so return... - return - endif - - ! create new megan compound and add it to the list - allocate(megan_comp) - - ! element%index = lookup_element( name ) - ! element%emis_factors = get_factors( list_elem%index ) - - megan_comp%index = shr_megan_megcomps_n+1 - - megan_comp%name = trim(name) - megan_comp%coeff = coeff - nullify(megan_comp%next_megcomp) - - call add_megan_comp_to_list(megan_comp) - - end function add_megan_comp - - !------------------------------------------------------------------------- - !------------------------------------------------------------------------- - recursive function get_megan_comp_by_name(list_comp, name) result(megan_comp) - - type(shr_megan_megcomp_t), pointer :: list_comp - character(len=*), intent(in) :: name ! variable name - type(shr_megan_megcomp_t), pointer :: megan_comp ! returned object - - if(associated(list_comp)) then - if(list_comp%name .eq. name) then - megan_comp => list_comp - else - megan_comp => get_megan_comp_by_name(list_comp%next_megcomp, name) - end if - else - nullify(megan_comp) - end if - - end function get_megan_comp_by_name - - !------------------------------------------------------------------------- - !------------------------------------------------------------------------- - subroutine add_megan_comp_to_list( new_megan_comp ) - - type(shr_megan_megcomp_t), target, intent(in) :: new_megan_comp - - type(shr_megan_megcomp_t), pointer :: list_comp - - if(associated(shr_megan_linkedlist)) then - list_comp => shr_megan_linkedlist - do while(associated(list_comp%next_megcomp)) - list_comp => list_comp%next_megcomp - end do - list_comp%next_megcomp => new_megan_comp - else - shr_megan_linkedlist => new_megan_comp - end if - - shr_megan_megcomps_n = shr_megan_megcomps_n + 1 - - end subroutine add_megan_comp_to_list - -endmodule shr_megan_mod diff --git a/src/drivers/nuopc/cime_flds/shr_ndep_mod.F90 b/src/drivers/nuopc/cime_flds/shr_ndep_mod.F90 deleted file mode 100644 index c48e0235651..00000000000 --- a/src/drivers/nuopc/cime_flds/shr_ndep_mod.F90 +++ /dev/null @@ -1,128 +0,0 @@ -module shr_ndep_mod - - !======================================================================== - ! Module for handling nitrogen depostion of tracers. - ! This module is shared by land and atmosphere models for the computations of - ! dry deposition of tracers - !======================================================================== - - !USES: - use shr_sys_mod, only : shr_sys_abort - use shr_log_mod, only : s_loglev => shr_log_Level - use shr_log_mod , only : s_logunit => shr_log_Unit - use shr_kind_mod, only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX - - implicit none - private - - ! !PUBLIC MEMBER FUNCTIONS - public :: shr_ndep_readnl ! Read namelist - character(len=*), parameter :: u_FILE_u=__FILE__ -!==================================================================================== -CONTAINS -!==================================================================================== - - subroutine shr_ndep_readnl(NLFilename, ndep_fields, ndep_nflds) - - !======================================================================== - ! reads ndep_inparm namelist and sets up driver list of fields for - ! atmosphere -> land and atmosphere -> ocn communications. - !======================================================================== - - use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit - use shr_nl_mod , only : shr_nl_find_group_name - use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMBroadcast, ESMF_VMGet - use shr_nuopc_utils_mod , only : shr_nuopc_utils_chkerr - - implicit none - - character(len=*), intent(in) :: NLFilename ! Namelist filename - character(len=*), intent(out) :: ndep_fields - integer , intent(out) :: ndep_nflds - - !----- local ----- - type(ESMF_VM) :: vm - integer :: i ! Indices - integer :: unitn ! namelist unit number - integer :: ierr ! error code - integer :: tmp(1) - logical :: exists ! if file exists or not - character(len=8) :: token ! dry dep field name to add - integer :: rc - integer, parameter :: maxspc = 100 ! Maximum number of species - character(len=32) :: ndep_list(maxspc) = '' ! List of ndep species - integer :: localpet - !----- formats ----- - character(*),parameter :: subName = '(shr_ndep_read) ' - character(*),parameter :: F00 = "('(shr_ndep_read) ',8a)" - character(*),parameter :: FI1 = "('(shr_ndep_init) ',a,I2)" - - namelist /ndep_inparm/ ndep_list - - !----------------------------------------------------------------------------- - ! Read namelist and figure out the ndep field list to pass - ! First check if file exists and if not, n_ndep will be zero - !----------------------------------------------------------------------------- - - !--- Open and read namelist --- - if ( len_trim(NLFilename) == 0 ) then - call shr_sys_abort( subName//'ERROR: nlfilename not set' ) - end if - call ESMF_VMGetCurrent(vm, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localpet=localpet, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - ndep_nflds=0 - if (localpet==0) then - inquire( file=trim(NLFileName), exist=exists) - if ( exists ) then - unitn = shr_file_getUnit() - open( unitn, file=trim(NLFilename), status='old' ) - if ( s_loglev > 0 ) then - write(s_logunit,F00) 'Read in ndep_inparm namelist from: ', trim(NLFilename) - end if - call shr_nl_find_group_name(unitn, 'ndep_inparm', ierr) - if (ierr == 0) then - ierr = 1 - do while ( ierr /= 0 ) - read(unitn, ndep_inparm, iostat=ierr) - if (ierr < 0) then - call shr_sys_abort( subName//'ERROR: encountered end-of-file on namelist read' ) - endif - end do - else - write(s_logunit,*) 'shr_ndep_readnl: no ndep_inparm namelist found in ',NLFilename - endif - close( unitn ) - call shr_file_freeUnit( unitn ) - do i=1,maxspc - if (len_trim(ndep_list(i)) > 0) then - ndep_nflds = ndep_nflds+1 - endif - enddo - end if - end if - tmp = ndep_nflds - call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc) - ndep_nflds=tmp(1) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - ndep_fields = ' ' - - if(ndep_nflds > 0) then - call ESMF_VMBroadcast(vm, ndep_list, 32*ndep_nflds, 0, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - ! Loop over species to fill list of fields to communicate for ndep - do i=1,ndep_nflds - if ( len_trim(ndep_list(i))==0 ) exit - if ( i == 1 ) then - ndep_fields = 'Faxa_' // trim(ndep_list(i)) - else - ndep_fields = trim(ndep_fields)//':'//'Faxa_' // trim(ndep_list(i)) - endif - enddo - end if - - end subroutine shr_ndep_readnl - -end module shr_ndep_mod diff --git a/src/drivers/nuopc/cime_flds_shr/seq_drydep_mod.F90 b/src/drivers/nuopc/cime_flds_shr/seq_drydep_mod.F90 index 225b561c91f..93bd212a2a6 100644 --- a/src/drivers/nuopc/cime_flds_shr/seq_drydep_mod.F90 +++ b/src/drivers/nuopc/cime_flds_shr/seq_drydep_mod.F90 @@ -19,12 +19,9 @@ module seq_drydep_mod use shr_sys_mod, only : shr_sys_abort use shr_log_mod, only : s_loglev => shr_log_Level use shr_kind_mod, only : r8 => shr_kind_r8, CS => SHR_KIND_CS, CX => SHR_KIND_CX - use shr_const_mod, only : SHR_CONST_G, SHR_CONST_RDAIR, & - SHR_CONST_CPDAIR, SHR_CONST_MWWV + use shr_const_mod, only : SHR_CONST_G, SHR_CONST_RDAIR, SHR_CONST_CPDAIR, SHR_CONST_MWWV implicit none - save - private ! !PUBLIC MEMBER FUNCTIONS @@ -35,18 +32,18 @@ module seq_drydep_mod ! !PRIVATE ARRAY SIZES - integer, private, parameter :: maxspc = 100 ! Maximum number of species integer, public, parameter :: n_species_table = 77 ! Number of species to work with + integer, private, parameter :: maxspc = 100 ! Maximum number of species integer, private, parameter :: NSeas = 5 ! Number of seasons integer, private, parameter :: NLUse = 11 ! Number of land-use types ! !PUBLIC DATA MEMBERS: ! method specification - character(16),public,parameter :: DD_XATM = 'xactive_atm'! dry-dep atmosphere - character(16),public,parameter :: DD_XLND = 'xactive_lnd'! dry-dep land - character(16),public,parameter :: DD_TABL = 'table' ! dry-dep table (atm and lnd) - character(16),public :: drydep_method = DD_XLND ! Which option choosen + character(16),public,parameter :: DD_XATM = 'xactive_atm' ! dry-dep atmosphere + character(16),public,parameter :: DD_XLND = 'xactive_lnd' ! dry-dep land + character(16),public,parameter :: DD_TABL = 'table' ! dry-dep table (atm and lnd) + character(16),public :: drydep_method = DD_XLND ! Which option choosen real(r8), public, parameter :: ph = 1.e-5_r8 ! measure of the acidity (dimensionless) @@ -54,11 +51,10 @@ module seq_drydep_mod integer, public :: n_drydep = 0 ! Number in drypdep list character(len=CS), public, dimension(maxspc) :: drydep_list = '' ! List of dry-dep species - character(len=CS), public :: drydep_fields_token = '' ! First drydep fields token - real(r8), public, allocatable, dimension(:) :: foxd ! reactivity factor for oxidation (dimensioness) real(r8), public, allocatable, dimension(:) :: drat ! ratio of molecular diffusivity (D_H2O/D_species; dimensionless) integer, public, allocatable, dimension(:) :: mapping ! mapping to species table + ! --- Indices for each species --- integer, public :: h2_ndx, ch4_ndx, co_ndx, pan_ndx, mpan_ndx, so2_ndx, o3_ndx, o3a_ndx, xpan_ndx @@ -504,41 +500,37 @@ module seq_drydep_mod !==================================================================================== - subroutine seq_drydep_readnl(NLFilename, seq_drydep_fields, seq_drydep_nflds) + subroutine seq_drydep_readnl(NLFilename, drydep_nflds) !======================================================================== - ! reads drydep_inparm namelist and sets up CCSM driver list of fields for - ! land-atmosphere communications. - ! - ! !REVISION HISTORY: - ! 2009-Feb-20 - E. Kluzek - Separate out as subroutine from previous input_init + ! reads drydep_inparm namelist and determines the number of drydep velocity + ! fields that are sent from the land component !======================================================================== - use ESMF, only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast - use shr_file_mod,only : shr_file_getUnit, shr_file_freeUnit - use shr_log_mod, only : s_logunit => shr_log_Unit - use shr_mpi_mod, only : shr_mpi_bcast - use shr_nl_mod, only : shr_nl_find_group_name - implicit none + + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast + use shr_file_mod, only : shr_file_getUnit, shr_file_freeUnit + use shr_log_mod , only : s_logunit => shr_log_Unit + use shr_mpi_mod , only : shr_mpi_bcast + use shr_nl_mod , only : shr_nl_find_group_name character(len=*), intent(in) :: NLFilename ! Namelist filename - character(len=*), intent(out) :: seq_drydep_fields - integer, intent(out) :: seq_drydep_nflds + integer, intent(out) :: drydep_nflds + !----- local ----- - integer :: i ! Indices - integer :: unitn ! namelist unit number - integer :: ierr ! error code - logical :: exists ! if file exists or not - character(len=8) :: token ! dry dep field name to add + integer :: i ! Indices + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not type(ESMF_VM) :: vm - integer :: localPet - integer :: tmp(1) - integer :: rc - !----- formats ----- + integer :: localPet + integer :: tmp(1) + integer :: rc character(*),parameter :: subName = '(seq_drydep_read) ' character(*),parameter :: F00 = "('(seq_drydep_read) ',8a)" character(*),parameter :: FI1 = "('(seq_drydep_init) ',a,I2)" namelist /drydep_inparm/ drydep_list, drydep_method + !----------------------------------------------------------------------------- !----------------------------------------------------------------------------- ! Read namelist and figure out the drydep field list to pass @@ -551,7 +543,8 @@ subroutine seq_drydep_readnl(NLFilename, seq_drydep_fields, seq_drydep_nflds) end if call ESMF_VMGetCurrent(vm, rc=rc) call ESMF_VMGet(vm, localPet=localPet, rc=rc) - seq_drydep_nflds=0 + + drydep_nflds=0 if (localPet==0) then inquire( file=trim(NLFileName), exist=exists) if ( exists ) then @@ -575,41 +568,31 @@ subroutine seq_drydep_readnl(NLFilename, seq_drydep_fields, seq_drydep_nflds) call shr_file_freeUnit( unitn ) do i=1,maxspc if(len_trim(drydep_list(i)) > 0) then - seq_drydep_nflds=seq_drydep_nflds+1 + drydep_nflds=drydep_nflds+1 endif enddo end if end if - tmp = seq_drydep_nflds + + tmp = drydep_nflds call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc) - seq_drydep_nflds = tmp(1) - if(seq_drydep_nflds > 0) then - call ESMF_VMBroadcast(vm, drydep_list, CS*seq_drydep_nflds, 0, rc=rc) + drydep_nflds = tmp(1) + if (drydep_nflds > 0) then + call ESMF_VMBroadcast(vm, drydep_list, CS*drydep_nflds, 0, rc=rc) call ESMF_VMBroadcast(vm, drydep_method, 16, 0, rc=rc) endif - !--- Loop over species to fill list of fields to communicate for drydep --- - seq_drydep_fields = ' ' - do i=1,seq_drydep_nflds - write(token,333) i - seq_drydep_fields = trim(seq_drydep_fields)//':'//trim(token) - if ( i == 1 ) then - seq_drydep_fields = trim(token) - drydep_fields_token = trim(token) - endif - enddo - !--- Make sure method is valid and determine if land is passing drydep fields --- - lnd_drydep = seq_drydep_nflds>0 .and. drydep_method == DD_XLND + lnd_drydep = (drydep_nflds>0 .and. drydep_method == DD_XLND) if (localpet==0) then if ( s_loglev > 0 ) then write(s_logunit,*) 'seq_drydep_read: drydep_method: ', trim(drydep_method) - if ( seq_drydep_nflds == 0 )then + if ( drydep_nflds == 0 )then write(s_logunit,F00) 'No dry deposition fields will be transfered' else - write(s_logunit,FI1) 'Number of dry deposition fields transfered is ', seq_drydep_nflds + write(s_logunit,FI1) 'Number of dry deposition fields transfered is ', drydep_nflds end if end if end if @@ -625,9 +608,6 @@ subroutine seq_drydep_readnl(NLFilename, seq_drydep_fields, seq_drydep_nflds) call shr_sys_abort('seq_drydep_read: incorrect dry deposition method specification') endif - ! Need to explicitly add Sl_ based on naming convention -333 format ('Sl_dd',i3.3) - end subroutine seq_drydep_readnl !==================================================================================== diff --git a/src/drivers/nuopc/cime_flds_shr/shr_carma_mod.F90 b/src/drivers/nuopc/cime_flds_shr/shr_carma_mod.F90 index d6d0e543ac5..c00f35beedb 100644 --- a/src/drivers/nuopc/cime_flds_shr/shr_carma_mod.F90 +++ b/src/drivers/nuopc/cime_flds_shr/shr_carma_mod.F90 @@ -1,14 +1,10 @@ -!================================================================================ -! This reads the carma_inparm 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 and how to assimble the fluxes. -! CAM needs to know what specific VOC fluxes to expect from CLM. -! -! Mariana Vertenstein -- 24 Sep 2012 -!================================================================================ module shr_carma_mod + !================================================================================ + ! This reads the carma_inparm namelist in drv_flds_in and makes the relavent + ! information available to CAM, CLM, and driver. + !================================================================================ + 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 : loglev => shr_log_Level @@ -17,19 +13,23 @@ module shr_carma_mod use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit implicit none - save private public :: shr_carma_readnl ! reads carma_inparm namelist +!------------------------------------------------------------------------- contains +!------------------------------------------------------------------------- - !------------------------------------------------------------------------- - ! This reads the carma_emis_nl namelist group in drv_flds_in and parses the - ! namelist information for the driver, CLM, and CAM. - !------------------------------------------------------------------------- subroutine shr_carma_readnl( NLFileName, carma_fields) + + !------------------------------------------------------------------------- + ! This reads the carma_emis_nl namelist group in drv_flds_in and parses the + ! namelist information for the driver, CLM, and CAM. + !------------------------------------------------------------------------- + use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadcast + character(len=*) , intent(in) :: NLFileName character(len=CX), intent(out) :: carma_fields diff --git a/src/drivers/nuopc/cime_flds_shr/shr_fire_emis_mod.F90 b/src/drivers/nuopc/cime_flds_shr/shr_fire_emis_mod.F90 index ae4220d281f..a86a0d393cd 100644 --- a/src/drivers/nuopc/cime_flds_shr/shr_fire_emis_mod.F90 +++ b/src/drivers/nuopc/cime_flds_shr/shr_fire_emis_mod.F90 @@ -1,12 +1,13 @@ -!================================================================================ -! Coordinates carbon emissions fluxes from CLM fires for use as sources of -! chemical constituents in CAM -! -! This module reads fire_emis_nl namelist which specifies the compound fluxes -! that are to be passed through the model coupler. -!================================================================================ module shr_fire_emis_mod + !================================================================================ + ! Coordinates carbon emissions fluxes from CLM fires for use as sources of + ! chemical constituents in CAM + ! + ! This module reads fire_emis_nl namelist which specifies the compound fluxes + ! that are to be passed through the model coupler. + !================================================================================ + use shr_kind_mod , only : r8 => shr_kind_r8 use shr_kind_mod , only : CL => SHR_KIND_CL, CX => SHR_KIND_CX, CS => SHR_KIND_CS use shr_sys_mod , only : shr_sys_abort @@ -29,10 +30,9 @@ module shr_fire_emis_mod logical :: shr_fire_emis_elevated = .true. - character(len=CS), public :: shr_fire_emis_fields_token = '' ! emissions fields token character(len=CL), public :: shr_fire_emis_factors_file = '' ! a table of basic fire emissions compounds character(len=CS), public :: shr_fire_emis_ztop_token = 'Sl_fztop' ! token for emissions top of vertical distribution - integer, parameter :: name_len=16 + integer, parameter :: name_len=16 ! fire emissions component data structure (or user defined type) type shr_fire_emis_comp_t @@ -61,56 +61,61 @@ module shr_fire_emis_mod integer :: shr_fire_emis_comps_n = 0 ! number of unique fire components integer :: shr_fire_emis_mechcomps_n = 0 ! number of unique compounds in the CAM chemical mechanism that have fire emissions +!------------------------------------------------------------------------- contains - - !------------------------------------------------------------------------- - ! - ! This reads the fire_emis_nl namelist group in drv_flds_in and parses the - ! namelist information for the driver, CLM, and CAM. - ! - ! Namelist variables: - ! fire_emis_specifier, fire_emis_factors_file, fire_emis_elevated - ! - ! fire_emis_specifier (array of strings) -- Each array element specifies - ! how CAM-Chem constituents are mapped to basic smoke compounds in - ! the fire emissions factors table (fire_emis_factors_file). Each - ! chemistry constituent name (left of '=' sign) is mapped to one or more - ! smoke compound (separated by + sign if more than one), which can be - ! proceeded by a multiplication factor (separated by '*'). - ! Example: - ! fire_emis_specifier = 'bc_a1 = BC','pom_a1 = 1.4*OC','SO2 = SO2' - ! - ! fire_emis_factors_file (string) -- Input file that contains the table - ! of basic compounds that make up the smoke from the CLM fires. This is - ! used in CLM module FireEmisFactorsMod. - ! - ! fire_emis_elevated (locical) -- If true then CAM-Chem treats the fire - ! emission sources as 3-D vertically distributed forcings for the - ! corresponding chemical tracers. - ! - !------------------------------------------------------------------------- - subroutine shr_fire_emis_readnl( NLFileName, emis_fields, emis_nflds ) - use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadcast - use shr_nl_mod, only : shr_nl_find_group_name - use shr_file_mod, only : shr_file_getUnit, shr_file_freeUnit - - +!------------------------------------------------------------------------- + + subroutine shr_fire_emis_readnl( NLFileName, emis_nflds ) + + !------------------------------------------------------------------------- + ! + ! This reads the fire_emis_nl namelist group in drv_flds_in and parses the + ! namelist information for the driver, CLM, and CAM. + ! + ! Namelist variables: + ! fire_emis_specifier, fire_emis_factors_file, fire_emis_elevated + ! + ! fire_emis_specifier (array of strings) -- Each array element specifies + ! how CAM-Chem constituents are mapped to basic smoke compounds in + ! the fire emissions factors table (fire_emis_factors_file). Each + ! chemistry constituent name (left of '=' sign) is mapped to one or more + ! smoke compound (separated by + sign if more than one), which can be + ! proceeded by a multiplication factor (separated by '*'). + ! Example: + ! fire_emis_specifier = 'bc_a1 = BC','pom_a1 = 1.4*OC','SO2 = SO2' + ! + ! fire_emis_factors_file (string) -- Input file that contains the table + ! of basic compounds that make up the smoke from the CLM fires. This is + ! used in CLM module FireEmisFactorsMod. + ! + ! fire_emis_elevated (locical) -- If true then CAM-Chem treats the fire + ! emission sources as 3-D vertically distributed forcings for the + ! corresponding chemical tracers. + ! + !------------------------------------------------------------------------- + + use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadcast + use shr_nl_mod , only : shr_nl_find_group_name + use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit + + ! input/output variables character(len=*), intent(in) :: NLFileName ! name of namelist file - character(len=*), intent(out) :: emis_fields ! emis flux fields integer, intent(out) :: emis_nflds - type(ESMF_VM) :: vm - integer :: localPet - integer :: rc - integer :: unitn ! namelist unit number - integer :: ierr ! error code - logical :: exists ! if file exists or not - integer, parameter :: maxspc = 100 - character(len=2*CX) :: fire_emis_specifier(maxspc) = ' ' - character(len=CL) :: fire_emis_factors_file = ' ' - logical :: fire_emis_elevated = .true. - integer :: i, tmp(1) + ! local variables + type(ESMF_VM) :: vm + integer :: localPet + integer :: rc + integer :: unitn ! namelist unit number + integer :: ierr ! error code + logical :: exists ! if file exists or not + integer, parameter :: maxspc = 100 + character(len=2*CX) :: fire_emis_specifier(maxspc) = ' ' + character(len=CL) :: fire_emis_factors_file = ' ' + logical :: fire_emis_elevated = .true. + integer :: i, tmp(1) character(*),parameter :: F00 = "('(shr_fire_emis_readnl) ',2a)" + !------------------------------------------------------------------ namelist /fire_emis_nl/ fire_emis_specifier, fire_emis_factors_file, fire_emis_elevated @@ -157,25 +162,30 @@ subroutine shr_fire_emis_readnl( NLFileName, emis_fields, emis_nflds ) shr_fire_emis_elevated = fire_emis_elevated ! parse the namelist info and initialize the module data - call shr_fire_emis_init( fire_emis_specifier, emis_fields ) + call shr_fire_emis_init( fire_emis_specifier ) end subroutine shr_fire_emis_readnl - !----------------------------------------------------------------------- - ! module data initializer - !------------------------------------------------------------------------ - subroutine shr_fire_emis_init( specifier, emis_fields ) +!------------------------------------------------------------------------- +! private methods... +!------------------------------------------------------------------------- + + subroutine shr_fire_emis_init( specifier ) + + !-------------------------------------------------- + ! module data initializer + !-------------------------------------------------- use shr_expr_parser_mod, only : shr_exp_parse, shr_exp_item_t, shr_exp_list_destroy + ! input/output variables character(len=*), intent(in) :: specifier(:) - character(len=*), intent(out) :: emis_fields + ! local variables integer :: n_entries integer :: i, j, k - type(shr_exp_item_t), pointer :: items_list, item - character(len=12) :: token ! fire emis field name to add + !------------------------------------------------------ nullify(shr_fire_emis_linkedlist) @@ -184,8 +194,6 @@ subroutine shr_fire_emis_init( specifier, emis_fields ) allocate(shr_fire_emis_mechcomps(n_entries)) shr_fire_emis_mechcomps(:)%n_emis_comps = 0 - emis_fields = '' - item => items_list i = 1 do while(associated(item)) @@ -208,32 +216,17 @@ subroutine shr_fire_emis_init( specifier, emis_fields ) enddo shr_fire_emis_mechcomps_n = shr_fire_emis_mechcomps_n+1 - write(token,333) shr_fire_emis_mechcomps_n - - if ( shr_fire_emis_mechcomps_n == 1 ) then - ! do not prepend ":" to the string for the first token - emis_fields = trim(token) - shr_fire_emis_fields_token = token - else - emis_fields = trim(emis_fields)//':'//trim(token) - endif - item => item%next_item i = i+1 enddo if (associated(items_list)) call shr_exp_list_destroy(items_list) ! Need to explicitly add Fl_ based on naming convention -333 format ('Fall_fire',i3.3) end subroutine shr_fire_emis_init !------------------------------------------------------------------------- - ! private methods... - - !------------------------------------------------------------------------- - !------------------------------------------------------------------------- function add_emis_comp( name, coeff ) result(emis_comp) character(len=*), intent(in) :: name @@ -263,7 +256,7 @@ function add_emis_comp( name, coeff ) result(emis_comp) end function add_emis_comp !------------------------------------------------------------------------- - !------------------------------------------------------------------------- + recursive function get_emis_comp_by_name(list_comp, name) result(emis_comp) type(shr_fire_emis_comp_t), pointer :: list_comp @@ -283,7 +276,7 @@ recursive function get_emis_comp_by_name(list_comp, name) result(emis_comp) end function get_emis_comp_by_name !------------------------------------------------------------------------- - !------------------------------------------------------------------------- + subroutine add_emis_comp_to_list( new_emis_comp ) type(shr_fire_emis_comp_t), target, intent(in) :: new_emis_comp diff --git a/src/drivers/nuopc/cime_flds_shr/shr_megan_mod.F90 b/src/drivers/nuopc/cime_flds_shr/shr_megan_mod.F90 index 659719f01bb..545d6cc7433 100644 --- a/src/drivers/nuopc/cime_flds_shr/shr_megan_mod.F90 +++ b/src/drivers/nuopc/cime_flds_shr/shr_megan_mod.F90 @@ -1,17 +1,19 @@ -!================================================================================ -! Handles MEGAN VOC emissions metadata for CLM produced chemical emissions -! 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 and how to assimble the fluxes. -! CAM needs to know what specific VOC fluxes to expect from CLM. -! -! Francis Vitt -- 26 Oct 2011 -!================================================================================ module shr_megan_mod + !================================================================================ + ! Handles MEGAN VOC emissions metadata for CLM produced chemical emissions + ! 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 + ! and how to assemble the fluxes. + ! - CAM needs to know what specific VOC fluxes to expect from CLM. + ! + ! Francis Vitt -- 26 Oct 2011 + !================================================================================ + use shr_kind_mod,only : r8 => shr_kind_r8 use shr_kind_mod,only : CL => SHR_KIND_CL, CX => SHR_KIND_CX, CS => SHR_KIND_CS use shr_sys_mod, only : shr_sys_abort @@ -19,7 +21,6 @@ module shr_megan_mod use shr_log_mod, only : logunit => shr_log_Unit implicit none - save private public :: shr_megan_readnl ! reads megan_emis_nl namelist @@ -33,9 +34,7 @@ module shr_megan_mod public :: shr_megan_comp_ptr logical , public :: megan_initialized = .false. ! true => shr_megan_readnl alreay called - character(len=CS), public :: shr_megan_fields_token = '' ! First drydep fields token character(len=CL), public :: shr_megan_factors_file = '' - character(len=CX), public :: shr_megan_fields = '' ! MEGAN compound data structure (or user defined type) type shr_megan_megcomp_t @@ -68,105 +67,108 @@ module shr_megan_mod ! switch to use mapped emission factors logical :: shr_megan_mapped_emisfctrs = .false. +!-------------------------------------------------------- contains - - !------------------------------------------------------------------------- - ! - ! This reads the megan_emis_nl namelist group in drv_flds_in and parses the - ! namelist information for the driver, CLM, and CAM. - ! - ! Namelist variables: - ! megan_specifier, megan_mapped_emisfctrs, megan_factors_file - ! - ! megan_specifier is a series of strings where each string contains one - ! CAM chemistry constituent name (left of = sign) and one or more MEGAN - ! compound (separated by + sign if more than one). Each MEGAN compound - ! can be proceeded by a multiplication factor (separated by *). The - ! specification of the MEGAN compounds to the right of the = signs tells - ! the MEGAN VOC model within CLM how to construct the VOC fluxes using - ! the factors in megan_factors_file and land surface state. - ! - ! megan_factors_file read by CLM contains valid MEGAN compound names, - ! MEGAN class groupings and scalar emission factors - ! - ! megan_mapped_emisfctrs switch is used to tell the MEGAN model to use - ! mapped emission factors read in from the CLM surface data input file - ! rather than the scalar factors from megan_factors_file - ! - ! Example: - ! &megan_emis_nl - ! megan_specifier = 'ISOP = isoprene', - ! 'C10H16 = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + ...', - ! 'CH3OH = methanol', - ! 'C2H5OH = ethanol', - ! 'CH2O = formaldehyde', - ! 'CH3CHO = acetaldehyde', - ! ... - ! megan_factors_file = '$datapath/megan_emis_factors.nc' - ! / - !------------------------------------------------------------------------- - subroutine shr_megan_readnl( NLFileName, megan_fields, megan_nflds ) - use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMBroadcast, ESMF_VMGet - use shr_nl_mod, only : shr_nl_find_group_name - use shr_file_mod, only : shr_file_getUnit, shr_file_freeUnit - +!-------------------------------------------------------- + + subroutine shr_megan_readnl( NLFileName, megan_nflds) + + !------------------------------------------------------------------------- + ! + ! This reads the megan_emis_nl namelist group in drv_flds_in and parses the + ! namelist information for the driver, CLM, and CAM. + ! + ! Namelist variables: + ! megan_specifier, megan_mapped_emisfctrs, megan_factors_file + ! + ! megan_specifier is a series of strings where each string contains one + ! CAM chemistry constituent name (left of = sign) and one or more MEGAN + ! compound (separated by + sign if more than one). Each MEGAN compound + ! can be proceeded by a multiplication factor (separated by *). The + ! specification of the MEGAN compounds to the right of the = signs tells + ! the MEGAN VOC model within CLM how to construct the VOC fluxes using + ! the factors in megan_factors_file and land surface state. + ! + ! megan_factors_file read by CLM contains valid MEGAN compound names, + ! MEGAN class groupings and scalar emission factors + ! + ! megan_mapped_emisfctrs switch is used to tell the MEGAN model to use + ! mapped emission factors read in from the CLM surface data input file + ! rather than the scalar factors from megan_factors_file + ! + ! Example: + ! &megan_emis_nl + ! megan_specifier = 'ISOP = isoprene', + ! 'C10H16 = myrcene + sabinene + limonene + carene_3 + ocimene_t_b + pinene_b + ...', + ! 'CH3OH = methanol', + ! 'C2H5OH = ethanol', + ! 'CH2O = formaldehyde', + ! 'CH3CHO = acetaldehyde', + ! ... + ! megan_factors_file = '$datapath/megan_emis_factors.nc' + ! / + !------------------------------------------------------------------------- + + use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMBroadcast, ESMF_VMGet + use shr_nl_mod , only : shr_nl_find_group_name + use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit + + ! input/output variables character(len=*), intent(in) :: NLFileName - character(len=*), intent(out) :: megan_fields integer, intent(out) :: megan_nflds - type(ESMF_VM) :: vm - integer :: localPet - integer :: unitn ! namelist unit number - integer :: ierr ! error code - logical :: exists ! if file exists or not + ! local variables + type(ESMF_VM) :: vm + integer :: localPet + 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) = ' ' logical :: megan_mapped_emisfctrs = .false. character(len=CL) :: megan_factors_file = ' ' - integer :: rc - integer :: i, tmp(1) + integer :: rc + integer :: i, tmp(1) character(*),parameter :: F00 = "('(shr_megan_readnl) ',2a)" + !-------------------------------------------------------------- namelist /megan_emis_nl/ megan_specifier, megan_factors_file, megan_mapped_emisfctrs ! If other processes have already initialized megan - then just return ! the megan_fields that have already been set if (megan_initialized) then - megan_fields = trim(shr_megan_fields) megan_nflds = shr_megan_mechcomps_n return end if + call ESMF_VMGetCurrent(vm, rc=rc) call ESMF_VMGet(vm, localpet=localpet, rc=rc) megan_nflds = 0 + if (localPet==0) then inquire( file=trim(NLFileName), exist=exists) if ( exists ) then unitn = shr_file_getUnit() open( unitn, file=trim(NLFilename), status='old' ) - if ( loglev > 0 ) write(logunit,F00) & - 'Read in megan_emis_readnl namelist from: ', trim(NLFilename) - + write(logunit,F00) 'Read in megan_emis_readnl namelist from: ', trim(NLFilename) call shr_nl_find_group_name(unitn, 'megan_emis_nl', status=ierr) - ! If ierr /= 0, no namelist present. - if (ierr == 0) then - read(unitn, megan_emis_nl, iostat=ierr) - + ! Note that ierr /= 0, no namelist is present. + read (unitn, megan_emis_nl, iostat=ierr) if (ierr > 0) then call shr_sys_abort( 'problem on read of megan_emis_nl namelist in shr_megan_readnl' ) endif endif - close( unitn ) call shr_file_freeUnit( unitn ) do i=1,maxspc - if(len_trim(megan_specifier(i)) > 0) then + if (len_trim(megan_specifier(i)) > 0) then megan_nflds=megan_nflds+1 endif enddo end if end if + tmp = megan_nflds call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc) megan_nflds = tmp(1) @@ -174,33 +176,39 @@ subroutine shr_megan_readnl( NLFileName, megan_fields, megan_nflds ) call ESMF_VMBroadcast(vm, megan_specifier, 2*CX*megan_nflds, 0, rc=rc) call ESMF_VMBroadcast(vm, megan_factors_file, CL, 0, rc=rc) tmp = 0 - if(megan_mapped_emisfctrs) tmp=1 + if (megan_mapped_emisfctrs) tmp=1 call ESMF_VMBroadcast(vm, tmp, 1, 0, rc=rc) - if(tmp(1)==1) megan_mapped_emisfctrs=.true. + if (tmp(1)==1) megan_mapped_emisfctrs=.true. endif shr_megan_factors_file = megan_factors_file shr_megan_mapped_emisfctrs = megan_mapped_emisfctrs ! parse the namelist info and initialize the module data - call shr_megan_init( megan_specifier, megan_fields ) + call shr_megan_init( megan_specifier ) + end subroutine shr_megan_readnl - !------------------------------------------------------------------------- - ! module data initializer - !------------------------------------------------------------------------- - subroutine shr_megan_init( specifier, megan_fields ) +!------------------------------------------------------------------------- +! private methods... +!------------------------------------------------------------------------- + + subroutine shr_megan_init( specifier) + + !----------------------------------------- + ! Initialize module data + !----------------------------------------- use shr_expr_parser_mod, only : shr_exp_parse, shr_exp_item_t, shr_exp_list_destroy + ! input/output variables character(len=*), intent(in) :: specifier(:) - character(len=*), intent(out) :: megan_fields - - integer :: n_entries - integer :: i, j, k + ! local variables + integer :: n_entries + integer :: i, j, k type(shr_exp_item_t), pointer :: items_list, item - character(len=12) :: token ! megan field name to add + !-------------------------------------------------------------- nullify(shr_megan_linkedlist) @@ -209,8 +217,6 @@ subroutine shr_megan_init( specifier, megan_fields ) allocate(shr_megan_mechcomps(n_entries)) shr_megan_mechcomps(:)%n_megan_comps = 0 - megan_fields = '' - item => items_list i = 1 do while(associated(item)) @@ -233,34 +239,18 @@ subroutine shr_megan_init( specifier, megan_fields ) enddo shr_megan_mechcomps_n = shr_megan_mechcomps_n+1 - write(token,333) shr_megan_mechcomps_n - - if ( shr_megan_mechcomps_n == 1 ) then - ! do not prepend ":" to the string for the first token - megan_fields = trim(token) - shr_megan_fields_token = token - else - megan_fields = trim(megan_fields)//':'//trim(token) - endif - item => item%next_item i = i+1 + enddo if (associated(items_list)) call shr_exp_list_destroy(items_list) megan_initialized = .true. - shr_megan_fields = trim(megan_fields) - - ! Need to explicitly add Fl_ based on naming convention -333 format ('Fall_voc',i3.3) end subroutine shr_megan_init !------------------------------------------------------------------------- - ! private methods... - !------------------------------------------------------------------------- - !------------------------------------------------------------------------- function add_megan_comp( name, coeff ) result(megan_comp) character(len=16), intent(in) :: name @@ -290,7 +280,7 @@ function add_megan_comp( name, coeff ) result(megan_comp) end function add_megan_comp !------------------------------------------------------------------------- - !------------------------------------------------------------------------- + recursive function get_megan_comp_by_name(list_comp, name) result(megan_comp) type(shr_megan_megcomp_t), pointer :: list_comp @@ -310,7 +300,7 @@ recursive function get_megan_comp_by_name(list_comp, name) result(megan_comp) end function get_megan_comp_by_name !------------------------------------------------------------------------- - !------------------------------------------------------------------------- + subroutine add_megan_comp_to_list( new_megan_comp ) type(shr_megan_megcomp_t), target, intent(in) :: new_megan_comp diff --git a/src/drivers/nuopc/cime_flds_shr/shr_ndep_mod.F90 b/src/drivers/nuopc/cime_flds_shr/shr_ndep_mod.F90 index c48e0235651..65605c98a7a 100644 --- a/src/drivers/nuopc/cime_flds_shr/shr_ndep_mod.F90 +++ b/src/drivers/nuopc/cime_flds_shr/shr_ndep_mod.F90 @@ -22,40 +22,37 @@ module shr_ndep_mod CONTAINS !==================================================================================== - subroutine shr_ndep_readnl(NLFilename, ndep_fields, ndep_nflds) + subroutine shr_ndep_readnl(NLFilename, ndep_nflds) !======================================================================== ! reads ndep_inparm namelist and sets up driver list of fields for ! atmosphere -> land and atmosphere -> ocn communications. !======================================================================== - use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit - use shr_nl_mod , only : shr_nl_find_group_name - use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMBroadcast, ESMF_VMGet + use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit + use shr_nl_mod , only : shr_nl_find_group_name + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMBroadcast, ESMF_VMGet use shr_nuopc_utils_mod , only : shr_nuopc_utils_chkerr - implicit none - + ! input/output variables character(len=*), intent(in) :: NLFilename ! Namelist filename - character(len=*), intent(out) :: ndep_fields integer , intent(out) :: ndep_nflds !----- local ----- - type(ESMF_VM) :: vm - integer :: i ! Indices - integer :: unitn ! namelist unit number - integer :: ierr ! error code - integer :: tmp(1) - logical :: exists ! if file exists or not - character(len=8) :: token ! dry dep field name to add - integer :: rc - integer, parameter :: maxspc = 100 ! Maximum number of species - character(len=32) :: ndep_list(maxspc) = '' ! List of ndep species - integer :: localpet - !----- formats ----- + type(ESMF_VM) :: vm + integer :: i ! Indices + integer :: unitn ! namelist unit number + integer :: ierr ! error code + integer :: tmp(1) + logical :: exists ! if file exists or not + integer :: rc + integer, parameter :: maxspc = 100 ! Maximum number of species + character(len=32) :: ndep_list(maxspc) = '' ! List of ndep species + integer :: localpet character(*),parameter :: subName = '(shr_ndep_read) ' character(*),parameter :: F00 = "('(shr_ndep_read) ',8a)" character(*),parameter :: FI1 = "('(shr_ndep_init) ',a,I2)" + ! ------------------------------------------------------------------ namelist /ndep_inparm/ ndep_list @@ -107,22 +104,6 @@ subroutine shr_ndep_readnl(NLFilename, ndep_fields, ndep_nflds) ndep_nflds=tmp(1) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - ndep_fields = ' ' - - if(ndep_nflds > 0) then - call ESMF_VMBroadcast(vm, ndep_list, 32*ndep_nflds, 0, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - ! Loop over species to fill list of fields to communicate for ndep - do i=1,ndep_nflds - if ( len_trim(ndep_list(i))==0 ) exit - if ( i == 1 ) then - ndep_fields = 'Faxa_' // trim(ndep_list(i)) - else - ndep_fields = trim(ndep_fields)//':'//'Faxa_' // trim(ndep_list(i)) - endif - enddo - end if - end subroutine shr_ndep_readnl end module shr_ndep_mod diff --git a/src/drivers/nuopc/mediator/med.F90 b/src/drivers/nuopc/mediator/med.F90 index 623b66a6133..631c5153ab3 100644 --- a/src/drivers/nuopc/mediator/med.F90 +++ b/src/drivers/nuopc/mediator/med.F90 @@ -48,20 +48,6 @@ subroutine SetServices(gcomp, rc) use NUOPC_Mediator , only: mediator_label_Finalize => label_Finalize use med_phases_history_mod , only: med_phases_history_write use med_phases_restart_mod , only: med_phases_restart_write - use med_connectors_mod , only: med_connectors_prep_med2atm - use med_connectors_mod , only: med_connectors_prep_med2ocn - use med_connectors_mod , only: med_connectors_prep_med2ice - use med_connectors_mod , only: med_connectors_prep_med2lnd - use med_connectors_mod , only: med_connectors_prep_med2rof - use med_connectors_mod , only: med_connectors_prep_med2wav - use med_connectors_mod , only: med_connectors_prep_med2glc - use med_connectors_mod , only: med_connectors_post_atm2med - use med_connectors_mod , only: med_connectors_post_ocn2med - use med_connectors_mod , only: med_connectors_post_ice2med - use med_connectors_mod , only: med_connectors_post_lnd2med - use med_connectors_mod , only: med_connectors_post_rof2med - use med_connectors_mod , only: med_connectors_post_wav2med - use med_connectors_mod , only: med_connectors_post_glc2med use med_phases_prep_atm_mod , only: med_phases_prep_atm use med_phases_prep_ice_mod , only: med_phases_prep_ice use med_phases_prep_lnd_mod , only: med_phases_prep_lnd @@ -177,110 +163,6 @@ subroutine SetServices(gcomp, rc) specPhaseLabel="med_phases_profile", specRoutine=med_phases_profile, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - !------------------ - ! prep and post phases for connectors - !------------------ - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_prep_med2atm"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_prep_med2atm", specRoutine=med_connectors_prep_med2atm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_post_atm2med"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_post_atm2med", specRoutine=med_connectors_post_atm2med, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_prep_med2ocn"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_prep_med2ocn", specRoutine=med_connectors_prep_med2ocn, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_post_ocn2med"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_post_ocn2med", specRoutine=med_connectors_post_ocn2med, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_prep_med2ice"/), & - userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_prep_med2ice", specRoutine=med_connectors_prep_med2ice, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_post_ice2med"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_post_ice2med", specRoutine=med_connectors_post_ice2med, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_prep_med2lnd"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_prep_med2lnd", specRoutine=med_connectors_prep_med2lnd, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_post_lnd2med"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_post_lnd2med", specRoutine=med_connectors_post_lnd2med, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_prep_med2rof"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_prep_med2rof", specRoutine=med_connectors_prep_med2rof, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_post_rof2med"/), & - userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_post_rof2med", specRoutine=med_connectors_post_rof2med, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_prep_med2wav"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_prep_med2wav", specRoutine=med_connectors_prep_med2wav, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_post_wav2med"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_post_wav2med", specRoutine=med_connectors_post_wav2med, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_prep_med2glc"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_prep_med2glc", specRoutine=med_connectors_prep_med2glc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & - phaseLabelList=(/"med_connectors_post_glc2med"/), userRoutine=mediator_routine_Run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Advance, & - specPhaseLabel="med_connectors_post_glc2med", specRoutine=med_connectors_post_glc2med, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - !------------------ ! prep routines for atm !------------------ @@ -453,8 +335,9 @@ end subroutine SetServices !----------------------------------------------------------------------------- subroutine InitializeP0(gcomp, importState, exportState, clock, rc) + use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_VM, ESMF_SUCCESS - use ESMF , only : ESMF_UtilString2Int, ESMF_GridCompGet, ESMF_VMGet, ESMF_AttributeGet + use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_AttributeGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE use ESMF , only : ESMF_GridCompGet use NUOPC , only : NUOPC_CompFilterPhaseMap @@ -467,11 +350,10 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) ! local variables type(ESMF_VM) :: vm - character(len=*),parameter :: subname='(module_MED:InitializeP0)' - character(len=128) :: value - integer :: dbrc + character(len=128) :: value integer :: localPet - character(len=CX):: msgString + character(len=CX) :: msgString + character(len=*),parameter :: subname='(module_MED:InitializeP0)' !----------------------------------------------------------- rc = ESMF_SUCCESS @@ -486,21 +368,17 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) convention="NUOPC", purpose="Instance", rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": Mediator verbosity is "//trim(value), ESMF_LOGMSG_INFO, rc=dbrc) - -! dbug_flag = ESMF_UtilString2Int(value, & -! specialStringList=(/"min","max","high"/), specialValueList=(/0,255,255/), rc=rc) -! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": Mediator verbosity is "//trim(value), ESMF_LOGMSG_INFO) write(msgString,'(A,i6)') trim(subname)//' dbug_flag = ',dbug_flag - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) ! Switch to IPDv03 by filtering all other phaseMap entries call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, acceptStringList=(/"IPDv03p"/), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine InitializeP0 @@ -535,12 +413,11 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) integer :: n, n1, n2, ncomp, nflds character(len=CS) :: transferOffer type(InternalState) :: is_local - integer :: dbrc integer :: stat character(len=*),parameter :: subname='(module_MED:InitializeIPDv03p1)' !----------------------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS !------------------ @@ -632,13 +509,14 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) call NUOPC_Advertise(is_local%wrap%NStateExp(ncomp), standardName=stdname, shortname=shortname, name=shortname, & TransferOfferGeomObject=transferOffer) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(subname//':To_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end do end if end do ! end of ncomps loop - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine InitializeIPDv03p1 @@ -665,35 +543,24 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - integer :: i, j - real(kind=R8),pointer :: lonPtr(:), latPtr(:) type(InternalState) :: is_local - real(R8) :: intervalSec - type(ESMF_TimeInterval) :: timeStep - ! tcx XGrid - ! type(ESMF_Field) :: fieldX, fieldA, fieldO - ! type(ESMF_XGrid) :: xgrid type(ESMF_VM) :: vm - integer :: n, n1, n2 - character(CL) :: cvalue - logical :: connected - integer :: dbrc - integer :: stat + integer :: n character(len=*),parameter :: subname='(module_MED:InitializeIPDv03p3)' !----------------------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS ! Get the internal state from Component. nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! Initialize the internal state members - is_local%wrap%vm = vm + ! Initialize the internal state mediator vm + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%vm = vm ! Realize States do n = 1,ncomps @@ -709,7 +576,7 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) endif enddo - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine InitializeIPDv03p3 @@ -744,11 +611,10 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) ! integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) ! integer, allocatable :: regDecompPTile(:,:) ! integer :: i, j, n, n1 - integer :: dbrc character(len=*),parameter :: subname='(module_MED:realizeConnectedGrid)' !----------------------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS ! Get the internal state from the mediator gridded component. @@ -761,7 +627,7 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) !------------------ do n1 = 1,ncomps - call ESMF_LogWrite(trim(subname)//": calling for component "//trim(compname(n1)), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": calling for component "//trim(compname(n1)), ESMF_LOGMSG_INFO) if (ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then call realizeConnectedGrid(is_local%wrap%NStateImp(n1), trim(compname(n1))//'Imp', rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -770,9 +636,9 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) call realizeConnectedGrid(is_local%wrap%NStateExp(n1), trim(compname(n1))//'Exp', rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return endif - call ESMF_LogWrite(trim(subname)//": finished for component "//trim(compname(n1)), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": finished for component "//trim(compname(n1)), ESMF_LOGMSG_INFO) enddo - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -813,10 +679,9 @@ subroutine realizeConnectedGrid(State,string,rc) type(ESMF_GeomType_Flag) :: geomtype character(ESMF_MAXSTR),allocatable :: fieldNameList(:) type(ESMF_FieldStatus_Flag) :: fieldStatus - integer :: dbrc character(len=CX) :: msgString character(len=*),parameter :: subname='(module_MEDIATOR:realizeConnectedGrid)' - + !----------------------------------------------------------- !NOTE: All of the Fields that set their TransferOfferGeomObject Attribute !NOTE: to "cannot provide" should now have the accepted Grid available. @@ -827,7 +692,7 @@ subroutine realizeConnectedGrid(State,string,rc) !TODO: quick implementation, do it for each field one by one !TODO: commented out below are application to other fields - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_Success call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) @@ -877,9 +742,9 @@ subroutine realizeConnectedGrid(State,string,rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": geomtype is ESMF_GEOMTYPE_GRID for "//trim(fieldnameList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) write(msgString,'(A,i8)') trim(subname)//':arbdimcount =',arbdimcount - call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO) ! make decision on whether the incoming Grid is arbDistr or not if (arbDimCount>0) then @@ -897,7 +762,7 @@ subroutine realizeConnectedGrid(State,string,rc) if (grid_arbopt == "grid_reg") then call ESMF_LogWrite(trim(subname)//trim(string)//": accept arb2reg grid for "//trim(fieldNameList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) ! Use a regDecomp representation for the grid ! first get tile min/max, only single tile supported for arbDistr Grid @@ -939,7 +804,7 @@ subroutine realizeConnectedGrid(State,string,rc) ! redistribute the arbSeqIndexList. Here simply keep the DEs of the ! provider Grid. call ESMF_LogWrite(trim(subname)//trim(string)//": accept arb2arb grid for "//trim(fieldNameList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) else ! grid_arbopt @@ -957,7 +822,7 @@ subroutine realizeConnectedGrid(State,string,rc) ! access localDeCount to show this is a real Grid call ESMF_LogWrite(trim(subname)//trim(string)//": accept reg2reg grid for "//& - trim(fieldNameList(n)), ESMF_LOGMSG_INFO, rc=dbrc) + trim(fieldNameList(n)), ESMF_LOGMSG_INFO) call ESMF_FieldGet(field, grid=grid, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1003,7 +868,7 @@ subroutine realizeConnectedGrid(State,string,rc) do i1 = 1,dimCount write(msgString,'(A,5i8)') trim(subname)//':PTile =',i2,i1,minIndexPTile(i1,i2),& maxIndexPTile(i1,i2),regDecompPTile(i1,i2) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) enddo enddo @@ -1085,7 +950,7 @@ subroutine realizeConnectedGrid(State,string,rc) elseif (geomtype == ESMF_GEOMTYPE_MESH) then call ESMF_LogWrite(trim(subname)//": geomtype is ESMF_GEOMTYPE_MESH for "//trim(fieldnameList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) if (dbug_flag > 1) then call shr_nuopc_methods_Field_GeomPrint(field,trim(fieldNameList(n))//'_orig',rc) @@ -1153,12 +1018,12 @@ subroutine realizeConnectedGrid(State,string,rc) elseif (fieldStatus==ESMF_FIELDSTATUS_EMPTY) then call ESMF_LogWrite(trim(subname)//trim(string)//": provide grid for "//trim(fieldNameList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) elseif (fieldStatus==ESMF_FIELDSTATUS_COMPLETE) then call ESMF_LogWrite(trim(subname)//trim(string)//": no grid provided for "//trim(fieldNameList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) else @@ -1172,7 +1037,7 @@ subroutine realizeConnectedGrid(State,string,rc) deallocate(fieldNameList) - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine realizeConnectedGrid @@ -1203,10 +1068,9 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) type(InternalState) :: is_local integer :: n1,n2 character(len=*),parameter :: subname='(module_MED:InitializeIPDv03p5)' - integer :: dbrc !----------------------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS @@ -1222,7 +1086,7 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) if (ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then call ESMF_LogWrite(trim(subname)//": calling completeFieldInitialize import states from "//trim(compname(n1)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) call completeFieldInitialization(is_local%wrap%NStateImp(n1), rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1232,7 +1096,7 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n1),rc=rc)) then call ESMF_LogWrite(trim(subname)//": calling completeFieldInitialize export states to "//trim(compname(n1)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) call completeFieldInitialization(is_local%wrap%NStateExp(n1), rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1249,7 +1113,7 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) endif enddo - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -1260,6 +1124,7 @@ subroutine completeFieldInitialization(State,rc) use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FieldGet, ESMF_FieldEmptyComplete use ESMF , only : ESMF_GeomType_Flag, ESMF_FieldCreate, ESMF_GridToMeshCell, ESMF_GEOMTYPE_GRID use ESMF , only : ESMF_MeshLoc_Element, ESMF_TYPEKIND_R8, ESMF_FIELDSTATUS_GRIDSET + use ESMF , only : ESMF_AttributeGet use NUOPC , only : NUOPC_getStateMemberLists, NUOPC_Realize use shr_nuopc_scalars_mod , only : flds_scalar_name, flds_scalar_num use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_getNumFields @@ -1278,9 +1143,14 @@ subroutine completeFieldInitialization(State,rc) type(ESMF_Field),pointer :: fieldList(:) type(ESMF_FieldStatus_Flag) :: fieldStatus type(ESMF_GeomType_Flag) :: geomtype + integer :: gridToFieldMapCount, ungriddedCount + integer, allocatable :: gridToFieldMap(:) + integer, allocatable :: ungriddedLBound(:), ungriddedUBound(:) + logical :: isPresent character(len=*),parameter :: subname='(module_MED:completeFieldInitialization)' + !----------------------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_Success call shr_nuopc_methods_State_GetNumFields(State, fieldCount, rc=rc) @@ -1310,7 +1180,8 @@ subroutine completeFieldInitialization(State,rc) mesh = ESMF_GridToMeshCell(grid,rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - meshField = ESMF_FieldCreate(mesh, typekind=ESMF_TYPEKIND_R8, meshloc=ESMF_MESHLOC_ELEMENT, name=fieldName, rc=rc) + meshField = ESMF_FieldCreate(mesh, typekind=ESMF_TYPEKIND_R8, & + meshloc=ESMF_MESHLOC_ELEMENT, name=fieldName, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! Swap grid for mesh, at this point, only connected fields are in the state @@ -1321,20 +1192,42 @@ subroutine completeFieldInitialization(State,rc) if (fieldStatus==ESMF_FIELDSTATUS_GRIDSET) then call ESMF_LogWrite(subname//" is allocating field memory for field "//trim(fieldName), & ESMF_LOGMSG_INFO, rc=rc) - call ESMF_FieldEmptyComplete(fieldList(n), typekind=ESMF_TYPEKIND_R8, rc=rc) + + call ESMF_AttributeGet(fieldList(n), name="GridToFieldMap", convention="NUOPC", & + purpose="Instance", itemCount=gridToFieldMapCount, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(gridToFieldMap(gridToFieldMapCount)) + call ESMF_AttributeGet(fieldList(n), name="GridToFieldMap", convention="NUOPC", & + purpose="Instance", valueList=gridToFieldMap, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ungriddedCount=0 ! initialize in case it was not set + call ESMF_AttributeGet(fieldList(n), name="UngriddedLBound", convention="NUOPC", & + purpose="Instance", itemCount=ungriddedCount, isPresent=isPresent, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(ungriddedLBound(ungriddedCount), ungriddedUBound(ungriddedCount)) + + if (ungriddedCount > 0) then + call ESMF_AttributeGet(fieldList(n), name="UngriddedLBound", convention="NUOPC", & + purpose="Instance", valueList=ungriddedLBound, rc=rc) + call ESMF_AttributeGet(fieldList(n), name="UngriddedUBound", convention="NUOPC", & + purpose="Instance", valueList=ungriddedUBound, rc=rc) + endif + + call ESMF_FieldEmptyComplete(fieldList(n), typekind=ESMF_TYPEKIND_R8, gridToFieldMap=gridToFieldMap, & + ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, rc=rc) + + deallocate(gridToFieldMap, ungriddedLbound, ungriddedUbound) endif ! fieldStatus - if (dbug_flag > 1) then - call shr_nuopc_methods_Field_GeomPrint(fieldList(n), trim(subname)//':'//trim(fieldName), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if + call shr_nuopc_methods_Field_GeomPrint(fieldList(n), trim(subname)//':'//trim(fieldName), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return enddo deallocate(fieldList) endif - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine completeFieldInitialization @@ -1343,6 +1236,7 @@ end subroutine InitializeIPDv03p5 !----------------------------------------------------------------------------- subroutine DataInitialize(gcomp, rc) + !---------------------------------------------------------- ! Finish initialization and resolve data dependencies ! There will be multiple passes @@ -1350,10 +1244,9 @@ subroutine DataInitialize(gcomp, rc) ! Do not assume any import fields are connected, just allocate space and such ! -- Check present flags ! -- Check for active coupling interactions - ! -- Initialize connector count arrays in med_internal_state ! -- Create FBs: FBImp, FBExp, FBExpAccum ! -- Create mediator specific field bundles (not part of import/export states) - ! -- Initialize med_infodata, FBExpAccums (to zero), and FBImp (from NStateImp) + ! -- Initialize FBExpAccums (to zero), and FBImp (from NStateImp) ! -- Read mediator restarts ! -- Initialize route handles ! -- Initialize field bundles for normalization @@ -1373,7 +1266,8 @@ subroutine DataInitialize(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_LogWrite, ESMF_LOGMSG_INFO use ESMF , only : ESMF_State, ESMF_Time, ESMF_Field, ESMF_StateItem_Flag, ESMF_MAXSTR use ESMF , only : ESMF_GridCompGet, ESMF_AttributeGet, ESMF_ClockGet, ESMF_Success - use ESMF , only : ESMF_StateIsCreated, ESMF_StateGet, ESMF_LogFlush + use ESMF , only : ESMF_StateIsCreated, ESMF_StateGet, ESMF_FieldBundleIsCreated, ESMF_LogFlush + use ESMF , only : ESMF_VM use NUOPC , only : NUOPC_CompAttributeSet, NUOPC_IsAtTime, NUOPC_SetAttribute use NUOPC , only : NUOPC_CompAttributeGet use med_internalstate_mod , only : InternalState @@ -1389,33 +1283,20 @@ subroutine DataInitialize(gcomp, rc) use esmFlds , only : shr_nuopc_fldList_Document_Merging use esmFldsExchange_mod , only : esmFldsExchange use shr_nuopc_scalars_mod , only : flds_scalar_name, flds_scalar_num + use shr_nuopc_scalars_mod , only : flds_scalar_index_nx, flds_scalar_index_ny use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_getNumFields use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_Init + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_Init_pointer use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_Reset use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_Copy use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk - use med_infodata_mod , only : med_infodata_CopyStateToInfodata - use med_infodata_mod , only : med_infodata + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_GetScalar use med_fraction_mod , only : med_fraction_init, med_fraction_set use med_phases_restart_mod , only : med_phases_restart_read use med_phases_prep_atm_mod , only : med_phases_prep_atm use med_phases_ocnalb_mod , only : med_phases_ocnalb_run use med_phases_aofluxes_mod , only : med_phases_aofluxes_run use med_phases_profile_mod , only : med_phases_profile - use med_connectors_mod , only : med_connectors_prep_med2atm - use med_connectors_mod , only : med_connectors_prep_med2ocn - use med_connectors_mod , only : med_connectors_prep_med2ice - use med_connectors_mod , only : med_connectors_prep_med2lnd - use med_connectors_mod , only : med_connectors_prep_med2rof - use med_connectors_mod , only : med_connectors_prep_med2wav - use med_connectors_mod , only : med_connectors_prep_med2glc - use med_connectors_mod , only : med_connectors_post_atm2med - use med_connectors_mod , only : med_connectors_post_ocn2med - use med_connectors_mod , only : med_connectors_post_ice2med - use med_connectors_mod , only : med_connectors_post_lnd2med - use med_connectors_mod , only : med_connectors_post_rof2med - use med_connectors_mod , only : med_connectors_post_wav2med - use med_connectors_mod , only : med_connectors_post_glc2med use med_map_mod , only : med_map_MapNorm_init, med_map_RouteHandles_init use med_io_mod , only : med_io_init @@ -1425,6 +1306,7 @@ 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 @@ -1445,12 +1327,12 @@ subroutine DataInitialize(gcomp, rc) logical,save :: ocnDone = .false. logical,save :: allDone = .false. logical,save :: first_call = .true. - integer :: dbrc + real(r8) :: real_nx, real_ny character(len=CX) :: msgString character(len=*), parameter :: subname='(module_MED:DataInitialize)' !----------------------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) @@ -1491,7 +1373,7 @@ subroutine DataInitialize(gcomp, rc) is_local%wrap%comp_present(n1) = (value == "true") write(msgString,'(A,L4)') trim(subname)//' comp_present(comp'//trim(compname(n1))//') = ',& is_local%wrap%comp_present(n1) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) enddo !---------------------------------------------------------- @@ -1511,8 +1393,7 @@ subroutine DataInitialize(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return if (cntn1 > 0) then do n2 = 1,ncomps - if (is_local%wrap%comp_present(n2) .and. & - ESMF_StateIsCreated(is_local%wrap%NStateExp(n2),rc=rc) .and. & + if (is_local%wrap%comp_present(n2) .and. ESMF_StateIsCreated(is_local%wrap%NStateExp(n2),rc=rc) .and. & med_coupling_allowed(n1,n2)) then call shr_nuopc_methods_State_GetNumFields(is_local%wrap%NStateExp(n2), cntn2, rc=rc) ! Import Field Count if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1566,9 +1447,6 @@ subroutine DataInitialize(gcomp, rc) call ESMF_LogWrite("Starting to Create FBs", ESMF_LOGMSG_INFO) call ESMF_LogFlush() - is_local%wrap%conn_prep_cnt(:) = 0 - is_local%wrap%conn_post_cnt(:) = 0 - !---------------------------------------------------------- ! Create field bundles FBImp, FBExp, FBImpAccum, FBExpAccum !---------------------------------------------------------- @@ -1580,30 +1458,28 @@ subroutine DataInitialize(gcomp, rc) if (mastertask) write(logunit,*) subname,' initializing FBs for '//trim(compname(n1)) - call shr_nuopc_methods_FB_init(is_local%wrap%FBImp(n1,n1), flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(n1), & - STflds=is_local%wrap%NStateImp(n1), & - name='FBImp'//trim(compname(n1)), rc=rc) + ! Create FBImp(:) with pointers directly into NStateImp(:) + call shr_nuopc_methods_FB_init_pointer(is_local%wrap%NStateImp(n1), is_local%wrap%FBImp(n1,n1), & + flds_scalar_name, name='FBImp'//trim(compname(n1)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create FBExp(:) with pointers directly into NStateExp(:) + call shr_nuopc_methods_FB_init_pointer(is_local%wrap%NStateExp(n1), is_local%wrap%FBExp(n1), & + flds_scalar_name, name='FBExp'//trim(compname(n1)), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! Create import accumulation field bundles call shr_nuopc_methods_FB_init(is_local%wrap%FBImpAccum(n1,n1), flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(n1), & - STflds=is_local%wrap%NStateImp(n1), & + STgeom=is_local%wrap%NStateImp(n1), STflds=is_local%wrap%NStateImp(n1), & name='FBImp'//trim(compname(n1)), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_reset(is_local%wrap%FBImpAccum(n1,n1), value=czero, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return is_local%wrap%FBImpAccumCnt(n1) = 0 - call shr_nuopc_methods_FB_init(is_local%wrap%FBExp(n1), flds_scalar_name, & - STgeom=is_local%wrap%NStateExp(n1), & - STflds=is_local%wrap%NStateExp(n1), & - name='FBExp'//trim(compname(n1)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + ! Create export accumulation field bundles call shr_nuopc_methods_FB_init(is_local%wrap%FBExpAccum(n1), flds_scalar_name, & - STgeom=is_local%wrap%NStateExp(n1), & - STflds=is_local%wrap%NStateExp(n1), & + STgeom=is_local%wrap%NStateExp(n1), STflds=is_local%wrap%NStateExp(n1), & name='FBExpAccum'//trim(compname(n1)), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_reset(is_local%wrap%FBExpAccum(n1), value=czero, rc=rc) @@ -1620,7 +1496,7 @@ subroutine DataInitialize(gcomp, rc) if (n1 /= n2 .and. & is_local%wrap%med_coupling_active(n1,n2) .and. & ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc) .and. & - ESMF_StateIsCreated(is_local%wrap%NStateExp(n2),rc=rc)) then + ESMF_StateIsCreated(is_local%wrap%NStateImp(n2),rc=rc)) then if (mastertask) write(logunit,*) subname,' initializing FBs for '//& trim(compname(n1))//'_'//trim(compname(n2)) @@ -1644,23 +1520,29 @@ subroutine DataInitialize(gcomp, rc) enddo ! loop over n2 enddo ! loop over n1 + if (mastertask) call shr_sys_flush(logunit) !--------------------------------------- ! Initialize field bundles needed for ocn albedo and ocn/atm flux calculations !--------------------------------------- + ! NOTE: the NStateImp(compocn) or NStateImp(compatm) used below + ! rather than NStateExp(n2), since the export state might only + ! contain control data and no grid information if if the target + ! component (n2) is not prognostic only receives control data back + + ! NOTE: this section must be done BEFORE the call to esmFldsExchange + ! Create field bundles for mediator ocean albedo computation + if ( is_local%wrap%med_coupling_active(compocn,compatm) .or. & is_local%wrap%med_coupling_active(compatm,compocn)) then - ! NOTE: the NStateImp(compocn) or NStateImp(compatm) used below - ! rather than NStateExp(n2), since the export state might only - ! contain control data and no grid information if if the target - ! component (n2) is not prognostic only receives control data back + if (.not. is_local%wrap%med_coupling_active(compatm,compocn)) then + is_local%wrap%med_coupling_active(compatm,compocn) = .true. + end if - ! NOTE: this section must be done BEFORE the call to esmFldsExchange ! Create field bundles for mediator ocean albedo computation - fieldCount = shr_nuopc_fldList_GetNumFlds(fldListMed_ocnalb) if (fieldCount > 0) then allocate(fldnames(fieldCount)) @@ -1670,15 +1552,28 @@ subroutine DataInitialize(gcomp, rc) call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_ocnalb_a, flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_ocnalb_a', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) write(logunit,*) subname,' initializing FB FBMed_ocnalb_a' call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_ocnalb_o, flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames, name='FBMed_ocnalb_o', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) write(logunit,*) subname,' initializing FB FBMed_ocnalb_o' deallocate(fldnames) + + ! The following assumes that the mediator atm/ocn flux calculation will be done on the ocean grid + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compatm,compocn), rc=rc)) then + call ESMF_LogWrite(trim(subname)//' creating field bundle FBImp(compatm,compocn)', ESMF_LOGMSG_INFO) + call shr_nuopc_methods_FB_init(is_local%wrap%FBImp(compatm,compocn), flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compocn), & + STflds=is_local%wrap%NStateImp(compatm), & + name='FBImp'//trim(compname(compatm))//'_'//trim(compname(compocn)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + if (mastertask) write(logunit,*) subname,' initializing FBs for '// & + trim(compname(compatm))//'_'//trim(compname(compocn)) end if ! Create field bundles for mediator ocean/atmosphere flux computation - fieldCount = shr_nuopc_fldList_GetNumFlds(fldListMed_aoflux) if (fieldCount > 0) then allocate(fldnames(fieldCount)) @@ -1688,10 +1583,12 @@ subroutine DataInitialize(gcomp, rc) call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_aoflux_a, flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_aoflux_a', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) write(logunit,*) subname,' initializing FB FBMed_aoflux_a' call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_aoflux_o, flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames, name='FBMed_aoflux_o', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (mastertask) write(logunit,*) subname,' initializing FB FBMed_aoflux_o' deallocate(fldnames) end if end if @@ -1731,6 +1628,9 @@ subroutine DataInitialize(gcomp, rc) ! This is called every loop around DataInitialize !--------------------------------------- + call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__LINE__,u_FILE_u)) return + do n1 = 1,ncomps LocalDone = .true. if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then @@ -1751,9 +1651,6 @@ subroutine DataInitialize(gcomp, rc) if (atCorrectTime) then if (fieldNameList(n) == flds_scalar_name) then - call med_infodata_CopyStateToInfodata(is_local%wrap%NStateImp(n1), med_infodata, & - trim(compname(n1))//'2cpli', is_local%wrap%vm, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//" MED - Initialize-Data-Dependency CSTI "//trim(compname(n1)), & ESMF_LOGMSG_INFO, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1765,9 +1662,11 @@ subroutine DataInitialize(gcomp, rc) deallocate(fieldNameList) if (LocalDone) then + ! This copies NStateImp(n1) TO FBImp(n1, n1) call shr_nuopc_methods_FB_copy(is_local%wrap%FBImp(n1,n1), is_local%wrap%NStateImp(n1), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//" MED - Initialize-Data-Dependency Copy Import "//trim(compname(n1)), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//" MED - Initialize-Data-Dependency Copy Import "//& + trim(compname(n1)), ESMF_LOGMSG_INFO, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return if (n1 == compocn) ocnDone = .true. if (n1 == compatm) atmDone = .true. @@ -1832,10 +1731,6 @@ subroutine DataInitialize(gcomp, rc) call med_phases_prep_atm(gcomp, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! copy the FBExp(compatm) to NstatExp(compatm) - call med_connectors_prep_med2atm(gcomp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! change 'Updated' attribute to true for ALL exportState fields call ESMF_StateGet(is_local%wrap%NStateExp(compatm), itemCount=fieldCount, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1854,12 +1749,6 @@ subroutine DataInitialize(gcomp, rc) call ESMF_LogWrite("MED - Initialize-Data-Dependency Sending Data to ATM", ESMF_LOGMSG_INFO, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return endif - else - if (is_local%wrap%comp_present(compatm)) then - ! Copy the NstateImp(compatm) to FBImp(compatm) - call med_connectors_post_atm2med(gcomp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if endif allDone = .true. @@ -1895,6 +1784,34 @@ subroutine DataInitialize(gcomp, rc) call ESMF_LogWrite("MED - Initialize-Data-Dependency allDone check Passed", ESMF_LOGMSG_INFO, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------- + ! Create component dimensions in mediator internal state + !--------------------------------------- + + write(logunit,*) + do n1 = 1,ncomps + if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then + call shr_nuopc_methods_State_GetScalar(scalar_value=real_nx, scalar_id=flds_scalar_index_nx, & + state=is_local%wrap%NstateImp(n1), flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, rc=rc) + call shr_nuopc_methods_State_GetScalar(scalar_value=real_ny, scalar_id=flds_scalar_index_ny, & + state=is_local%wrap%NstateImp(n1), flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, rc=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 + write(logunit,*) '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 + write(logunit,*) + + !--------------------------------------- + ! Initialize mediator IO + !--------------------------------------- + call med_io_init() !--------------------------------------- @@ -1922,7 +1839,7 @@ subroutine DataInitialize(gcomp, rc) end if if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine DataInitialize @@ -1959,7 +1876,6 @@ subroutine SetRunClock(gcomp, rc) type(ESMF_ALARM) :: glc_avg_alarm logical :: glc_present character(len=16) :: glc_avg_period - integer :: dbrc integer :: first_time = .true. character(len=*),parameter :: subname='(module_MED:SetRunClock)' !----------------------------------------------------------- @@ -1967,7 +1883,7 @@ subroutine SetRunClock(gcomp, rc) rc = ESMF_SUCCESS if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif ! query the Mediator for clocks @@ -2085,7 +2001,7 @@ subroutine SetRunClock(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) endif end subroutine SetRunClock diff --git a/src/drivers/nuopc/mediator/med_connectors_mod.F90 b/src/drivers/nuopc/mediator/med_connectors_mod.F90 deleted file mode 100644 index ca3bff37c6a..00000000000 --- a/src/drivers/nuopc/mediator/med_connectors_mod.F90 +++ /dev/null @@ -1,553 +0,0 @@ -module med_connectors_mod - - !----------------------------------------------------------------------------- - ! Connector phases - !----------------------------------------------------------------------------- - - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_Failure - use ESMF , only : ESMF_State, ESMF_Clock, ESMF_GridComp - use med_internalstate_mod , only : InternalState - use shr_nuopc_utils_mod , only : shr_nuopc_utils_ChkErr - use med_constants_mod , only : spval => med_constants_spval - use med_constants_mod , only : czero => med_constants_czero - - implicit none - private - character(*) , parameter :: u_FILE_u = & - __FILE__ - - !-------------------------------------------------------------------------- - ! Public interfaces - !-------------------------------------------------------------------------- - - public med_connectors_prep_med2atm - public med_connectors_prep_med2ocn - public med_connectors_prep_med2ice - public med_connectors_prep_med2lnd - public med_connectors_prep_med2rof - public med_connectors_prep_med2wav - public med_connectors_prep_med2glc - public med_connectors_post_atm2med - public med_connectors_post_ocn2med - public med_connectors_post_ice2med - public med_connectors_post_lnd2med - public med_connectors_post_rof2med - public med_connectors_post_wav2med - public med_connectors_post_glc2med - - !-------------------------------------------------------------------------- - ! Private - !-------------------------------------------------------------------------- - - private med_connectors_prep_generic - private med_connectors_post_generic - private med_connectors_diagnose - -!----------------------------------------------------------------------------- -contains -!----------------------------------------------------------------------------- - - subroutine med_connectors_prep_generic(gcomp, type, compid, rc) - use ESMF , only : ESMF_GridCompGet, ESMF_VMGet - use med_infodata_mod , only : med_infodata_CopyStateToInfodata - use med_infodata_mod , only : med_infodata_CopyInfodataToState - use med_infodata_mod , only : med_infodata - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_reset - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_copy - use perf_mod , only : t_startf, t_stopf - ! input/output variables - type(ESMF_GridComp) :: gcomp - character(len=*), intent(in) :: type - integer, intent(in) :: compid - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(InternalState) :: is_local - logical :: diagnose - logical :: connected - integer :: n - integer :: dbrc - integer :: mytask - character(len=10) :: med2comp - character(len=7) :: cpl2comp - character(len=*),parameter :: subname='(med_connectors_prep_generic)' - !--------------------------------------------- - call t_startf('MED:'//subname) - call ESMF_LogWrite(trim(subname)//trim(type)//": called", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_SUCCESS - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(is_local%wrap%vm, localPet=mytask, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - !------------------------- - ! diagnose export state - ! update scalar data in Exp and Imp State - !------------------------- - med2comp = "med_to_"//type - cpl2comp = "cpl2"//type - - is_local%wrap%conn_prep_cnt(compid) = is_local%wrap%conn_prep_cnt(compid) + 1 - call shr_nuopc_methods_State_reset(is_local%wrap%NStateExp(compid), value=spval, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_copy(is_local%wrap%NStateExp(compid), is_local%wrap%FBExp(compid), rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call med_connectors_diagnose(is_local%wrap%NStateExp(compid), is_local%wrap%conn_prep_cnt(compid), med2comp, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateExp(compid), cpl2comp, mytask, rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyInfodataToState(med_infodata,is_local%wrap%NStateImp(compid), cpl2comp, mytask, rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//trim(type)//": done", ESMF_LOGMSG_INFO, rc=rc) - - call t_stopf('MED:'//subname) - - end subroutine med_connectors_prep_generic - - !----------------------------------------------------------------------------- - - subroutine med_connectors_post_generic(gcomp, type, compid, rc) - - use ESMF , only : ESMF_GridCompGet - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_copy - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset - use med_infodata_mod , only : med_infodata - use med_infodata_mod , only : med_infodata_CopyStateToInfodata - use perf_mod , only : t_startf, t_stopf - ! input/output variables - type(ESMF_GridComp) :: gcomp - character(len=*), intent(in) :: type - integer, intent(in) :: compid - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(InternalState) :: is_local - integer :: dbrc - character(len=10) :: comp2med - character(len=7) :: comp2cpl - character(len=*),parameter :: subname='(med_connectors_post_generic)' - !--------------------------------------------- - - ! Note: for information obtained by the mediator always write out the state - ! if statewrite_flag is .true. - rc = ESMF_SUCCESS - call t_startf('MED:'//subname) - - call ESMF_LogWrite(trim(subname)//trim(type)//": called", ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - ! query the Component for its clock, importState and exportState - call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - !------------------------- - ! diagnose import state - ! copy import state scalar data to local datatype - !------------------------- - comp2med = "med_from_"//type - comp2cpl = type//"2cpl" - - is_local%wrap%conn_post_cnt(compid) = is_local%wrap%conn_post_cnt(compid) + 1 - call med_connectors_diagnose(is_local%wrap%NStateImp(compid), is_local%wrap%conn_post_cnt(compid),comp2med, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call med_infodata_CopyStateToInfodata(is_local%wrap%NStateImp(compid),med_infodata, comp2cpl ,is_local%wrap%vm,rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_reset(is_local%wrap%FBImp(compid,compid), value=czero, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_copy(is_local%wrap%FBImp(compid,compid), is_local%wrap%NStateImp(compid), rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//trim(type)//": done", ESMF_LOGMSG_INFO, rc=rc) - - call t_stopf('MED:'//subname) - - end subroutine med_connectors_post_generic - - !----------------------------------------------------------------------------- - - subroutine med_connectors_prep_med2atm(gcomp, rc) - use perf_mod, only : t_startf, t_stopf - use esmFlds, only : compatm - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - integer :: dbrc - character(len=*),parameter :: subname='(med_connectors_prep_med2atm)' - !--------------------------------------------- - call t_startf('MED:'//subname) - - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - - rc = ESMF_SUCCESS - - call med_connectors_prep_generic(gcomp, 'atm', compatm, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) - call t_stopf('MED:'//subname) - - end subroutine med_connectors_prep_med2atm - - !----------------------------------------------------------------------------- - - subroutine med_connectors_prep_med2ocn(gcomp, rc) - use esmFlds, only : compocn - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - integer :: dbrc - character(len=*),parameter :: subname='(med_connectors_prep_med2ocn)' - !--------------------------------------------- - - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - - rc = ESMF_SUCCESS - - call med_connectors_prep_generic(gcomp, 'ocn', compocn, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) - - end subroutine med_connectors_prep_med2ocn - - !----------------------------------------------------------------------------- - - subroutine med_connectors_prep_med2ice(gcomp, rc) - use esmFlds, only : compice - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - integer :: dbrc - character(len=*),parameter :: subname='(med_connectors_prep_med2ice)' - !--------------------------------------------- - - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_SUCCESS - - call med_connectors_prep_generic(gcomp, 'ice', compice, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) - - end subroutine med_connectors_prep_med2ice - - !----------------------------------------------------------------------------- - - subroutine med_connectors_prep_med2lnd(gcomp, rc) - use esmFlds, only : complnd - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - integer :: dbrc - character(len=*),parameter :: subname='(med_connectors_prep_med2lnd)' - !--------------------------------------------- - - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_SUCCESS - - call med_connectors_prep_generic(gcomp, 'lnd', complnd, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) - - end subroutine med_connectors_prep_med2lnd - - !----------------------------------------------------------------------------- - - subroutine med_connectors_prep_med2rof(gcomp, rc) - use esmFlds, only : comprof - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - integer :: dbrc - character(len=*),parameter :: subname='(med_connectors_prep_med2rof)' - !--------------------------------------------- - - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_SUCCESS - - call med_connectors_prep_generic(gcomp, 'rof', comprof, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) - - end subroutine med_connectors_prep_med2rof - - !----------------------------------------------------------------------------- - - subroutine med_connectors_prep_med2wav(gcomp, rc) - use esmFlds, only : compwav - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - integer :: dbrc - character(len=*),parameter :: subname='(med_connectors_prep_med2wav)' - !--------------------------------------------- - - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - - rc = ESMF_SUCCESS - - call med_connectors_prep_generic(gcomp, 'wav', compwav, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) - - end subroutine med_connectors_prep_med2wav - - !----------------------------------------------------------------------------- - - subroutine med_connectors_prep_med2glc(gcomp, rc) - use esmFlds, only : compglc - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - integer :: dbrc - character(len=*),parameter :: subname='(med_connectors_prep_med2glc)' - !--------------------------------------------- - - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_SUCCESS - - call med_connectors_prep_generic(gcomp, 'glc', compglc, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) - - end subroutine med_connectors_prep_med2glc - - !----------------------------------------------------------------------------- - - subroutine med_connectors_post_atm2med(gcomp, rc) - use esmFlds, only : compatm - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - integer :: dbrc - character(len=*),parameter :: subname='(med_connectors_post_atm2med)' - !--------------------------------------------- - - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - - rc = ESMF_SUCCESS - - call med_connectors_post_generic(gcomp, 'atm', compatm, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) - - end subroutine med_connectors_post_atm2med - - !----------------------------------------------------------------------------- - - subroutine med_connectors_post_ocn2med(gcomp, rc) - use esmFlds, only : compocn - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - integer :: dbrc - character(len=*),parameter :: subname='(med_connectors_post_ocn2med)' - !--------------------------------------------- - - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_SUCCESS - - call med_connectors_post_generic(gcomp, 'ocn', compocn, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) - - end subroutine med_connectors_post_ocn2med - - !----------------------------------------------------------------------------- - - subroutine med_connectors_post_ice2med(gcomp, rc) - use esmFlds, only : compice - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - integer :: dbrc - character(len=*),parameter :: subname='(med_connectors_post_ice2med)' - !--------------------------------------------- - - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_SUCCESS - - call med_connectors_post_generic(gcomp, 'ice', compice, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) - - end subroutine med_connectors_post_ice2med - - !----------------------------------------------------------------------------- - - subroutine med_connectors_post_lnd2med(gcomp, rc) - use esmFlds, only : complnd - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - integer :: dbrc - character(len=*),parameter :: subname='(med_connectors_post_lnd2med)' - !--------------------------------------------- - - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_SUCCESS - - call med_connectors_post_generic(gcomp, 'lnd', complnd, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) - - end subroutine med_connectors_post_lnd2med - - !----------------------------------------------------------------------------- - - subroutine med_connectors_post_rof2med(gcomp, rc) - use esmFlds, only : comprof - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - integer :: dbrc - character(len=*),parameter :: subname='(med_connectors_post_rof2med)' - !--------------------------------------------- - - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_SUCCESS - - call med_connectors_post_generic(gcomp, 'rof', comprof, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) - - end subroutine med_connectors_post_rof2med - - !----------------------------------------------------------------------------- - - subroutine med_connectors_post_wav2med(gcomp, rc) - use esmFlds, only : compwav - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - integer :: dbrc - character(len=*),parameter :: subname='(med_connectors_post_wav2med)' - !--------------------------------------------- - - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - - rc = ESMF_SUCCESS - - call med_connectors_post_generic(gcomp, 'wav', compwav, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) - - end subroutine med_connectors_post_wav2med - - !----------------------------------------------------------------------------- - - subroutine med_connectors_post_glc2med(gcomp, rc) - use esmFlds, only : compglc - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - integer :: dbrc - character(len=*),parameter :: subname='(med_connectors_post_glc2med)' - !--------------------------------------------- - - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_SUCCESS - - call med_connectors_post_generic(gcomp, 'glc', compglc, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) - - end subroutine med_connectors_post_glc2med - - !----------------------------------------------------------------------------- - - subroutine med_connectors_diagnose(State, cntr, string, rc) - - use ESMF , only : ESMF_State, ESMF_MAXSTR, ESMF_StateGet - use NUOPC , only : NUOPC_Write - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_diagnose - use med_constants_mod , only : statewrite_flag => med_constants_statewrite_flag - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - - ! input/output variables - type(ESMF_State), intent(in) :: State - integer , intent(inout) :: cntr - character(len=*), intent(in) :: string - integer , intent(out) :: rc - - ! local variables - integer :: fieldCount - character(ESMF_MAXSTR),pointer :: fieldnamelist(:) - integer :: dbrc - character(len=*),parameter :: subname='(med_connectors_diagnose)' - !--------------------------------------------- - - call ESMF_LogWrite(trim(subname)//trim(string)//": called", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_SUCCESS - - call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - ! Obtain the field names in State - allocate memory which will be deallocated at the end - allocate(fieldnamelist(fieldCount)) - call ESMF_StateGet(State, itemNameList=fieldnamelist, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - - if (dbug_flag > 1) then - call shr_nuopc_methods_State_diagnose(State, string=trim(subname)//trim(string), rc=rc) - endif - - ! Write out the fields in State to netcdf files - if (cntr > 0 .and. statewrite_flag) then - call ESMF_LogWrite(trim(subname)//trim(string)//": writing out fields", ESMF_LOGMSG_INFO, rc=rc) - call NUOPC_Write(State, & - fieldnamelist(1:fieldCount), & - "field_"//trim(string)//"_", timeslice=cntr, & - overwrite=.true., relaxedFlag=.true., rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - endif - - deallocate(fieldnamelist) - - call ESMF_LogWrite(trim(subname)//trim(string)//": done", ESMF_LOGMSG_INFO, rc=rc) - - end subroutine med_connectors_diagnose - - !----------------------------------------------------------------------------- - -end module med_connectors_mod diff --git a/src/drivers/nuopc/mediator/med_fraction_mod.F90 b/src/drivers/nuopc/mediator/med_fraction_mod.F90 index 1363f466da8..a7524da754c 100644 --- a/src/drivers/nuopc/mediator/med_fraction_mod.F90 +++ b/src/drivers/nuopc/mediator/med_fraction_mod.F90 @@ -599,12 +599,15 @@ subroutine med_fraction_init(gcomp, rc) ! Diagnostic output !--------------------------------------- - do n = 1,ncomps - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBfrac(n), trim(subname) // trim(compname(n)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - enddo + if (dbug_flag > 1) then + do n = 1,ncomps + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBfrac(n), & + trim(subname) // trim(compname(n)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end do + end if if (dbug_flag > 20) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) @@ -633,6 +636,8 @@ subroutine med_fraction_set(gcomp, rc) use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFldPtr use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FieldRegrid use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_init + use shr_nuopc_scalars_mod , only : flds_scalar_name use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -666,8 +671,15 @@ subroutine med_fraction_set(gcomp, rc) ! Update FBFrac(compice), FBFrac(compocn) and FBFrac(compatm) field bundles !--------------------------------------- - if (is_local%wrap%med_coupling_active(compice,compocn)) then + if (is_local%wrap%comp_present(compice) .and. is_local%wrap%comp_present(compocn)) then if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compice,compocn,mapfcopy), rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compice,compocn))) then + call shr_nuopc_methods_FB_init(is_local%wrap%FBImp(compice,compocn), flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compocn), & + STflds=is_local%wrap%NStateImp(compice), & + name='FBImp'//trim(compname(compice))//'_'//trim(compname(compocn)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if call med_map_Fractions_init( gcomp, compice, compocn, & FBSrc=is_local%wrap%FBImp(compice,compice), & FBDst=is_local%wrap%FBImp(compice,compocn), & @@ -675,6 +687,13 @@ subroutine med_fraction_set(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compocn,compice,mapfcopy), rc=rc)) then + if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(compocn,compice))) then + call shr_nuopc_methods_FB_init(is_local%wrap%FBImp(compocn,compice), flds_scalar_name, & + STgeom=is_local%wrap%NStateImp(compice), & + STflds=is_local%wrap%NStateImp(compocn), & + name='FBImp'//trim(compname(compocn))//'_'//trim(compname(compice)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if call med_map_Fractions_init( gcomp, compocn, compice, & FBSrc=is_local%wrap%FBImp(compocn,compocn), & FBDst=is_local%wrap%FBImp(compocn,compice), & @@ -718,19 +737,15 @@ subroutine med_fraction_set(gcomp, rc) ! The following is just a redistribution from FBFrac(compice) - ! Map 'ifrac' from FBfrac(compice) to FBfrac(compocn) if (is_local%wrap%comp_present(compocn)) then - if (is_local%wrap%med_coupling_active(compice,compocn)) then - call shr_nuopc_methods_FB_FieldRegrid(& - is_local%wrap%FBfrac(compice), 'ifrac', & - is_local%wrap%FBfrac(compocn), 'ifrac', & - is_local%wrap%RH(compice,compocn,mapfcopy), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - end if + ! Map 'ifrac' from FBfrac(compice) to FBfrac(compocn) + call shr_nuopc_methods_FB_FieldRegrid(& + is_local%wrap%FBfrac(compice), 'ifrac', & + is_local%wrap%FBfrac(compocn), 'ifrac', & + is_local%wrap%RH(compice,compocn,mapfcopy), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! Map 'ofrac' from FBfrac(compice) to FBfrac(comp) - if (is_local%wrap%med_coupling_active(compice,compocn)) then + ! Map 'ofrac' from FBfrac(compice) to FBfrac(compocn) call shr_nuopc_methods_FB_FieldRegrid(& is_local%wrap%FBfrac(compice), 'ofrac', & is_local%wrap%FBfrac(compocn), 'ofrac', & @@ -822,12 +837,15 @@ subroutine med_fraction_set(gcomp, rc) ! Diagnostic output !--------------------------------------- - do n = 1,ncomps - if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBfrac(n), trim(subname) // trim(compname(n))//' frac', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - enddo + if (dbug_flag > 1) then + do n = 1,ncomps + if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBfrac(n), & + trim(subname) // trim(compname(n))//' frac', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + enddo + end if if (dbug_flag > 20) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) diff --git a/src/drivers/nuopc/mediator/med_infodata_mod.F90 b/src/drivers/nuopc/mediator/med_infodata_mod.F90 deleted file mode 100644 index e83e5f71876..00000000000 --- a/src/drivers/nuopc/mediator/med_infodata_mod.F90 +++ /dev/null @@ -1,275 +0,0 @@ -module med_infodata_mod - - ! !DESCRIPTION: A module to get, put, and store some standard scalar data - - ! !USES: - - use med_constants_mod , only: CL, R8 - use esmFlds , only: ncomps - - implicit none - private ! default private - - ! !PUBLIC TYPES: - - public :: med_infodata_type - - ! !PUBLIC MEMBER FUNCTIONS - - public :: med_infodata_GetData ! Get values from infodata object - public :: med_infodata_CopyStateToInfodata - public :: med_infodata_CopyInfodataToState - - ! !PUBLIC DATA MEMBERS: - public :: med_infodata ! instance of infodata datatype - - ! InputInfo derived type - type med_infodata_type - private - - ! Set via components and held fixed after initialization - integer :: nx(ncomps) = -1 ! global nx - integer :: ny(ncomps) = -1 ! global ny - logical :: rofice_present = .false. ! does rof have iceberg coupling on - logical :: rof_prognostic = .false. ! does rof component need input data - logical :: flood_present = .false. ! does rof have flooding on - logical :: iceberg_prognostic = .false. ! does the ice model support icebergs - logical :: glclnd_present = .false. ! does glc have land coupling fields on - logical :: glcocn_present = .false. ! does glc have ocean runoff on - logical :: glcice_present = .false. ! does glc have iceberg coupling on - logical :: glc_coupled_fluxes = .false. ! does glc send fluxes to other components - ! (only relevant if glc_present is .true.) - - ! Set via components and may be time varying - real(R8) :: nextsw_cday = -1.0_R8 ! calendar of next atm shortwave - real(R8) :: precip_fact = 1.0_R8 ! precip factor - - ! Set by mediator and may be time varying - logical :: glc_valid_input = .true. ! is valid accumulated data being sent to prognostic glc - - end type med_infodata_type - - type (med_infodata_type), target :: med_infodata ! single instance for cpl and all comps - - ! used/reused in module - - character(*),parameter :: u_FILE_u = & - __FILE__ - -!=============================================================================== -CONTAINS -!=============================================================================== - - subroutine med_infodata_CopyStateToInfodata(State, infodata, type, vm, rc) - - use ESMF , only : ESMF_State, ESMF_Field, ESMF_StateItem_Flag - use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_LogWrite - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_STATEITEM_NOTFOUND, operator(==) - use ESMF , only : ESMF_VMBroadCast, ESMF_VM, ESMF_VMGet - use esmFlds , only : compname - use shr_nuopc_scalars_mod , only : flds_scalar_num, flds_scalar_name - use shr_nuopc_scalars_mod , only : flds_scalar_index_nx, flds_scalar_index_ny - use shr_nuopc_scalars_mod , only : flds_scalar_index_nextsw_cday - use shr_nuopc_scalars_mod , only : flds_scalar_index_precip_fact - use shr_nuopc_methods_mod , only : shr_nuopc_methods_chkErr - - ! ---------------------------------------------- - ! Copy scalar data from State to local data on root then broadcast data - ! to all PETs in component. - ! ---------------------------------------------- - - type(ESMF_State), intent(in) :: State - type(med_infodata_type), intent(inout) :: infodata - character(len=*), intent(in) :: type - type(ESMF_VM), intent(inout) :: vm - integer, intent(inout) :: rc - - ! local variables - integer :: n - integer :: mytask, ierr, len - type(ESMF_Field) :: field - type(ESMF_StateItem_Flag) :: itemType - real(R8), pointer :: farrayptr(:,:) - real(R8) :: data(flds_scalar_num) - character(len=32) :: ntype - integer :: dbrc - character(len=1024) :: msgString - character(len=*), parameter :: subname='(med_infodata_CopyStateToInfodata)' - !---------------------------------------------------------- - - rc = ESMF_SUCCESS - call ESMF_VMGet(vm, localPet=mytask, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_StateGet(State, itemName=trim(flds_scalar_name), itemType=itemType, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (itemType == ESMF_STATEITEM_NOTFOUND) then - call ESMF_LogWrite(trim(subname)//": "//trim(flds_scalar_name)//" not found", ESMF_LOGMSG_INFO, & - line=__LINE__, file=u_FILE_u, rc=dbrc) - else - call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (mytask == 0) then - call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (size(data) < flds_scalar_num .or. size(farrayptr) < flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR on data size", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) - rc = ESMF_FAILURE - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - data(1:flds_scalar_num) = farrayptr(1:flds_scalar_num,1) - endif - - call ESMF_VMBroadCast(vm, data, flds_scalar_num, 0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - do n = 1,ncomps - ntype = trim(compname(n))//'2cpli' - if (trim(type) == trim(ntype)) then - infodata%nx(n) = nint(data(flds_scalar_index_nx)) - infodata%ny(n) = nint(data(flds_scalar_index_ny)) - write(msgString,'(2i8,2l4)') nint(data(flds_scalar_index_nx)),nint(data(flds_scalar_index_ny)) - call ESMF_LogWrite(trim(subname)//":"//trim(type)//":"//trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) - endif - enddo - - if (type == 'atm2cpli') then - infodata%nextsw_cday = data(flds_scalar_index_nextsw_cday) - elseif (type == 'ocn2cpli') then - infodata%precip_fact=data(flds_scalar_index_precip_fact) - elseif (type == 'atm2cpl') then - infodata%nextsw_cday=data(flds_scalar_index_nextsw_cday) - elseif (type == 'ocn2cpl') then - infodata%precip_fact=data(flds_scalar_index_precip_fact) - endif - - endif - - end subroutine med_infodata_CopyStateToInfodata - - !================================================================================ - - subroutine med_infodata_CopyInfodataToState(infodata, State, type, mytask, rc) - - use ESMF , only : ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_StateItem_Flag, ESMF_FieldGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_STATEITEM_NOTFOUND - use ESMF , only : operator(==), ESMF_FAILURE - use shr_nuopc_scalars_mod , only : flds_scalar_num, flds_scalar_name - use shr_nuopc_scalars_mod , only : flds_scalar_index_nx, flds_scalar_index_ny - use shr_nuopc_scalars_mod , only : flds_scalar_index_nextsw_cday - use shr_nuopc_scalars_mod , only : flds_scalar_index_precip_fact - use shr_nuopc_methods_mod , only : shr_nuopc_methods_chkErr - - ! ---------------------------------------------- - ! Copy local scalar data into State, root only, - ! but called on all PETs in component - ! ---------------------------------------------- - - type(med_infodata_type),intent(in):: infodata - type(ESMF_State), intent(inout) :: State - character(len=*), intent(in) :: type - integer , intent(in) :: mytask - integer, intent(inout) :: rc - - ! local variables - type(ESMF_Field) :: field - type(ESMF_StateItem_Flag) :: ItemType - real(R8), pointer :: farrayptr(:,:) - real(R8) :: nextsw_cday, precip_fact - integer :: dbrc - character(len=*), parameter :: subname='(med_infodata_CopyInfodataToState)' - !---------------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_StateGet(State, itemName=trim(flds_scalar_name), itemType=itemType, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (itemType == ESMF_STATEITEM_NOTFOUND) then - - call ESMF_LogWrite(trim(subname)//": "//trim(flds_scalar_name)//" not found", & - ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) - - else - - call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (mytask == 0) then - call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (size(farrayptr) < flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR on data size", & - ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) - rc = ESMF_FAILURE - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - farrayptr(flds_scalar_index_nextsw_cday,1) = infodata%nextsw_cday - farrayptr(flds_scalar_index_precip_fact,1) = infodata%precip_fact - endif - - endif - - end subroutine med_infodata_CopyInfodataToState - - !=============================================================================== - - subroutine med_infodata_GetData( infodata, ncomp, flux_epbal, flux_epbalfact, nx, ny) - - ! Get values out of the infodata object. - - use med_constants_mod , only : CL, IN - use med_internalstate_mod , only : logunit, loglevel - use shr_sys_mod , only : shr_sys_abort - - ! !INPUT/OUTPUT PARAMETERS: - type(med_infodata_type) , intent(IN) :: infodata ! Input CCSM structure - integer(IN), optional , intent(IN) :: ncomp ! Component ID - character(CL), optional , intent(IN) :: flux_epbal ! selects E,P,R adjustment technique - real(R8), optional , intent(OUT) :: flux_epbalfact ! adjusted precip factor - integer(IN), optional , intent(OUT) :: nx ! nx - integer(IN), optional , intent(OUT) :: ny ! ny - - !----- local ----- - character(len=*), parameter :: subname = '(med_infodata_GetData) ' - !------------------------------------------------------------------------------- - - if ( present(flux_epbalfact)) then - if (.not. present(flux_epbal)) then - call shr_sys_abort(subname // "Must provide flux_epbal as an input argument to determine infodata%precip_fact") - end if - - flux_epbalfact = 1.0_R8 - if (trim(flux_epbal) == 'ocn') then - flux_epbalfact = infodata%precip_fact - if (flux_epbalfact <= 0.0_R8) then - if (loglevel > 0) then - write(logunit,'(2a,e16.6)') trim(subname),' WARNING: factor from ocn = ',flux_epbalfact - write(logunit,'(2a)') trim(subname),' WARNING: resetting flux_epbalfact to 1.0' - end if - flux_epbalfact = 1.0_R8 - end if - end if - endif - - if (present(nx)) then - if (.not.present(ncomp)) then - call shr_sys_abort(subname // " Must provide nx") - endif - nx = infodata%nx(ncomp) - endif - - if (present(ny)) then - if (.not.present(ncomp)) then - call shr_sys_abort(subname // "Must provide ny") - endif - ny = infodata%ny(ncomp) - endif - - end subroutine med_infodata_GetData - -end module med_infodata_mod diff --git a/src/drivers/nuopc/mediator/med_internalstate_mod.F90 b/src/drivers/nuopc/mediator/med_internalstate_mod.F90 index 5ad35244786..fa565718cf0 100644 --- a/src/drivers/nuopc/mediator/med_internalstate_mod.F90 +++ b/src/drivers/nuopc/mediator/med_internalstate_mod.F90 @@ -50,6 +50,12 @@ module med_internalstate_mod ! FBImp(n,k) is the FBImp(n,n) interpolated to grid k ! RH(n,k,m) is a RH from grid n to grid k, map type m + ! Mediator vm + type(ESMF_VM) :: vm + + ! Global nx,ny dimensions of input arrays (needed for mediator history output) + integer :: nx(ncomps), ny(ncomps) + ! Present/Active logical flags logical :: comp_present(ncomps) ! comp present flag logical :: med_coupling_active(ncomps,ncomps) ! computes the active coupling @@ -82,11 +88,6 @@ module med_internalstate_mod type(ESMF_FieldBundle) :: FBImpAccum(ncomps,ncomps) ! Accumulator for various components import integer :: FBImpAccumCnt(ncomps) ! Accumulator counter for each FBImpAccum - ! Connectors - integer :: conn_prep_cnt(ncomps) ! Connector prep count - integer :: conn_post_cnt(ncomps) ! Connector post count - type(ESMF_VM) :: vm - end type InternalStateStruct type, public :: InternalState diff --git a/src/drivers/nuopc/mediator/med_io_mod.F90 b/src/drivers/nuopc/mediator/med_io_mod.F90 index 9c802883132..f5ba2091ff0 100644 --- a/src/drivers/nuopc/mediator/med_io_mod.F90 +++ b/src/drivers/nuopc/mediator/med_io_mod.F90 @@ -2,10 +2,11 @@ module med_io_mod ! !DESCRIPTION: Writes attribute vectors to netcdf ! !USES: - use ESMF, only : ESMF_VM - use med_constants_mod , only : CL - use pio, only : file_desc_t, iosystem_desc_t - use shr_nuopc_utils_mod, only : shr_nuopc_utils_ChkErr + use ESMF , only : ESMF_VM + use med_constants_mod , only : CL + use pio , only : file_desc_t, iosystem_desc_t + use shr_nuopc_utils_mod , only : shr_nuopc_utils_ChkErr + implicit none private @@ -20,6 +21,9 @@ module med_io_mod public med_io_write public med_io_init + ! private member functions + private :: med_io_file_exists + ! public data members: interface med_io_read module procedure med_io_read_FB @@ -40,22 +44,21 @@ module med_io_mod end interface med_io_write !------------------------------------------------------------------------------- - ! Local data + ! module data !------------------------------------------------------------------------------- - character(*),parameter :: prefix = "med_io_" - character(*),parameter :: modName = "(med_io_mod) " - character(*),parameter :: version = "cmeps0" - - integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now - character(*),parameter :: u_file_u = & - __FILE__ - + character(*),parameter :: prefix = "med_io_" + character(*),parameter :: modName = "(med_io_mod) " + character(*),parameter :: version = "cmeps0" + integer , parameter :: file_desc_t_cnt = 20 ! Note - this is hard-wired for now + integer , parameter :: number_strlen = 2 character(CL) :: wfilename = '' type(file_desc_t) :: io_file(0:file_desc_t_cnt) integer :: pio_iotype integer :: pio_ioformat type(iosystem_desc_t), pointer :: io_subsystem + character(*),parameter :: u_file_u = & + __FILE__ !================================================================================= contains @@ -69,13 +72,15 @@ logical function med_io_file_exists(vm, iam, filename) use ESMF, only : ESMF_VMBroadCast + ! input/output variables type(ESMF_VM) :: vm integer, intent(in) :: iam character(len=*), intent(in) :: filename - logical :: exists + ! local variables integer :: tmp(1) integer :: rc + !------------------------------------------------------------------------------- med_io_file_exists = .false. if (iam==0) inquire(file=trim(filename),exist=med_io_file_exists) @@ -127,7 +132,6 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) character(CL), optional, intent(in) :: model_doi_url ! local variables - logical :: exists logical :: lclobber integer :: tmp(1) integer :: rcode @@ -207,12 +211,14 @@ end subroutine med_io_wopen !=============================================================================== subroutine med_io_close(filename, iam, file_ind) + !--------------- + ! close netcdf file + !--------------- + use pio, only: pio_file_is_open, pio_closefile use med_internalstate_mod, only : logunit use shr_sys_mod, only : shr_sys_abort - ! !DESCRIPTION: close netcdf file - ! input/output variables character(*), intent(in) :: filename integer, intent(in) :: iam @@ -242,26 +248,38 @@ end subroutine med_io_close !=============================================================================== subroutine med_io_redef(filename,file_ind) + use pio, only : pio_redef + + ! input/output variables character(len=*), intent(in) :: filename integer,optional,intent(in):: file_ind + ! 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)) + end subroutine med_io_redef !=============================================================================== subroutine med_io_enddef(filename,file_ind) - use med_internalstate_mod, only : logunit - use pio, only : pio_enddef - character(len=*), intent(in) :: filename - integer,optional,intent(in):: file_ind + + use med_internalstate_mod , only : logunit + use pio , only : pio_enddef + + ! input/output variables + character(len=*) , intent(in) :: filename + integer,optional , intent(in) :: file_ind + + ! local variables integer :: lfile_ind integer :: rcode + !------------------------------------------------------------------------------- lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind @@ -271,22 +289,24 @@ end subroutine med_io_enddef !=============================================================================== character(len=24) function med_io_date2yyyymmdd (date) + use shr_cal_mod, only : shr_cal_datetod2string - ! input arguments + integer, intent(in) :: date ! date expressed as an integer: yyyymmdd - !---------------------------------------------------------------------- call shr_cal_datetod2string(date_str = med_io_date2yyyymmdd, ymd = date) end function med_io_date2yyyymmdd !=============================================================================== character(len=8) function med_io_sec2hms (seconds) - use shr_sys_mod, only : shr_sys_abort + + use shr_sys_mod , only : shr_sys_abort use med_internalstate_mod , only : logunit - ! Input arguments + + ! input arguments integer, intent(in) :: seconds - ! Local workspace + ! local variables integer :: hours ! hours of hh:mm:ss integer :: minutes ! minutes of hh:mm:ss integer :: secs ! seconds of hh:mm:ss @@ -320,22 +340,25 @@ end function med_io_sec2hms subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & fillval, pre, tavg, use_float, file_ind, rc) - ! !DESCRIPTION: Write FB to netcdf file - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundle, ESMF_Field, ESMF_Mesh, ESMF_DistGrid + !--------------- + ! Write FB to netcdf file + !--------------- + + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + 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_VMGetCurrent, ESMF_VMGet - use med_constants_mod , only : R4, R8 + use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_AttributeGet + use med_constants_mod , only : R4, R8, dbug_flag=>med_constants_dbug_flag use shr_const_mod , only : fillvalue=>SHR_CONST_SPVAL - use pio , only : var_desc_t, io_desc_t, pio_offset_kind - use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFieldN use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFldPtr use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNameN use esmFlds , only : shr_nuopc_fldList_GetMetadata + 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 use pio , only : pio_syncfile + ! input/output variables character(len=*), intent(in) :: filename ! file integer, intent(in) :: iam ! local pet @@ -360,7 +383,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & integer :: mpicom integer :: rcode integer :: nf,ns,ng - integer :: k + integer :: k,n integer ,target :: dimid2(2) integer ,target :: dimid3(3) integer ,pointer :: dimid(:) @@ -382,20 +405,23 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & integer :: dimCount, tileCount integer, pointer :: Dof(:) integer :: lfile_ind - real(r8), pointer :: fldptr1(:), tmpfldptr(:) + real(r8), pointer :: fldptr1(:) + real(r8), pointer :: fldptr2(:,:) + character(len=number_strlen) :: cnumber character(CL) :: tmpstr - integer :: dbrc + type(ESMF_Field) :: lfield + 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 character(*),parameter :: subName = '(med_io_write_FB) ' !------------------------------------------------------------------------------- if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_Success -! call ESMF_VMGetCurrent(vm, rc=rc) -! call ESMF_VMGet(vm, mpiCommunicator=mpicom, rc=rc) - lfillvalue = fillvalue if (present(fillval)) then lfillvalue = fillval @@ -406,10 +432,10 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & lpre = trim(pre) endif - if (.not. ESMF_FieldBundleIsCreated(FB,rc=rc)) then - call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO, rc=rc) + if (.not. ESMF_FieldBundleIsCreated(FB, rc=rc)) then + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif rc = ESMF_Success return @@ -423,7 +449,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & if (.not.lwhead .and. .not.lwdata) then ! should we write a warning? if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif return endif @@ -436,11 +462,11 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) write(tmpstr,*) subname//' field count = '//trim(lpre),nf - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) if (nf < 1) then - call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif rc = ESMF_Success return @@ -462,8 +488,8 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, maxIndexPTile=maxIndexPTile, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - ! write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + ! write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile + ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) ! TODO: this is not getting the global size correct for a FB coming in that does not have ! all the global grid values in the distgrid - e.g. CTSM @@ -485,7 +511,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & endif if (lnx*lny /= ng) then write(tmpstr,*) subname,' ERROR: grid2d size not consistent ',ng,lnx,lny - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) !TODO: this should not be an error for say CTSM which does not send a global grid !rc = ESMF_FAILURE @@ -504,74 +530,144 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & dimid => dimid2 endif - write(tmpstr,*) subname,' tcx dimid = ',dimid - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + write(tmpstr,*) subname,' dimid = ',dimid + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) do k = 1,nf call shr_nuopc_methods_FB_getNameN(FB, k, itemc, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - !-------tcraig, this is a temporary mod to NOT write hgt + ! Determine rank of field with name itemc + call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=rank, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + ! TODO (mvertens, 2019-03-13): this is a temporary mod to NOT write hgt if (trim(itemc) /= "hgt") then - name1 = trim(lpre)//'_'//trim(itemc) - call shr_nuopc_fldList_GetMetadata(itemc,longname=lname,stdname=sname,units=cunit) - call ESMF_LogWrite(trim(subname)//':'//trim(itemc)//':'//trim(name1),ESMF_LOGMSG_INFO, rc=rc) - 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)) + if (rank == 2) then + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + write(cnumber,'(i0)') ungriddedUbound(1) + call ESMF_LogWrite(trim(subname)//':'//'field '//trim(itemc)// & + ' has an griddedUBound of '//trim(cnumber), ESMF_LOGMSG_INFO) + + ! Create a new output variable for each element of the undistributed dimension + do n = 1,ungriddedUBound(1) + if (trim(itemc) /= "hgt") then + write(cnumber,'(i0)') n + name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) + call shr_nuopc_fldList_GetMetadata(itemc, longname=lname, stdname=sname, units=cunit) + 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)) + 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) + end if + rcode = pio_put_att(io_file(lfile_ind), varid, "units" , trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind), varid, "long_name" , trim(lname)) + rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name", trim(sname)) + if (present(tavg)) then + if (tavg) then + rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + endif + endif + end if + end do 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) + name1 = trim(lpre)//'_'//trim(itemc) + call shr_nuopc_fldList_GetMetadata(itemc,longname=lname,stdname=sname,units=cunit) + 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)) + 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) + end if + rcode = pio_put_att(io_file(lfile_ind), varid, "units" , trim(cunit)) + rcode = pio_put_att(io_file(lfile_ind), varid, "long_name" , trim(lname)) + rcode = pio_put_att(io_file(lfile_ind), varid, "standard_name" , trim(sname)) + if (present(tavg)) then + if (tavg) then + rcode = pio_put_att(io_file(lfile_ind), varid, "cell_methods", "time: mean") + endif + end if end if - rcode = pio_put_att(io_file(lfile_ind),varid,"units",trim(cunit)) - rcode = pio_put_att(io_file(lfile_ind),varid,"long_name",trim(lname)) - rcode = pio_put_att(io_file(lfile_ind),varid,"standard_name",trim(sname)) - if (present(tavg)) then - if (tavg) then - rcode = pio_put_att(io_file(lfile_ind),varid,"cell_methods","time: mean") - endif - endif - endif - !-------tcraig - enddo + end if + end do + + ! Finish define mode if (lwdata) call med_io_enddef(filename, file_ind=lfile_ind) + end if if (lwdata) then + ! use distgrid extracted from field 1 above call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return allocate(dof(ns)) call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) -! call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) + ! call pio_writedof(lpre, (/lnx,lny/), int(dof,kind=PIO_OFFSET_KIND), mpicom) deallocate(dof) do k = 1,nf call shr_nuopc_methods_FB_getNameN(FB, k, itemc, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(FB, itemc, fldptr1=fldptr1, rc=rc) + + call shr_nuopc_methods_FB_getFldPtr(FB, itemc, & + fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - !-------tcraig, this is a temporary mod to NOT write hgt + + ! TODO (mvertens, 2019-03-13): this is a temporary mod to NOT write hgt if (trim(itemc) /= "hgt") 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) - call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr1, rcode, fillval=lfillvalue) - !-------tcraig - endif - enddo - call pio_syncfile(io_file(lfile_ind)) + if (rank == 2) then + + ! Determine the size of the ungridded dimension and the index where the undistributed dimension is located + call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, gridToFieldMap=gridToFieldMap, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + ! Output for each ungriddedUbound index + 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) + + if (gridToFieldMap(1) == 1) then + call pio_write_darray(io_file(lfile_ind), 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) + end if + end do + else if (rank == 1) 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) + call pio_write_darray(io_file(lfile_ind), varid, iodesc, fldptr1, rcode, fillval=lfillvalue) + end if ! end if rank is 2 or 1 + + end if ! end if not "hgt" + end do ! end loop over fields in FB + call pio_syncfile(io_file(lfile_ind)) call pio_freedecomp(io_file(lfile_ind), iodesc) endif if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine med_io_write_FB @@ -582,7 +678,9 @@ subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind) use pio , only : var_desc_t, pio_def_var, pio_put_att, pio_int, pio_inq_varid, pio_put_var use esmFlds, only : shr_nuopc_fldList_GetMetadata - ! !DESCRIPTION: Write scalar integer to netcdf file + !--------------- + ! Write scalar integer to netcdf file + !--------------- ! intput/output variables character(len=*),intent(in) :: filename ! file @@ -639,13 +737,15 @@ end subroutine med_io_write_int !=============================================================================== subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_ind) + !--------------- + ! Write 1d integer array to netcdf file + !--------------- + use pio , only : var_desc_t, pio_def_dim, pio_def_var use pio , only : pio_put_att, pio_inq_varid, pio_put_var use pio , only : pio_int, pio_def_var use esmFlds , only : shr_nuopc_fldList_GetMetadata - ! !DESCRIPTION: Write 1d integer array to netcdf file - ! input/output arguments character(len=*),intent(in) :: filename ! file integer ,intent(in) :: iam ! local pet @@ -704,13 +804,15 @@ end subroutine med_io_write_int1d !=============================================================================== subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind) + !--------------- + ! Write scalar double to netcdf file + !--------------- + use med_constants_mod , only : R8 use pio , only : var_desc_t, pio_def_var, pio_put_att use pio , only : pio_double, pio_noerr, pio_inq_varid, pio_put_var use esmFlds , only : shr_nuopc_fldList_GetMetadata - ! !DESCRIPTION: Write scalar double to netcdf file - ! input/output arguments character(len=*),intent(in) :: filename ! file integer ,intent(in) :: iam ! local pet @@ -766,7 +868,9 @@ end subroutine med_io_write_r8 !=============================================================================== subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind) - ! !DESCRIPTION: Write 1d double array to netcdf file + !--------------- + ! Write 1d double array to netcdf file + !--------------- use med_constants_mod , only : R8 use pio , only : var_desc_t, pio_def_dim, pio_def_var @@ -828,7 +932,9 @@ end subroutine med_io_write_r81d !=============================================================================== subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind) - ! !DESCRIPTION: Write char string to netcdf file + !--------------- + ! Write char string to netcdf file + !--------------- use pio , only : var_desc_t, pio_def_dim, pio_put_att, pio_def_var, pio_inq_varid use pio , only : pio_char, pio_put_var @@ -891,6 +997,10 @@ end subroutine med_io_write_char subroutine med_io_write_time(filename, iam, time_units, time_cal, time_val, nt,& whead, wdata, tbnds, file_ind) + !--------------- + ! Write time variable to netcdf file + !--------------- + use med_constants_mod , only : R8 use shr_cal_mod , only : shr_cal_calMaxLen use shr_cal_mod , only : shr_cal_noleap @@ -900,8 +1010,6 @@ subroutine med_io_write_time(filename, iam, time_units, time_cal, time_val, nt,& use pio , only : pio_double, pio_def_dim, pio_def_var, pio_put_att use pio , only : pio_inq_varid, pio_put_var - ! !DESCRIPTION: Write time variable to netcdf file - ! input/output variables character(len=*), intent(in) :: filename ! file integer, intent(in) :: iam ! local pet @@ -988,6 +1096,10 @@ end subroutine med_io_write_time !=============================================================================== subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) + !--------------- + ! Read FB from netcdf file + !--------------- + use med_constants_mod , only : R8, CL use shr_const_mod , only : fillvalue=>SHR_CONST_SPVAL use ESMF , only : ESMF_FieldBundle, ESMF_Field, ESMF_Mesh, ESMF_DistGrid @@ -996,57 +1108,49 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet use ESMF , only : ESMF_FieldGet, ESMF_MeshGet, ESMF_DistGridGet use pio , only : file_desc_T, var_desc_t, io_desc_t, pio_nowrite, pio_openfile - use pio , only : pio_noerr, pio_inq_varndims, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR - use pio , only : pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, pio_inq_vardimid + use pio , only : pio_noerr, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR + use pio , only : pio_inq_varid use pio , only : pio_double, pio_get_att, pio_seterrorhandling, pio_freedecomp, pio_closefile - use pio , only : pio_read_darray, pio_initdecomp, pio_offset_kind - use pio , only : pio_setframe + use pio , only : pio_read_darray, pio_offset_kind, pio_setframe use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNameN use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFldPtr use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFieldN - ! !DESCRIPTION: Read FB to netcdf file - - ! !input/output arguments - character(len=*) ,intent(in) :: filename ! file - type(ESMF_VM) :: vm - integer ,intent(in) :: iam - type(ESMF_FieldBundle) ,intent(in) :: FB ! data to be read - character(len=*),optional ,intent(in) :: pre ! prefix to variable name - integer(kind=PIO_OFFSET_KIND),optional ,intent(in) :: frame - integer ,intent(out) :: rc + ! input/output arguments + character(len=*) ,intent(in) :: filename ! file + type(ESMF_VM) ,intent(in) :: vm + integer ,intent(in) :: iam + type(ESMF_FieldBundle) ,intent(in) :: FB ! data to be read + character(len=*) ,optional ,intent(in) :: pre ! prefix to variable name + integer(kind=PIO_OFFSET_KIND) ,optional ,intent(in) :: frame + integer ,intent(out) :: rc ! local variables - - type(ESMF_Field) :: field - type(ESMF_Mesh) :: mesh - type(ESMF_Distgrid) :: distgrid - integer :: rcode - integer :: nf,ns,ng - integer :: k,n,ndims - integer, pointer :: dimid(:) - type(file_desc_t) :: pioid - type(var_desc_t) :: varid - type(io_desc_t) :: iodesc - character(CL) :: itemc ! string converted to char - character(CL) :: name1 ! var name - character(CL) :: lpre ! local prefix - integer :: lnx,lny - real(r8) :: lfillvalue - logical :: exists - integer :: tmp(1) - integer, pointer :: minIndexPTile(:,:) - integer, pointer :: maxIndexPTile(:,:) - integer :: dimCount, tileCount - integer, pointer :: Dof(:) - real(r8), pointer :: fldptr1(:) - character(CL) :: tmpstr + type(ESMF_Field) :: lfield + integer :: rcode + integer :: nf,ns,ng + integer :: k,n,l + type(file_desc_t) :: pioid + type(var_desc_t) :: varid + type(io_desc_t) :: iodesc + character(CL) :: itemc ! string converted to char + 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(:,:) + character(CL) :: tmpstr + character(len=16) :: cnumber integer(kind=Pio_Offset_Kind) :: lframe + integer :: ungriddedUBound(1) ! currently the size must equal 1 for rank 2 fieldds + integer :: gridToFieldMap(1) ! currently the size must equal 1 for rank 2 fieldds character(*),parameter :: subName = '(med_io_read_FB) ' !------------------------------------------------------------------------------- rc = ESMF_Success - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return lpre = ' ' @@ -1059,10 +1163,10 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) lframe = 1 endif if (.not. ESMF_FieldBundleIsCreated(FB,rc=rc)) then - call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" not created", ESMF_LOGMSG_INFO) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif return @@ -1071,13 +1175,13 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write(tmpstr,*) subname//' field count = '//trim(lpre),nf - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (nf < 1) then - call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return endif return @@ -1085,110 +1189,242 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) if (med_io_file_exists(vm, iam, trim(filename))) then rcode = pio_openfile(io_subsystem, pioid, pio_iotype, trim(filename),pio_nowrite) - call ESMF_LogWrite(trim(subname)//' open file '//trim(filename), ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//' open file '//trim(filename), ESMF_LOGMSG_INFO) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//' ERROR: file invalid '//trim(filename), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif + call pio_seterrorhandling(pioid, PIO_BCAST_ERROR) + do k = 1,nf + ! Get name of field call shr_nuopc_methods_FB_getNameN(FB, k, itemc, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(FB, itemc, fldptr1=fldptr1, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - name1 = trim(lpre)//'_'//trim(itemc) - call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO, rc=rc) + ! Get iodesc for all fields based on iodesc of first field (assumes that all fields have + ! the same iodesc) + if (k == 1) then + call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=rank, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (rank == 2) then + name1 = trim(lpre)//'_'//trim(itemc)//'1' + else if (rank == 1) then + name1 = trim(lpre)//'_'//trim(itemc) + end if + call med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + end if + + call ESMF_LogWrite(trim(subname)//' reading field '//trim(itemc), ESMF_LOGMSG_INFO) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call pio_seterrorhandling(pioid, PIO_BCAST_ERROR) - rcode = pio_inq_varid(pioid,trim(name1),varid) - if (rcode == pio_noerr) then - - if (k == 1) then - rcode = pio_inq_varndims(pioid, varid, ndims) - write(tmpstr,*) trim(subname),' ndims = ',ndims,k - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - allocate(dimid(ndims)) - rcode = pio_inq_vardimid(pioid, varid, dimid(1:ndims)) - rcode = pio_inq_dimlen(pioid, dimid(1), lnx) - write(tmpstr,*) trim(subname),' lnx = ',lnx - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (ndims>=2) then - rcode = pio_inq_dimlen(pioid, dimid(2), lny) + + ! Get pointer to field bundle field + ! Field bundle might be 2d or 1d - but field on mediator history or restart file will always be 1d + call shr_nuopc_methods_FB_getFldPtr(FB, itemc, & + fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + if (rank == 2) then + + ! Determine the size of the ungridded dimension and the + ! index where the undistributed dimension is located + call ESMF_FieldBundleGet(FB, itemc, field=lfield, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, gridToFieldMap=gridToFieldMap, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + if (gridToFieldMap(1) == 1) then + lsize = size(fldptr2, dim=1) + else if (gridToFieldMap(1) == 2) then + lsize = size(fldptr2, dim=2) + end if + allocate(fldptr1_tmp(lsize)) + + do n = 1,ungriddedUBound(1) + ! Creat a name for the 1d field on the mediator history or restart file based on the + ! ungridded dimension index of the field bundle 2d fiedl + write(cnumber,'(i0)') n + name1 = trim(lpre)//'_'//trim(itemc)//trim(cnumber) + + rcode = pio_inq_varid(pioid, trim(name1), varid) + if (rcode == pio_noerr) then + call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call pio_setframe(pioid, varid, lframe) + call pio_read_darray(pioid, varid, iodesc, fldptr1_tmp, rcode) + rcode = pio_get_att(pioid, varid, "_FillValue", lfillvalue) + if (rcode /= pio_noerr) then + lfillvalue = fillvalue + endif + do l = 1,size(fldptr1_tmp) + if (fldptr1_tmp(l) == lfillvalue) fldptr1_tmp(l) = 0.0_r8 + enddo else - lny = 1 + fldptr1_tmp = 0.0_r8 + endif + if (gridToFieldMap(1) == 1) then + fldptr2(:,n) = fldptr1_tmp(:) + else if (gridToFieldMap(1) == 2) then + fldptr2(n,:) = fldptr1_tmp(:) end if - deallocate(dimid) - write(tmpstr,*) trim(subname),' lny = ',lny - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - ng = lnx * lny - - call shr_nuopc_methods_FB_getFieldN(FB, k, field, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(field, mesh=mesh, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - allocate(minIndexPTile(dimCount, tileCount), & - maxIndexPTile(dimCount, tileCount)) - call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & - maxIndexPTile=maxIndexPTile, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - !write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile - !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - - if (ng > maxval(maxIndexPTile)) then - write(tmpstr,*) subname,' ERROR: dimensions do not match', lnx, lny, maxval(maxIndexPTile) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) - - !TODO: this should not be an error for say CTSM which does not send a global grid - !rc = ESMF_Failure - !return + end do + + deallocate(fldptr1_tmp) + + else if (rank == 1) then + name1 = trim(lpre)//'_'//trim(itemc) + + rcode = pio_inq_varid(pioid, trim(name1), varid) + if (rcode == pio_noerr) then + call ESMF_LogWrite(trim(subname)//' read field '//trim(name1), ESMF_LOGMSG_INFO) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call pio_setframe(pioid,varid,lframe) + call pio_read_darray(pioid, varid, iodesc, fldptr1, rcode) + rcode = pio_get_att(pioid,varid,"_FillValue",lfillvalue) + if (rcode /= pio_noerr) then + lfillvalue = fillvalue endif - - call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return - allocate(dof(ns)) - call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) - write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) - deallocate(dof) - endif - call pio_setframe(pioid,varid,lframe) - call pio_read_darray(pioid, varid, iodesc, fldptr1, rcode) - rcode = pio_get_att(pioid,varid,"_FillValue",lfillvalue) - if (rcode /= pio_noerr) then - lfillvalue = fillvalue + do n = 1,size(fldptr1) + if (fldptr1(n) == lfillvalue) fldptr1(n) = 0.0_r8 + enddo + else + fldptr1 = 0.0_r8 endif - do n = 1,size(fldptr1) - if (fldptr1(n) == lfillvalue) fldptr1(n) = 0.0_r8 - enddo - else - fldptr1 = 0.0_r8 - endif - call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) - enddo + end if + + enddo ! end of loop over fields + call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) - deallocate(minIndexPTile, maxIndexPTile) call pio_freedecomp(pioid, iodesc) call pio_closefile(pioid) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine med_io_read_FB + !=============================================================================== + subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) + + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + 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 pio , only : file_desc_T, var_desc_t, io_desc_t, pio_nowrite, pio_openfile + use pio , only : pio_noerr, pio_inq_varndims + use pio , only : pio_inq_dimid, pio_inq_dimlen, pio_inq_varid, pio_inq_vardimid + use pio , only : pio_double, pio_seterrorhandling, pio_initdecomp + use shr_nuopc_methods_mod, only : shr_nuopc_methods_FB_getFieldN + + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: name1 + type(file_desc_t) , intent(in) :: pioid + type(io_desc_t) , intent(inout) :: iodesc + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: field + type(ESMF_Mesh) :: mesh + type(ESMF_Distgrid) :: distgrid + integer :: rcode + integer :: ns,ng + integer :: n,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) ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + rcode = pio_inq_varid(pioid, trim(name1), varid) + if (rcode == pio_noerr) then + + rcode = pio_inq_varndims(pioid, varid, ndims) + write(tmpstr,*) trim(subname),' ndims = ',ndims + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + allocate(dimid(ndims)) + rcode = pio_inq_vardimid(pioid, varid, dimid(1:ndims)) + rcode = pio_inq_dimlen(pioid, dimid(1), lnx) + write(tmpstr,*) trim(subname),' lnx = ',lnx + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + if (ndims>=2) then + rcode = pio_inq_dimlen(pioid, dimid(2), lny) + else + lny = 1 + end if + deallocate(dimid) + + write(tmpstr,*) trim(subname),' lny = ',lny + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + ng = lnx * lny + + call shr_nuopc_methods_FB_getFieldN(FB, 1, field, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldGet(field, mesh=mesh, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + allocate(minIndexPTile(dimCount, tileCount), maxIndexPTile(dimCount, tileCount)) + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + !write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile + !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + if (ng > maxval(maxIndexPTile)) then + write(tmpstr,*) subname,' WARNING: dimensions do not match', lnx, lny, maxval(maxIndexPTile) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + !TODO: this should not be an error for say CTSM which does not send a global grid + !rc = ESMF_Failure + !return + endif + + call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) + if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + + allocate(dof(ns)) + call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) + write(tmpstr,*) subname,' dof = ',ns,size(dof),dof(1),dof(ns) !,minval(dof),maxval(dof) + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + call pio_initdecomp(io_subsystem, pio_double, (/lnx,lny/), dof, iodesc) + deallocate(dof) + + deallocate(minIndexPTile, maxIndexPTile) + + end if ! end if rcode check + + end subroutine med_io_read_init_iodesc + !=============================================================================== subroutine med_io_read_int(filename, vm, iam, idata, dname) - ! !DESCRIPTION: Read scalar integer from netcdf file + !--------------- + ! Read scalar integer from netcdf file + !--------------- ! input/output arguments character(len=*) , intent(in) :: filename ! file @@ -1210,7 +1446,9 @@ end subroutine med_io_read_int !=============================================================================== subroutine med_io_read_int1d(filename, vm, iam, idata, dname) - ! !DESCRIPTION: Read 1d integer array from netcdf file + !--------------- + ! Read 1d integer array from netcdf file + !--------------- use shr_sys_mod , only : shr_sys_abort use med_constants_mod , only : R8 @@ -1231,7 +1469,6 @@ subroutine med_io_read_int1d(filename, vm, iam, idata, dname) integer :: rcode type(file_desc_t) :: pioid type(var_desc_t) :: varid - logical :: exists character(CL) :: lversion character(CL) :: name1 integer :: rc @@ -1265,7 +1502,9 @@ end subroutine med_io_read_int1d subroutine med_io_read_r8(filename, vm, iam, rdata, dname) use med_constants_mod, only : R8 - ! !DESCRIPTION: Read scalar double from netcdf file + !--------------- + ! Read scalar double from netcdf file + !--------------- ! input/output arguments character(len=*) , intent(in) :: filename ! file @@ -1285,13 +1524,17 @@ end subroutine med_io_read_r8 !=============================================================================== subroutine med_io_read_r81d(filename, vm, iam, rdata, dname) + + !--------------- + ! Read 1d double array from netcdf file + !--------------- + use med_constants_mod, only : R8 use pio, only : file_desc_t, var_desc_t, pio_openfile, pio_closefile, pio_seterrorhandling use pio, only : PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, pio_inq_varid, pio_get_var use pio, only : pio_nowrite, pio_openfile, pio_global, pio_get_att use med_internalstate_mod, only : logunit use shr_sys_mod, only : shr_sys_abort - ! !DESCRIPTION: Read 1d double array from netcdf file ! input/output arguments character(len=*), intent(in) :: filename ! file @@ -1304,8 +1547,6 @@ subroutine med_io_read_r81d(filename, vm, iam, rdata, dname) integer :: rcode type(file_desc_T) :: pioid type(var_desc_t) :: varid - logical :: exists - integer :: rc character(CL) :: lversion character(CL) :: name1 @@ -1337,12 +1578,16 @@ end subroutine med_io_read_r81d !=============================================================================== subroutine med_io_read_char(filename, vm, iam, rdata, dname) - use pio, only : file_desc_t, var_desc_t, pio_seterrorhandling, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR - use pio, only : pio_closefile, pio_inq_varid, pio_get_var - use pio, only : pio_openfile, pio_global, pio_get_att, pio_nowrite - use med_internalstate_mod, only : logunit - use shr_sys_mod, only : shr_sys_abort - ! !DESCRIPTION: Read char string from netcdf file + + !--------------- + ! Read char string from netcdf file + !--------------- + + use pio , only : file_desc_t, var_desc_t, pio_seterrorhandling, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR + use pio , only : pio_closefile, pio_inq_varid, pio_get_var + use pio , only : pio_openfile, pio_global, pio_get_att, pio_nowrite + use med_internalstate_mod , only : logunit + use shr_sys_mod , only : shr_sys_abort ! input/output arguments character(len=*), intent(in) :: filename ! file @@ -1355,11 +1600,10 @@ subroutine med_io_read_char(filename, vm, iam, rdata, dname) integer :: rcode type(file_desc_T) :: pioid type(var_desc_t) :: varid - logical :: exists integer :: rc character(CL) :: lversion character(CL) :: name1 - character(CL) :: charvar ! buffer for string read/write + character(CL) :: charvar ! buffer for string read/write character(*),parameter :: subName = '(med_io_read_char) ' !------------------------------------------------------------------------------- diff --git a/src/drivers/nuopc/mediator/med_map_mod.F90 b/src/drivers/nuopc/mediator/med_map_mod.F90 index 454e1e0d059..b71758f7aa0 100644 --- a/src/drivers/nuopc/mediator/med_map_mod.F90 +++ b/src/drivers/nuopc/mediator/med_map_mod.F90 @@ -4,6 +4,9 @@ module med_map_mod use med_constants_mod , only : ispval_mask => med_constants_ispval_mask use med_constants_mod , only : czero => med_constants_czero use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use esmFlds , only : mapbilnr, mapconsf, mapconsd, mappatch, mapfcopy + use esmFlds , only : mapunset, mapnames + use esmFlds , only : mapnstod, mapnstod_consd, mapnstod_consf implicit none private @@ -21,10 +24,10 @@ module med_map_mod ! private module variables - character(*) , parameter :: u_FILE_u = __FILE__ - ! should this be a module variable? - integer :: srcTermProcessing_Value = 0 - logical :: mastertask + integer :: srcTermProcessing_Value = 0 ! should this be a module variable? + logical :: mastertask + character(*), parameter :: u_FILE_u = & + __FILE__ !================================================================================ contains @@ -70,9 +73,6 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) use NUOPC , only : NUOPC_Write use esmFlds , only : ncomps, compice, compocn, compname use esmFlds , only : fldListFr, fldListTo - use esmFlds , only : mapnames - use esmFlds , only : mapbilnr, mapconsf, mapconsd, mappatch, mapfcopy - use esmFlds , only : mapunset, mapfiler, mapnstod, mapnstod_consd, mapnstod_consf use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFieldN use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use med_internalstate_mod , only : InternalState @@ -105,7 +105,6 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) character(CL) , pointer :: fldnames(:) !integer(ESMF_KIND_I4), pointer :: unmappedDstList(:) character(len=128) :: logMsg - integer :: dbrc type(ESMF_PoleMethod_Flag), parameter :: polemethod=ESMF_POLEMETHOD_ALLAVG character(len=*), parameter :: subname=' (module_med_map: RouteHandles_init) ' !----------------------------------------------------------- @@ -187,45 +186,35 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) mapfile = trim(fldListFr(n1)%flds(nf)%mapfile(n2)) string = trim(rhname)//'_weights' - if (mapindex == mapfiler .and. mapfile /= 'unset') then - ! TODO: actually error out if mapfile is unset in this case - if (mastertask) then - write(llogunit,'(4A)') subname,trim(string),' RH '//trim(mapname)//' via input file ',& - trim(mapfile) - end if - call ESMF_LogWrite(subname // trim(string) //& - ' RH '//trim(mapname)//' via input file '//trim(mapfile), ESMF_LOGMSG_INFO, rc=dbrc) - call ESMF_FieldSMMStore(fldsrc, flddst, mapfile, & - routehandle=is_local%wrap%RH(n1,n2,mapindex), & - ignoreUnmatchedIndices=.true., & - srcTermProcessing=srcTermProcessing_Value, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - else if (mapindex == mapfcopy) then + if (mapindex == mapfcopy) then + ! Create redist route handle if (mastertask) then write(llogunit,'(3A)') subname,trim(string),' RH redist ' end if - call ESMF_LogWrite(trim(subname) // trim(string) // ' RH redist ', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname) // trim(string) // ' RH redist ', ESMF_LOGMSG_INFO) call ESMF_FieldRedistStore(fldsrc, flddst, & routehandle=is_local%wrap%RH(n1,n2,mapindex), & ignoreUnmatchedIndices = .true., rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return else if (mapfile /= 'unset') then + ! Get route handle from mapping file if (mastertask) then write(llogunit,'(4A)') subname,trim(string),' RH '//trim(mapname)//' via input file ',& trim(mapfile) end if call ESMF_LogWrite(subname // trim(string) //& - ' RH '//trim(mapname)//' via input file '//trim(mapfile), ESMF_LOGMSG_INFO, rc=dbrc) + ' RH '//trim(mapname)//' via input file '//trim(mapfile), ESMF_LOGMSG_INFO) call ESMF_FieldSMMStore(fldsrc, flddst, mapfile, & routehandle=is_local%wrap%RH(n1,n2,mapindex), & ignoreUnmatchedIndices=.true., & srcTermProcessing=srcTermProcessing_Value, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return else + ! Create route handle on the fly if (mastertask) write(llogunit,'(3A)') subname,trim(string),& ' RH regrid for '//trim(mapname)//' computed on the fly' call ESMF_LogWrite(subname // trim(string) //& - ' RH regrid for '//trim(mapname)//' computed on the fly', ESMF_LOGMSG_INFO, rc=dbrc) + ' RH regrid for '//trim(mapname)//' computed on the fly', ESMF_LOGMSG_INFO) if (mapindex == mapbilnr) then srcTermProcessing_Value = 0 call ESMF_FieldRegridStore(fldsrc, flddst, & @@ -299,12 +288,12 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) end if !if (associated(unmappedDstList)) then ! write(logMsg,*) trim(subname),trim(string),' number of unmapped dest points = ', size(unmappedDstList) - ! call ESMF_LogWrite(trim(logMsg), ESMF_LOGMSG_INFO, rc=dbrc) + ! call ESMF_LogWrite(trim(logMsg), ESMF_LOGMSG_INFO) !end if end if if (rhprint_flag .and. mapindex /= mapnstod_consd .and. mapindex /= mapnstod_consf) then call ESMF_LogWrite(trim(subname)//trim(string)//": printing RH for "//trim(mapname), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) call ESMF_RouteHandlePrint(is_local%wrap%RH(n1,n2,mapindex), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -313,7 +302,7 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) if ( mapindex /= mapnstod_consd .and. mapindex /= mapnstod_consf .and. & .not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(n1,n2,mapindex), rc=rc)) then call ESMF_LogWrite(trim(subname)//trim(string)//": failed RH "//trim(mapname), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) endif end if end do ! loop over fields @@ -323,7 +312,7 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) end do ! loop over n1 if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif call t_stopf('MED:'//subname) @@ -366,7 +355,6 @@ subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) integer :: SrcMaskValue integer :: DstMaskValue real(R8), pointer :: factorList(:) - integer :: dbrc character(len=*), parameter :: subname=' (med_map_fractions_init: ) ' !--------------------------------------------- call t_startf('MED:'//subname) @@ -402,14 +390,14 @@ subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) if (mapfile == 'idmap') then call ESMF_LogWrite(trim(subname) // trim(string) //& - ' RH '//trim(mapname)// ' is redist', ESMF_LOGMSG_INFO, rc=dbrc) + ' RH '//trim(mapname)// ' is redist', ESMF_LOGMSG_INFO) call ESMF_FieldRedistStore(fldsrc, flddst, & routehandle=RouteHandle, & ignoreUnmatchedIndices = .true., rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return else if (mapfile /= 'unset') then call ESMF_LogWrite(subname // trim(string) //& - ' RH '//trim(mapname)//' via input file '//trim(mapfile), ESMF_LOGMSG_INFO, rc=dbrc) + ' RH '//trim(mapname)//' via input file '//trim(mapfile), ESMF_LOGMSG_INFO) call ESMF_FieldSMMStore(fldsrc, flddst, mapfile, & routehandle=RouteHandle, & ignoreUnmatchedIndices=.true., & @@ -417,7 +405,7 @@ subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(subname // trim(string) //& - ' RH '//trim(mapname)//' computed on the fly '//trim(mapfile), ESMF_LOGMSG_INFO, rc=dbrc) + ' RH '//trim(mapname)//' computed on the fly '//trim(mapfile), ESMF_LOGMSG_INFO) call ESMF_FieldRegridStore(fldsrc, flddst, & routehandle=RouteHandle, & srcMaskValues=(/srcMaskValue/), & @@ -431,7 +419,7 @@ subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) end if if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif call t_stopf('MED:'//subname) @@ -459,6 +447,7 @@ subroutine med_map_MapNorm_init(gcomp, llogunit, rc) use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_FieldRegrid use shr_nuopc_methods_mod , only: shr_nuopc_methods_ChkErr use perf_mod , only: t_startf, t_stopf + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(in) :: llogunit @@ -471,7 +460,6 @@ subroutine med_map_MapNorm_init(gcomp, llogunit, rc) character(len=CS) :: normname character(len=1) :: cn1,cn2,cm real(R8), pointer :: dataptr(:) - integer :: dbrc character(len=*),parameter :: subname='(module_MED_MAP:MapNorm_init)' !----------------------------------------------------------- call t_startf('MED:'//subname) @@ -500,7 +488,7 @@ subroutine med_map_MapNorm_init(gcomp, llogunit, rc) write(cn1,'(i1)') n1; write(cn2,'(i1)') n2; write(cm ,'(i1)') m call ESMF_LogWrite(trim(subname)//":"//'creating FBMapNormOne for '& //compname(n1)//'->'//compname(n2)//'with mapping '//mapnames(m), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) endif call shr_nuopc_methods_FB_init(FBout=is_local%wrap%FBNormOne(n1,n2,m), & flds_scalar_name=flds_scalar_name, & @@ -537,7 +525,7 @@ subroutine med_map_MapNorm_init(gcomp, llogunit, rc) end do if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif call t_stopf('MED:'//subname) @@ -546,7 +534,7 @@ end subroutine med_map_MapNorm_init !================================================================================ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & - FBSrc, FBDst, FBFrac, FBNormOne, RouteHandles, string, rc) + FBSrc, FBDst, FBFracSrc, FBFracDst, FBNormOne, RouteHandles, string, rc) ! ---------------------------------------------- ! Map field bundles with appropriate fraction weighting @@ -554,10 +542,11 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & use NUOPC , only: NUOPC_IsConnected use ESMF , only: ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only: ESMF_LOGMSG_ERROR, ESMF_FAILURE + use ESMF , only: ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR use ESMF , only: ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet - use ESMF , only: ESMF_RouteHandle, ESMF_RouteHandleIsCreated, ESMF_Field + use ESMF , only: ESMF_RouteHandle, ESMF_RouteHandleIsCreated use ESMF , only: ESMF_REGION_SELECT, ESMF_REGION_TOTAL + use ESMF , only: ESMF_Field, ESMF_FieldGet use esmFlds , only: compname use esmFlds , only: mapnames, mapfcopy, mapconsd, mapconsf, mapnstod use esmFlds , only: mapnstod_consd, mapnstod_consf @@ -580,32 +569,32 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & integer , intent(in) :: destcomp type(ESMF_FieldBundle) , intent(inout) :: FBSrc type(ESMF_FieldBundle) , intent(inout) :: FBDst - type(ESMF_FieldBundle) , intent(in) :: FBFrac + type(ESMF_FieldBundle) , intent(in) :: FBFracSrc + type(ESMF_FieldBundle) , intent(in) :: FBFracDst type(ESMF_FieldBundle) , intent(in) :: FBNormOne(:) type(ESMF_RouteHandle) , intent(inout) :: RouteHandles(:) character(len=*), optional , intent(in) :: string integer , intent(out) :: rc ! local variables - integer :: i, n - type(ESMF_Field) :: srcField - type(ESMF_Field) :: tmpfield - integer :: mapindex - character(len=CS) :: lstring - character(len=CS) :: mapnorm - character(len=CS) :: fldname - real(R8), allocatable :: data_srctmp(:) ! temporary - real(R8), allocatable :: data_dsttmp(:) ! temporary - real(R8), pointer :: data_src(:) - real(R8), pointer :: data_dst(:) - real(R8), pointer :: data_frac(:) - real(R8), pointer :: data_norm(:) - integer :: dbrc + integer :: i, n, k + character(len=CS) :: lstring + integer :: mapindex + character(len=CS) :: mapnorm + character(len=CS) :: fldname + type(ESMF_Field) :: srcField + type(ESMF_Field) :: dstField + type(ESMF_Field) :: lfield + real(R8), allocatable :: data_srctmp(:) + real(R8), pointer :: data_src(:) + real(R8), pointer :: data_dst(:) + real(R8), pointer :: data_frac(:) + real(R8), pointer :: data_norm(:) character(len=*), parameter :: subname='(module_MED_Map:med_map_Regrid_Norm)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call shr_nuopc_memcheck(subname, 1, mastertask) !--------------------------------------- @@ -631,9 +620,10 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & !--------------------------------------- call ESMF_LogWrite(trim(subname)//" *** mapping from "//trim(compname(srccomp))//" to "//& - trim(compname(destcomp))//" ***", ESMF_LOGMSG_INFO, rc=dbrc) + trim(compname(destcomp))//" ***", ESMF_LOGMSG_INFO) do n = 1,size(fldsSrc) + ! Determine if field is a scalar - and if so go to next iternation fldname = fldsSrc(n)%shortname if (fldname == flds_scalar_name) CYCLE @@ -643,17 +633,33 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & if (mapindex == 0) CYCLE mapnorm = fldsSrc(n)%mapnorm(destcomp) + ! Determine if field is FBSrc or FBDst or connected - and if not go to next iteration + if (.not. shr_nuopc_methods_FB_FldChk(FBSrc, trim(fldname), rc=rc)) then + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//" field not found in FBSrc: "//trim(fldname), ESMF_LOGMSG_INFO) + end if + CYCLE + else if (.not. shr_nuopc_methods_FB_FldChk(FBDst, trim(fldname), rc=rc)) then + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//" field not found in FBDst: "//trim(fldname), ESMF_LOGMSG_INFO) + end if + CYCLE + end if + + ! ------------------- ! Error checks + ! ------------------- + if (.not. shr_nuopc_methods_FB_FldChk(FBSrc, fldname, rc=rc)) then - call ESMF_LogWrite(trim(subname)//" field not found in FBSrc: "//trim(fldname), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//" field not found in FBSrc: "//trim(fldname), ESMF_LOGMSG_INFO) else if (.not. shr_nuopc_methods_FB_FldChk(FBDst, fldname, rc=rc)) then - call ESMF_LogWrite(trim(subname)//" field not found in FBDst: "//trim(fldname), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//" field not found in FBDst: "//trim(fldname), ESMF_LOGMSG_INFO) else if (mapindex == mapnstod_consd) then if (.not. ESMF_RouteHandleIsCreated(RouteHandles(mapconsd), rc=rc) .or. & .not. ESMF_RouteHandleIsCreated(RouteHandles(mapnstod), rc=rc)) then call ESMF_LogWrite(trim(subname)//trim(lstring)//& ": ERROR RH not available for "//mapnames(mapindex)//": fld="//trim(fldname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return end if @@ -662,35 +668,34 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & .not. ESMF_RouteHandleIsCreated(RouteHandles(mapnstod), rc=rc)) then call ESMF_LogWrite(trim(subname)//trim(lstring)//& ": ERROR RH not available for "//mapnames(mapindex)//": fld="//trim(fldname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return end if else if (.not. ESMF_RouteHandleIsCreated(RouteHandles(mapindex), rc=rc)) then call ESMF_LogWrite(trim(subname)//trim(lstring)//& ": ERROR RH not available for "//mapnames(mapindex)//": fld="//trim(fldname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return end if - ! Determine if field is FBSrc or FBDst or connected - and if not go to next iteration - if (.not. shr_nuopc_methods_FB_FldChk(FBSrc, trim(fldname), rc=rc)) then - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//" field not found in FBSrc: "//trim(fldname), ESMF_LOGMSG_INFO, rc=dbrc) - end if - CYCLE - else if (.not. shr_nuopc_methods_FB_FldChk(FBDst, trim(fldname), rc=rc)) then - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//" field not found in FBDst: "//trim(fldname), ESMF_LOGMSG_INFO, rc=dbrc) - end if - CYCLE - end if + ! ------------------- + ! Get the source and destination fields + ! ------------------- call ESMF_LogWrite(trim(subname)//" --> remapping "//trim(fldname)//" with "//trim(mapnames(mapindex)), & ESMF_LOGMSG_INFO) + call ESMF_FieldBundleGet(FBSrc, fieldName=trim(fldname), field=srcfield, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldBundleGet(FBDst, fieldName=trim(fldname), field=dstfield, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! ------------------- ! Do the mapping + ! ------------------- + if (mapindex == mapfcopy) then call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapindex), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -701,10 +706,16 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & if ( trim(mapnorm) /= 'unset' .and. trim(mapnorm) /= 'one' .and. trim(mapnorm) /= 'none') then - ! Get field and pointer to source field data in FBSrc - call shr_nuopc_methods_FB_GetFldPtr(FBSrc, fldname, data_src, field=srcfield, rc=rc) + !------------------------------------------------- + ! fractional normalization (1) + ! multiple source field by fraction and map product + !------------------------------------------------- + + ! get a pointer to source field data in FBSrc + call shr_nuopc_methods_FB_GetFldPtr(FBSrc, fldname, data_src, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! allocate memory for a save array if not already allocated if (.not. allocated(data_srctmp) .or. size(data_srctmp) /= size(data_src)) then if (allocated(data_srctmp)) then deallocate(data_srctmp) @@ -712,192 +723,213 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & allocate(data_srctmp(size(data_src))) endif - !------------------------------------------------- - ! fractional normalization - !------------------------------------------------- - ! get a pointer to the array of the normalization on the source grid - this must ! be the same size is as fraction on the source grid - call shr_nuopc_methods_FB_GetFldPtr(FBFrac, trim(mapnorm), data_frac, rc=rc) + call shr_nuopc_methods_FB_GetFldPtr(FBFracSrc, trim(mapnorm), data_frac, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return ! regrid FBSrc to FBDst - ! Copy data_src to data_srctmp and multiply by fraction, regrid this then replace with original data_src + ! - copy data_src to data_srctmp + ! - multiply by fraction, regrid this then replace with original data_src + ! - regrid field with name fldname from FBsrc to FBDst + ! - restore original value data_srctmp = data_src data_src = data_src * data_frac + call map_field_src2dst (fldname, srcfield, dstfield, RouteHandles, mapindex, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + data_src = data_srctmp - if (mapindex == mapnstod_consd) then - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapnstod), rc, & - zeroregion=ESMF_REGION_TOTAL) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after nstod: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapconsd), rc, & - zeroregion=ESMF_REGION_SELECT) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! get the field from FBFrac that has the target normalization fraction + call shr_nuopc_methods_FB_GetFldPtr(FBFracDst, mapnorm, data_norm, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after consd: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! normalize destination mapped values by the reciprocal of the mapped fraction + call norm_field_dest(trim(fldname), dstfield, data_norm, rc) - else if (mapindex == mapnstod_consf) then - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapnstod), rc, & - zeroregion=ESMF_REGION_TOTAL) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + else if (trim(mapnorm) == 'one' .or. trim(mapnorm) == 'none') then - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after nstod: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------------------------------------- + ! unity or no normalization + !------------------------------------------------- - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapconsf), rc, & - zeroregion=ESMF_REGION_SELECT) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! map src field to destination grid + call map_field_src2dst (trim(fldname), srcfield, dstfield, RouteHandles, mapindex, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after consf: ", rc=rc) + ! obtain unity normalization factor and multiply interpolated field by reciprocal of normalization factor + if (trim(mapnorm) == 'one') then + call ESMF_FieldBundleGet(FBNormOne(mapindex), fieldName='one', field=lfield, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - else - - call shr_nuopc_methods_FB_FieldRegrid( FBSrc, trim(fldname), FBDst, fldname, RouteHandles(mapindex), rc) + call ESMF_FieldGet(lfield, farrayPtr=data_norm, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! Restore original value - data_src = data_srctmp - - call shr_nuopc_methods_FB_GetFldPtr(FBDst, trim(fldname), data_dst, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (.not. allocated(data_dsttmp) .or. size(data_dsttmp) /= size(data_dst)) then - if(allocated(data_dsttmp)) then - deallocate(data_dsttmp) - endif - allocate(data_dsttmp(size(data_dst))) - endif - - ! Copy data_dst to tmp location, regrid fraction from source - data_dsttmp = data_dst - data_dst = czero + call norm_field_dest(trim(fldname), dstfield, data_norm, rc) + end if ! mapnorm is 'one' - if (mapindex == mapnstod_consd) then - call shr_nuopc_methods_FB_FieldRegrid(FBFrac, mapnorm, FBDst, trim(fldname), RouteHandles(mapnstod), rc, & - zeroregion=ESMF_REGION_TOTAL) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_FieldRegrid(FBFrac, mapnorm, FBDst, trim(fldname), RouteHandles(mapconsd), rc, & - zeroregion=ESMF_REGION_SELECT) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - else if (mapindex == mapnstod_consf) then - call shr_nuopc_methods_FB_FieldRegrid(FBFrac, mapnorm, FBDst, trim(fldname), RouteHandles(mapnstod), rc, & - zeroregion=ESMF_REGION_TOTAL) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_FieldRegrid(FBFrac, mapnorm, FBDst, trim(fldname), RouteHandles(mapconsf), rc, & - zeroregion=ESMF_REGION_SELECT) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - else - call shr_nuopc_methods_FB_FieldRegrid(FBFrac, mapnorm, FBDst, trim(fldname), RouteHandles(mapindex), rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if + end if ! mapnorm is 'one' or 'nne' + end if ! mapindex is not mapfcopy and field exists - do i= 1,size(data_dst) - if (data_dst(i) /= 0.0_R8) then - data_dst(i) = data_dsttmp(i)/data_dst(i) - endif - end do + !if (dbug_flag > 1) then + call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, & + string=trim(subname) //' FBImp('//trim(compname(srccomp))//','//trim(compname(destcomp))//') ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + !end if - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after frac: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end do ! loop over fields + if (allocated(data_srctmp)) deallocate(data_srctmp) - else if (trim(mapnorm) == 'one' .or. trim(mapnorm) == 'none') then + call t_stopf('MED:'//subname) - !------------------------------------------------- - ! unity or no normalization - !------------------------------------------------- + end subroutine med_map_FB_Regrid_Norm_All - ! map source field to destination grid - mapindex = fldsSrc(n)%mapindex(destcomp) + !================================================================================ - if (mapindex == mapnstod_consd) then + subroutine map_field_src2dst (fldname, srcfield, dstfield, RouteHandles, mapindex, rc) - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapnstod), rc, & - zeroregion=ESMF_REGION_TOTAL) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + !--------------------------------------------------- + ! map the source field to the destination field + !--------------------------------------------------- - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after nstod: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_MAXSTR + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldRegrid + use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_Region_Flag, ESMF_REGION_TOTAL + use ESMF , only : ESMF_RouteHandle, ESMF_RouteHandleIsCreated + use shr_nuopc_methods_mod , only : shr_nuopc_methods_Field_diagnose + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_chkerr - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapconsd), rc, & - zeroregion=ESMF_REGION_SELECT) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! input/output variables + character(len=*) , intent(in) :: fldname + type(ESMF_Field) , intent(in) :: srcfield + type(ESMF_Field) , intent(inout) :: dstfield + type(ESMF_RouteHandle) , intent(inout) :: RouteHandles(:) + integer , intent(in) :: mapindex + integer , intent(out) :: rc - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after consd: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! local variables + logical :: checkflag = .false. + !--------------------------------------------------- - else if (mapindex == mapnstod_consf) then - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapnstod), rc, & - zeroregion=ESMF_REGION_TOTAL) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + rc = ESMF_SUCCESS - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after nstod: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return +#ifdef DEBUG + checkflag = .true. +#endif - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapconsf), rc, & - zeroregion=ESMF_REGION_SELECT) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (mapindex == mapnstod_consd) then + call ESMF_FieldRegrid(srcfield, dstfield, routehandle=RouteHandles(mapnstod), & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_Field_diagnose(dstfield, fldname, " --> after nstod: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldRegrid(srcfield, dstfield, routehandle=RouteHandles(mapconsd), & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_Field_diagnose(dstfield, fldname, " --> after consd: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + else if (mapindex == mapnstod_consf) then + call ESMF_FieldRegrid(srcfield, dstfield, routehandle=RouteHandles(mapnstod), & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_Field_diagnose(dstfield, fldname, " --> after nstod: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_FieldRegrid(srcfield, dstfield, routehandle=RouteHandles(mapconsf), & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_Field_diagnose(dstfield, fldname, " --> after consf: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + else + call ESMF_FieldRegrid(srcfield, dstfield, routehandle=RouteHandles(mapindex), & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, zeroregion=ESMF_REGION_TOTAL, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if - ! temp diagnostics - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, " --> after consf: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine map_field_src2dst - else + !================================================================================ - call shr_nuopc_methods_FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapindex), rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - end if + subroutine norm_field_dest (fldname, dstfield, frac, rc) - ! obtain unity normalization factor and multiply interpolated field by reciprocal of normalization factor - if (trim(mapnorm) == 'one') then - call shr_nuopc_methods_FB_GetFldPtr(FBNormOne(mapindex), 'one', data_norm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + !------------------------------------------------ + ! normalize destination mapped values by the reciprocal of the + ! mapped fraction or 'one' + ! ------------------------------------------------ - call shr_nuopc_methods_FB_GetFldPtr(FBDst, trim(fldname), data_dst, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + use ESMF , only : ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_SUCCESS + use shr_nuopc_methods_mod , only : shr_nuopc_methods_Field_Diagnose + use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_chkerr - do i= 1,size(data_dst) - if (data_norm(i) == 0.0_R8) then - data_dst(i) = 0.0_R8 - else - data_dst(i) = data_dst(i)/data_norm(i) - endif - enddo - end if ! mapnorm is 'one' + ! input/output variables + character(len=*) , intent(in) :: fldname + type(ESMF_Field) , intent(inout) :: dstfield + real(r8) , intent(in) :: frac(:) + integer , intent(out) :: rc - end if ! mapnorm is 'one' or 'nne' - end if ! mapindex is not mapfcopy and field exists + ! local variables + integer :: i,n + integer :: lrank + real(R8), pointer :: data1d(:) + real(R8), pointer :: data2d(:,:) + 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 + ! ------------------------------------------------ - !if (dbug_flag > 1) then - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, & - string=trim(subname) //' FBImp('//trim(compname(srccomp))//','//trim(compname(destcomp))//') ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - !end if + rc = ESMF_SUCCESS - end do ! loop over fields + call ESMF_FieldGet(dstfield, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - if (allocated(data_srctmp)) deallocate(data_srctmp) - if (allocated(data_dsttmp)) deallocate(data_dsttmp) + if (lrank == 1) then + call ESMF_FieldGet(dstfield, farrayPtr=data1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do i= 1,size(data1d) + if (frac(i) == 0.0_R8) then + data1d(i) = 0.0_R8 + else + data1d(i) = data1d(i)/frac(i) + endif + enddo + else if (lrank == 2) then + call ESMF_FieldGet(dstfield, ungriddedUBound=ungriddedUBound, gridToFieldMap=gridToFieldMap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(dstfield, farrayPtr=data2d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,ungriddedUbound(1) + if (gridToFieldMap(1) == 1) then + do i = 1,size(data2d,dim=1) + if (frac(i) == 0.0_r8) then + data2d(i,n) = 0.0_r8 + else + data2d(i,n) = data2d(i,n)/frac(i) + end if + end do + else if (gridToFieldMap(1) == 2) then + do i = 1,size(data2d,dim=2) + if (frac(i) == 0.0_r8) then + data2d(n,i) = 0.0_r8 + else + data2d(n,i) = data2d(n,i)/frac(i) + end if + end do + end if + end do + end if - call t_stopf('MED:'//subname) + call shr_nuopc_methods_Field_diagnose(dstfield, fldname, " --> after frac: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - end subroutine med_map_FB_Regrid_Norm_All + end subroutine norm_field_dest !================================================================================ @@ -948,14 +980,13 @@ subroutine med_map_FB_Regrid_Norm_Frac(fldnames, FBSrc, FBDst, & real(R8), pointer :: data_dstnorm(:) ! temporary real(R8), pointer :: data_frac(:) ! temporary real(R8), pointer :: data_norm(:) ! temporary - integer :: dbrc character(len=*), parameter :: subname='(module_MED_Map:med_map_Regrid_Norm)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) call shr_nuopc_memcheck(subname, 1, mastertask) @@ -1018,12 +1049,12 @@ subroutine med_map_FB_Regrid_Norm_Frac(fldnames, FBSrc, FBDst, & ! error checks if (size(data_srcnorm) /= size(data_frac)) then call ESMF_LogWrite(trim(subname)//" fldname= "//trim(fldnames(n))//" mapnorm= "//trim(mapnorm), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) write(csize1,'(i8)') size(data_srcnorm) write(csize2,'(i8)') size(data_frac) call ESMF_LogWrite(trim(subname)//": ERROR data_normsrc size "//trim(csize1)//& " and data_frac size "//trim(csize2)//" are inconsistent", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return else if (size(data_srcnorm) /= size(data_srctmp)) then @@ -1031,7 +1062,7 @@ subroutine med_map_FB_Regrid_Norm_Frac(fldnames, FBSrc, FBDst, & write(csize2,'(i8)') size(data_srctmp) call ESMF_LogWrite(trim(subname)//": ERROR data_srcnorm size "//trim(csize1)//& " and data_srctmp size "//trim(csize2)//" are inconsistent", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return end if @@ -1046,7 +1077,7 @@ subroutine med_map_FB_Regrid_Norm_Frac(fldnames, FBSrc, FBDst, & ! regrid FBSrcTmp to FBDst if (trim(fldnames(n)) == trim(flds_scalar_name)) then call ESMF_LogWrite(trim(subname)//trim(lstring)//": skip : fld="//trim(fldnames(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) else call shr_nuopc_methods_FB_FieldRegrid( FBSrcTmp, 'data_srctmp', FBDst, fldnames(n), RouteHandle, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/drivers/nuopc/mediator/med_merge_mod.F90 b/src/drivers/nuopc/mediator/med_merge_mod.F90 index b52cfd96eb1..7343fd957b5 100644 --- a/src/drivers/nuopc/mediator/med_merge_mod.F90 +++ b/src/drivers/nuopc/mediator/med_merge_mod.F90 @@ -31,8 +31,7 @@ module med_merge_mod contains !----------------------------------------------------------------------------- - subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, FBMed2, & - document, string, mastertask, rc) + subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, FBMed2, rc) use ESMF , only : ESMF_FieldBundle use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet @@ -63,9 +62,6 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, type(shr_nuopc_fldList_type) , intent(in) :: fldListTo ! Information for merging type(ESMF_FieldBundle) , intent(in) , optional :: FBMed1 ! mediator field bundle type(ESMF_FieldBundle) , intent(in) , optional :: FBMed2 ! mediator field bundle - logical , intent(in) :: document - character(len=*) , intent(in) :: string - logical , intent(in) :: mastertask integer , intent(out) :: rc ! local variables @@ -207,25 +203,33 @@ end subroutine med_merge_auto subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fldw, rc) use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LogMsg_Error - use ESMF , only : ESMF_FieldBundle, ESMF_LogWrite, ESMF_LogMsg_Info + use ESMF , only : ESMF_LogWrite, ESMF_LogMsg_Info + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF , only : ESMF_FieldGet, ESMF_Field use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr + use shr_sys_mod , only : shr_sys_abort + ! input/output variables character(len=*) ,intent(in) :: merge_type type(ESMF_FieldBundle),intent(inout) :: FBout character(len=*) ,intent(in) :: FBoutfld type(ESMF_FieldBundle),intent(in) :: FB character(len=*) ,intent(in) :: FBfld - type(ESMF_FieldBundle),intent(inout) :: FBw - character(len=*) ,intent(in) :: fldw + type(ESMF_FieldBundle),intent(inout) :: FBw ! field bundle with weights + character(len=*) ,intent(in) :: fldw ! name of weight field to use in FBw integer ,intent(out) :: rc ! local variables - real(R8), pointer :: dp1 (:), dp2(:,:) - real(R8), pointer :: dpf1(:), dpf2(:,:) - real(R8), pointer :: dpw1(:), dpw2(:,:) - integer :: lrank - integer :: dbrc + integer :: n + type(ESMF_Field) :: lfield + real(R8), pointer :: dp1 (:), dp2(:,:) ! output pointers to 1d and 2d fields + real(R8), pointer :: dpf1(:), dpf2(:,:) ! intput pointers to 1d and 2d fields + real(R8), pointer :: dpw1(:) ! weight pointer + integer :: lrank ! rank of array + integer :: ungriddedUBound_output(1) ! currently the size must equal 1 for rank 2 fieldds + integer :: ungriddedUBound_input(1) ! currently the size must equal 1 for rank 2 fieldds + integer :: gridToFieldMap_output(1) ! currently the size must equal 1 for rank 2 fieldds + integer :: gridToFieldMap_input(1) ! currently the size must equal 1 for rank 2 fieldds character(len=*),parameter :: subname=' (med_merge_mod: med_merge)' !--------------------------------------- @@ -238,13 +242,13 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld if (merge_type == 'copy_with_weights' .or. merge_type == 'merge') then if (trim(fldw) == 'unset') then call ESMF_LogWrite(trim(subname)//": error required merge_fracname is not set", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return end if if (.not. shr_nuopc_methods_FB_FldChk(FBw, trim(fldw), rc=rc)) then call ESMF_LogWrite(trim(subname)//": error "//trim(fldw)//"is not in FBw", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return end if @@ -254,33 +258,54 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld ! Get appropriate field pointers !------------------------- - call shr_nuopc_methods_FB_GetFldPtr(FBout, trim(FBoutfld), fldptr1=dp1, fldptr2=dp2, rank=lrank, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - if (merge_type == 'copy_with_weights' .or. merge_type == 'merge' .or. merge_type == 'sum_with_weights') then - if (lrank == 1) then - call shr_nuopc_methods_FB_GetFldPtr(FBw, trim(fldw), fldptr1=dpw1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (lrank == 2) then - call shr_nuopc_methods_FB_GetFldPtr(FBw, trim(fldw), fldptr2=dpw2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end if - endif - - !------------------------- - ! Loop over all output fields and do the merge - !------------------------- + ! Get field pointer to output field + call ESMF_FieldBundleGet(FBout, fieldName=trim(FBoutfld), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (lrank == 1) then + call ESMF_FieldGet(lfield, farrayPtr=dp1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else if (lrank == 2) then + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound_output, & + gridToFieldMap=gridToFieldMap_output, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dp2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if ! Get field pointer to input field used in the merge + call ESMF_FieldBundleGet(FB, fieldName=trim(FBfld), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return if (lrank == 1) then - call shr_nuopc_methods_FB_GetFldPtr(FB, trim(FBfld), fldptr1=dpf1, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dpf1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else if (lrank == 2) then - call shr_nuopc_methods_FB_GetFldPtr(FB, trim(FBfld), fldptr2=dpf2, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound_input, & + gridToFieldMap=gridToFieldMap_input, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dpf2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if - ! Do one of two types of merges (copy or merge) + ! error checks + if (ungriddedUBound_output(1) /= ungriddedUBound_input(1)) then + call shr_sys_abort("ungriddedUBound_input not equal to ungriddedUBound_output") + else if (gridToFieldMap_input(1) /= gridToFieldMap_output(1)) then + call shr_sys_abort("gridToFieldMap_input not equal to gridToFieldMap_output") + end if + + ! Get pointer to weights that weights are only rank 1 + if (merge_type == 'copy_with_weights' .or. merge_type == 'merge' .or. merge_type == 'sum_with_weights') then + call ESMF_FieldBundleGet(FBw, fieldName=trim(fldw), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, farrayPtr=dpw1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + + ! Do supported merges if (trim(merge_type) == 'copy') then if (lrank == 1) then dp1(:) = dpf1(:) @@ -291,13 +316,25 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld if (lrank == 1) then dp1(:) = dpf1(:)*dpw1(:) else - dp2(:,:) = dpf2(:,:)*dpw2(:,:) + do n = 1,ungriddedUBound_input(1) + if (gridToFieldMap_input(1) == 1) then + dp2(:,n) = dpf2(:,n)*dpw1(:) + else if (gridToFieldMap_input(1) == 2) then + dp2(n,:) = dpf2(n,:)*dpw1(:) + end if + end do endif - else if (trim(merge_type) == 'merge') then + else if (trim(merge_type) == 'merge' .or. trim(merge_type) == 'sum_with_weights') then if (lrank == 1) then dp1(:) = dp1(:) + dpf1(:)*dpw1(:) else - dp2(:,:) = dp2(:,:) + dpf2(:,:)*dpw2(:,:) + do n = 1,ungriddedUBound_input(1) + if (gridToFieldMap_input(1) == 1) then + dp2(:,n) = dp2(:,n) + dpf2(:,n)*dpw1(:) + else if (gridToFieldMap_input(1) == 2) then + dp2(n,:) = dp2(n,:) + dpf2(n,:)*dpw1(:) + end if + end do endif else if (trim(merge_type) == 'sum') then if (lrank == 1) then @@ -305,15 +342,9 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld else dp2(:,:) = dp2(:,:) + dpf2(:,:) endif - else if (trim(merge_type) == 'sum_with_weights') then - if (lrank == 1) then - dp1(:) = dp1(:) + dpf1(:)*dpw1(:) - else - dp2(:,:) = dp2(:,:) + dpf2(:,:)*dpw2(:,:) - endif else call ESMF_LogWrite(trim(subname)//": merge type "//trim(merge_type)//" not supported", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return end if diff --git a/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 b/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 index 7e284975d80..ef127088cd5 100644 --- a/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 @@ -2,7 +2,7 @@ module med_phases_aofluxes_mod use med_constants_mod , only : R8, CL, CX use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_internalstate_mod , only : mastertask + use med_internalstate_mod , only : mastertask, logunit use shr_nuopc_utils_mod , only : shr_nuopc_memcheck use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_chkerr use shr_nuopc_methods_mod , only : fldchk => shr_nuopc_methods_FB_FldChk @@ -20,7 +20,6 @@ module med_phases_aofluxes_mod ! Private routines !-------------------------------------------------------------------------- - private :: med_phases_aofluxes_init private :: med_aofluxes_init private :: med_aofluxes_run @@ -72,118 +71,33 @@ module med_phases_aofluxes_mod ! Fields that are not obtained via GetFldPtr real(R8) , pointer :: uGust (:) ! wind gust + logical :: created ! has this data type been created end type aoflux_type ! The following three variables are obtained as attributes from gcomp logical :: flds_wiso ! use case logical :: compute_atm_dens logical :: compute_atm_thbot - character(3) :: aoflux_grid character(*), parameter :: u_FILE_u = & __FILE__ !================================================================================ contains -!================================================================================ - - subroutine med_phases_aofluxes_init(gcomp, aoflux, rc) - - use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_VMGet, ESMF_GridCompGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LOGERR_PASSTHRU - use ESMF , only : ESMF_SUCCESS, ESMF_LogFoundError - use NUOPC , only : NUOPC_CompAttributeGet - use esmFlds , only : compatm, compocn - use med_internalstate_mod , only : InternalState, mastertask - use shr_nuopc_scalars_mod , only : flds_scalar_name - use shr_nuopc_scalars_mod , only : flds_scalar_num - use perf_mod , only : t_startf, t_stopf - - !----------------------------------------------------------------------- - ! Initialize ocn/atm flux calculations - !----------------------------------------------------------------------- - - ! input/output variables - type(ESMF_GridComp) :: gcomp - type(aoflux_type) , intent(inout) :: aoflux - integer , intent(out) :: rc - - ! Local variables - character(3) :: aoflux_grid - character(len=256) :: cvalue - type(InternalState) :: is_local - integer :: localPet - type(ESMF_VM) :: vm - integer :: dbrc - character(len=*),parameter :: subname='(med_phases_aofluxes_init)' - !--------------------------------------- - call t_startf('MED:'//subname) - - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif - rc = ESMF_SUCCESS - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - mastertask = .false. - if (localPet == 0) mastertask=.true. - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Determine src and dst comps depending on the aoflux_grid setting - - call NUOPC_CompAttributeGet(gcomp, name='aoflux_grid', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) aoflux_grid - - if (trim(aoflux_grid) == 'ocn') then - - ! Create FBMed_aoflux_o (field bundle on the ocean grid) - call med_aofluxes_init(gcomp, aoflux, & - FBAtm=is_local%wrap%FBImp(compatm,compocn), & - FBOcn=is_local%wrap%FBImp(compocn,compocn), & - FBFrac=is_local%wrap%FBfrac(compocn), & - FBMed_aoflux=is_local%wrap%FBMed_aoflux_o, & - rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - else if (trim(aoflux_grid) == 'atm') then - - ! Create FBMed_aoflux_a (field bundle on the atmosphere grid) - call med_aofluxes_init(gcomp, aoflux, & - FBAtm=is_local%wrap%FBImp(compatm,compatm), & - FBOcn=is_local%wrap%FBImp(compocn,compatm), & - FBFrac=is_local%wrap%FBfrac(compatm), & - FBMed_aoflux=is_local%wrap%FBMed_aoflux_a, & - rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - else - - call ESMF_LogWrite(trim(subname)//' aoflux_grid = '//trim(aoflux_grid)//' not available', & - ESMF_LOGMSG_INFO, rc=dbrc) - return - - end if - call t_stopf('MED:'//subname) - - end subroutine med_phases_aofluxes_init - !================================================================================ subroutine med_phases_aofluxes_run(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_GridCompGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_FieldBundleIsCreated use NUOPC , only : NUOPC_IsConnected, NUOPC_CompAttributeGet use med_internalstate_mod , only : InternalState use med_map_mod , only : med_map_FB_Regrid_Norm - use esmFlds , only : fldListFr - use esmFlds , only : compatm, compocn, compname + use esmFlds , only : shr_nuopc_fldList_GetNumFlds, shr_nuopc_fldList_GetFldNames + use esmFlds , only : fldListFr, fldListMed_aoflux, compatm, compocn, compname use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_init + use shr_nuopc_scalars_mod , only : flds_scalar_name use perf_mod , only : t_startf, t_stopf !----------------------------------------------------------------------- @@ -196,101 +110,77 @@ subroutine med_phases_aofluxes_run(gcomp, rc) ! local variables type(InternalState) :: is_local - type(ESMF_Clock) :: clock - character(CL) :: cvalue - character(CL) :: aoflux_grid type(aoflux_type), save :: aoflux logical, save :: first_call = .true. - integer :: dbrc character(len=*),parameter :: subname='(med_phases_aofluxes)' !--------------------------------------- - call t_startf('MED:'//subname) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif rc = ESMF_SUCCESS - call shr_nuopc_memcheck(subname, 5, mastertask) - ! Get the clock from the mediator Component - call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return ! Get the internal state from the mediator Component. nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - ! Initialize aoflux instance if (first_call) then - call med_phases_aofluxes_init(gcomp, aoflux, rc) - first_call = .false. - end if - - ! Determine source and destination comps depending on the aoflux_grid setting - call NUOPC_CompAttributeGet(gcomp, name='aoflux_grid', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) aoflux_grid - - if (trim(aoflux_grid) == 'ocn') then - - ! TODO(mvertens, 2019-01-12): ONLY regrid atm import fields that are needed for the atm/ocn flux calculation - - ! Regrid atm import field bundle from atm to ocn grid as input for ocn/atm flux calculation - call med_map_FB_Regrid_Norm( & - fldListFr(compatm)%flds, compatm, compocn, & - is_local%wrap%FBImp(compatm,compatm), & - is_local%wrap%FBImp(compatm,compocn), & - is_local%wrap%FBFrac(compatm), & - is_local%wrap%FBNormOne(compatm,compocn,:), & - is_local%wrap%RH(compatm,compocn,:), & - string=trim(compname(compatm))//'2'//trim(compname(compocn)), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Calculate atm/ocn fluxes on the destination grid - call med_aofluxes_run(gcomp, aoflux, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBMed_aoflux_o, & - string=trim(subname) //' FBAMed_aoflux_o' , rc=rc) + ! If field bundles have been created for the ocean/atmosphere flux computation + if ( ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_a, rc=rc) .and. & + ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_aoflux_o, rc=rc)) then + + ! Allocate memoroy for the aoflux module data type (mediator atm/ocn field bundle on the ocean grid) + call med_aofluxes_init(gcomp, aoflux, & + FBAtm=is_local%wrap%FBImp(compatm,compocn), & + FBOcn=is_local%wrap%FBImp(compocn,compocn), & + FBFrac=is_local%wrap%FBfrac(compocn), & + FBMed_aoflux=is_local%wrap%FBMed_aoflux_o, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + aoflux%created = .true. + else + aoflux%created = .false. end if - else if (trim(aoflux_grid) == 'atm') then + ! Now set first_call to .false. + first_call = .false. + end if - call med_map_FB_Regrid_Norm( & - fldListFr(compocn)%flds, compocn, compatm, & - is_local%wrap%FBImp(compocn,compocn), & - is_local%wrap%FBImp(compocn,compatm), & - is_local%wrap%FBFrac(compocn), & - is_local%wrap%FBNormOne(compocn,compatm,:), & - is_local%wrap%RH(compocn,compatm,:), & - string=trim(compname(compocn))//'2'//trim(compname(compatm)), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + ! Return if there is no aoflux has not been created + if (.not. aoflux%created) then + RETURN + end if - if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImp(compocn,compatm), & - string=trim(subname) //' FBImp('//trim(compname(compocn))//','//trim(compname(compatm))//') ', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + ! Start time timer + call t_startf('MED:'//subname) - ! Calculate atm/ocn fluxes on the destination grid - call med_aofluxes_run(gcomp, aoflux, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif - if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImp(compocn,compatm), & - string=trim(subname) //' FBImp('//trim(compname(compocn))//','//trim(compname(compatm))//') ', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end if + call shr_nuopc_memcheck(subname, 5, mastertask) - else + ! TODO(mvertens, 2019-01-12): ONLY regrid atm import fields that are needed for the atm/ocn flux calculation + + ! Regrid atm import field bundle from atm to ocn grid as input for ocn/atm flux calculation + call med_map_FB_Regrid_Norm( & + fldListFr(compatm)%flds, compatm, compocn, & + is_local%wrap%FBImp(compatm,compatm), & + is_local%wrap%FBImp(compatm,compocn), & + is_local%wrap%FBFrac(compatm), & + is_local%wrap%FBFrac(compocn), & + is_local%wrap%FBNormOne(compatm,compocn,:), & + is_local%wrap%RH(compatm,compocn,:), & + string=trim(compname(compatm))//'2'//trim(compname(compocn)), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//' aoflux_grid = '//trim(aoflux_grid)//' not available', & - ESMF_LOGMSG_INFO, rc=dbrc) - return + ! Calculate atm/ocn fluxes on the destination grid + call med_aofluxes_run(gcomp, aoflux, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBMed_aoflux_o, & + string=trim(subname) //' FBAMed_aoflux_o' , rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if + call t_stopf('MED:'//subname) end subroutine med_phases_aofluxes_run @@ -321,7 +211,6 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, integer , intent(out) :: rc ! local variables - type(ESMF_VM) :: vm integer :: iam integer :: n integer :: lsize @@ -329,23 +218,15 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, real(R8), pointer :: ifrac(:) character(CL) :: cvalue logical :: flds_wiso ! use case - integer :: dbrc character(len=CX) :: tmpstr character(*),parameter :: subName = '(med_aofluxes_init) ' !----------------------------------------------------------------------- - call t_startf('MED:'//subname) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS call shr_nuopc_memcheck(subname, 5, mastertask) - ! The following is for debugging - call ESMF_GridCompGet(gcomp, vm=vm, 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 !---------------------------------- ! get attributes that are set as module variables @@ -355,10 +236,6 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return read(cvalue,*) flds_wiso - call NUOPC_CompAttributeGet(gcomp, name='aoflux_grid', value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) aoflux_grid - !---------------------------------- ! atm/ocn fields !---------------------------------- @@ -524,7 +401,7 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, ! where (ofrac(:) + ifrac(:) <= 0.0_R8) mask(:) = 0 if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif call t_stopf('MED:'//subname) @@ -564,6 +441,7 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) logical,save :: first_call = .true. character(*),parameter :: subName = '(med_aofluxes_run) ' !----------------------------------------------------------------------- + call t_startf('MED:'//subname) !---------------------------------- diff --git a/src/drivers/nuopc/mediator/med_phases_history_mod.F90 b/src/drivers/nuopc/mediator/med_phases_history_mod.F90 index e118555fe1b..be58ec543ec 100644 --- a/src/drivers/nuopc/mediator/med_phases_history_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_history_mod.F90 @@ -45,16 +45,15 @@ subroutine med_phases_history_write(gcomp, rc) use shr_nuopc_time_mod , only : shr_nuopc_time_alarmInit use med_constants_mod , only : dbug_flag =>med_constants_dbug_flag use med_constants_mod , only : SecPerDay =>med_constants_SecPerDay - use med_constants_mod , only : R8, CL, CS, IN + use med_constants_mod , only : R8, CL, CS use med_constants_mod , only : med_constants_noleap, med_constants_gregorian - use med_infodata_mod , only : med_infodata, med_infodata_GetData use med_map_mod , only : med_map_FB_Regrid_Norm use med_internalstate_mod , only : InternalState, mastertask use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef - use med_io_mod , only : med_io_close, med_io_date2yyyymmdd - use med_io_mod , only : med_io_sec2hms + use med_io_mod , only : med_io_close, med_io_date2yyyymmdd, med_io_sec2hms use perf_mod , only : t_startf, t_stopf - ! Input/output variables + + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -276,13 +275,15 @@ subroutine med_phases_history_write(gcomp, rc) do n = 1,ncomps if (is_local%wrap%comp_present(n)) then if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_infodata_GetData(med_infodata, ncomp=n, nx=nx, ny=ny) + nx = is_local%wrap%nx(n) + ny = is_local%wrap%ny(n) call med_io_write(hist_file, iam, is_local%wrap%FBimp(n,n), & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Imp', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then - call med_infodata_GetData(med_infodata, ncomp=n, nx=nx, ny=ny) + nx = is_local%wrap%nx(n) + ny = is_local%wrap%ny(n) call med_io_write(hist_file, iam, is_local%wrap%FBexp(n), & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Exp', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/drivers/nuopc/mediator/med_phases_mod.F90 b/src/drivers/nuopc/mediator/med_phases_mod.F90 deleted file mode 100644 index 6256a565d10..00000000000 --- a/src/drivers/nuopc/mediator/med_phases_mod.F90 +++ /dev/null @@ -1,150 +0,0 @@ -module med_phases_mod - - !----------------------------------------------------------------------------- - ! Mediator Phases - !----------------------------------------------------------------------------- - - implicit none - private - - public :: med_phases_init - -!----------------------------------------------------------------------------- - contains -!----------------------------------------------------------------------------- - - subroutine med_phases_init(gcomp, llogunit, rc) - use ESMF ,only : ESMF_GridCompGet, ESMF_VMGet, ESMF_LogWrite, ESMF_LogFlush - use ESMF ,only : ESMF_GRIDCOMP, ESMF_VM, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use med_constants_mod ,only : CL, R8 - use med_constants_mod ,only : dbug_flag => med_constants_dbug_flag - use esmFlds , only : compatm, complnd, compocn - use esmFlds , only : compice, comprof, compglc - use esmFlds , only : ncomps, compname - use esmFlds , only : flds_scalar_name - use esmFlds , only : fldListFr, fldListTo - use esmFlds , only : fldListMed_aoflux_a - use esmFlds , only : fldListMed_aoflux_o - use esmFlds , only : fldListMed_ocnalb_o - use shr_nuopc_fldList_mod , only : shr_nuopc_fldList_GetFldNames - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_init - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk - use med_fraction_mod , only : med_fraction_init - use med_constants_mod , only : med_constants_dbug_flag - use med_constants_mod , only : med_constants_czero - use med_merge_mod , only : med_merge_auto - use med_map_mod , only : med_map_FB_Regrid_Norm - use med_internalstate_mod , only : InternalState - use perf_mod , only : t_startf, t_stopf - !---------------------------------------------------------- - ! Initialize field bundles, etc. that are needed as part of - ! the med_phases routines - !---------------------------------------------------------- - - type(ESMF_GridComp) :: gcomp - integer, intent(in) :: llogunit - integer, intent(out) :: rc - - ! local variables - type(InternalState) :: is_local - type(ESMF_VM) :: vm - integer :: localPet - integer :: n, n1, n2, ncomp, nflds - character(CL), pointer :: fldnames(:) - logical :: mastertask - character(*) , parameter :: u_FILE_u = __FILE__ - character(len=*) , parameter :: subname="med_phases_init" - !----------------------------------------------------------- - call t_startf('MED:'//subname) - - if (dbug_flag > 1) then - call ESMF_LogWrite("Starting to initialize mediator phases", ESMF_LOGMSG_INFO) - call ESMF_LogFlush() - endif - - rc = ESMF_SUCCESS - - ! Determine mastertask - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - mastertask = .false. - if (localPet == 0) mastertask=.true. - - ! Get the internal state from Component. - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - !---------------------------------------------------------- - ! Create FBfrac field bundles and initialize fractions - !---------------------------------------------------------- - - call med_fraction_init(gcomp,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - !--------------------------------------- - ! Initialize field bundles needed for ocn albedo and ocn/atm flux calculations - !--------------------------------------- - - if (is_local%wrap%med_coupling_active(compocn,compatm) .and. & - is_local%wrap%med_coupling_active(compatm,compocn)) then - - ! NOTE: the NStateImp(compocn) or NStateImp(compatm) used below - ! rather than NStateExp(n2), since the export state might only - ! contain control data and no grid information if if the target - ! component (n2) is not prognostic only receives control data back - - ! Create field bundles for ocean albedo computation - - nflds = size(fldListMed_ocnalb_o%flds) - allocate(fldnames(nflds)) - call shr_nuopc_fldList_getfldnames(fldListMed_ocnalb_o%flds, fldnames) - - call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_ocnalb_a, flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_ocnalb_a', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_ocnalb_o, flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames, name='FBMed_ocnalb_o', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(fldnames) - - ! Create field bundles for ocean/atmosphere flux computation - - nflds = size(fldListMed_aoflux_o%flds) - allocate(fldnames(nflds)) - call shr_nuopc_fldList_getfldnames(fldListMed_aoflux_a%flds, fldnames) - - call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_aoflux_a, flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_aoflux_a', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_aoflux_o, flds_scalar_name, & - STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames, name='FBMed_aoflux_o', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - deallocate(fldnames) - - end if - - !---------------------------------------------------------- - ! Create mediator specific field bundles needed in phases routines - ! TODO: this needs to be filled in - !---------------------------------------------------------- - - ! FBs for lnd <-> glc accumulation and elevation class downscaling - if (is_local%wrap%comp_present(complnd) .and. is_local%wrap%comp_present(compglc)) then - ! call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_l2x_to_glc_accum, & - ! STgeom=is_local%wrap%NStateImp(complnd), fieldnamelist=flds_l2x_to_glc, name='FBMed_l2g_l_accum', rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - ! call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_g2x_to_lnd, & - ! STgeom=is_local%wrap%NStateImp(complnd), fieldnamelist=flds_g2x_to_lnd, name='FBMed_g2x_to_lnd', rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call t_stopf('MED:'//subname) - - end subroutine med_phases_init - -end module med_phases_mod diff --git a/src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 b/src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 index 9f07eac4e4e..e9b01e4de9d 100644 --- a/src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 @@ -30,6 +30,7 @@ module med_phases_ocnalb_mod real(r8) , pointer :: avsdr (:) ! albedo: visible , direct real(r8) , pointer :: anidf (:) ! albedo: near infrared, diffuse real(r8) , pointer :: avsdf (:) ! albedo: visible , diffuse + logical :: created ! has memory been allocated here end type ocnalb_type ! Conversion from degrees to radians @@ -178,7 +179,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time, ESMF_TimeInterval use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFoundError - use ESMF , only : ESMF_RouteHandleIsCreated + use ESMF , only : ESMF_RouteHandleIsCreated, ESMF_FieldBundleIsCreated use ESMF , only : operator(+) use NUOPC , only : NUOPC_CompAttributeGet use shr_const_mod , only : shr_const_pi @@ -198,6 +199,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) use shr_nuopc_scalars_mod , only : flds_scalar_index_nextsw_cday use esmFlds , only : compatm, compocn use perf_mod , only : t_startf, t_stopf + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -238,10 +240,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) logical :: first_call = .true. character(len=*) , parameter :: subname='(med_phases_ocnalb_run)' !--------------------------------------- - call t_startf('MED:'//subname) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + rc = ESMF_SUCCESS ! Get the internal state from Component. @@ -249,14 +248,32 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + ! 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 + ocnalb%created = .true. + else + ocnalb%created = .false. + end if + end if + if (.not. ocnalb%created) then + return + end if + ! Note that in the mct version the atm was initialized first so ! that nextsw_cday could be passed to the other components - this ! assumed that atmosphere component was ALWAYS initialized first. ! In the nuopc version it will be easier to assume that on startup ! - nextsw_cday is just what cam was setting it as the current calendar day - if (first_call) then + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + endif + + call t_startf('MED:'//subname) + if (first_call) then ! Initialize ocean albedo calculation call med_phases_ocnalb_init(gcomp, ocnalb, rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return @@ -284,9 +301,9 @@ subroutine med_phases_ocnalb_run(gcomp, rc) call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return else - call shr_nuopc_methods_State_GetScalar(is_local%wrap%NstateImp(compatm), & + call shr_nuopc_methods_State_GetScalar(state=is_local%wrap%NstateImp(compatm), & flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, & - scalar_id=flds_scalar_index_nextsw_cday, value=nextsw_cday, rc=rc) + scalar_id=flds_scalar_index_nextsw_cday, scalar_value=nextsw_cday, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -295,9 +312,9 @@ subroutine med_phases_ocnalb_run(gcomp, rc) else ! Note that shr_nuopc_methods_State_GetScalar includes a broadcast to all other pets - call shr_nuopc_methods_State_GetScalar(is_local%wrap%NstateImp(compatm), & + call shr_nuopc_methods_State_GetScalar(state=is_local%wrap%NstateImp(compatm), & flds_scalar_name=flds_scalar_name, flds_scalar_num=flds_scalar_num, & - scalar_id=flds_scalar_index_nextsw_cday, value=nextsw_cday, rc=rc) + scalar_id=flds_scalar_index_nextsw_cday, scalar_value=nextsw_cday, rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -378,7 +395,8 @@ subroutine med_phases_ocnalb_run(gcomp, rc) endif if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBMed_ocnalb_o, string=trim(subname)//' FBMed_ocnalb_o', rc=rc) + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBMed_ocnalb_o, & + string=trim(subname)//' FBMed_ocnalb_o', rc=rc) if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return end if call t_stopf('MED:'//subname) @@ -430,6 +448,7 @@ subroutine med_phases_ocnalb_mapo2a(gcomp, rc) is_local%wrap%FBMed_ocnalb_o, & is_local%wrap%FBMed_ocnalb_a, & is_local%wrap%FBFrac(compocn), & + is_local%wrap%FBFrac(compatm), & is_local%wrap%FBNormOne(compocn,compatm,:), & is_local%wrap%RH(compocn,compatm,:), & string='FBMed_ocnalb_o_To_FBMed_ocnalb_a', rc=rc) diff --git a/src/drivers/nuopc/mediator/med_phases_prep_atm_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_atm_mod.F90 index d645fd6007f..ba91ff76a30 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_atm_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_atm_mod.F90 @@ -1,7 +1,7 @@ module med_phases_prep_atm_mod !----------------------------------------------------------------------------- - ! Mediator Phase + ! Mediator phases for preparing atm export from mediator !----------------------------------------------------------------------------- implicit none @@ -9,7 +9,7 @@ module med_phases_prep_atm_mod public :: med_phases_prep_atm - character(*) , parameter :: u_FILE_u = & + character(*), parameter :: u_FILE_u = & __FILE__ !----------------------------------------------------------------------------- @@ -18,8 +18,6 @@ module med_phases_prep_atm_mod subroutine med_phases_prep_atm(gcomp, rc) - ! Prepares the ATM import Fields. - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_FieldBundleGet, ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time, ESMF_ClockPrint @@ -53,16 +51,18 @@ subroutine med_phases_prep_atm(gcomp, rc) type(InternalState) :: is_local real(R8), pointer :: dataPtr1(:),dataPtr2(:) integer :: i, j, n, n1, ncnt - logical,save :: first_call = .true. integer :: dbrc character(len=*),parameter :: subname='(med_phases_prep_atm)' !------------------------------------------------------------------------------- call t_startf('MED:'//subname) - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) - call shr_nuopc_memcheck(subname, 3, mastertask) rc = ESMF_SUCCESS + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + end if + call shr_nuopc_memcheck(subname, 3, mastertask) + !--------------------------------------- ! --- Get the internal state !--------------------------------------- @@ -114,6 +114,7 @@ subroutine med_phases_prep_atm(gcomp, rc) is_local%wrap%FBImp(n1,n1), & is_local%wrap%FBImp(n1,compatm), & is_local%wrap%FBFrac(n1), & + is_local%wrap%FBFrac(compatm), & is_local%wrap%FBNormOne(n1,compatm,:), & is_local%wrap%RH(n1,compatm,:), & string=trim(compname(n1))//'2'//trim(compname(compatm)), rc=rc) @@ -139,6 +140,7 @@ subroutine med_phases_prep_atm(gcomp, rc) is_local%wrap%FBMed_aoflux_o, & is_local%wrap%FBMed_aoflux_a, & is_local%wrap%FBFrac(compocn), & + is_local%wrap%FBFrac(compatm), & is_local%wrap%FBNormOne(compocn,compatm,:), & is_local%wrap%RH(compocn,compatm,:), & string='FBMed_aoflux_o_To_FBMEd_aoflux_a', rc=rc) @@ -153,26 +155,26 @@ subroutine med_phases_prep_atm(gcomp, rc) is_local%wrap%FBExp(compatm), is_local%wrap%FBFrac(compatm), & is_local%wrap%FBImp(:,compatm), fldListTo(compatm), & FBMed1=is_local%wrap%FBMed_ocnalb_a, & - FBMed2=is_local%wrap%FBMed_aoflux_a, & - document=first_call, string='(merge_to_atm)', mastertask=mastertask, rc=rc) + FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_orig') then call med_merge_auto(trim(compname(compatm)), & is_local%wrap%FBExp(compatm), is_local%wrap%FBFrac(compatm), & is_local%wrap%FBImp(:,compatm), fldListTo(compatm), & - FBMed1=is_local%wrap%FBMed_aoflux_a, & - document=first_call, string='(merge_to_atm)', mastertask=mastertask, rc=rc) + FBMed1=is_local%wrap%FBMed_aoflux_a, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac') then call med_merge_auto(trim(compname(compatm)), & is_local%wrap%FBExp(compatm), is_local%wrap%FBFrac(compatm), & - is_local%wrap%FBImp(:,compatm), fldListTo(compatm), & - document=first_call, string='(merge_to_atm)', mastertask=mastertask, rc=rc) + is_local%wrap%FBImp(:,compatm), fldListTo(compatm), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compatm), string=trim(subname)//' FBexp(compatm) ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compatm), & + string=trim(subname)//' FBexp(compatm) ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if !--------------------------------------- !--- custom calculations @@ -217,10 +219,11 @@ subroutine med_phases_prep_atm(gcomp, rc) !--- clean up !--------------------------------------- - first_call = .false. endif - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + end if call t_stopf('MED:'//subname) end subroutine med_phases_prep_atm diff --git a/src/drivers/nuopc/mediator/med_phases_prep_glc_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_glc_mod.F90 index 524b87b6353..d6cba2895f2 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_glc_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_glc_mod.F90 @@ -1,34 +1,38 @@ module med_phases_prep_glc_mod !----------------------------------------------------------------------------- - ! Mediator Phases + ! Mediator phases for preparing glc export from mediator !----------------------------------------------------------------------------- implicit none private - character(*) , parameter :: u_FILE_u = __FILE__ - public :: med_phases_prep_glc + character(*), parameter :: u_FILE_u = & + __FILE__ + !----------------------------------------------------------------------------- contains !----------------------------------------------------------------------------- subroutine med_phases_prep_glc(gcomp, rc) - use ESMF, only : ESMF_GridComp, ESMF_Clock, ESMF_Time - use ESMF, only: ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF, only: ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_ClockPrint - use ESMF, only: ESMF_FieldBundleGet - use esmFlds , only : compglc, ncomps, compname - use esmFlds , only : fldListFr, fldListTo - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose - use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag - use med_merge_mod , only : med_merge_auto - use med_map_mod , only : med_map_FB_Regrid_Norm - use med_internalstate_mod , only : InternalState, mastertask - use perf_mod , only : t_startf, t_stopf + + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time + use ESMF , only: ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only: ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_ClockPrint + use ESMF , only: ESMF_FieldBundleGet + use esmFlds , only : compglc, ncomps, compname + use esmFlds , only : fldListFr, fldListTo + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds + use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use med_merge_mod , only : med_merge_auto + use med_map_mod , only : med_map_FB_Regrid_Norm + use med_internalstate_mod , only : InternalState, mastertask + use perf_mod , only : t_startf, t_stopf + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -40,12 +44,14 @@ subroutine med_phases_prep_glc(gcomp, rc) character(len=64) :: timestr type(InternalState) :: is_local integer :: i,j,n,n1,ncnt - logical,save :: first_call = .true. + integer :: dbrc character(len=*),parameter :: subname='(med_phases_prep_glc)' - integer :: dbrc !--------------------------------------- + call t_startf('MED:'//subname) - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + end if rc = ESMF_SUCCESS !--------------------------------------- @@ -57,21 +63,16 @@ subroutine med_phases_prep_glc(gcomp, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- - !--- Count the number of fields outside of scalar data, if zero, then return + ! --- Count the number of fields outside of scalar data, if zero, then return !--------------------------------------- ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the ! fieldCount is 0 and not 1 here - call ESMF_FieldBundleGet(is_local%wrap%FBExp(compglc), fieldCount=ncnt, rc=rc) + call shr_nuopc_methods_FB_getNumFlds(is_local%wrap%FBExp(compglc), trim(subname)//"FBexp(compglc)", ncnt, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (ncnt == 0) then - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBexp(compglc), returning", & - ESMF_LOGMSG_INFO, rc=dbrc) - endif - else + if (ncnt > 0) then !--------------------------------------- !--- Get the current time from the clock @@ -95,7 +96,7 @@ subroutine med_phases_prep_glc(gcomp, rc) end if !--------------------------------------- - !--- mapping + !--- map to create FBimp(:,compglc) !--------------------------------------- do n1 = 1,ncomps @@ -105,6 +106,7 @@ subroutine med_phases_prep_glc(gcomp, rc) is_local%wrap%FBImp(n1,n1), & is_local%wrap%FBImp(n1,compglc), & is_local%wrap%FBFrac(n1), & + is_local%wrap%FBFrac(compglc), & is_local%wrap%FBNormOne(n1,compglc,:), & is_local%wrap%RH(n1,compglc,:), & string=trim(compname(n1))//'2'//trim(compname(compglc)), rc=rc) @@ -113,19 +115,21 @@ subroutine med_phases_prep_glc(gcomp, rc) enddo !--------------------------------------- - !--- auto merges + !--- auto merges to create FBExp(compglc) !--------------------------------------- call med_merge_auto(trim(compname(compglc)), & - is_local%wrap%FBExp(compglc), is_local%wrap%FBFrac(compglc), & - is_local%wrap%FBImp(:,compglc), fldListTo(compglc), & - document=first_call, string='(merge_to_lnd)', mastertask=mastertask, rc=rc) + is_local%wrap%FBExp(compglc), & + is_local%wrap%FBFrac(compglc), & + is_local%wrap%FBImp(:,compglc), & + fldListTo(compglc), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compglc), string=trim(subname)//' FBexp(compglc) ', rc=rc) + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compglc), & + string=trim(subname)//' FBexp(compglc) ', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif + end if !--------------------------------------- !--- custom calculations @@ -141,9 +145,11 @@ subroutine med_phases_prep_glc(gcomp, rc) !--- clean up !--------------------------------------- - first_call = .false. endif - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + end if call t_stopf('MED:'//subname) end subroutine med_phases_prep_glc diff --git a/src/drivers/nuopc/mediator/med_phases_prep_ice_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_ice_mod.F90 index 98fb9a85a54..a991b84b583 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_ice_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_ice_mod.F90 @@ -1,7 +1,7 @@ module med_phases_prep_ice_mod !----------------------------------------------------------------------------- - ! Mediator Phases + ! Mediator phases for preparing ice export from mediator !----------------------------------------------------------------------------- implicit none @@ -12,30 +12,32 @@ module med_phases_prep_ice_mod public :: med_phases_prep_ice !----------------------------------------------------------------------------- - contains +contains !----------------------------------------------------------------------------- subroutine med_phases_prep_ice(gcomp, rc) - ! Prepares the ICE import Fields. - - use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_ClockPrint use ESMF , only : ESMF_FieldBundleGet, ESMF_RouteHandleIsCreated use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE use NUOPC , only : NUOPC_IsConnected - use med_constants_mod , only : CL, CS, R8 use esmFlds , only : compatm, compice, comprof, compglc, ncomps, compname use esmFlds , only : fldListFr, fldListTo use esmFlds , only : mapbilnr + use shr_nuopc_methods_mod , only : fldchk => shr_nuopc_methods_FB_FldChk use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : FB_GetFldPtr => shr_nuopc_methods_FB_GetFldPtr use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FieldRegrid - use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_GetScalar + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar + use shr_nuopc_scalars_mod , only : flds_scalar_name, flds_scalar_num + use shr_nuopc_scalars_mod , only : flds_scalar_index_nextsw_cday + use med_constants_mod , only : CS, R8, dbug_flag=>med_constants_dbug_flag use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_FB_Regrid_Norm use med_internalstate_mod , only : InternalState, logunit, mastertask @@ -46,31 +48,28 @@ subroutine med_phases_prep_ice(gcomp, rc) integer, intent(out) :: rc ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: time - character(len=64) :: timestr - type(InternalState) :: is_local - real(R8), pointer :: dataPtr1(:) - integer :: i,n,n1,ncnt - character(len=CS) :: fldname - real(R8), pointer :: dataptr(:) - real(R8), pointer :: temperature(:) - real(R8), pointer :: pressure(:) - real(R8), pointer :: humidity(:) - real(R8), pointer :: air_density(:) - real(R8), pointer :: pot_temp(:) - character(len=1024) :: msgString - ! TODO: the calculation needs to be set at run time based on receiving it from the ocean - real(R8) :: flux_epbalfact = 1._R8 - logical,save :: first_call = .true. - integer :: dbrc - character(len=*),parameter :: subname='(med_phases_prep_ice)' + character(len=64) :: timestr + type(InternalState) :: is_local + integer :: i,n,n1,ncnt + character(len=CS) :: fldname + real(R8), pointer :: dataptr(:) + real(R8), pointer :: temperature(:) + real(R8), pointer :: pressure(:) + real(R8), pointer :: humidity(:) + real(R8), pointer :: air_density(:) + real(R8), pointer :: pot_temp(:) + real(R8) :: precip_fact + character(len=CS) :: cvalue + character(len=64), allocatable :: fldnames(:) + real(r8) :: nextsw_cday + logical :: first_precip_fact_call = .true. + character(len=*),parameter :: subname='(med_phases_prep_ice)' !--------------------------------------- call t_startf('MED:'//subname) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -89,169 +88,160 @@ subroutine med_phases_prep_ice(gcomp, rc) ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the ! fieldCount is 0 and not 1 here - call ESMF_FieldBundleGet(is_local%wrap%FBExp(compice), fieldCount=ncnt, rc=rc) + call shr_nuopc_methods_FB_getNumFlds(is_local%wrap%FBExp(compice), trim(subname)//"FBexp(compice)", ncnt, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (ncnt == 0) then - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBexp(compice), returning", & - ESMF_LOGMSG_INFO, rc=dbrc) - endif - RETURN - end if - !--------------------------------------- - !--- Get the current time from the clock - !--------------------------------------- + if (ncnt > 0) then + + !--------------------------------------- + !--- map to create FBImp(:,compice) + !--------------------------------------- + + do n1 = 1,ncomps + if (is_local%wrap%med_coupling_active(n1,compice)) then + call med_map_FB_Regrid_Norm( & + fldListFr(n1)%flds, n1, compice, & + is_local%wrap%FBImp(n1,n1), & + is_local%wrap%FBImp(n1,compice), & + is_local%wrap%FBFrac(n1), & + is_local%wrap%FBFrac(compice), & + is_local%wrap%FBNormOne(n1,compice,:), & + is_local%wrap%RH(n1,compice,:), & + string=trim(compname(n1))//'2'//trim(compname(compice)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + enddo - call ESMF_GridCompGet(gcomp, clock=clock) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(clock,currtime=time,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(time,timestring=timestr) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - endif -#if DEBUG - if (mastertask) then - call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) + !--------------------------------------- + !--- auto merges to create FBExp(compice) + !--------------------------------------- + + call med_merge_auto(trim(compname(compice)), & + is_local%wrap%FBExp(compice), is_local%wrap%FBFrac(compice), & + is_local%wrap%FBImp(:,compice), fldListTo(compice), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if -#endif - !--------------------------------------- - !--- map to create FBimp(:,compice) - !--------------------------------------- - do n1 = 1,ncomps - if (is_local%wrap%med_coupling_active(n1,compice)) then - call med_map_FB_Regrid_Norm( & - fldListFr(n1)%flds, n1, compice, & - is_local%wrap%FBImp(n1,n1), & - is_local%wrap%FBImp(n1,compice), & - is_local%wrap%FBFrac(n1), & - is_local%wrap%FBNormOne(n1,compice,:), & - is_local%wrap%RH(n1,compice,:), & - string=trim(compname(n1))//'2'//trim(compname(compice)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - enddo + !--------------------------------------- + !--- custom calculations + !--------------------------------------- - !--------------------------------------- - !--- auto merges - !--------------------------------------- + ! application of precipitation factor from ocean - call med_merge_auto(trim(compname(compice)), & - is_local%wrap%FBExp(compice), is_local%wrap%FBFrac(compice), & - is_local%wrap%FBImp(:,compice), fldListTo(compice), & - document=first_call, string='(merge_to_ice)', mastertask=mastertask, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! TODO (mvertens, 2019-03-18): precip_fact here is not valid if + ! the component does not send it - hardwire it to 1 until this is resolved + precip_fact = 1.0_R8 - !--------------------------------------- - !--- custom calculations - !--------------------------------------- + if (precip_fact /= 1.0_R8) then + if (first_precip_fact_call .and. mastertask) then + write(logunit,'(a)')'(merge_to_ice): Scaling rain, snow, liquid and ice runoff by precip_fact ' + first_precip_fact_call = .false. + end if + write(cvalue,*) precip_fact + call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO) + + allocate(fldnames(3)) + fldnames = (/'Faxa_rain', 'Faxa_snow', 'Fixx_rofi'/) + do n = 1,size(fldnames) + if (fldchk(is_local%wrap%FBExp(compice), trim(fldnames(n)), rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compice), trim(fldnames(n)) , dataptr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr(:) = dataptr(:) * precip_fact + end if + end do + deallocate(fldnames) + end if - ! If either air density or ptem from atm is not available - then need to remp pbot since it will be - ! required for either calculation - if ( .not. shr_nuopc_methods_FB_FldChk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens',rc=rc) .or. & - .not. shr_nuopc_methods_FB_FldChk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ptem',rc=rc)) then - - ! Determine Sa_pbot on the ice grid and get a pointer to it - if (.not. shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compice), 'Sa_pbot',rc=rc)) then - if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compatm,compice,mapbilnr))) then - call ESMF_LogWrite(trim(subname)//": ERROR bilinr RH not available for atm->ice", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) - rc = ESMF_FAILURE - return + ! If either air density or ptem from atm is not available - then need pbot since it will be + ! required for either calculation + if ( .not. fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens',rc=rc) .or. & + .not. fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ptem',rc=rc)) then + + ! Determine Sa_pbot on the ice grid and get a pointer to it + if (.not. fldchk(is_local%wrap%FBExp(compice), 'Sa_pbot',rc=rc)) then + if (.not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(compatm,compice,mapbilnr))) then + call ESMF_LogWrite(trim(subname)//": ERROR bilinr RH not available for atm->ice", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + end if + call shr_nuopc_methods_FB_FieldRegrid( & + is_local%wrap%FBImp(compatm,compatm), 'Sa_pbot', & + is_local%wrap%FBImp(compatm,compice), 'Sa_pbot', & + is_local%wrap%RH(compatm,compice,mapbilnr), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if - call shr_nuopc_methods_FB_FieldRegrid( & - is_local%wrap%FBImp(compatm,compatm), 'Sa_pbot', & - is_local%wrap%FBImp(compatm,compice), 'Sa_pbot', & - is_local%wrap%RH(compatm,compice,mapbilnr), rc=rc) + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_pbot', pressure, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_pbot', pressure, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! Get a pointer to Sa_tbot on the ice grid - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_tbot', temperature, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - ! compute air density as a custom calculation - if ( .not. shr_nuopc_methods_FB_FldChk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens',rc=rc)) then - call ESMF_LogWrite(trim(subname)//": computing air density as a custom calculation", ESMF_LOGMSG_INFO, rc=dbrc) + ! Get a pointer to Sa_tbot on the ice grid + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_tbot', temperature, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_shum', humidity, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Sa_dens', air_density, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! compute air density as a custom calculation + if ( .not. fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens',rc=rc)) then + call ESMF_LogWrite(trim(subname)//": computing air density as a custom calculation", ESMF_LOGMSG_INFO) - do n = 1,size(temperature) - if (temperature(n) /= 0._R8) then - air_density(n) = pressure(n) / (287.058_R8*(1._R8 + 0.608_R8*humidity(n))*temperature(n)) - else - air_density(n) = 0._R8 - endif - end do - end if + call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compice), 'Sa_shum', humidity, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Sa_dens', air_density, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! compute potential temperature as a custom calculation - if (.not. shr_nuopc_methods_FB_FldChk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ptem',rc=rc)) then - call ESMF_LogWrite(trim(subname)//": computing potential temp as a custom calculation", ESMF_LOGMSG_INFO, rc=dbrc) + do n = 1,size(temperature) + if (temperature(n) /= 0._R8) then + air_density(n) = pressure(n) / (287.058_R8*(1._R8 + 0.608_R8*humidity(n))*temperature(n)) + else + air_density(n) = 0._R8 + endif + end do + end if - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Sa_ptem', pot_temp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! compute potential temperature as a custom calculation + if (.not. fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_ptem',rc=rc)) then + call ESMF_LogWrite(trim(subname)//": computing potential temp as a custom calculation", ESMF_LOGMSG_INFO) - do n = 1,size(temperature) - pot_temp(n) = temperature(n) * (100000._R8/pressure(n))**0.286_R8 ! Potential temperature (K) - end do - end if + call FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Sa_ptem', pot_temp, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ! scale rain, snow and rof to ice by flux_epbalfact - if (shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compice), 'Faxa_rain', rc=rc)) then - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Faxa_rain' , dataptr1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - dataptr1(:) = dataptr1(:) * flux_epbalfact - if (first_call .and. mastertask) then - write(logunit,'(a)')'(merge_to_ice): Scaling Faxa_rain by flux_epbalfact ' - end if - end if - if (shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compice), 'Faxa_snow', rc=rc)) then - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Faxa_snow' , dataptr1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - dataptr1(:) = dataptr1(:) * flux_epbalfact - if (first_call .and. mastertask) then - write(logunit,'(a)')'(merge_to_ice): Scaling Faxa_snow by flux_epbalfact ' + do n = 1,size(temperature) + if (pressure(n) /= 0._R8) then + pot_temp(n) = temperature(n) * (100000._R8/pressure(n))**0.286_R8 ! Potential temperature (K) + else + pot_temp(n) = 0._R8 + end if + end do end if - end if - if (shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compice), 'Fixx_rofi', rc=rc)) then - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compice), 'Fixx_rofi' , dataptr1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - dataptr1(:) = dataptr1(:) * flux_epbalfact - if (first_call .and. mastertask) then - write(logunit,'(a)')'(merge_to_ice): Scaling Fixx_rofi by flux_epbalfact ' + + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compice), string=trim(subname)//' FBexp(compice) ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if - end if - if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compice), string=trim(subname)//' FBexp(compice) ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif + !--------------------------------------- + !--- update scalar data + !--------------------------------------- - !--------------------------------------- - !--- update local scalar data - !--------------------------------------- + ! send nextsw_cday to land - first obtain it from atm import + call shr_nuopc_methods_State_GetScalar(& + scalar_value=nextsw_cday, scalar_id=flds_scalar_index_nextsw_cday, & + state=is_local%wrap%NstateImp(compatm), flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_State_SetScalar(& + scalar_value=nextsw_cday, scalar_id=flds_scalar_index_nextsw_cday, & + state=is_local%wrap%NstateExp(compice), flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__LINE__,u_FILE_u)) return - !is_local%wrap%scalar_data(1) = - !--------------------------------------- - !--- clean up - !--------------------------------------- + !--------------------------------------- + !--- clean up + !--------------------------------------- - first_call = .false. + end if if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif call t_stopf('MED:'//subname) diff --git a/src/drivers/nuopc/mediator/med_phases_prep_lnd_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_lnd_mod.F90 index a69fbf256cd..150d498ff4c 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_lnd_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_lnd_mod.F90 @@ -1,7 +1,7 @@ module med_phases_prep_lnd_mod !----------------------------------------------------------------------------- - ! Mediator Phases + ! Mediator phases for preparing land export from mediator !----------------------------------------------------------------------------- implicit none @@ -18,22 +18,24 @@ module med_phases_prep_lnd_mod subroutine med_phases_prep_lnd(gcomp, rc) - ! Prepares the LND import Fields. - use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_ClockPrint use ESMF , only : ESMF_FieldBundleGet - use med_constants_mod , only : CL, CS, CX - use esmFlds , only : complnd, ncomps, compname, comprof + use esmFlds , only : complnd, compatm, ncomps, compname use esmFlds , only : fldListFr, fldListTo use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_init use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose - use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_GetScalar + use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_SetScalar + use shr_nuopc_scalars_mod , only : flds_scalar_name, flds_scalar_num + use shr_nuopc_scalars_mod , only : flds_scalar_index_nextsw_cday + use med_constants_mod , only : R8, dbug_flag=>med_constants_dbug_flag use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_FB_Regrid_Norm - use med_internalstate_mod , only : InternalState, mastertask + use med_internalstate_mod , only : InternalState use perf_mod , only : t_startf, t_stopf ! input/output variables @@ -41,21 +43,19 @@ subroutine med_phases_prep_lnd(gcomp, rc) integer, intent(out) :: rc ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: time - character(len=64) :: timestr type(InternalState) :: is_local - integer :: i,j,n,n1,nf,compsrc - integer :: ncnt - integer :: dbrc - logical,save :: first_call = .true. - character(len=*),parameter :: subname='(med_phases_prep_lnd)' + integer :: n1,ncnt + real(r8) :: nextsw_cday + character(len=*), parameter :: subname='(med_phases_prep_lnd)' !--------------------------------------- - call t_startf('MED:'//subname) - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) rc = ESMF_SUCCESS + call t_startf('MED:'//subname) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + end if + !--------------------------------------- ! --- Get the internal state !--------------------------------------- @@ -71,32 +71,13 @@ subroutine med_phases_prep_lnd(gcomp, rc) ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the ! fieldCount is 0 and not 1 here - call ESMF_FieldBundleGet(is_local%wrap%FBExp(complnd), fieldCount=ncnt, rc=rc) + call shr_nuopc_methods_FB_getNumFlds(is_local%wrap%FBExp(complnd), trim(subname)//"FBexp(complnd)", ncnt, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (ncnt == 0) then - call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBexp(complnd), returning", & - ESMF_LOGMSG_INFO, rc=dbrc) - else + if (ncnt > 0) then !--------------------------------------- - !--- Get the current time from the clock - !--------------------------------------- - - if (mastertask) then - call ESMF_GridCompGet(gcomp, clock=clock) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(clock,currtime=time,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(time,timestring=timestr) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - !--------------------------------------- - !--- Map import fields to the complnd grid + !--- map to create FBimp(:,complnd) !--------------------------------------- do n1 = 1,ncomps @@ -106,6 +87,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) is_local%wrap%FBImp(n1,n1), & is_local%wrap%FBImp(n1,complnd), & is_local%wrap%FBFrac(n1), & + is_local%wrap%FBFrac(complnd), & is_local%wrap%FBNormOne(n1,complnd,:), & is_local%wrap%RH(n1,complnd,:), & string=trim(compname(n1))//'2'//trim(compname(complnd)), rc=rc) @@ -114,36 +96,51 @@ subroutine med_phases_prep_lnd(gcomp, rc) enddo !--------------------------------------- - !--- Merge all required import fields on the complnd grid to create FBExp + !--- auto merges to create FBExp(complnd) !--------------------------------------- call med_merge_auto(trim(compname(complnd)), & - is_local%wrap%FBExp(complnd), is_local%wrap%FBFrac(complnd), & - is_local%wrap%FBImp(:,complnd), fldListTo(complnd), & - document=first_call, string='(merge_to_lnd)', mastertask=mastertask, rc=rc) + is_local%wrap%FBExp(complnd), & + is_local%wrap%FBFrac(complnd), & + is_local%wrap%FBImp(:,complnd), & + fldListTo(complnd), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(complnd), string=trim(subname)//' FBexp(complnd) ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(complnd), & + string=trim(subname)//' FBexp(complnd) ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if !--------------------------------------- !--- custom calculations !--------------------------------------- !--------------------------------------- - !--- update local scalar data + !--- update scalar data !--------------------------------------- - !is_local%wrap%scalar_data(1) = + ! send nextsw_cday to land - first obtain it from atm import + call shr_nuopc_methods_State_GetScalar(& + scalar_value=nextsw_cday, scalar_id=flds_scalar_index_nextsw_cday, & + state=is_local%wrap%NstateImp(compatm), flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_State_SetScalar(& + scalar_value=nextsw_cday, scalar_id=flds_scalar_index_nextsw_cday, & + state=is_local%wrap%NstateExp(complnd), flds_scalar_name=flds_scalar_name, & + flds_scalar_num=flds_scalar_num, rc=rc) + if (shr_nuopc_methods_chkerr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- !--- clean up !--------------------------------------- - first_call = .false. end if - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + end if call t_stopf('MED:'//subname) end subroutine med_phases_prep_lnd diff --git a/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 index d1e9d3d724e..cae6dc9aa95 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 @@ -1,13 +1,13 @@ module med_phases_prep_ocn_mod + !----------------------------------------------------------------------------- + ! Mediator phases for preparing ocn export from mediator + !----------------------------------------------------------------------------- + use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag use shr_nuopc_utils_mod , only : shr_nuopc_memcheck use med_internalstate_mod , only : mastertask - !----------------------------------------------------------------------------- - ! Carry out fast accumulation for the ocean - !----------------------------------------------------------------------------- - implicit none private @@ -86,6 +86,7 @@ subroutine med_phases_prep_ocn_map(gcomp, rc) is_local%wrap%FBImp(n1,n1), & is_local%wrap%FBImp(n1,compocn), & is_local%wrap%FBFrac(n1), & + is_local%wrap%FBFrac(compocn), & is_local%wrap%FBNormOne(n1,compocn,:), & is_local%wrap%RH(n1,compocn,:), & string=trim(compname(n1))//'2'//trim(compname(compocn)), rc=rc) @@ -113,7 +114,7 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) use shr_nuopc_methods_mod , only : FB_GetFldPtr => shr_nuopc_methods_FB_GetFldPtr use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds - use med_constants_mod , only : R8 + use med_constants_mod , only : R8, CS use med_internalstate_mod , only : InternalState, mastertask, logunit use med_merge_mod , only : med_merge_auto, med_merge_field use esmFlds , only : fldListTo @@ -137,6 +138,7 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) real(R8), pointer :: Faxa_swvdf(:), Faxa_swndf(:) real(R8), pointer :: Faxa_swvdr(:), Faxa_swndr(:) real(R8), pointer :: Foxx_swnet(:) + real(R8), pointer :: Foxx_swnet_afracr(:) real(R8), pointer :: Foxx_swnet_vdr(:), Foxx_swnet_vdf(:) real(R8), pointer :: Foxx_swnet_idr(:), Foxx_swnet_idf(:) real(R8), pointer :: Fioi_swpen_vdr(:), Fioi_swpen_vdf(:) @@ -146,18 +148,21 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) real(R8), pointer :: Foxx_lwnet(:) real(R8), pointer :: Faox_lwup(:) real(R8), pointer :: Faxa_lwdn(:) + real(R8), pointer :: dataptr_i(:), dataptr_o(:) real(R8) :: ifrac_scaled, ofrac_scaled real(R8) :: ifracr_scaled, ofracr_scaled real(R8) :: frac_sum real(R8) :: albvis_dir, albvis_dif real(R8) :: albnir_dir, albnir_dif real(R8) :: fswabsv, fswabsi - real(R8) :: flux_epbalfact logical :: export_swnet_by_bands logical :: import_swpen_by_bands - logical :: first_call = .true. + logical :: export_swnet_afracr + logical :: first_precip_fact_call = .true. + real(R8) :: precip_fact integer :: lsize integer :: dbrc + character(CS) :: cvalue ! NEMS-orig real(R8), pointer :: ocnwgt1(:) real(R8), pointer :: icewgt1(:) @@ -193,7 +198,7 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) call shr_nuopc_methods_FB_getNumFlds(is_local%wrap%FBExp(compocn), trim(subname)//"FBexp(compocn)", ncnt, rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (ncnt >= 0) then + if (ncnt > 0) then !--------------------------------------- !--- auto merges to ocn @@ -203,14 +208,12 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) call med_merge_auto(trim(compname(compocn)), & is_local%wrap%FBExp(compocn), is_local%wrap%FBFrac(compocn), & is_local%wrap%FBImp(:,compocn), fldListTo(compocn), & - FBMed1=is_local%wrap%FBMed_aoflux_o, & - document=first_call, string='(merge_to_ocn)', mastertask=mastertask, rc=rc) + FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(coupling_mode) == 'nems_frac') then call med_merge_auto(trim(compname(compocn)), & is_local%wrap%FBExp(compocn), is_local%wrap%FBFrac(compocn), & - is_local%wrap%FBImp(:,compocn), fldListTo(compocn), & - document=first_call, string='(merge_to_ocn)', mastertask=mastertask, rc=rc) + is_local%wrap%FBImp(:,compocn), fldListTo(compocn), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -276,7 +279,7 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) end if end if - ! Output to ocean + ! Output to ocean swnet if (fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet', Foxx_swnet, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -284,6 +287,8 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) lsize = size(Faxa_swvdr) allocate(Foxx_swnet(lsize)) end if + + ! Output to ocean swnet by radiation bands if (fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', rc=rc)) then export_swnet_by_bands = .true. call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdr', Foxx_swnet_vdr, rc=rc) @@ -298,6 +303,15 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) export_swnet_by_bands = .false. end if + ! Swnet without swpen from sea-ice + if ( fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr',rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_afracr', Foxx_swnet_afracr, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + export_swnet_afracr = .true. + else + export_swnet_afracr = .false. + end if + do n = 1,lsize ! Determine ocean albedos @@ -318,6 +332,10 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) fswabsi = Faxa_swndr(n) * (1.0_R8 - albnir_dir) + Faxa_swndf(n) * (1.0_R8 - albnir_dif) Foxx_swnet(n) = fswabsv + fswabsi + if (export_swnet_afracr) then + Foxx_swnet_afracr(n) = fswabsv + fswabsi + end if + ! Add swpen from sea ice if sea ice is present if (is_local%wrap%comp_present(compice)) then if (trim(coupling_mode) == 'cesm') then @@ -360,35 +378,61 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) Foxx_swnet_idf(n) = c4 * Foxx_swnet(n) end if end if - ! TODO (mvertens, 2018-12-16): fill in the following - ! if (i2o_per_cat) then - ! Sf_ofrac(n) = ofrac(n) - ! Sf_ofracr(n) = ofracr(n) - ! Foxx_swnet_ofracr(n) = (fswabsv + fswabsi) * ofracr_scaled - ! end if end if ! if sea-ice is present end do + ! Output to ocean per ice thickness fraction and sw penetrating into ocean + if ( fldchk(is_local%wrap%FBImp(compice,compice), 'Si_ifrac_n', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Si_ifrac_n', rc=rc)) then + + call FB_GetFldPtr(is_local%wrap%FBImp(compice,compice), 'Si_ifrac_n', dataptr_i, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Si_ifrac_n', dataptr_o, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr_o(:) = dataptr_i(:) + end if + + if ( fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_ifrac_n', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Fioi_swpen_ifrac_n', rc=rc)) then + + call FB_GetFldPtr(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_ifrac_n', dataptr_i, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Fioi_swpen_ifrac_n', dataptr_o, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr_o(:) = dataptr_i(:) + end if + + if ( fldchk(is_local%wrap%FBExp(compocn), 'Sf_afrac', rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afrac', dataptr_o, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr_o(:) = ofrac(:) + end if + + if ( fldchk(is_local%wrap%FBExp(compocn), 'Sf_afracr', rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Sf_afracr', dataptr_o, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + dataptr_o(:) = ofracr(:) + end if + !------------- - ! custom calculation for cesm coupling + ! application of precipitation factor from ocean !------------- - if (trim(coupling_mode) == 'cesm') then - - ! scale precipitation and runoff by epbalfact - ! TODO (mvertens, 2018-12-16): the calculation needs to be set - ! at run time based on receiving it from the ocean - flux_epbalfact = 1.0_r8 + precip_fact = 1.0_R8 + if (precip_fact /= 1.0_R8) then + if (first_precip_fact_call .and. mastertask) then + write(logunit,'(a)')'(merge_to_ocn): Scaling rain, snow, liquid and ice runoff by precip_fact ' + first_precip_fact_call = .false. + end if + write(cvalue,*) precip_fact + call ESMF_LogWrite(trim(subname)//" precip_fact is "//trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) - allocate(fldnames(5)) - fldnames = (/'Foxx_rain',' Foxx_snow', 'Foxx_prec', 'Foxx_rofl', 'Foxx_rofi'/) + allocate(fldnames(4)) + fldnames = (/'Faxa_rain',' Faxa_snow', 'Foxx_rofl', 'Foxx_rofi'/) do n = 1,size(fldnames) if (fldchk(is_local%wrap%FBExp(compocn), trim(fldnames(n)), rc=rc)) then call FB_GetFldPtr(is_local%wrap%FBExp(compocn), trim(fldnames(n)) , dataptr, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - dataptr(:) = dataptr(:) * flux_epbalfact - if (first_call .and. mastertask) then - write(logunit,'(a)')'(merge_to_ocn): Scaling '//trim(fldnames(n))//' by flux_epbalfact ' - end if + dataptr(:) = dataptr(:) * precip_fact end if end do deallocate(fldnames) @@ -507,8 +551,11 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) !--- diagnose output !--------------------------------------- - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compocn), string=trim(subname)//' FBexp(compocn) ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compocn), & + string=trim(subname)//' FBexp(compocn) ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if ! TODO (mvertens, 2018-12-16): document above custom calculation @@ -516,7 +563,6 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) !--- clean up !--------------------------------------- - first_call = .false. endif if (dbug_flag > 20) then @@ -589,9 +635,11 @@ subroutine med_phases_prep_ocn_accum_fast(gcomp, rc) is_local%wrap%FBExpAccumCnt(compocn) = is_local%wrap%FBExpAccumCnt(compocn) + 1 - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExpAccum(compocn), & - string=trim(subname)//' FBExpAccum accumulation ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExpAccum(compocn), & + string=trim(subname)//' FBExpAccum accumulation ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if !--------------------------------------- !--- clean up @@ -665,17 +713,21 @@ subroutine med_phases_prep_ocn_accum_avg(gcomp, rc) !--- average ocn accumulator !--------------------------------------- - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExpAccum(compocn), & - string=trim(subname)//' FBExpAccum(compocn) before avg ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExpAccum(compocn), & + string=trim(subname)//' FBExpAccum(compocn) before avg ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if call shr_nuopc_methods_FB_average(is_local%wrap%FBExpAccum(compocn), & is_local%wrap%FBExpAccumCnt(compocn), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compocn), & - string=trim(subname)//' FBExpAccum(compocn) after avg ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compocn), & + string=trim(subname)//' FBExpAccum(compocn) after avg ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if !--------------------------------------- !--- copy to FBExp(compocn) diff --git a/src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 index 78e1bbe24b3..aeb9ca62000 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 @@ -10,10 +10,9 @@ module med_phases_prep_rof_mod ! this will be done in med_phases_prep_rof_avg !----------------------------------------------------------------------------- - use ESMF , only : ESMF_FieldBundle, ESMF_MAXSTR + use ESMF , only : ESMF_FieldBundle use esmFlds , only : ncomps, complnd, comprof, compname, mapconsf use med_constants_mod , only : R8, CS - use med_constants_mod , only : czero => med_constants_czero use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_chkerr use perf_mod , only : t_startf, t_stopf @@ -45,9 +44,12 @@ module med_phases_prep_rof_mod subroutine med_phases_prep_rof_accum_fast(gcomp, rc) + !------------------------------------ ! Carry out fast accumulation for the river (rof) component - ! Accumulation and averaging is done on the land input to the river component on the land grid + ! Accumulation and averaging is done on the land input on the land grid for the fields that will + ! will be sent to the river component ! Mapping from the land to the rof grid is then done with the time averaged fields + !------------------------------------ use ESMF , only : ESMF_GridComp, ESMF_GridCompGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS @@ -59,6 +61,7 @@ subroutine med_phases_prep_rof_accum_fast(gcomp, rc) ! input/output variables type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc ! local variables @@ -89,31 +92,34 @@ subroutine med_phases_prep_rof_accum_fast(gcomp, rc) if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(complnd,complnd))) then ncnt = 0 + call ESMF_LogWrite(trim(subname)//": FBImp(complnd,complnd) is not created", & + ESMF_LOGMSG_INFO, rc=dbrc) else ! The scalar field has been removed from all mediator field bundles - so check if the fieldCount is ! 0 and not 1 here call ESMF_FieldBundleGet(is_local%wrap%FBImp(complnd,complnd), fieldCount=ncnt, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBimp(complnd), returning", & + ESMF_LOGMSG_INFO) end if - if (ncnt == 0) then - call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBimp(complnd), returning", & - ESMF_LOGMSG_INFO, rc=dbrc) - else + !--------------------------------------- + !-- Accumulate lnd input on lnd grid to send to rof + !--------------------------------------- - !--------------------------------------- - ! Accumulate lnd input on lnd grid to send to rof - !--------------------------------------- - call shr_nuopc_methods_FB_accum(is_local%wrap%FBImpAccum(complnd,complnd), & + if (ncnt > 0) then + call shr_nuopc_methods_FB_accum(& + is_local%wrap%FBImpAccum(complnd,complnd), & is_local%wrap%FBImp(complnd,complnd), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return is_local%wrap%FBImpAccumCnt(complnd) = is_local%wrap%FBImpAccumCnt(complnd) + 1 - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImpAccum(complnd,complnd), & - string=trim(subname)//' FBImpAccum(complnd,complnd) ', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImpAccum(complnd,complnd), & + string=trim(subname)//' FBImpAccum(complnd,complnd) ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if end if if (dbug_flag > 20) then @@ -127,7 +133,9 @@ end subroutine med_phases_prep_rof_accum_fast subroutine med_phases_prep_rof_avg(gcomp, rc) + !------------------------------------ ! Prepare the ROF export Fields from the mediator + !------------------------------------ use NUOPC , only : NUOPC_IsConnected use ESMF , only : ESMF_GridComp, ESMF_GridCompGet @@ -141,6 +149,7 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) use med_merge_mod , only : med_merge_auto use med_map_mod , only : med_map_FB_Regrid_Norm use med_internalstate_mod , only : InternalState, mastertask + use med_constants_mod , only : czero => med_constants_czero ! input/output variables type(ESMF_GridComp) :: gcomp @@ -152,7 +161,6 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) integer :: dbrc logical :: connected real(r8), pointer :: dataptr(:) - logical , save :: first_call = .true. character(len=*),parameter :: subname='(med_phases_prep_rof_mod: med_phases_prep_rof_avg)' !--------------------------------------- @@ -194,9 +202,11 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) is_local%wrap%FBImpAccumCnt(complnd), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImpAccum(complnd,complnd), & - string=trim(subname)//' FBImpAccum(complnd,complnd) after avg ', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImpAccum(complnd,complnd), & + string=trim(subname)//' FBImpAccum(complnd,complnd) after avg ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if !--------------------------------------- !--- map to create FBImpAccum(complnd,comprof) @@ -212,14 +222,17 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) is_local%wrap%FBImpAccum(complnd,complnd), & is_local%wrap%FBImpAccum(complnd,comprof), & is_local%wrap%FBFrac(complnd), & + is_local%wrap%FBFrac(comprof), & is_local%wrap%FBNormOne(complnd,comprof,:), & is_local%wrap%RH(complnd,comprof,:), & string=trim(compname(complnd))//'2'//trim(compname(comprof)), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImpAccum(complnd,comprof), & - string=trim(subname)//' FBImpAccum(complnd,comprof) after avg ', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImpAccum(complnd,comprof), & + string=trim(subname)//' FBImpAccum(complnd,comprof) after avg ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if ! Reset the irrig_flux_field with the map_lnd2rof_irrig calculation below if appropriate if ( NUOPC_IsConnected(is_local%wrap%NStateImp(complnd), fieldname=trim(irrig_flux_field))) then @@ -238,21 +251,24 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) !--- auto merges to create FBExp(comprof) !--------------------------------------- - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBFrac(comprof), & - string=trim(subname)//' FBFrac(comprof) before merge ', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBFrac(comprof), & + string=trim(subname)//' FBFrac(comprof) before merge ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if call med_merge_auto(trim(compname(comprof)), & is_local%wrap%FBExp(comprof), & is_local%wrap%FBFrac(comprof), & is_local%wrap%FBImpAccum(:,comprof), & - fldListTo(comprof), & - document=first_call, string='(merge_to_rof)', mastertask=mastertask, rc=rc) + fldListTo(comprof), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(comprof), & - string=trim(subname)//' FBexp(comprof) ', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(comprof), & + string=trim(subname)//' FBexp(comprof) ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if !--------------------------------------- !--- zero accumulator @@ -271,7 +287,6 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) !--- clean up !--------------------------------------- - first_call = .false. endif if (dbug_flag > 20) then @@ -315,7 +330,6 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_clean use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FieldRegrid - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose use shr_nuopc_scalars_mod , only : flds_scalar_name use med_internalstate_mod , only : InternalState, mastertask use med_map_mod , only : med_map_FB_Regrid_norm @@ -472,9 +486,10 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) ! convert to a total irrigation flux on the ROF grid ! ------------------------------------------------------------------------ - call med_map_FB_Regrid_Norm((/trim(irrig_normalized_field), trim(irrig_volr0_field)/), & + call med_map_FB_Regrid_Norm(& + (/trim(irrig_normalized_field), trim(irrig_volr0_field)/), & FBlndIrrig, FBrofIrrig, & - is_local%wrap%FBFrac(complnd), 'lfrin', & + is_local%wrap%FBFrac(complnd), 'lfrac', & is_local%wrap%RH(complnd, comprof, mapconsf), & string='mapping normalized irrig from lnd to to rof', rc=rc) diff --git a/src/drivers/nuopc/mediator/med_phases_prep_wav_mod.F90 b/src/drivers/nuopc/mediator/med_phases_prep_wav_mod.F90 index 2213b76d034..a94a264db78 100644 --- a/src/drivers/nuopc/mediator/med_phases_prep_wav_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_prep_wav_mod.F90 @@ -1,152 +1,137 @@ module med_phases_prep_wav_mod !----------------------------------------------------------------------------- - ! Mediator Phases + ! Mediator phases for preparing wav export from mediator !----------------------------------------------------------------------------- implicit none private - character(*) , parameter :: u_FILE_u = __FILE__ - public :: med_phases_prep_wav + character(*), parameter :: u_FILE_u = & + __FILE__ + !----------------------------------------------------------------------------- - contains +contains !----------------------------------------------------------------------------- - subroutine med_phases_prep_wav(gcomp, rc) - use ESMF, only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF, only : ESMF_GridComp, ESMF_Clock, ESMF_Time - use ESMF, only : ESMF_GridCompGet, ESMF_FieldBundleGet, ESMF_ClockGet, ESMF_TimeGet - use ESMF, only : ESMF_ClockPrint - use med_constants_mod, only : CS - use esmFlds , only : compwav, ncomps, compname - use esmFlds , only : fldListFr, fldListTo - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose - use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag - use med_merge_mod , only : med_merge_auto - use med_map_mod , only : med_map_FB_Regrid_Norm - use med_internalstate_mod , only : InternalState, mastertask - use perf_mod , only : t_startf, t_stopf - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! Prepares the WAV import Fields. - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: time - character(len=CS) :: timestr - type(InternalState) :: is_local - integer :: i,j,n,n1,ncnt - logical,save :: first_call = .true. - integer :: dbrc - character(len=*),parameter :: subname='(med_phases_prep_wav)' - !--------------------------------------- - call t_startf('MED:'//subname) - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - rc = ESMF_SUCCESS - - !--------------------------------------- - ! --- Get the internal state - !--------------------------------------- - - nullify(is_local%wrap) - call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - !--------------------------------------- - !--- Count the number of fields outside of scalar data, if zero, then return - !--------------------------------------- - - ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the - ! fieldCount is 0 and not 1 here - - call ESMF_FieldBundleGet(is_local%wrap%FBExp(compwav), fieldCount=ncnt, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (ncnt == 0) then - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBexp(compwav), returning", & - ESMF_LOGMSG_INFO, rc=dbrc) - endif - else - - !--------------------------------------- - !--- Get the current time from the clock - !--------------------------------------- - - call ESMF_GridCompGet(gcomp, clock=clock) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_ClockGet(clock,currtime=time,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet(time,timestring=timestr) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) - endif - - if (mastertask) then - call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end if - - !--------------------------------------- - !--- map to create FBimp(:,compwav) - !--------------------------------------- - - do n1 = 1,ncomps - if (is_local%wrap%med_coupling_active(n1,compwav)) then - call med_map_FB_Regrid_Norm( & - fldListFr(n1)%flds, n1, compwav, & - is_local%wrap%FBImp(n1,n1), & - is_local%wrap%FBImp(n1,compwav), & - is_local%wrap%FBFrac(n1), & - is_local%wrap%FBNormOne(n1,compwav,:), & - is_local%wrap%RH(n1,compwav,:), & - string=trim(compname(n1))//'2'//trim(compname(compwav)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - enddo - - !--------------------------------------- - !--- auto merges - !--------------------------------------- - - call med_merge_auto(trim(compname(compwav)), & - is_local%wrap%FBExp(compwav), is_local%wrap%FBFrac(compwav), & - is_local%wrap%FBImp(:,compwav), fldListTo(compwav), & - document=first_call, string='(merge_to_wav)', mastertask=mastertask, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compwav), string=trim(subname)//' FBexp(compwav) ', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - - !--------------------------------------- - !--- custom calculations - !--------------------------------------- - - !--------------------------------------- - !--- update local scalar data - !--------------------------------------- - - !is_local%wrap%scalar_data(1) = - - !--------------------------------------- - !--- clean up - !--------------------------------------- - - first_call = .false. - endif - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - call t_stopf('MED:'//subname) - - end subroutine med_phases_prep_wav + subroutine med_phases_prep_wav(gcomp, rc) + + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS + use ESMF , only : ESMF_GridComp, ESMF_Clock, ESMF_Time + use ESMF , only : ESMF_GridCompGet, ESMF_FieldBundleGet, ESMF_ClockGet, ESMF_TimeGet + use ESMF , only : ESMF_ClockPrint + use med_constants_mod , only : CS + use esmFlds , only : compwav, ncomps, compname + use esmFlds , only : fldListFr, fldListTo + use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds + use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use med_merge_mod , only : med_merge_auto + use med_map_mod , only : med_map_FB_Regrid_Norm + use med_internalstate_mod , only : InternalState, mastertask + use perf_mod , only : t_startf, t_stopf + + ! input/output variables + type(ESMF_GridComp) :: gcomp + integer, intent(out) :: rc + + ! local variables + type(InternalState) :: is_local + integer :: i,j,n,n1,ncnt + integer :: dbrc + character(len=*),parameter :: subname='(med_phases_prep_wav)' + !--------------------------------------- + + call t_startf('MED:'//subname) + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + end if + rc = ESMF_SUCCESS + + !--------------------------------------- + ! --- Get the internal state + !--------------------------------------- + + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + ! --- Count the number of fields outside of scalar data, if zero, then return + !--------------------------------------- + + ! Note - the scalar field has been removed from all mediator field bundles - so this is why we check if the + ! fieldCount is 0 and not 1 here + + call shr_nuopc_methods_FB_getNumFlds(is_local%wrap%FBExp(compwav), trim(subname)//"FBexp(compwav)", ncnt, rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (ncnt > 0) then + + !--------------------------------------- + !--- map to create FBimp(:,compwav) + !--------------------------------------- + + do n1 = 1,ncomps + if (is_local%wrap%med_coupling_active(n1,compwav)) then + call med_map_FB_Regrid_Norm( & + fldListFr(n1)%flds, n1, compwav, & + is_local%wrap%FBImp(n1,n1), & + is_local%wrap%FBImp(n1,compwav), & + is_local%wrap%FBFrac(n1), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBNormOne(n1,compwav,:), & + is_local%wrap%RH(n1,compwav,:), & + string=trim(compname(n1))//'2'//trim(compname(compwav)), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + endif + enddo + + !--------------------------------------- + !--- auto merges to create FBExp(compwav) + !--------------------------------------- + + call med_merge_auto(trim(compname(compwav)), & + is_local%wrap%FBExp(compwav), & + is_local%wrap%FBFrac(compwav), & + is_local%wrap%FBImp(:,compwav), & + fldListTo(compwav), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------- + !--- diagnose output + !--------------------------------------- + + if (dbug_flag > 1) then + call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compwav), & + string=trim(subname)//' FBexp(compwav) ', rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + !--------------------------------------- + !--- custom calculations + !--------------------------------------- + + !--------------------------------------- + !--- update local scalar data + !--------------------------------------- + + !is_local%wrap%scalar_data(1) = + + !--------------------------------------- + !--- clean up + !--------------------------------------- + + endif + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + end if + call t_stopf('MED:'//subname) + + end subroutine med_phases_prep_wav end module med_phases_prep_wav_mod diff --git a/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 b/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 index fab1b2e34fc..b113c1e7f3b 100644 --- a/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 +++ b/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 @@ -38,7 +38,6 @@ subroutine med_phases_restart_write(gcomp, rc) use esmFlds , only : ncomps, compname, compocn use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use med_internalstate_mod , only : InternalState - use med_infodata_mod , only : med_infodata, med_infodata_GetData use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit use med_io_mod , only : med_io_write, med_io_wopen, med_io_enddef use med_io_mod , only : med_io_close, med_io_date2yyyymmdd @@ -268,9 +267,11 @@ subroutine med_phases_restart_write(gcomp, rc) do n = 1,ncomps if (is_local%wrap%comp_present(n)) then + nx = is_local%wrap%nx(n) + ny = is_local%wrap%ny(n) + ! Write import field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then - call med_infodata_GetData(med_infodata, ncomp=n, nx=nx, ny=ny) !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) call med_io_write(restart_file, iam, is_local%wrap%FBimp(n,n), & @@ -280,7 +281,6 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write fraction field bundles if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then - call med_infodata_GetData(med_infodata, ncomp=n, nx=nx, ny=ny) !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) call med_io_write(restart_file, iam, is_local%wrap%FBfrac(n), & @@ -291,7 +291,6 @@ subroutine med_phases_restart_write(gcomp, rc) ! Write export accumulators if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccum(n),rc=rc)) then ! TODO: only write this out if actually have done accumulation - call med_infodata_GetData(med_infodata, ncomp=n, nx=nx, ny=ny) !write(tmpstr,*) subname,' nx,ny = ',trim(compname(n)),nx,ny !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) call med_io_write(restart_file, iam, is_local%wrap%FBExpAccum(n), & @@ -303,7 +302,8 @@ subroutine med_phases_restart_write(gcomp, rc) !Write ocn albedo field bundle (CESM only) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then - call med_infodata_GetData(med_infodata, ncomp=compocn, nx=nx, ny=ny) + nx = is_local%wrap%nx(compocn) + ny = is_local%wrap%ny(compocn) call med_io_write(restart_file, iam, is_local%wrap%FBMed_ocnalb_o, & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre='MedOcnAlb_o', rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/src/drivers/nuopc/shr/med_constants_mod.F90 b/src/drivers/nuopc/shr/med_constants_mod.F90 index c5e1f0454eb..b37a65f21c6 100644 --- a/src/drivers/nuopc/shr/med_constants_mod.F90 +++ b/src/drivers/nuopc/shr/med_constants_mod.F90 @@ -36,6 +36,6 @@ module med_constants_mod integer, parameter :: med_constants_SecPerDay = 86400 ! Seconds per day !----------------------------------------------------------------------------- - integer :: med_constants_dbug_flag = 0 + integer :: med_constants_dbug_flag = 5 end module med_constants_mod diff --git a/src/drivers/nuopc/shr/seq_comm_mct.F90 b/src/drivers/nuopc/shr/seq_comm_mct.F90 deleted file mode 100644 index 4b673336e2b..00000000000 --- a/src/drivers/nuopc/shr/seq_comm_mct.F90 +++ /dev/null @@ -1,1156 +0,0 @@ -module seq_comm_mct - -!--------------------------------------------------------------------- -! -! Purpose: Set up necessary communications -! Note that if no MPI, will call MCTs fake version -! (including mpif.h) will be utilized -! -!--------------------------------------------------------------------- - - -!!! NOTE: If all atmospheres are identical in number of processes, -!!! number of threads, and grid layout, we should check that the -!!! user-provided number of processes and threads are consistent -!!! (or else, only accept one entry for these quantities when reading -!!! the namelist). ARE OTHER PROTECTIONS/CHECKS NEEDED??? - use ESMF, only : ESMF_LogKind_Flag - implicit none - - private - -!-------------------------------------------------------------------------- -! Public interfaces -!-------------------------------------------------------------------------- - - public seq_comm_setcomm - public seq_comm_iamin - public seq_comm_iamroot - public seq_comm_mpicom - public seq_comm_iam - public seq_comm_gloroot - public seq_comm_name - public seq_comm_inst - public seq_comm_suffix - public seq_comm_petlist - public seq_comm_setptrs - public seq_comm_setnthreads - public seq_comm_getnthreads - public seq_comm_printcomms - -!-------------------------------------------------------------------------- -! Public data -!-------------------------------------------------------------------------- - - integer, public :: logunit = 6 ! log unit number - integer, public :: loglevel = 1 ! log level - - ! NOTE: NUM_COMP_INST_XXX are cpp variables set in buildlib.csm_share - integer, parameter, public :: num_inst_atm = NUM_COMP_INST_ATM - integer, parameter, public :: num_inst_lnd = NUM_COMP_INST_LND - integer, parameter, public :: num_inst_ocn = NUM_COMP_INST_OCN - integer, parameter, public :: num_inst_ice = NUM_COMP_INST_ICE - integer, parameter, public :: num_inst_glc = NUM_COMP_INST_GLC - integer, parameter, public :: num_inst_wav = NUM_COMP_INST_WAV - integer, parameter, public :: num_inst_rof = NUM_COMP_INST_ROF - integer, parameter, public :: num_inst_esp = NUM_COMP_INST_ESP - - integer, public :: num_inst_min, num_inst_max - - integer, parameter, public :: num_inst_total = & - num_inst_atm + num_inst_lnd + num_inst_ocn + num_inst_ice + & - num_inst_glc + num_inst_wav + num_inst_rof + num_inst_esp + 1 - - integer, parameter :: ncouplers = 1 ! number of couplers - integer, parameter :: ncomps = (ncouplers + num_inst_total) - - integer, public :: GLOID - integer, public :: CPLID - integer, public :: ATMID(num_inst_atm) - integer, public :: LNDID(num_inst_lnd) - integer, public :: OCNID(num_inst_ocn) - integer, public :: ICEID(num_inst_ice) - integer, public :: GLCID(num_inst_glc) - integer, public :: ROFID(num_inst_rof) - integer, public :: WAVID(num_inst_wav) - integer, public :: ESPID(num_inst_esp) - - type(ESMF_LogKind_Flag), public :: esmf_logfile_kind - - integer, parameter, public :: seq_comm_namelen=16 - - type seq_comm_type - character(len=seq_comm_namelen) :: name ! my name - character(len=seq_comm_namelen) :: suffix ! recommended suffix - integer :: inst ! my inst index - integer :: ID ! my id number - integer :: mpicom ! mpicom - integer :: mpigrp ! mpigrp - integer :: npes ! number of mpi tasks in comm - integer :: nthreads ! number of omp threads per task - integer :: iam ! my task number in mpicom - logical :: iamroot ! am i the root task in mpicom - integer :: gloroot ! the global task number of each comps root on all pes - integer :: pethreads ! max number of threads on my task - logical :: set ! has this datatype been set - integer, pointer :: petlist(:) ! esmf pet list - logical :: petlist_allocated ! whether the petlist pointer variable was allocated - end type seq_comm_type - - type(seq_comm_type) :: seq_comms(ncomps) - - character(*), parameter :: layout_concurrent = 'concurrent' - character(*), parameter :: layout_sequential = 'sequential' - - character(*), parameter :: F11 = "(a,a,'(',i3,' ',a,')',a, 3i6,' (',a,i6,')',' (',a,i3,')')" - character(*), parameter :: F12 = "(a,a,'(',i3,' ',a,')',a,2i6,6x,' (',a,i6,')',' (',a,i3,')','(',a,2i6,')')" - character(*), parameter :: F13 = "(a,a,'(',i3,' ',a,')',a,2i6,6x,' (',a,i6,')',' (',a,i3,')')" - character(*), parameter :: F14 = "(a,a,'(',i3,' ',a,')',a, 6x,' (',a,i6,')',' (',a,i3,')')" - integer :: Global_Comm - - - character(len=32), public :: & - atm_layout, lnd_layout, ice_layout, glc_layout, rof_layout, & - ocn_layout, wav_layout, esp_layout - - logical :: seq_comm_mct_initialized = .false. ! whether this module has been initialized - -!======================================================================= -contains -!====================================================================== - - subroutine seq_comm_init(Comm_in, nmlfile) - use shr_sys_mod, only : shr_sys_abort - use shr_file_mod, only : shr_file_getUnit, shr_file_freeUnit - use shr_mpi_mod, only : shr_mpi_max, shr_mpi_chkerr, shr_mpi_bcast - use mpi, only : mpi_comm_rank, mpi_comm_size, mpi_comm_null, MPI_INTEGER, MPI_CHARACTER - use mpi, only : mpi_comm_null, mpi_group_null - use ESMF, only : ESMF_LOGKIND_NONE, ESMF_LOGKIND_MULTI, ESMF_LOGKIND_SINGLE - use mct_mod, only: mct_die, mct_world_init - !---------------------------------------------------------- - ! Arguments - integer, intent(in) :: Comm_in - character(len=*), intent(IN) :: nmlfile - ! - ! Local variables - ! - logical :: error_state - integer :: ierr, n, count - integer :: mpi_group_world ! MPI_COMM_WORLD group - integer :: mype,numpes,myncomps,max_threads,gloroot - integer :: atm_inst_tasks, lnd_inst_tasks, ocn_inst_tasks, ice_inst_tasks - integer :: glc_inst_tasks, rof_inst_tasks, wav_inst_tasks, esp_inst_tasks - integer :: current_task_rootpe, droot - integer :: amin(num_inst_atm), amax(num_inst_atm), astr(num_inst_atm) - integer :: lmin(num_inst_lnd), lmax(num_inst_lnd), lstr(num_inst_lnd) - integer :: imin(num_inst_ice), imax(num_inst_ice), istr(num_inst_ice) - integer :: omin(num_inst_ocn), omax(num_inst_ocn), ostr(num_inst_ocn) - integer :: gmin(num_inst_glc), gmax(num_inst_glc), gstr(num_inst_glc) - integer :: wmin(num_inst_wav), wmax(num_inst_wav), wstr(num_inst_wav) - integer :: rmin(num_inst_rof), rmax(num_inst_rof), rstr(num_inst_rof) - integer :: emin(num_inst_esp), emax(num_inst_esp), estr(num_inst_esp) - integer :: cmin,cmax,cstr - integer :: pelist(3,1) ! start, stop, stride for group - integer :: nu, i - character(len=24) :: esmf_logging - integer, pointer :: comps(:) ! array with component ids - integer, pointer :: comms(:) ! array with mpicoms - character(*), parameter :: subName = '(seq_comm_init) ' - - integer :: & - atm_ntasks, atm_rootpe, atm_pestride, atm_nthreads, & - lnd_ntasks, lnd_rootpe, lnd_pestride, lnd_nthreads, & - ice_ntasks, ice_rootpe, ice_pestride, ice_nthreads, & - glc_ntasks, glc_rootpe, glc_pestride, glc_nthreads, & - wav_ntasks, wav_rootpe, wav_pestride, wav_nthreads, & - rof_ntasks, rof_rootpe, rof_pestride, rof_nthreads, & - ocn_ntasks, ocn_rootpe, ocn_pestride, ocn_nthreads, & - esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, & - cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads - - namelist /cime_pes/ & - atm_ntasks, atm_rootpe, atm_pestride, atm_nthreads, atm_layout, & - lnd_ntasks, lnd_rootpe, lnd_pestride, lnd_nthreads, lnd_layout, & - ice_ntasks, ice_rootpe, ice_pestride, ice_nthreads, ice_layout, & - glc_ntasks, glc_rootpe, glc_pestride, glc_nthreads, glc_layout, & - wav_ntasks, wav_rootpe, wav_pestride, wav_nthreads, wav_layout, & - rof_ntasks, rof_rootpe, rof_pestride, rof_nthreads, rof_layout, & - ocn_ntasks, ocn_rootpe, ocn_pestride, ocn_nthreads, ocn_layout, & - esp_ntasks, esp_rootpe, esp_pestride, esp_nthreads, esp_layout, & - cpl_ntasks, cpl_rootpe, cpl_pestride, cpl_nthreads, esmf_logging - !---------------------------------------------------------- - - ! make sure this is first pass and set comms unset - if (seq_comm_mct_initialized) then - write(logunit,*) trim(subname),' ERROR seq_comm_init already called ' - call shr_sys_abort() - endif - seq_comm_mct_initialized = .true. - Global_Comm = Comm_in - - !! Initialize seq_comms elements - - do n = 1,ncomps - seq_comms(n)%name = 'unknown' - seq_comms(n)%suffix = ' ' - seq_comms(n)%inst = 0 - seq_comms(n)%set = .false. - seq_comms(n)%petlist_allocated = .false. - seq_comms(n)%mpicom = MPI_COMM_NULL ! do some initialization here - seq_comms(n)%iam = -1 - seq_comms(n)%iamroot = .false. - seq_comms(n)%npes = -1 - seq_comms(n)%nthreads = -1 - seq_comms(n)%gloroot = -1 - seq_comms(n)%pethreads = -1 - enddo - - ! Initialize MPI - Note that if no MPI, will call MCTs fake version - call mpi_comm_rank(GLOBAL_COMM, mype , ierr) - call shr_mpi_chkerr(ierr,subname//' mpi_comm_rank comm_world') - - call mpi_comm_size(GLOBAL_COMM, numpes, ierr) - call shr_mpi_chkerr(ierr,subname//' mpi_comm_size comm_world') - - ! Set ntasks, rootpe, pestride, nthreads for all components - if (mype == 0) then - - !! Set up default component process parameters - atm_ntasks = numpes - atm_rootpe = 0 - atm_pestride = 1 - atm_nthreads = 1 - atm_layout = trim(layout_concurrent) - - lnd_ntasks = numpes - lnd_rootpe = 0 - lnd_pestride = 1 - lnd_nthreads = 1 - lnd_layout = trim(layout_concurrent) - - ocn_ntasks = numpes - ocn_rootpe = 0 - ocn_pestride = 1 - ocn_nthreads = 1 - ocn_layout = trim(layout_concurrent) - - ice_ntasks = numpes - ice_rootpe = 0 - ice_pestride = 1 - ice_nthreads = 1 - ice_layout = trim(layout_concurrent) - - glc_ntasks = numpes - glc_rootpe = 0 - glc_pestride = 1 - glc_nthreads = 1 - glc_layout = trim(layout_concurrent) - - rof_ntasks = numpes - rof_rootpe = 0 - rof_pestride = 1 - rof_nthreads = 1 - rof_layout = trim(layout_concurrent) - - wav_ntasks = numpes - wav_rootpe = 0 - wav_pestride = 1 - wav_nthreads = 1 - wav_layout = trim(layout_concurrent) - - esp_ntasks = numpes - esp_rootpe = 0 - esp_pestride = 1 - esp_nthreads = 1 - esp_layout = trim(layout_concurrent) - - cpl_ntasks = numpes - cpl_rootpe = 0 - cpl_pestride = 1 - cpl_nthreads = 1 - - esmf_logging = "ESMF_LOGKIND_NONE" - - ! Read namelist if it exists - ! TODO: obtain this from attributes - nu = shr_file_getUnit() - open(nu, file=trim(nmlfile), status='old', iostat=ierr) - - if (ierr == 0) then - ierr = 1 - do while( ierr > 0 ) - read(nu, nml=cime_pes, iostat=ierr) - end do - close(nu) - end if - call shr_file_freeUnit(nu) - end if - - !--- compute num_inst_min, num_inst_max - !--- instances must be either 1 or a constant across components - !--- checks for prognostic/present consistency in the driver - - error_state = .false. - num_inst_min = num_inst_atm - num_inst_min = min(num_inst_min, num_inst_lnd) - num_inst_min = min(num_inst_min, num_inst_ocn) - num_inst_min = min(num_inst_min, num_inst_ice) - num_inst_min = min(num_inst_min, num_inst_glc) - num_inst_min = min(num_inst_min, num_inst_wav) - num_inst_min = min(num_inst_min, num_inst_rof) - ! ESP is currently limited to one instance, should not affect other comps - ! num_inst_min = min(num_inst_min, num_inst_esp) - num_inst_max = num_inst_atm - num_inst_max = max(num_inst_max, num_inst_lnd) - num_inst_max = max(num_inst_max, num_inst_ocn) - num_inst_max = max(num_inst_max, num_inst_ice) - num_inst_max = max(num_inst_max, num_inst_glc) - num_inst_max = max(num_inst_max, num_inst_wav) - num_inst_max = max(num_inst_max, num_inst_rof) - num_inst_max = max(num_inst_max, num_inst_esp) - - if (num_inst_min /= num_inst_max .and. num_inst_min /= 1) error_state = .true. - if (num_inst_atm /= num_inst_min .and. num_inst_atm /= num_inst_max) error_state = .true. - if (num_inst_lnd /= num_inst_min .and. num_inst_lnd /= num_inst_max) error_state = .true. - if (num_inst_ocn /= num_inst_min .and. num_inst_ocn /= num_inst_max) error_state = .true. - if (num_inst_ice /= num_inst_min .and. num_inst_ice /= num_inst_max) error_state = .true. - if (num_inst_glc /= num_inst_min .and. num_inst_glc /= num_inst_max) error_state = .true. - if (num_inst_wav /= num_inst_min .and. num_inst_wav /= num_inst_max) error_state = .true. - if (num_inst_rof /= num_inst_min .and. num_inst_rof /= num_inst_max) error_state = .true. - if (num_inst_esp /= 1) then - write(logunit,*) trim(subname),' ERROR: ESP restricted to one instance' - error_state = .true. - end if - - if (error_state) then - write(logunit,*) trim(subname),' ERROR: num_inst inconsistent' - call shr_sys_abort(trim(subname)//' ERROR: num_inst inconsistent') - endif - - ! Initialize IDs - - count = 0 - count = count + 1 - GLOID = count - count = count + 1 - CPLID = count - do n = 1, num_inst_atm - count = count + 1 - ATMID(n) = count - end do - do n = 1, num_inst_lnd - count = count + 1 - LNDID(n) = count - end do - do n = 1, num_inst_ocn - count = count + 1 - OCNID(n) = count - end do - do n = 1, num_inst_ice - count = count + 1 - ICEID(n) = count - end do - do n = 1, num_inst_glc - count = count + 1 - GLCID(n) = count - end do - do n = 1, num_inst_rof - count = count + 1 - ROFID(n) = count - end do - do n = 1, num_inst_wav - count = count + 1 - WAVID(n) = count - end do - do n = 1, num_inst_esp - count = count + 1 - ESPID(n) = count - end do - if (count /= ncomps) then - write(logunit,*) trim(subname),' ERROR in ID count ',count,ncomps - call shr_sys_abort(trim(subname)//' ERROR in ID count') - endif - - if (mype == 0) then - !--- validation of inputs --- - ! rootpes >= 0 - - error_state = .false. - - if (atm_rootpe < 0) error_state = .true. - if (lnd_rootpe < 0) error_state = .true. - if (ice_rootpe < 0) error_state = .true. - if (ocn_rootpe < 0) error_state = .true. - if (glc_rootpe < 0) error_state = .true. - if (wav_rootpe < 0) error_state = .true. - if (rof_rootpe < 0) error_state = .true. - if (esp_rootpe < 0) error_state = .true. - if (cpl_rootpe < 0) error_state = .true. - - if (error_state) then - write(logunit,*) trim(subname),' ERROR: rootpes must be >= 0' - call shr_sys_abort(trim(subname)//' ERROR: rootpes >= 0') - endif - - !! Determine the process layout - !! - !! We will assign atm_ntasks / num_inst_atm tasks to each atmosphere - !! instance. (This may lead to unallocated tasks if atm_ntasks is - !! not an integer multiple of num_inst_atm.) - - if (trim(atm_layout) == trim(layout_concurrent)) then - atm_inst_tasks = atm_ntasks / num_inst_atm - droot = (atm_inst_tasks * atm_pestride) - elseif (trim(atm_layout) == trim(layout_sequential)) then - atm_inst_tasks = atm_ntasks - droot = 0 - else - call shr_sys_abort(subname//' ERROR invalid atm_layout ') - endif - current_task_rootpe = atm_rootpe - do n = 1, num_inst_atm - amin(n) = current_task_rootpe - amax(n) = current_task_rootpe & - + ((atm_inst_tasks - 1) * atm_pestride) - astr(n) = atm_pestride - current_task_rootpe = current_task_rootpe + droot - end do - - !! Land instance tasks - - if (trim(lnd_layout) == trim(layout_concurrent)) then - lnd_inst_tasks = lnd_ntasks / num_inst_lnd - droot = (lnd_inst_tasks * lnd_pestride) - elseif (trim(lnd_layout) == trim(layout_sequential)) then - lnd_inst_tasks = lnd_ntasks - droot = 0 - else - call shr_sys_abort(subname//' ERROR invalid lnd_layout ') - endif - current_task_rootpe = lnd_rootpe - do n = 1, num_inst_lnd - lmin(n) = current_task_rootpe - lmax(n) = current_task_rootpe & - + ((lnd_inst_tasks - 1) * lnd_pestride) - lstr(n) = lnd_pestride - current_task_rootpe = current_task_rootpe + droot - end do - - !! Ocean instance tasks - - if (trim(ocn_layout) == trim(layout_concurrent)) then - ocn_inst_tasks = ocn_ntasks / num_inst_ocn - droot = (ocn_inst_tasks * ocn_pestride) - elseif (trim(ocn_layout) == trim(layout_sequential)) then - ocn_inst_tasks = ocn_ntasks - droot = 0 - else - call shr_sys_abort(subname//' ERROR invalid ocn_layout ') - endif - current_task_rootpe = ocn_rootpe - do n = 1, num_inst_ocn - omin(n) = current_task_rootpe - omax(n) = current_task_rootpe & - + ((ocn_inst_tasks - 1) * ocn_pestride) - ostr(n) = ocn_pestride - current_task_rootpe = current_task_rootpe + droot - end do - - !! Sea ice instance tasks - - if (trim(ice_layout) == trim(layout_concurrent)) then - ice_inst_tasks = ice_ntasks / num_inst_ice - droot = (ice_inst_tasks * ice_pestride) - elseif (trim(ice_layout) == trim(layout_sequential)) then - ice_inst_tasks = ice_ntasks - droot = 0 - else - call shr_sys_abort(subname//' ERROR invalid ice_layout ') - endif - current_task_rootpe = ice_rootpe - do n = 1, num_inst_ice - imin(n) = current_task_rootpe - imax(n) = current_task_rootpe & - + ((ice_inst_tasks - 1) * ice_pestride) - istr(n) = ice_pestride - current_task_rootpe = current_task_rootpe + droot - end do - - !! Glacier instance tasks - - if (trim(glc_layout) == trim(layout_concurrent)) then - glc_inst_tasks = glc_ntasks / num_inst_glc - droot = (glc_inst_tasks * glc_pestride) - elseif (trim(glc_layout) == trim(layout_sequential)) then - glc_inst_tasks = glc_ntasks - droot = 0 - else - call shr_sys_abort(subname//' ERROR invalid glc_layout ') - endif - current_task_rootpe = glc_rootpe - do n = 1, num_inst_glc - gmin(n) = current_task_rootpe - gmax(n) = current_task_rootpe & - + ((glc_inst_tasks - 1) * glc_pestride) - gstr(n) = glc_pestride - current_task_rootpe = current_task_rootpe + droot - end do - - !! Runoff instance tasks - - if (trim(rof_layout) == trim(layout_concurrent)) then - rof_inst_tasks = rof_ntasks / num_inst_rof - droot = (rof_inst_tasks * rof_pestride) - elseif (trim(rof_layout) == trim(layout_sequential)) then - rof_inst_tasks = rof_ntasks - droot = 0 - else - call shr_sys_abort(subname//' ERROR invalid rof_layout ') - endif - current_task_rootpe = rof_rootpe - do n = 1, num_inst_rof - rmin(n) = current_task_rootpe - rmax(n) = current_task_rootpe & - + ((rof_inst_tasks - 1) * rof_pestride) - rstr(n) = rof_pestride - current_task_rootpe = current_task_rootpe + droot - end do - - !! Wave instance tasks - - if (trim(wav_layout) == trim(layout_concurrent)) then - wav_inst_tasks = wav_ntasks / num_inst_wav - droot = (wav_inst_tasks * wav_pestride) - elseif (trim(wav_layout) == trim(layout_sequential)) then - wav_inst_tasks = wav_ntasks - droot = 0 - else - call shr_sys_abort(subname//' ERROR invalid wav_layout ') - endif - current_task_rootpe = wav_rootpe - do n = 1, num_inst_wav - wmin(n) = current_task_rootpe - wmax(n) = current_task_rootpe & - + ((wav_inst_tasks - 1) * wav_pestride) - wstr(n) = wav_pestride - current_task_rootpe = current_task_rootpe + droot - end do - - !! External System Processing instance tasks - - if (trim(esp_layout) == trim(layout_concurrent)) then - esp_inst_tasks = esp_ntasks / num_inst_esp - droot = (esp_inst_tasks * esp_pestride) - elseif (trim(esp_layout) == trim(layout_sequential)) then - esp_inst_tasks = esp_ntasks - droot = 0 - else - call shr_sys_abort(subname//' ERROR invalid esp_layout ') - endif - current_task_rootpe = esp_rootpe - do n = 1, num_inst_esp - emin(n) = current_task_rootpe - emax(n) = current_task_rootpe & - + ((esp_inst_tasks - 1) * esp_pestride) - estr(n) = esp_pestride - current_task_rootpe = current_task_rootpe + droot - end do - - !! Coupler tasks - - cmin = cpl_rootpe - cmax = cpl_rootpe + (cpl_ntasks-1)*cpl_pestride - cstr = cpl_pestride - end if - - call shr_mpi_bcast(atm_nthreads,GLOBAL_COMM,'atm_nthreads') - call shr_mpi_bcast(lnd_nthreads,GLOBAL_COMM,'lnd_nthreads') - call shr_mpi_bcast(ocn_nthreads,GLOBAL_COMM,'ocn_nthreads') - call shr_mpi_bcast(ice_nthreads,GLOBAL_COMM,'ice_nthreads') - call shr_mpi_bcast(glc_nthreads,GLOBAL_COMM,'glc_nthreads') - call shr_mpi_bcast(wav_nthreads,GLOBAL_COMM,'wav_nthreads') - call shr_mpi_bcast(rof_nthreads,GLOBAL_COMM,'rof_nthreads') - call shr_mpi_bcast(esp_nthreads,GLOBAL_COMM,'esp_nthreads') - call shr_mpi_bcast(cpl_nthreads,GLOBAL_COMM,'cpl_nthreads') - - ! Create MPI communicator groups - - if (mype == 0) then - pelist(1,1) = 0 - pelist(2,1) = numpes-1 - pelist(3,1) = 1 - end if - call mpi_bcast(pelist, size(pelist), MPI_INTEGER, 0, GLOBAL_COMM, ierr) - call seq_comm_setcomm(GLOID, pelist,iname='GLOBAL') - - if (mype == 0) then - pelist(1,1) = cmin - pelist(2,1) = cmax - pelist(3,1) = cstr - end if - call mpi_bcast(pelist, size(pelist), MPI_INTEGER, 0, GLOBAL_COMM, ierr) - call seq_comm_setcomm(CPLID,pelist,cpl_nthreads,'CPL') - - do n = 1, num_inst_atm - if (mype == 0) then - pelist(1,1) = amin(n) - pelist(2,1) = amax(n) - pelist(3,1) = astr(n) - end if - call mpi_bcast(pelist, size(pelist), MPI_INTEGER, 0, GLOBAL_COMM, ierr) - call seq_comm_setcomm(ATMID(n), pelist, atm_nthreads, 'ATM', n, num_inst_atm) - end do - - do n = 1, num_inst_lnd - if (mype == 0) then - pelist(1,1) = lmin(n) - pelist(2,1) = lmax(n) - pelist(3,1) = lstr(n) - end if - call mpi_bcast(pelist, size(pelist), MPI_INTEGER, 0, GLOBAL_COMM, ierr) - call seq_comm_setcomm(LNDID(n), pelist, lnd_nthreads, 'LND', n, num_inst_lnd) - end do - - do n = 1, num_inst_ocn - if (mype == 0) then - pelist(1,1) = omin(n) - pelist(2,1) = omax(n) - pelist(3,1) = ostr(n) - end if - call mpi_bcast(pelist, size(pelist), MPI_INTEGER, 0, GLOBAL_COMM, ierr) - call seq_comm_setcomm(OCNID(n), pelist, ocn_nthreads, 'OCN', n, num_inst_ocn) - end do - - do n = 1, num_inst_ice - if (mype == 0) then - pelist(1,1) = imin(n) - pelist(2,1) = imax(n) - pelist(3,1) = istr(n) - end if - call mpi_bcast(pelist, size(pelist), MPI_INTEGER, 0, GLOBAL_COMM, ierr) - call seq_comm_setcomm(ICEID(n), pelist, ice_nthreads, 'ICE', n, num_inst_ice) - end do - - do n = 1, num_inst_glc - if (mype == 0) then - pelist(1,1) = gmin(n) - pelist(2,1) = gmax(n) - pelist(3,1) = gstr(n) - end if - call mpi_bcast(pelist, size(pelist), MPI_INTEGER, 0, GLOBAL_COMM, ierr) - call seq_comm_setcomm(GLCID(n), pelist, glc_nthreads, 'GLC', n, num_inst_glc) - end do - - do n = 1, num_inst_rof - if (mype == 0) then - pelist(1,1) = rmin(n) - pelist(2,1) = rmax(n) - pelist(3,1) = rstr(n) - end if - call mpi_bcast(pelist, size(pelist), MPI_INTEGER, 0, GLOBAL_COMM, ierr) - call seq_comm_setcomm(ROFID(n), pelist, rof_nthreads, 'ROF', n, num_inst_rof) - end do - - do n = 1, num_inst_wav - if (mype == 0) then - pelist(1,1) = wmin(n) - pelist(2,1) = wmax(n) - pelist(3,1) = wstr(n) - end if - call mpi_bcast(pelist, size(pelist), MPI_INTEGER, 0, GLOBAL_COMM, ierr) - call seq_comm_setcomm(WAVID(n), pelist, wav_nthreads, 'WAV', n, num_inst_wav) - end do - - do n = 1, num_inst_esp - if (mype == 0) then - pelist(1,1) = emin(n) - pelist(2,1) = emax(n) - pelist(3,1) = estr(n) - end if - call mpi_bcast(pelist, size(pelist), MPI_INTEGER, 0, GLOBAL_COMM, ierr) - call seq_comm_setcomm(ESPID(n), pelist, esp_nthreads, 'ESP', n, num_inst_esp) - end do - - !! Count the total number of threads - - max_threads = -1 - do n = 1,ncomps - max_threads = max(max_threads,seq_comms(n)%nthreads) - enddo - do n = 1,ncomps - seq_comms(n)%pethreads = max_threads - enddo - - ! compute each components root pe global id and broadcast so all pes have info - do n = 1,ncomps - gloroot = -999 - call shr_mpi_max(gloroot,seq_comms(n)%gloroot,GLOBAL_COMM, trim(subname)//' gloroot',all=.true.) - enddo - - !------------------------------------------ - ! Initialize MCT - !------------------------------------------ - - ! add up valid comps on local pe - myncomps = 0 - do n = 1,ncomps - if (seq_comms(n)%mpicom /= MPI_COMM_NULL) then - myncomps = myncomps + 1 - endif - enddo - - ! set comps and comms - allocate(comps(myncomps),comms(myncomps),stat=ierr) - if(ierr/=0) call mct_die(subName,'allocate comps comms',ierr) - - myncomps = 0 - do n = 1,ncomps - if (seq_comms(n)%mpicom /= MPI_COMM_NULL) then - myncomps = myncomps + 1 - if (myncomps > size(comps)) then - write(logunit,*) trim(subname),' ERROR in myncomps ',myncomps,size(comps) - call shr_sys_abort() - endif - comps(myncomps) = seq_comms(n)%ID - comms(myncomps) = seq_comms(n)%mpicom - endif - enddo - if (myncomps /= size(comps)) then - write(logunit,*) trim(subname),' ERROR in myncomps ',myncomps,size(comps) - call shr_sys_abort() - endif - - call mct_world_init(ncomps, GLOBAL_COMM, comms, comps) - - deallocate(comps,comms) - - !------------------------------------------ - ! ESMF logging (only has effect if ESMF libraries are used) - !------------------------------------------ - - call mpi_bcast(esmf_logging, len(esmf_logging), MPI_CHARACTER, 0, GLOBAL_COMM, ierr) - - select case(esmf_logging) - case ("ESMF_LOGKIND_SINGLE") - esmf_logfile_kind = ESMF_LOGKIND_SINGLE - case ("ESMF_LOGKIND_MULTI") - esmf_logfile_kind = ESMF_LOGKIND_MULTI - case ("ESMF_LOGKIND_NONE") - esmf_logfile_kind = ESMF_LOGKIND_NONE - case default - if (mype == 0) then - write(logunit,*) trim(subname),' ERROR: Invalid value for esmf_logging, ',esmf_logging - endif - call shr_sys_abort(trim(subname)//' ERROR: Invalid value for esmf_logging '//esmf_logging) - end select - - end subroutine seq_comm_init - -!--------------------------------------------------------- - subroutine seq_comm_setcomm(ID,pelist,nthreads,iname,inst,tinst, comm_in) - use shr_sys_mod, only : shr_sys_abort - use mpi, only : MPI_COMM_NULL, mpi_comm_group, mpi_comm_create, mpi_group_range_incl - use mpi, only: mpi_comm_size, mpi_comm_rank - use shr_mpi_mod, only : shr_mpi_chkerr - implicit none - integer,intent(IN) :: ID - integer,intent(IN) :: pelist(:,:) - integer,intent(IN),optional :: nthreads - character(len=*),intent(IN),optional :: iname ! name of component - integer,intent(IN),optional :: inst ! instance of component - integer,intent(IN),optional :: tinst ! total number of instances for this component - integer,intent(in),optional :: comm_in - - integer :: mpigrp_world - integer :: mpigrp - integer :: mpicom - integer :: ntask,ntasks,cnt - integer :: ierr - character(len=seq_comm_namelen) :: cname - logical :: set_suffix - character(*),parameter :: subName = '(seq_comm_setcomm) ' - - if (ID < 1 .or. ID > ncomps) then - write(logunit,*) subname,' ID out of range, abort ',ID - call shr_sys_abort() - endif - if(present(comm_in)) then - GLOBAL_COMM=comm_in - endif - - call mpi_comm_group(GLOBAL_COMM, mpigrp_world, ierr) - call shr_mpi_chkerr(ierr,subname//' mpi_comm_group mpigrp_world') - call mpi_group_range_incl(mpigrp_world, 1, pelist, mpigrp,ierr) - call shr_mpi_chkerr(ierr,subname//' mpi_group_range_incl mpigrp') - call mpi_comm_create(GLOBAL_COMM, mpigrp, mpicom, ierr) - call shr_mpi_chkerr(ierr,subname//' mpi_comm_create mpigrp') - - ntasks = ((pelist(2,1) - pelist(1,1)) / pelist(3,1)) + 1 - allocate(seq_comms(ID)%petlist(ntasks)) - seq_comms(ID)%petlist_allocated = .true. - cnt = 0 - do ntask = pelist(1,1),pelist(2,1),pelist(3,1) - cnt = cnt + 1 - if (cnt > ntasks) then - write(logunit,*) subname,' ERROR in petlist init ',ntasks,pelist(1:3,1),ntask,cnt - call shr_sys_abort(subname//' ERROR in petlist init') - endif - seq_comms(ID)%petlist(cnt) = ntask - enddo - - seq_comms(ID)%set = .true. - seq_comms(ID)%ID = ID - - if (present(inst)) then - seq_comms(ID)%inst = inst - set_suffix = .true. - else - seq_comms(ID)%inst = 1 - set_suffix = .false. - endif - - if (present(tinst)) then - if (tinst == 1) set_suffix = .false. - endif - - if (present(iname)) then - seq_comms(ID)%name = trim(iname) - if (set_suffix) then - call seq_comm_mkname(cname,iname,seq_comms(ID)%inst) - seq_comms(ID)%name = trim(cname) - endif - endif - - if (set_suffix) then - call seq_comm_mkname(cname,'_',seq_comms(ID)%inst) - seq_comms(ID)%suffix = trim(cname) - else - seq_comms(ID)%suffix = ' ' - endif - - seq_comms(ID)%mpicom = mpicom - seq_comms(ID)%mpigrp = mpigrp - if (present(nthreads)) then - seq_comms(ID)%nthreads = nthreads - else - seq_comms(ID)%nthreads = 1 - endif - - if (mpicom /= MPI_COMM_NULL) then - call mpi_comm_size(mpicom,seq_comms(ID)%npes,ierr) - call shr_mpi_chkerr(ierr,subname//' mpi_comm_size') - call mpi_comm_rank(mpicom,seq_comms(ID)%iam,ierr) - call shr_mpi_chkerr(ierr,subname//' mpi_comm_rank') - if (seq_comms(ID)%iam == 0) then - seq_comms(ID)%iamroot = .true. - else - seq_comms(ID)%iamroot = .false. - endif - else - seq_comms(ID)%npes = -1 - seq_comms(ID)%iam = -1 - seq_comms(ID)%nthreads = 1 - seq_comms(ID)%iamroot = .false. - endif - - if (seq_comms(ID)%iamroot) then - write(logunit,F11) trim(subname),' initialize ID ',ID,seq_comms(ID)%name, & - ' pelist =',pelist,' npes =',seq_comms(ID)%npes,' nthreads =',seq_comms(ID)%nthreads - endif - - end subroutine seq_comm_setcomm - -!--------------------------------------------------------- - subroutine seq_comm_printcomms() - use shr_sys_mod, only : shr_sys_flush - integer :: n - character(*),parameter :: subName = '(seq_comm_printcomms) ' - - do n = 1,ncomps - write(logunit,'(a,4i6,2x,3a)') trim(subName), n, & - seq_comms(n)%gloroot, seq_comms(n)%npes, seq_comms(n)%nthreads, & - trim(seq_comms(n)%name),':',trim(seq_comms(n)%suffix) - enddo - call shr_sys_flush(logunit) - - end subroutine seq_comm_printcomms - -!--------------------------------------------------------- - - subroutine seq_comm_setptrs(ID,mpicom,mpigrp,npes,nthreads,iam,iamroot,gloroot, pethreads, name) - use mpi, only : mpi_comm_null, mpi_group_null - implicit none - integer,intent(in) :: ID - integer,intent(out),optional :: mpicom - integer,intent(out),optional :: mpigrp - integer,intent(out),optional :: npes - integer,intent(out),optional :: nthreads - integer,intent(out),optional :: iam - logical,intent(out),optional :: iamroot - integer,intent(out),optional :: gloroot - integer,intent(out),optional :: pethreads - character(len=seq_comm_namelen) , intent(out), optional :: name - character(*),parameter :: subName = '(seq_comm_setptrs) ' - - ! Negative ID means there is no comm, return default or inactive values - if ((ID == 0) .or. (ID > ncomps)) then - write(logunit,*) subname,' ID out of range, return ',ID - return - endif - - if (present(mpicom)) then - if (ID > 0) then - mpicom = seq_comms(ID)%mpicom - else - mpicom = MPI_COMM_NULL - end if - endif - - if (present(mpigrp)) then - if (ID > 0) then - mpigrp = seq_comms(ID)%mpigrp - else - mpigrp = MPI_GROUP_NULL - end if - endif - - if (present(npes)) then - if (ID > 0) then - npes = seq_comms(ID)%npes - else - npes = 0 - end if - endif - - if (present(nthreads)) then - if (ID > 0) then - nthreads = seq_comms(ID)%nthreads - else - nthreads = 1 - end if - endif - - if (present(iam)) then - if (ID > 0) then - iam = seq_comms(ID)%iam - else - iam = -1 - end if - endif - - if (present(iamroot)) then - if (ID > 0) then - iamroot = seq_comms(ID)%iamroot - else - iamroot = .false. - end if - endif - - if (present(gloroot)) then - if (ID > 0) then - gloroot = seq_comms(ID)%gloroot - else - gloroot = -1 - end if - endif - - if (present(pethreads)) then - if (ID > 0) then - pethreads = seq_comms(ID)%pethreads - else - pethreads = 1 - end if - endif - - if(present(name)) then - if (ID > 0) then - name = seq_comms(ID)%name - else - name = '' - end if - end if - - end subroutine seq_comm_setptrs -!--------------------------------------------------------- - subroutine seq_comm_setnthreads(nthreads) - use shr_sys_mod, only : shr_sys_abort - - implicit none - integer,intent(in) :: nthreads - character(*),parameter :: subName = '(seq_comm_setnthreads) ' - -#ifdef _OPENMP - if (nthreads < 1) then - call shr_sys_abort(subname//' ERROR: nthreads less than one') - endif - call omp_set_num_threads(nthreads) -#endif - - end subroutine seq_comm_setnthreads -!--------------------------------------------------------- - integer function seq_comm_getnthreads() - - implicit none - integer :: omp_get_num_threads - character(*),parameter :: subName = '(seq_comm_getnthreads) ' - - seq_comm_getnthreads = -1 -#ifdef _OPENMP -!$OMP PARALLEL - seq_comm_getnthreads = omp_get_num_threads() -!$OMP END PARALLEL -#endif - - end function seq_comm_getnthreads -!--------------------------------------------------------- - logical function seq_comm_iamin(ID) - - implicit none - integer,intent(in) :: ID - character(*),parameter :: subName = '(seq_comm_iamin) ' - - if ((ID < 1) .or. (ID > ncomps)) then - seq_comm_iamin = .false. - else if (seq_comms(ID)%iam >= 0) then - seq_comm_iamin = .true. - else - seq_comm_iamin = .false. - endif - - end function seq_comm_iamin -!--------------------------------------------------------- - logical function seq_comm_iamroot(ID) - - implicit none - integer,intent(in) :: ID - character(*),parameter :: subName = '(seq_comm_iamroot) ' - - if ((ID < 1) .or. (ID > ncomps)) then - seq_comm_iamroot = .false. - else - seq_comm_iamroot = seq_comms(ID)%iamroot - end if - - end function seq_comm_iamroot -!--------------------------------------------------------- - integer function seq_comm_mpicom(ID) - use mpi, only : mpi_comm_null - implicit none - integer,intent(in) :: ID - character(*),parameter :: subName = '(seq_comm_mpicom) ' - - if ((ID < 1) .or. (ID > ncomps)) then - seq_comm_mpicom = MPI_COMM_NULL - else - seq_comm_mpicom = seq_comms(ID)%mpicom - end if - - end function seq_comm_mpicom -!--------------------------------------------------------- - integer function seq_comm_iam(ID) - - implicit none - integer,intent(in) :: ID - character(*),parameter :: subName = '(seq_comm_iam) ' - - if ((ID < 1) .or. (ID > ncomps)) then - seq_comm_iam = -1 - else - seq_comm_iam = seq_comms(ID)%iam - end if - - end function seq_comm_iam - -!--------------------------------------------------------- - integer function seq_comm_gloroot(ID) - - implicit none - integer,intent(in) :: ID - character(*),parameter :: subName = '(seq_comm_gloroot) ' - - if ((ID < 1) .or. (ID > ncomps)) then - seq_comm_gloroot = -1 - else - seq_comm_gloroot = seq_comms(ID)%gloroot - end if - - end function seq_comm_gloroot - -!--------------------------------------------------------- - character(len=seq_comm_namelen) function seq_comm_name(ID) - - implicit none - integer,intent(in) :: ID - character(*),parameter :: subName = '(seq_comm_name) ' - - if ((ID < 1) .or. (ID > ncomps)) then - seq_comm_name = '' - else - seq_comm_name = trim(seq_comms(ID)%name) - end if - - end function seq_comm_name -!--------------------------------------------------------- - character(len=seq_comm_namelen) function seq_comm_suffix(ID) - - implicit none - integer,intent(in) :: ID - character(*),parameter :: subName = '(seq_comm_suffix) ' - - if ((ID < 1) .or. (ID > ncomps)) then - seq_comm_suffix = '' - else - seq_comm_suffix = trim(seq_comms(ID)%suffix) - end if - - end function seq_comm_suffix -!--------------------------------------------------------- - subroutine seq_comm_petlist(ID,petlist) - - implicit none - integer,intent(in) :: ID - integer,pointer :: petlist(:) - character(*),parameter :: subName = '(seq_comm_petlist) ' - - if ((ID < 1) .or. (ID > ncomps)) then - nullify(petlist) - else - petlist => seq_comms(ID)%petlist - end if - - end subroutine seq_comm_petlist -!--------------------------------------------------------- - integer function seq_comm_inst(ID) - - implicit none - integer,intent(in) :: ID - character(*),parameter :: subName = '(seq_comm_inst) ' - - if ((ID < 1) .or. (ID > ncomps)) then - seq_comm_inst = 0 - else - seq_comm_inst = seq_comms(ID)%inst - end if - - end function seq_comm_inst -!--------------------------------------------------------- - subroutine seq_comm_mkname(oname,str1,num) - use shr_sys_mod, only : shr_sys_abort - implicit none - character(len=*),intent(out) :: oname - character(len=*),intent(in) :: str1 - integer,intent(in) :: num - character(*),parameter :: subName = '(seq_comm_mkname) ' - - character(len=8) :: cnum - - write(cnum,'(i4.4)') num - if (len_trim(str1) + len_trim(cnum) > len(oname)) then - write(logunit,*) trim(subname),' ERROR in str lens ',len(oname),trim(str1),trim(cnum) - call shr_sys_abort(trim(subname)) - endif - oname = trim(str1)//trim(cnum) - - end subroutine seq_comm_mkname -!--------------------------------------------------------- -end module seq_comm_mct diff --git a/src/drivers/nuopc/shr/seq_timemgr_mod.F90 b/src/drivers/nuopc/shr/seq_timemgr_mod.F90 deleted file mode 100644 index 2e28aa248bf..00000000000 --- a/src/drivers/nuopc/shr/seq_timemgr_mod.F90 +++ /dev/null @@ -1,2151 +0,0 @@ -module seq_timemgr_mod - - ! !DESCRIPTION: A module to create derived types to manage time and clock information - - ! !USES: - use ESMF, only : ESMF_Clock, ESMF_Alarm, ESMF_Calendar - use ESMF, only: operator(<), operator(/=), operator(+), operator(-), operator(*) , operator(>=) - use ESMF, only: operator(<=), operator(>), operator(==) - use med_constants_mod, only : CL, IN - use med_constants_mod, only : seq_timemgr_noleap => med_constants_noleap - use med_constants_mod, only: seq_timemgr_gregorian=>med_constants_gregorian - - implicit none - private ! default private - - ! MEMBER FUNCTIONS: - - ! --- Clock object methods -------------------------------------------------- - public :: seq_timemgr_clockInit ! Setup the sync clock - public :: seq_timemgr_EClockGetData ! Get data from an ESMF clock - public :: seq_timemgr_EClockDateInSync ! compare EClock to ymd/tod - public :: seq_timemgr_EclockPrint ! Print ESMF clock information - public :: seq_timemgr_alarmInit ! initialize an alarm - public :: seq_timemgr_alarmGet ! get info about alarm - public :: seq_timemgr_alarmSetOn ! Turn an alarm on - public :: seq_timemgr_alarmSetOff ! Turn an alarm off - public :: seq_timemgr_alarmIsOn ! Is an alarm ringing - public :: seq_timemgr_ETimeInit ! Create ESMF_Time object - public :: seq_timemgr_ETimeGet ! Query ESMF_Time object - - ! --- For usability, built on interfaces above --- - public :: seq_timemgr_restartAlarmIsOn ! Is a restart alarm ringing - public :: seq_timemgr_stopAlarmIsOn ! Is a stop alarm ringing - public :: seq_timemgr_historyAlarmIsOn ! Is a history alarm ringing - public :: seq_timemgr_pauseAlarmIsOn ! Is a pause alarm ringing - - ! --- ESP components need to know about the state of other components - public :: seq_timemgr_pause_active ! Pause/resume is enabled - public :: seq_timemgr_pause_component_index ! Index of named component - public :: seq_timemgr_pause_component_active ! .true. is comp should pause - - public :: seq_timemgr_clockPrint ! Print sync clock information - - private:: seq_timemgr_EClockInit - private:: seq_timemgr_ESMFDebug - - ! PARAMETERS: - - ! History output types - integer(IN) ,public :: seq_timemgr_histavg_type - integer(IN) ,public ,parameter :: seq_timemgr_type_other = -1 - integer(IN) ,public ,parameter :: seq_timemgr_type_never = 1 - integer(IN) ,public ,parameter :: seq_timemgr_type_nhour = 2 - integer(IN) ,public ,parameter :: seq_timemgr_type_nday = 3 - integer(IN) ,public ,parameter :: seq_timemgr_type_nmonth = 4 - integer(IN) ,public ,parameter :: seq_timemgr_type_nyear = 5 - - ! Clock and alarm options - character(len=*), private, parameter :: & - seq_timemgr_optNONE = "none" , & - seq_timemgr_optNever = "never" , & - seq_timemgr_optNSteps = "nsteps" , & - seq_timemgr_optNStep = "nstep" , & - seq_timemgr_optNSeconds = "nseconds" , & - seq_timemgr_optNSecond = "nsecond" , & - seq_timemgr_optNMinutes = "nminutes" , & - seq_timemgr_optNMinute = "nminute" , & - seq_timemgr_optNHours = "nhours" , & - seq_timemgr_optNHour = "nhour" , & - seq_timemgr_optNDays = "ndays" , & - seq_timemgr_optNDay = "nday" , & - seq_timemgr_optNMonths = "nmonths" , & - seq_timemgr_optNMonth = "nmonth" , & - seq_timemgr_optNYears = "nyears" , & - seq_timemgr_optNYear = "nyear" , & - seq_timemgr_optMonthly = "monthly" , & - seq_timemgr_optYearly = "yearly" , & - seq_timemgr_optDate = "date" , & - seq_timemgr_optIfdays0 = "ifdays0" , & - seq_timemgr_optEnd = "end" , & - seq_timemgr_optGLCCouplingPeriod = "glc_coupling_period" - - ! Clock numbers - integer(IN),private,parameter :: & - seq_timemgr_nclock_drv = 1, & - seq_timemgr_nclock_atm = 2, & - seq_timemgr_nclock_lnd = 3, & - seq_timemgr_nclock_ocn = 4, & - seq_timemgr_nclock_ice = 5, & - seq_timemgr_nclock_glc = 6, & - seq_timemgr_nclock_wav = 7, & - seq_timemgr_nclock_rof = 8, & - seq_timemgr_nclock_esp = 9, & - max_clocks = 9 - - ! Clock names - character(len=*), public,parameter :: & - seq_timemgr_clock_drv = 'seq_timemgr_clock_drv' , & - seq_timemgr_clock_atm = 'seq_timemgr_clock_atm' , & - seq_timemgr_clock_lnd = 'seq_timemgr_clock_lnd' , & - seq_timemgr_clock_ocn = 'seq_timemgr_clock_ocn' , & - seq_timemgr_clock_ice = 'seq_timemgr_clock_ice' , & - seq_timemgr_clock_glc = 'seq_timemgr_clock_glc' , & - seq_timemgr_clock_wav = 'seq_timemgr_clock_wav' , & - seq_timemgr_clock_rof = 'seq_timemgr_clock_rof' , & - seq_timemgr_clock_esp = 'seq_timemgr_clock_esp' - - ! Array of clock names - character(len=8), private,parameter :: seq_timemgr_clocks(max_clocks) = & - (/'drv ','atm ','lnd ','ocn ', & - 'ice ','glc ','wav ','rof ','esp '/) - - ! Alarm numbers - integer(IN), private,parameter :: & - seq_timemgr_nalarm_restart = 1 , & ! driver and component clock alarm - seq_timemgr_nalarm_stop = 2 , & ! driver and component clock alarm - seq_timemgr_nalarm_datestop = 3 , & ! driver and component clock alarm - seq_timemgr_nalarm_history = 4 , & ! driver and component clock alarm - seq_timemgr_nalarm_tprof = 5 , & ! driver and component clock alarm - seq_timemgr_nalarm_histavg = 6 , & ! driver and component clock alarm - seq_timemgr_nalarm_pause = 7 , & - seq_timemgr_nalarm_barrier = 8 , & ! driver and component clock alarm - max_alarms = seq_timemgr_nalarm_barrier - - ! Alarm names - character(len=*), public,parameter :: & - seq_timemgr_alarm_restart = 'seq_timemgr_alarm_restart ', & - seq_timemgr_alarm_stop = 'seq_timemgr_alarm_stop ', & - seq_timemgr_alarm_datestop = 'seq_timemgr_alarm_datestop', & - seq_timemgr_alarm_history = 'seq_timemgr_alarm_history ', & - seq_timemgr_alarm_tprof = 'seq_timemgr_alarm_tprof ', & - seq_timemgr_alarm_histavg = 'seq_timemgr_alarm_histavg ', & - seq_timemgr_alarm_pause = 'seq_timemgr_alarm_pause ', & - seq_timemgr_alarm_barrier = 'seq_timemgr_alarm_barrier ' - - ! Active pause - resume components - logical, private :: pause_active(max_clocks) = .false. - - ! TYPES: - - type EClock_pointer ! needed for array of pointers - type(ESMF_Clock),pointer :: EClock => null() - end type EClock_pointer - - public :: seq_timemgr_type ! Wrapped clock object - type seq_timemgr_type - private - type(EClock_pointer) :: ECP(max_clocks) ! ESMF clocks, array of pointers - type(ESMF_Alarm) :: EAlarm(max_clocks,max_alarms) ! array of clock alarms - end type seq_timemgr_type - - ! MODULE DATA - - type(seq_timemgr_type) :: SyncClock ! array of all clocks & alarm - type(ESMF_Calendar), target :: seq_timemgr_cal ! calendar - character(CL) :: seq_timemgr_calendar ! calendar string - integer, parameter :: SecPerDay = 86400 ! Seconds per day - integer :: seq_timemgr_pause_sig_index ! Index of pause comp with smallest dt - logical :: seq_timemgr_esp_run_on_pause ! Run ESP component on pause cycle - logical :: seq_timemgr_end_restart ! write restarts at end of run? - character(CL) :: tmpstr - integer :: dbrc - integer, parameter :: dbug_flag = 10 - character(len=*), parameter :: sp_str = 'str_undefined' - character(len=*), parameter :: u_FILE_u = __FILE__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine seq_timemgr_clockInit(driver, logunit, & - EClock_drv, EClock_atm, EClock_lnd, EClock_ocn, & - EClock_ice, Eclock_glc, Eclock_rof, EClock_wav, Eclock_esp, rc) - - ! !DESCRIPTION: Initializes clock - use med_constants_mod , only : CS, CL, IN - use NUOPC , only : NUOPC_CompAttributeGet - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_ClockSet, ESMF_CalendarCreate, ESMF_FAILURE - use ESMF , only : ESMF_Time, ESMF_TimeInterval, ESMF_CalKind_Flag, ESMF_VM, ESMF_VMGet - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LOGERR_PASSTHRU - use ESMF , only : ESMF_LogFoundError, ESMF_TimeIntervalSet, ESMF_AlarmGet - use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN, ESMF_CalKind_Flag - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_mpi_mod , only : shr_mpi_bcast - use shr_sys_mod , only : shr_sys_abort - use shr_cal_mod , only : shr_cal_calendarName - use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit - use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr, nf90_inq_varid, nf90_get_var, nf90_close - - ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_GridComp), intent(inout) :: driver - integer , intent(in) :: logunit - type(ESMF_clock),target, intent(in) :: EClock_drv ! drv clock - type(ESMF_clock),target, intent(in) :: EClock_atm ! atm clock - type(ESMF_clock),target, intent(in) :: EClock_lnd ! lnd clock - type(ESMF_clock),target, intent(in) :: EClock_ocn ! ocn clock - type(ESMF_clock),target, intent(in) :: EClock_ice ! ice clock - type(ESMF_clock),target, intent(in) :: EClock_glc ! glc clock - type(ESMF_clock),target, intent(in) :: EClock_rof ! rof clock - type(ESMF_clock),target, intent(in) :: EClock_wav ! wav clock - type(ESMF_clock),target, intent(in) :: EClock_esp ! esp clock - integer , intent(out) :: rc - - !----- local ----- - integer :: mpicom ! MPI communicator - logical :: mastertask - logical :: read_restart - character(CL) :: restart_file - character(CL) :: restart_pfile - character(CL) :: cvalue - type(ESMF_Time) :: StartTime ! Start time - type(ESMF_Time) :: RefTime ! Reference time - type(ESMF_Time) :: CurrTime ! Current time - type(ESMF_Time) :: StopTime1 ! Stop time - type(ESMF_Time) :: StopTime2 ! Stop time - type(ESMF_TimeInterval) :: TimeStep ! Clock time-step - type(ESMF_CalKind_Flag) :: esmf_caltype ! local esmf calendar - integer :: n, i ! index - logical :: found - integer :: iam, unitn - integer :: min_dt ! smallest time step - integer :: dtime(max_clocks) ! time-step to use - character(CS) :: calendar ! Calendar type - character(CS) :: stop_option ! Stop option units - integer(IN) :: stop_n ! Number until stop - integer(IN) :: stop_ymd ! Stop date (YYYYMMDD) - integer(IN) :: stop_tod ! Stop time-of-day - character(CS) :: restart_option ! Restart option units - integer(IN) :: restart_n ! Number until restart interval - integer(IN) :: restart_ymd ! Restart date (YYYYMMDD) - character(CS) :: pause_option ! Pause option units - integer(IN) :: pause_n ! Number between pause intervals - character(CS) :: pause_component_list ! Pause - resume components - character(CS) :: history_option ! History option units - integer(IN) :: history_n ! Number until history interval - integer(IN) :: history_ymd ! History date (YYYYMMDD) - character(CS) :: histavg_option ! Histavg option units - integer(IN) :: histavg_n ! Number until histavg interval - integer(IN) :: histavg_ymd ! Histavg date (YYYYMMDD) - character(CS) :: barrier_option ! Barrier option units - integer(IN) :: barrier_n ! Number until barrier interval - integer(IN) :: barrier_ymd ! Barrier date (YYYYMMDD) - character(CS) :: tprof_option ! tprof option units - integer(IN) :: tprof_n ! Number until tprof interval - integer(IN) :: tprof_ymd ! tprof date (YYYYMMDD) - integer(IN) :: start_ymd ! Start date (YYYYMMDD) - integer(IN) :: start_tod ! Start time of day (seconds) - integer(IN) :: curr_ymd ! Current ymd (YYYYMMDD) - integer(IN) :: curr_tod ! Current tod (seconds) - integer(IN) :: ref_ymd ! Reference date (YYYYMMDD) - integer(IN) :: ref_tod ! Reference time of day (seconds) - integer(IN) :: atm_cpl_dt ! Atmosphere coupling interval - integer(IN) :: lnd_cpl_dt ! Land coupling interval - integer(IN) :: ice_cpl_dt ! Sea-Ice coupling interval - integer(IN) :: ocn_cpl_dt ! Ocean coupling interval - integer(IN) :: glc_cpl_dt ! Glc coupling interval - integer(IN) :: rof_cpl_dt ! Runoff coupling interval - integer(IN) :: wav_cpl_dt ! Wav coupling interval - integer(IN) :: esp_cpl_dt ! Esp coupling interval - character(CS) :: glc_avg_period ! Glc avering coupling period - logical :: esp_run_on_pause ! Run ESP on pause cycle - logical :: end_restart ! Write restart at end of run - integer(IN) :: ierr ! Return code - integer(IN) :: status, ncid, varid ! netcdf stuff - type(ESMF_VM) :: vm - character(len=*), parameter :: F0A = "(2A,A)" - character(len=*), parameter :: F0I = "(2A,I10)" - character(len=*), parameter :: F0L = "(2A,L3)" - character(len=*), parameter :: subname = '(seq_timemgr_clockInit) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - endif - - call ESMF_GridCompGet(driver, vm=vm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, mpiCommunicator=mpicom, localPet=iam, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (iam == 0) then - mastertask=.true. - else - mastertask = .false. - end if - - call NUOPC_CompAttributeGet(driver, name='read_restart', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) read_restart - - !--------------------------------------------------------------------------- - ! Get clock config attributes - !--------------------------------------------------------------------------- - - call NUOPC_CompAttributeGet(driver, name="calendar", value=calendar, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompAttributeGet(driver, name="stop_option", value=stop_option, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompAttributeGet(driver, name="stop_n", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) stop_n - - call NUOPC_CompAttributeGet(driver, name="stop_ymd", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) stop_ymd - - call NUOPC_CompAttributeGet(driver, name="stop_tod", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) stop_tod - - call NUOPC_CompAttributeGet(driver, name="restart_option", value=restart_option, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompAttributeGet(driver, name="restart_n", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) restart_n - - call NUOPC_CompAttributeGet(driver, name="restart_ymd", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) restart_ymd - - call NUOPC_CompAttributeGet(driver, name="pause_option", value=pause_option, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompAttributeGet(driver, name="pause_n", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) pause_n - - ! TODO: currently this is not in namelist_definition_drv.xml - ! call NUOPC_CompAttributeGet(driver, name="pause_component_list", value=pause_component_list, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) call shr_sys_abort() - pause_component_list = ' ' - - call NUOPC_CompAttributeGet(driver, name="history_option", value=history_option, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompAttributeGet(driver, name="history_n", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) history_n - - call NUOPC_CompAttributeGet(driver, name="history_ymd", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) history_ymd - - call NUOPC_CompAttributeGet(driver, name="histavg_option", value=histavg_option, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompAttributeGet(driver, name="histavg_n", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) histavg_n - - call NUOPC_CompAttributeGet(driver, name="histavg_ymd", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) histavg_ymd - - call NUOPC_CompAttributeGet(driver, name="barrier_option", value=barrier_option, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompAttributeGet(driver, name="barrier_n", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) barrier_n - - call NUOPC_CompAttributeGet(driver, name="barrier_ymd", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) barrier_ymd - - call NUOPC_CompAttributeGet(driver, name="tprof_option", value=tprof_option, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompAttributeGet(driver, name="tprof_n", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) tprof_n - - call NUOPC_CompAttributeGet(driver, name="tprof_ymd", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) tprof_ymd - - call NUOPC_CompAttributeGet(driver, name="start_ymd", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) start_ymd - - call NUOPC_CompAttributeGet(driver, name="start_tod", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) start_tod - - call NUOPC_CompAttributeGet(driver, name="ref_ymd", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ref_ymd - - call NUOPC_CompAttributeGet(driver, name="ref_tod", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ref_tod - - ! These do not appear in namelist_definition_drv.xml and its not clear they should - ! call NUOPC_CompAttributeGet(driver, name="curr_ymd", value=cvalue, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) call shr_sys_abort() - ! read(cvalue,*) curr_ymd - curr_ymd = 0.0 - - ! call NUOPC_CompAttributeGet(driver, name="curr_tod", value=cvalue, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) call shr_sys_abort() - ! read(cvalue,*) curr_tod - curr_tod = 0.0 - - call NUOPC_CompAttributeGet(driver, name="atm_cpl_dt", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) atm_cpl_dt - - call NUOPC_CompAttributeGet(driver, name="lnd_cpl_dt", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) lnd_cpl_dt - - call NUOPC_CompAttributeGet(driver, name="ice_cpl_dt", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ice_cpl_dt - - call NUOPC_CompAttributeGet(driver, name="ocn_cpl_dt", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) ocn_cpl_dt - - call NUOPC_CompAttributeGet(driver, name="glc_cpl_dt", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_cpl_dt - - call NUOPC_CompAttributeGet(driver, name="rof_cpl_dt", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) rof_cpl_dt - - call NUOPC_CompAttributeGet(driver, name="wav_cpl_dt", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) wav_cpl_dt - - ! TODO: for now - this is not in the namelist_definition_drv.xml file - ! call NUOPC_CompAttributeGet(driver, name="esp_cpl_dt", value=cvalue, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) call shr_sys_abort() - ! read(cvalue,*) esp_cpl_dt - esp_cpl_dt = 0. - - call NUOPC_CompAttributeGet(driver, name="glc_avg_period", value=glc_avg_period, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_avg_period - - call NUOPC_CompAttributeGet(driver, name="esp_run_on_pause", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) esp_run_on_pause - - call NUOPC_CompAttributeGet(driver, name="end_restart", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) end_restart - - if (read_restart) then - if (iam == 0) then - call NUOPC_CompAttributeGet(driver, name='driver_restart_file', value=restart_file, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - !--- read rpointer if restart_file is set to sp_str --- - if (trim(restart_file) == trim(sp_str)) then - - ! Error check on restart_pfile - call NUOPC_CompAttributeGet(driver, name="driver_restart_pfile", value=restart_pfile, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if ( len_trim(restart_pfile) == 0 ) then - rc = ESMF_FAILURE - call ESMF_LogWrite(trim(subname)//' ERROR driver_restart_pfile must be defined', & - ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=dbrc) - return - end if - - unitn = shr_file_getUnit() - call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & - ESMF_LOGMSG_INFO, rc=dbrc) - open(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_INFO, line=__LINE__, file=__FILE__, rc=dbrc) - 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__, rc=dbrc) - return - end if - close(unitn) - call shr_file_freeUnit( unitn ) - call ESMF_LogWrite(trim(subname)//" read driver restart from file = "//trim(restart_file), & - ESMF_LOGMSG_INFO, rc=dbrc) - endif - - ! tcraig, use netcdf here since it's serial and pio may not have been initialized yet - status = nf90_open(restart_file, NF90_NOWRITE, ncid) - if (status /= nf90_NoErr) call shr_sys_abort(trim(subname)//' ERROR: nf90_open') - status = nf90_inq_varid(ncid, 'start_ymd', varid) - if (status /= nf90_NoErr) call shr_sys_abort(trim(subname)//' ERROR: nf90_inq_varid start_ymd') - status = nf90_get_var(ncid, varid, start_ymd) - if (status /= nf90_NoErr) call shr_sys_abort(trim(subname)//' ERROR: nf90_get_var start_ymd') - status = nf90_inq_varid(ncid, 'start_tod', varid) - if (status /= nf90_NoErr) call shr_sys_abort(trim(subname)//' ERROR: nf90_inq_varid start_tod') - status = nf90_get_var(ncid, varid, start_tod) - if (status /= nf90_NoErr) call shr_sys_abort(trim(subname)//' ERROR: nf90_get_var start_tod') - status = nf90_inq_varid(ncid, 'ref_ymd', varid) - if (status /= nf90_NoErr) call shr_sys_abort(trim(subname)//' ERROR: nf90_inq_varid ref_ymd') - status = nf90_get_var(ncid, varid, ref_ymd) - if (status /= nf90_NoErr) call shr_sys_abort(trim(subname)//' ERROR: nf90_get_var ref_ymd') - status = nf90_inq_varid(ncid, 'ref_tod', varid) - if (status /= nf90_NoErr) call shr_sys_abort(trim(subname)//' ERROR: nf90_inq_varid ref_tod') - status = nf90_get_var(ncid, varid, ref_tod) - if (status /= nf90_NoErr) call shr_sys_abort(trim(subname)//' ERROR: nf90_get_var ref_tod') - status = nf90_inq_varid(ncid, 'curr_ymd', varid) - if (status /= nf90_NoErr) call shr_sys_abort(trim(subname)//' ERROR: nf90_inq_varid curr_ymd') - status = nf90_get_var(ncid, varid, curr_ymd) - if (status /= nf90_NoErr) call shr_sys_abort(trim(subname)//' ERROR: nf90_get_var curr_ymd') - status = nf90_inq_varid(ncid, 'curr_tod', varid) - if (status /= nf90_NoErr) call shr_sys_abort(trim(subname)//' ERROR: nf90_inq_varid curr_tod') - status = nf90_get_var(ncid, varid, curr_tod) - if (status /= nf90_NoErr) call shr_sys_abort(trim(subname)//' ERROR: nf90_get_var curr_tod') - status = nf90_close(ncid) - if (status /= nf90_NoErr) call shr_sys_abort(trim(subname)//' ERROR: nf90_close') - - write(tmpstr,*) trim(subname)//" read start_ymd = ",start_ymd - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - write(tmpstr,*) trim(subname)//" read start_tod = ",start_tod - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - write(tmpstr,*) trim(subname)//" read ref_ymd = ",ref_ymd - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - write(tmpstr,*) trim(subname)//" read ref_tod = ",ref_tod - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - write(tmpstr,*) trim(subname)//" read curr_ymd = ",curr_ymd - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - write(tmpstr,*) trim(subname)//" read curr_tod = ",curr_tod - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - endif - - call shr_mpi_bcast(start_ymd, mpicom) - call shr_mpi_bcast(start_tod, mpicom) - call shr_mpi_bcast( ref_ymd, mpicom) - call shr_mpi_bcast( ref_tod, mpicom) - call shr_mpi_bcast( curr_ymd, mpicom) - call shr_mpi_bcast( curr_tod, mpicom) - - endif - - !--------------------------------------------------------------------------- - ! Modify input config data as needed - !--------------------------------------------------------------------------- - - if (lnd_cpl_dt == 0) lnd_cpl_dt = atm_cpl_dt ! Copy atm coupling time into lnd - if (rof_cpl_dt == 0) rof_cpl_dt = atm_cpl_dt ! Copy atm coupling time into rof - if (ice_cpl_dt == 0) ice_cpl_dt = atm_cpl_dt ! Copy atm coupling time into ice - if (ocn_cpl_dt == 0) ocn_cpl_dt = atm_cpl_dt ! Copy atm coupling time into ocn - if (glc_cpl_dt == 0) glc_cpl_dt = atm_cpl_dt ! Copy atm coupling time into glc - if (wav_cpl_dt == 0) wav_cpl_dt = atm_cpl_dt ! Copy atm coupling time into wav - if (esp_cpl_dt == 0) esp_cpl_dt = atm_cpl_dt ! Copy atm coupling time into esp - - if ( ref_ymd == 0 ) then - ref_ymd = start_ymd - ref_tod = start_tod - endif - if ( curr_ymd == 0 ) then - curr_ymd = start_ymd - curr_tod = start_tod - endif - if ( stop_ymd < 0) then - stop_ymd = 99990101 - stop_tod = 0 - endif - if (trim(restart_option) == trim(seq_timemgr_optNone) .or. & - trim(restart_option) == trim(seq_timemgr_optNever)) then - if (end_restart) then - end_restart = .false. - write(logunit,F0A) trim(subname),' WARNING: overriding end_restart to '// & - 'false based on restart_option ' - endif - endif - if (trim(restart_option) == trim(seq_timemgr_optEnd)) then - restart_option = seq_timemgr_optNone - write(logunit,F0A) trim(subname),' WARNING: overriding restart_option to '// & - 'none and verifying end_restart flag is true ' - if (.not. end_restart) then - end_restart = .true. - write(logunit,F0A) trim(subname),' WARNING: overriding end_restart to '// & - 'true based on restart_option (end) ' - endif - endif - - !--------------------------------------------------------------------------- - ! Print out the namelist settings - !--------------------------------------------------------------------------- - - if (mastertask) then - write(logunit,F0A) ' ' - write(logunit,F0A) trim(subname),' Clock Init Settings:' - write(logunit,F0A) trim(subname),' calendar = ',trim(calendar) - write(logunit,F0A) trim(subname),' stop_option = ',trim(stop_option) - write(logunit,F0I) trim(subname),' stop_n = ',stop_n - write(logunit,F0I) trim(subname),' stop_ymd = ',stop_ymd - write(logunit,F0I) trim(subname),' stop_tod = ',stop_tod - write(logunit,F0A) trim(subname),' restart_option = ',trim(restart_option) - write(logunit,F0I) trim(subname),' restart_n = ',restart_n - write(logunit,F0I) trim(subname),' restart_ymd = ',restart_ymd - write(logunit,F0L) trim(subname),' end_restart = ',end_restart - write(logunit,F0A) trim(subname),' pause_option = ',trim(pause_option) - write(logunit,F0I) trim(subname),' pause_n = ',pause_n - write(logunit,F0A) trim(subname),' pause_component_list = ',trim(pause_component_list) - write(logunit,F0L) trim(subname),' esp_run_on_pause = ',esp_run_on_pause - write(logunit,F0A) trim(subname),' history_option = ',trim(history_option) - write(logunit,F0I) trim(subname),' history_n = ',history_n - write(logunit,F0I) trim(subname),' history_ymd = ',history_ymd - write(logunit,F0A) trim(subname),' histavg_option = ',trim(histavg_option) - write(logunit,F0I) trim(subname),' histavg_n = ',histavg_n - write(logunit,F0I) trim(subname),' histavg_ymd = ',histavg_ymd - write(logunit,F0A) trim(subname),' barrier_option = ',trim(barrier_option) - write(logunit,F0I) trim(subname),' barrier_n = ',barrier_n - write(logunit,F0I) trim(subname),' barrier_ymd = ',barrier_ymd - write(logunit,F0A) trim(subname),' tprof_option = ',trim(tprof_option) - write(logunit,F0I) trim(subname),' tprof_n = ',tprof_n - write(logunit,F0I) trim(subname),' tprof_ymd = ',tprof_ymd - write(logunit,F0I) trim(subname),' start_ymd = ',start_ymd - write(logunit,F0I) trim(subname),' start_tod = ',start_tod - write(logunit,F0I) trim(subname),' ref_ymd = ',ref_ymd - write(logunit,F0I) trim(subname),' ref_tod = ',ref_tod - write(logunit,F0I) trim(subname),' atm_cpl_dt = ',atm_cpl_dt - write(logunit,F0I) trim(subname),' lnd_cpl_dt = ',lnd_cpl_dt - write(logunit,F0I) trim(subname),' ice_cpl_dt = ',ice_cpl_dt - write(logunit,F0I) trim(subname),' ocn_cpl_dt = ',ocn_cpl_dt - write(logunit,F0I) trim(subname),' glc_cpl_dt = ',glc_cpl_dt - write(logunit,F0A) trim(subname),' glc_avg_period = ',glc_avg_period - write(logunit,F0I) trim(subname),' rof_cpl_dt = ',rof_cpl_dt - write(logunit,F0I) trim(subname),' wav_cpl_dt = ',wav_cpl_dt - write(logunit,F0I) trim(subname),' esp_cpl_dt = ',esp_cpl_dt - write(logunit,F0A) ' ' - - ! check couling intervals - if ( atm_cpl_dt <= 0 .or. & - lnd_cpl_dt /= atm_cpl_dt .or. & - ice_cpl_dt /= atm_cpl_dt .or. & - ocn_cpl_dt <= 0 .or. & - glc_cpl_dt <= 0 .or. & - rof_cpl_dt <=0 .or. & - wav_cpl_dt <=0 .or. & - esp_cpl_dt <=0) then - - write(logunit,*) trim(subname),' ERROR: aliogrwe _cpl_dt = ', & - atm_cpl_dt, lnd_cpl_dt, ice_cpl_dt, ocn_cpl_dt, glc_cpl_dt, & - rof_cpl_dt, wav_cpl_dt, esp_cpl_dt - - call shr_sys_abort( subname//': ERROR coupling intervals invalid' ) - end if - - ! check start time date - if ( (start_ymd < 101) .or. (start_ymd > 99991231)) then - write(logunit,*) subname,' ERROR: illegal start_ymd',start_ymd - call shr_sys_abort( subname//': ERROR invalid start_ymd') - end if - - endif - - ! set module variable seq_timemgr_histavg_type - if (trim(histavg_option) == trim(seq_timemgr_optNever) .or. & - trim(histavg_option) == trim(seq_timemgr_optNone)) then - - seq_timemgr_histavg_type = seq_timemgr_type_never - - elseif (trim(histavg_option) == trim(seq_timemgr_optNHours) .or. & - trim(histavg_option) == trim(seq_timemgr_optNHour)) then - - seq_timemgr_histavg_type = seq_timemgr_type_nhour - - elseif (trim(histavg_option) == trim(seq_timemgr_optNDays) .or. & - trim(histavg_option) == trim(seq_timemgr_optNDay)) then - - seq_timemgr_histavg_type = seq_timemgr_type_nday - - elseif (trim(histavg_option) == trim(seq_timemgr_optNMonths) .or. & - trim(histavg_option) == trim(seq_timemgr_optNMonth) .or. & - trim(histavg_option) == trim(seq_timemgr_optMonthly)) then - - seq_timemgr_histavg_type = seq_timemgr_type_nmonth - - elseif (trim(histavg_option) == trim(seq_timemgr_optNYears) .or. & - trim(histavg_option) == trim(seq_timemgr_optNYear) .or. & - trim(histavg_option) == trim(seq_timemgr_optYearly)) then - - seq_timemgr_histavg_type = seq_timemgr_type_nyear - - else - - seq_timemgr_histavg_type = seq_timemgr_type_other - - endif - - ! --- Initialize generic stuff --- - seq_timemgr_calendar = shr_cal_calendarName(calendar) - seq_timemgr_esp_run_on_pause = esp_run_on_pause - seq_timemgr_end_restart = end_restart - - ! --- Figure out which components (if any) are doing pause this run - rc = 1 - i = 1 - if (trim(pause_component_list) == 'all') then - pause_active = .true. - else if (trim(pause_component_list) == 'none') then - pause_active = .false. - else - do - i = scan(trim(pause_component_list(rc:)), ':') - 1 - if ((i < 0) .and. (len_trim(pause_component_list) >= rc)) then - i = len_trim(pause_component_list(rc:)) - end if - if (i > 0) then - found = .false. - do n = 1, max_clocks - if (pause_component_list(rc:rc+i-1) == trim(seq_timemgr_clocks(n))) then - pause_active(n) = .true. - found = .true. - exit - end if - end do - ! Special case for cpl -- synonym for drv - if ((.not. found) .and. (pause_component_list(rc:rc+i-1) == 'cpl')) then - pause_active(seq_timemgr_nclock_drv) = .true. - found = .true. - end if - if (.not. found) then - call shr_sys_abort(subname//': unknown pause component, '//pause_component_list(rc:rc+i-1)) - end if - rc = rc + i - if (pause_component_list(rc:rc) == ':') then - rc = rc + 1 - end if - if (rc >= len_trim(pause_component_list)) then - exit - end if - else - exit - end if - end do - end if - if ( ANY(pause_active) .and. & - (trim(pause_option) /= seq_timemgr_optNONE) .and. & - (trim(pause_option) /= seq_timemgr_optNever)) then - do n = 1, max_clocks - if (pause_active(n)) then - write(logunit, '(4a)') subname, ': Pause active for ', & - trim(seq_timemgr_clocks(n)),' component' - end if - end do - end if - - ! --- Create the new calendar if not already set ------ - if ( trim(seq_timemgr_calendar) == trim(seq_timemgr_noleap)) then - esmf_caltype = ESMF_CALKIND_NOLEAP - else if ( trim(seq_timemgr_calendar) == trim(seq_timemgr_gregorian)) then - esmf_caltype = ESMF_CALKIND_GREGORIAN - else - write(logunit,*) subname//': unrecognized ESMF calendar specified: '// & - trim(seq_timemgr_calendar) - call shr_sys_abort( subname//'ERROR:: bad calendar for ESMF' ) - end if - - seq_timemgr_cal = ESMF_CalendarCreate( name='CMEPS_'//seq_timemgr_calendar, calkindflag=esmf_caltype, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - ! --- Initialize start, ref, and current date --- - - call seq_timemgr_ETimeInit( StartTime, start_ymd, start_tod, "Start date" ) - call seq_timemgr_ETimeInit( RefTime , ref_ymd , ref_tod , "Reference date" ) - call seq_timemgr_ETimeInit( CurrTime , curr_ymd , curr_tod , "Current date") - - ! --- Figure out what time-stepping interval should be. --------------- - - dtime = 0 - dtime(seq_timemgr_nclock_atm ) = atm_cpl_dt - dtime(seq_timemgr_nclock_lnd ) = lnd_cpl_dt - dtime(seq_timemgr_nclock_ocn ) = ocn_cpl_dt - dtime(seq_timemgr_nclock_ice ) = ice_cpl_dt - dtime(seq_timemgr_nclock_glc ) = glc_cpl_dt - dtime(seq_timemgr_nclock_rof ) = rof_cpl_dt - dtime(seq_timemgr_nclock_wav ) = wav_cpl_dt - dtime(seq_timemgr_nclock_esp ) = esp_cpl_dt - - ! --- this finds the min of dtime excluding the driver value --- - dtime(seq_timemgr_nclock_drv) = maxval(dtime) - dtime(seq_timemgr_nclock_drv) = minval(dtime) - - ! --- For figuring pause cycle - min_dt = maxval(dtime) - seq_timemgr_pause_sig_index = -1 - - do n = 1,max_clocks - if ( mod(dtime(n),dtime(seq_timemgr_nclock_drv)) /= 0) then - write(logunit,*) trim(subname),' ERROR: dtime inconsistent = ',dtime - call shr_sys_abort( subname//' :coupling intervals not compatible' ) - endif - if (pause_active(n) .and. (dtime(n) < min_dt)) then - min_dt = dtime(n) - seq_timemgr_pause_sig_index = n - end if - enddo - if (ANY(pause_active)) then - if (seq_timemgr_pause_sig_index < 1) then - write(logunit, *) subname,"ERROR: No pause_sig_index even with active pause" - call shr_sys_abort(subname//"ERROR: No pause_sig_index even with active pause") - end if - else - ! Don't try to run ESP on non-existent pauses - seq_timemgr_esp_run_on_pause = .false. - end if - - ! --- Initialize component and driver clocks and alarms common to components and driver clocks --- - SyncClock%ECP(seq_timemgr_nclock_drv)%EClock => EClock_drv - SyncClock%ECP(seq_timemgr_nclock_atm)%EClock => EClock_atm - SyncClock%ECP(seq_timemgr_nclock_lnd)%EClock => EClock_lnd - SyncClock%ECP(seq_timemgr_nclock_ocn)%EClock => EClock_ocn - SyncClock%ECP(seq_timemgr_nclock_ice)%EClock => EClock_ice - SyncClock%ECP(seq_timemgr_nclock_glc)%EClock => EClock_glc - SyncClock%ECP(seq_timemgr_nclock_rof)%EClock => EClock_rof - SyncClock%ECP(seq_timemgr_nclock_wav)%EClock => EClock_wav - SyncClock%ECP(seq_timemgr_nclock_esp)%EClock => EClock_esp - - do n = 1,max_clocks - call ESMF_TimeIntervalSet( TimeStep, s=dtime(n), rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call seq_timemgr_EClockInit( TimeStep, StartTime, RefTime, CurrTime, SyncClock%ECP(n)%EClock) - - call seq_timemgr_alarmInit(SyncClock%ECP(n)%EClock, & - EAlarm = SyncClock%EAlarm(n,seq_timemgr_nalarm_stop), & - option = stop_option, & - opt_n = stop_n, & - opt_ymd = stop_ymd, & - opt_tod = stop_tod, & - RefTime = CurrTime, & - alarmname = trim(seq_timemgr_alarm_stop), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call seq_timemgr_alarmInit(SyncClock%ECP(n)%EClock, & - EAlarm = SyncClock%EAlarm(n,seq_timemgr_nalarm_datestop), & - option = seq_timemgr_optDate, & - opt_ymd = stop_ymd, & - opt_tod = stop_tod, & - RefTime = StartTime, & - alarmname = trim(seq_timemgr_alarm_datestop), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call seq_timemgr_alarmInit(SyncClock%ECP(n)%EClock, & - EAlarm = SyncClock%EAlarm(n,seq_timemgr_nalarm_restart), & - option = restart_option, & - opt_n = restart_n, & - opt_ymd = restart_ymd, & - RefTime = CurrTime, & - alarmname = trim(seq_timemgr_alarm_restart), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call seq_timemgr_alarmInit(SyncClock%ECP(n)%EClock, & - EAlarm = SyncClock%EAlarm(n,seq_timemgr_nalarm_history), & - option = history_option, & - opt_n = history_n, & - opt_ymd = history_ymd, & - RefTime = StartTime, & - alarmname = trim(seq_timemgr_alarm_history), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call seq_timemgr_alarmInit(SyncClock%ECP(n)%EClock, & - EAlarm = SyncClock%EAlarm(n,seq_timemgr_nalarm_histavg), & - option = histavg_option, & - opt_n = histavg_n, & - opt_ymd = histavg_ymd, & - RefTime = StartTime, & - alarmname = trim(seq_timemgr_alarm_histavg), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call seq_timemgr_alarmInit(SyncClock%ECP(n)%EClock, & - EAlarm = SyncClock%EAlarm(n,seq_timemgr_nalarm_barrier), & - option = barrier_option, & - opt_n = barrier_n, & - opt_ymd = barrier_ymd, & - RefTime = CurrTime, & - alarmname = trim(seq_timemgr_alarm_barrier), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call seq_timemgr_alarmInit(SyncClock%ECP(n)%EClock, & - EAlarm = SyncClock%EAlarm(n,seq_timemgr_nalarm_tprof), & - option = tprof_option, & - opt_n = tprof_n, & - opt_ymd = tprof_ymd, & - RefTime = StartTime, & - alarmname = trim(seq_timemgr_alarm_tprof), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_AlarmGet(SyncClock%EAlarm(n,seq_timemgr_nalarm_stop), RingTime=StopTime1, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_AlarmGet(SyncClock%EAlarm(n,seq_timemgr_nalarm_datestop), RingTime=StopTime2, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (StopTime2 < StopTime1) then - call ESMF_ClockSet(SyncClock%ECP(n)%EClock, StopTime=StopTime2, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - else - call ESMF_ClockSet(SyncClock%ECP(n)%EClock, StopTime=StopTime1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - - ! Set the pause option if pause/resume is active - if (pause_active(n)) then - call seq_timemgr_alarmInit(SyncClock%ECP(n)%EClock, & - EAlarm = SyncClock%EAlarm(n,seq_timemgr_nalarm_pause), & - option = pause_option, & - opt_n = pause_n, & - RefTime = CurrTime, & - alarmname = trim(seq_timemgr_alarm_pause), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - else - call seq_timemgr_alarmInit(SyncClock%ECP(n)%EClock, & - EAlarm = SyncClock%EAlarm(n,seq_timemgr_nalarm_pause), & - option = seq_timemgr_optNever, & - opt_n = -1, & - RefTime = StartTime, & - alarmname = trim(seq_timemgr_alarm_pause), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - - enddo - - if (mastertask) then - call seq_timemgr_clockPrint(SyncClock) - endif - - end subroutine seq_timemgr_clockInit - - !=============================================================================== - - subroutine seq_timemgr_EClockGetData( EClock, & - curr_yr, curr_mon, curr_day, & - curr_ymd, curr_tod, prev_ymd, prev_tod, start_ymd, & - start_tod, StepNo, ref_ymd, ref_tod, & - stop_ymd, stop_tod, dtime, ECurrTime, alarmcount, & - curr_cday, next_cday, curr_time, prev_time, calendar) - - ! !DESCRIPTION: Get various values from the clock. - use ESMF, only: ESMF_Clock, ESMF_Time, ESMF_TimeInterval - use ESMF, only: ESMF_ClockGet, ESMF_TimeGet, ESMF_TimeIntervalGet - use ESMF, only: ESMF_TimeSet, ESMF_TimeIntervalSet - use med_constants_mod, only : IN, R8, I8 - use shr_nuopc_methods_mod, only : shr_nuopc_methods_ChkErr - - ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_Clock) , intent(in) :: EClock ! Input clock object - integer(IN) , intent(out), optional :: curr_yr ! Current year - integer(IN) , intent(out), optional :: curr_mon ! Current month - integer(IN) , intent(out), optional :: curr_day ! Current day in month - integer(IN) , intent(out), optional :: curr_ymd ! Current date YYYYMMDD - integer(IN) , intent(out), optional :: curr_tod ! Current time of day (s) - integer(IN) , intent(out), optional :: prev_ymd ! Previous date YYYYMMDD - integer(IN) , intent(out), optional :: prev_tod ! Previous time of day (s) - integer(IN) , intent(out), optional :: start_ymd ! Starting date YYYYMMDD - integer(IN) , intent(out), optional :: start_tod ! Starting time-of-day (s) - integer(IN) , intent(out), optional :: StepNo ! Number of steps taken - integer(IN) , intent(out), optional :: ref_ymd ! Reference date YYYYMMDD - integer(IN) , intent(out), optional :: ref_tod ! Reference time-of-day (s) - integer(IN) , intent(out), optional :: stop_ymd ! Stop date YYYYMMDD - integer(IN) , intent(out), optional :: stop_tod ! Stop time-of-day (s) - integer(IN) , intent(out), optional :: dtime ! Time-step (seconds) - integer(IN) , intent(out), optional :: alarmcount ! Number of Valid Alarms - type(ESMF_Time) , intent(out), optional :: ECurrTime ! Current ESMF time - real(R8) , intent(out), optional :: curr_cday ! current calendar day - real(R8) , intent(out), optional :: next_cday ! current calendar day - real(R8) , intent(out), optional :: curr_time ! time interval between current time and reference date - real(R8) , intent(out), optional :: prev_time ! time interval between previous time and reference date - character(len=*) , intent(out), optional :: calendar ! calendar type - - !----- local ----- - type(ESMF_Time) :: CurrentTime ! Current time - type(ESMF_Time) :: PreviousTime ! Previous time - type(ESMF_Time) :: StartTime ! Start time - type(ESMF_Time) :: StopTime ! Stop time - type(ESMF_Time) :: RefTime ! Ref time - type(ESMF_TimeInterval) :: timeStep ! Clock, time-step - type(ESMF_TimeInterval) :: timediff ! Used to calculate curr_time - integer(IN) :: rc ! Return code - integer(I8) :: advSteps ! Number of time-steps that have advanced - integer(IN) :: yy, mm, dd, sec ! Return time values - integer(IN) :: ymd ! Date (YYYYMMDD) - integer(IN) :: tod ! time of day (sec) - integer(IN) :: ldtime ! local dtime - integer(IN) :: days ! number of whole days in time interval - integer(IN) :: seconds ! number of seconds in time interval - integer(IN) :: acount ! number of valid alarms - real(R8) :: doy, tmpdoy ! day of year - type(ESMF_Time) :: tmpTime ! tmp time, needed for next_cday - type(ESMF_TimeInterval) :: tmpDTime ! tmp time interval, needed for next_cday - real(R8), parameter :: c1 = 1.0_R8 - character(len=*) , parameter :: subname = '(seq_timemgr_EClockGetData) ' - !------------------------------------------------------------------------------- - - if (present(calendar)) calendar = trim(seq_timemgr_calendar) - - call ESMF_ClockGet( EClock, currTime=CurrentTime, & - advanceCount=advSteps, prevTime=previousTime, TimeStep=timeStep, & - startTime=StartTime, stopTime=stopTime, refTime=RefTime, & - AlarmCount=acount, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_TimeGet( CurrentTime, yy=yy, mm=mm, dd=dd, s=sec, dayofyear_r8=doy, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call seq_timemgr_ETimeGet( CurrentTime, ymd=ymd, tod=tod ) - call ESMF_TimeIntervalGet( timeStep, s=ldtime, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if ( present(curr_yr) ) curr_yr = yy - if ( present(curr_mon) ) curr_mon = mm - if ( present(curr_day) ) curr_day = dd - if ( present(curr_tod) ) curr_tod = tod - if ( present(curr_ymd) ) curr_ymd = ymd - if ( present(ECurrTime)) ECurrTime= CurrentTime - if ( present(StepNo) ) StepNo = advSteps - if ( present(dtime) ) dtime = ldtime - if ( present(curr_cday)) curr_cday = doy - if ( present(alarmcount)) alarmcount = acount - - if ( present(next_cday)) then - call ESMF_TimeSet(tmpTime, yy=yy, mm=mm, dd=dd, s=tod, calendar=seq_timemgr_cal, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalSet( tmpDTime, d=1, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - tmpTime = tmpTime + tmpDTime - call ESMF_TimeGet(tmpTime, dayOfYear_r8=tmpdoy, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - next_cday = tmpdoy - endif - - ! ---Current Time (the time interval between the current date and the reference date) --- - if ( present(curr_time)) then - timediff = CurrentTime - RefTime - call ESMF_TimeIntervalGet(timediff, d=days, s=seconds, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - curr_time = days + seconds/real(SecPerDay,R8) - end if - - ! ---Previous Time (the time interval between the previous date and the reference date) --- - if ( present(prev_time)) then - timediff = PreviousTime - RefTime - call ESMF_TimeIntervalGet(timediff, d=days, s=seconds, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - prev_time = days + seconds/real(SecPerDay,R8) - end if - - ! --- Previous time -------------------------------------------------------- - if ( present(prev_ymd) .or. present(prev_tod) )then - call seq_timemgr_ETimeGet( PreviousTime, ymd=ymd, tod=tod ) - if ( present(prev_ymd) ) prev_ymd = ymd - if ( present(prev_tod) ) prev_tod = tod - end if - - ! --- If want start date ----------------------------------------------- - if ( present(start_ymd) .or. present(start_tod) )then - call seq_timemgr_ETimeGet( StartTime, ymd=ymd, tod=tod ) - if ( present(start_ymd) ) start_ymd = ymd - if ( present(start_tod) ) start_tod = tod - end if - - ! --- If want stop date ----------------------------------------------- - if ( present(stop_ymd) .or. present(stop_tod) )then - call seq_timemgr_ETimeGet( stopTime, ymd=ymd, tod=tod ) - if ( present(stop_ymd) ) stop_ymd = ymd - if ( present(stop_tod) ) stop_tod = tod - end if - - ! --- If want ref date ----------------------------------------------- - if ( present(ref_ymd) .or. present(ref_tod) )then - call seq_timemgr_ETimeGet( RefTime, ymd=ymd, tod=tod ) - if ( present(ref_ymd) ) ref_ymd = ymd - if ( present(ref_tod) ) ref_tod = tod - end if - - end subroutine seq_timemgr_EClockGetData - - !=============================================================================== - - subroutine seq_timemgr_alarmInit( EClock, EAlarm, option, opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) - - ! !DESCRIPTION: Setup an alarm in a clock - use shr_sys_mod, only : shr_sys_abort - use ESMF, only : ESMF_Clock, ESMF_Alarm, ESMF_ClockGet, ESMF_Time, ESMF_TimeGet - use ESMF, only : ESMF_TimeIntervalSet, ESMF_TimeSet, ESMF_TimeInterval - use ESMF, only: ESMF_AlarmCreate - use shr_nuopc_methods_mod, only : shr_nuopc_methods_ChkErr - - ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_Clock) , intent(INOUT) :: EClock ! clock - type(ESMF_Alarm) , intent(INOUT) :: EAlarm ! alarm - character(len=*) , intent(in) :: option ! alarm option - integer(IN) ,optional , intent(in) :: opt_n ! alarm freq - integer(IN) ,optional , intent(in) :: opt_ymd ! alarm ymd - integer(IN) ,optional , intent(in) :: opt_tod ! alarm tod (sec) - type(ESMF_Time) ,optional , intent(in) :: RefTime ! ref time - character(len=*) ,optional , intent(in) :: alarmname ! alarm name - integer , intent(INOUT) :: rc ! Return code - - !----- local ----- - integer :: lymd ! local ymd - integer :: ltod ! local tod - integer :: cyy,cmm,cdd,csec ! time info - integer :: nyy,nmm,ndd,nsec ! time info - character(len=64) :: lalarmname ! local alarm name - logical :: update_nextalarm ! update next alarm - type(ESMF_Time) :: CurrTime ! Current Time - type(ESMF_Time) :: NextAlarm ! Next restart alarm time - type(ESMF_TimeInterval) :: AlarmInterval ! Alarm interval - character(len=*), parameter :: subname = '(seq_timemgr_alarmInit): ' - !------------------------------------------------------------------------------- - ! Notes: The ringtime sent to AlarmCreate MUST be the next alarm time. - ! If you send an arbitrary but proper ringtime from the past and the ring interval, - ! the alarm will always go off on the next clock advance and this will cause serious problems. - ! Even if it makes sense to initialize an alarm with some reference time and the alarm interval, - ! that reference time has to be advance forward to be >= the current time. In the logic below - ! we set an appropriate "NextAlarm" and then we make sure to advance it properly based on the - ! ring interval. - !------------------------------------------------------------------------------- - - lalarmname = 'alarm_unknown' - if (present(alarmname)) then - lalarmname = trim(alarmname) - endif - - ltod = 0 - if (present(opt_tod)) then - ltod = opt_tod - endif - - lymd = -1 - if (present(opt_ymd)) then - lymd = opt_ymd - endif - - call ESMF_ClockGet(EClock, CurrTime=CurrTime, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(CurrTime, yy=nyy, mm=nmm, dd=ndd, s=nsec, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - ! --- initial guess of next alarm, this will be updated below --- - if (present(RefTime)) then - NextAlarm = RefTime - else - NextAlarm = CurrTime - endif - - update_nextalarm = .true. - - selectcase (trim(option)) - - case (seq_timemgr_optNONE) - !--- tcx seems we need an alarm interval or the alarm create fails, - !--- problem in esmf_wrf_timemgr? - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=seq_timemgr_cal, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (seq_timemgr_optNever) - !--- tcx seems we need an alarm interval or the alarm create fails, - !--- problem in esmf_wrf_timemgr? - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=seq_timemgr_cal, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (seq_timemgr_optDate) - !--- tcx seems we need an alarm interval or the alarm create fails, - !--- problem in esmf_wrf_timemgr? - if (.not. present(opt_ymd)) call shr_sys_abort(subname//trim(option)//' requires opt_ymd') - if (lymd < 0 .or. ltod < 0) call shr_sys_abort(subname//trim(option)//'opt_ymd, opt_tod invalid') - call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call seq_timemgr_ETimeInit(NextAlarm, lymd, ltod, "optDate") - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - update_nextalarm = .false. - - case (seq_timemgr_optIfdays0) - if (.not. present(opt_ymd)) call shr_sys_abort(subname//trim(option)//' requires opt_ymd') - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=seq_timemgr_cal, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case (seq_timemgr_optNSteps) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_ClockGet(EClock, TimeStep=AlarmInterval, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - - case (seq_timemgr_optNStep) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_ClockGet(EClock, TimeStep=AlarmInterval, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - - case (seq_timemgr_optNSeconds) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - - case (seq_timemgr_optNSecond) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - - case (seq_timemgr_optNMinutes) - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - AlarmInterval = AlarmInterval * opt_n - - case (seq_timemgr_optNMinute) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - - case (seq_timemgr_optNHours) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - - case (seq_timemgr_optNHour) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - - case (seq_timemgr_optNDays) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - - case (seq_timemgr_optNDay) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - - case (seq_timemgr_optNMonths) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - - case (seq_timemgr_optNMonth) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - AlarmInterval = AlarmInterval * opt_n - - case (seq_timemgr_optMonthly) - call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=seq_timemgr_cal, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case (seq_timemgr_optNYears) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - - case (seq_timemgr_optNYear) - if (.not.present(opt_n)) call shr_sys_abort(subname//trim(option)//' requires opt_n') - if (opt_n <= 0) call shr_sys_abort(subname//trim(option)//' invalid opt_n') - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - AlarmInterval = AlarmInterval * opt_n - - case (seq_timemgr_optYearly) - call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=seq_timemgr_cal, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - case (seq_timemgr_optEnd) - call shr_sys_abort(subname//'deprecated option '//trim(option)) - - case default - call shr_sys_abort(subname//'unknown option '//trim(option)) - - end select - - ! -------------------------------------------------------------------------------- - ! --- AlarmInterval and NextAlarm should be set --- - ! -------------------------------------------------------------------------------- - - ! --- advance Next Alarm so it won't ring on first timestep for - ! --- most options above. go back one alarminterval just to be careful - - if (update_nextalarm) then - NextAlarm = NextAlarm - AlarmInterval - do while (NextAlarm <= CurrTime) - NextAlarm = NextAlarm + AlarmInterval - enddo - endif - - EAlarm = ESMF_AlarmCreate( name=lalarmname, clock=EClock, ringTime=NextAlarm, ringInterval=AlarmInterval, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - end subroutine seq_timemgr_AlarmInit - - !=============================================================================== - - subroutine seq_timemgr_alarmGet( EAlarm, next_ymd, next_tod, prev_ymd, prev_tod, & - IntSec, IntMon, IntYrs, name) - - ! !DESCRIPTION: Get informationn from the alarm - use med_constants_mod, only : IN - use ESMF, only: ESMF_Alarm, ESMF_Time, ESMF_TimeInterval, ESMF_AlarmGet, ESMF_TimeIntervalGet - use ESMF, only: ESMF_ALARMLIST_ALL - use shr_nuopc_methods_mod, only : shr_nuopc_methods_ChkErr - - ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_Alarm) , intent(INOUT) :: EAlarm ! Input Alarm object - integer(IN), intent(out), optional :: next_ymd ! alarm date yyyymmdd - integer(IN), intent(out), optional :: next_tod ! alarm tod sec - integer(IN), intent(out), optional :: prev_ymd ! alarm date yyyymmdd - integer(IN), intent(out), optional :: prev_tod ! alarm tod sec - integer(IN), intent(out), optional :: IntSec ! alarm int sec - integer(IN), intent(out), optional :: IntMon ! alarm int mon - integer(IN), intent(out), optional :: IntYrs ! alarm int yrs - character(len=*) , intent(out), optional :: name ! alarm name - - !----- local ----- - integer :: yy, mm, dd, sec ! Return time values - integer :: ymd ! Date (YYYYMMDD) - integer :: tod ! time of day (sec) - integer :: rc ! error code - type(ESMF_TimeInterval) :: alarmInterval ! Alarm interval - type(ESMF_Time) :: ringTime ! Next alarm ring time - character(len=*), parameter :: subname = '(seq_timemgr_alarmGet) ' - !------------------------------------------------------------------------------- - - if (present(name)) then - call ESMF_AlarmGet( EAlarm, name=name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - - call ESMF_AlarmGet( EAlarm, RingTime=RingTime, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call seq_timemgr_ETimeGet( RingTime, ymd=ymd, tod=tod) - if ( present(next_ymd) ) next_ymd = ymd - if ( present(next_tod) ) next_tod = tod - - call ESMF_AlarmGet( EAlarm, PrevRingTime=RingTime, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call seq_timemgr_ETimeGet( RingTime, ymd=ymd, tod=tod) - if ( present(prev_ymd) ) prev_ymd = ymd - if ( present(prev_tod) ) prev_tod = tod - - yy = 0 - mm = 0 - dd = 0 - sec = 0 - call ESMF_AlarmGet( EAlarm, RingInterval=AlarmInterval, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet( alarmInterval, yy=yy, mm=mm, d=dd, s=sec, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - sec = sec + dd*(SecPerDay) - - ! --- If want restart next interval information ------------------------- - if ( present(IntSec) ) IntSec = sec - if ( present(IntMon) ) IntMon = mm - if ( present(IntYrs) ) IntYrs = yy - - end subroutine seq_timemgr_alarmGet - - !=============================================================================== - - subroutine seq_timemgr_AlarmSetOn( EClock, alarmname) - - ! !DESCRIPTION: turn alarm on - use shr_sys_mod, only : shr_sys_abort - use ESMF, only : ESMF_Alarm, ESMF_Clock, ESMF_AlarmRingerOn - use ESMF, only : ESMF_AlarmGet, ESMF_ClockGetAlarmList - use ESMF, only : ESMF_ALARMLIST_ALL - use shr_nuopc_methods_mod, only : shr_nuopc_methods_ChkErr - ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_Clock), intent(INOUT) :: EClock ! clock/alarm - character(len=*), intent(in), optional :: alarmname ! alarmname - - !----- local ----- - integer :: n - integer :: rc - logical :: found - logical :: set - character(len=64) :: name - type(ESMF_Alarm),pointer :: EAlarm_list(:) - integer(IN) :: AlarmCount ! Number of valid alarms - character(len=*), parameter :: xalarm = 'unset' - character(len=*), parameter :: subname = '(seq_timemgr_alarmSetOn) ' - - !------------------------------------------------------------------------------- - ! Notes: The Alarm_list is returned and only a subset of the alarms may - ! be initialized. In the esmf_wrf_timemgr, numalarms is not used internally, - ! and the alarm pointer is valid if it's associated. If it's not associated - ! the AlarmGet calls will generally return an error code. What we really - ! want is to ignore the unset alarms. So below, we have to kind of kludge - ! this up. We set name=xalarm, a special value, before the AlarmGet call so - ! if Alarm_list(n) is not associated, the name will remain the value of - ! xalarm. Then we check whether it's a valid alarm by first checking - ! the name vs xalarm. If name is not xalarm, then it must be a valid alarm - ! and we either set found to true if we are setting all alarms or we compare - ! the name returned to the alarm name we're looking for and only set found - ! to true if the names match. - !------------------------------------------------------------------------------- - - set = .false. - - call seq_timemgr_EClockGetData(EClock, AlarmCount=AlarmCount) - allocate(EAlarm_list(AlarmCount)) - call ESMF_ClockGetAlarmList(EClock, alarmListFlag=ESMF_ALARMLIST_ALL, & - alarmList=EAlarm_list, alarmCount=AlarmCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,AlarmCount - found = .false. - if (present(alarmname)) then - call ESMF_AlarmGet(EAlarm_list(n), name=name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(name) == trim(alarmname)) found = .true. - else - found = .true. - endif - if (found) then - set = .true. - call ESMF_AlarmRingerOn( EAlarm_list(n), rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - enddo - - if (present(alarmname) .and. .not. set) then - call shr_sys_abort(subname//' ERROR in alarmname '//trim(alarmname)) - endif - deallocate(EAlarm_list) - - end subroutine seq_timemgr_AlarmSetOn - - !=============================================================================== - - subroutine seq_timemgr_AlarmSetOff( EClock, alarmname, rc) - - ! !DESCRIPTION: turn alarm off - use med_constants_mod, only : IN - use shr_sys_mod, only : shr_sys_abort - use ESMF, only : ESMF_Clock, ESMF_Alarm, ESMF_AlarmRingerOff - use ESMF, only : ESMF_ClockGetAlarmList, ESMF_AlarmGet - use ESMF, only : ESMF_ALARMLIST_ALL - use seq_comm_mct, only: logunit - use shr_nuopc_methods_mod, only : shr_nuopc_methods_ChkErr - ! !INPUT/OUTPUT PARAMETERS: - - type(ESMF_Clock), intent(INOUT) :: EClock ! clock/alarm - character(len=*), intent(in), optional :: alarmname ! alarmname - integer , intent(INOUT) :: rc - - !----- local ----- - integer :: n - logical :: found - logical :: set - character(len=64) :: name - type(ESMF_Alarm),pointer :: EAlarm_list(:) - integer(IN) :: AlarmCount ! Number of valid alarms - character(len=*), parameter :: xalarm = 'unset' - character(len=*), parameter :: subname = '(seq_timemgr_alarmSetOff) ' - - !------------------------------------------------------------------------------- - ! Notes: The Alarm_list is returned and only a subset of the alarms may - ! be initialized. We check whether it's a valid alarm by first checking - ! the name vs xalarm. If name is not xalarm, then it must be a valid alarm - ! and we either set found to true if we are setting all alarms or we compare - ! the name returned to the alarm name we're looking for and only set found - ! to true if the names match. - !------------------------------------------------------------------------------- - - set = .false. - - call seq_timemgr_EClockGetData(EClock, AlarmCount=AlarmCount) - allocate(EAlarm_list(AlarmCount)) - call ESMF_ClockGetAlarmList(EClock, alarmListFlag=ESMF_ALARMLIST_ALL, & - alarmList=EAlarm_list, alarmCount=AlarmCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do n = 1,AlarmCount - found = .false. - if (present(alarmname)) then - call ESMF_AlarmGet(EAlarm_list(n), name=name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (trim(name) == trim(alarmname)) found = .true. - else - found = .true. - endif - if (found) then - set = .true. - call ESMF_AlarmRingerOff( EAlarm_list(n), rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif - enddo - - if (present(alarmname) .and. .not. set) then - write(logunit,*) subname,' ERROR in alarmname ',trim(alarmname) - call shr_sys_abort() - endif - deallocate(EAlarm_list) - - end subroutine seq_timemgr_AlarmSetOff - - !=============================================================================== - - logical function seq_timemgr_alarmIsOn( EClock, alarmname, rc) - - ! !DESCRIPTION: check if an alarm is ringing - use shr_sys_mod, only : shr_sys_abort - use ESMF, only : ESMF_Clock, ESMF_Time, ESMF_Alarm, ESMF_AlarmIsRinging - use ESMF, only : ESMF_ClockGetAlarmList, ESMF_AlarmGet, ESMF_ClockGet - use ESMF, only : ESMF_ALARMLIST_ALL - use seq_comm_mct, only : logunit - use shr_nuopc_methods_mod, only : shr_nuopc_methods_ChkErr - - ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_Clock), intent(in) :: EClock ! clock/alarm - character(len=*), intent(in) :: alarmname ! which alarm - integer , intent(INOUT) :: rc ! return code - - !----- local ----- - integer :: n - logical :: found - character(len=64) :: name - type(ESMF_Time) :: ETime1, ETime2 - type(ESMF_Alarm),pointer :: EAlarm_list(:) - integer(IN) :: AlarmCount ! Number of valid alarms - character(len=*), parameter :: xalarm = 'unset' - character(len=*), parameter :: subname = '(seq_timemgr_alarmIsOn) ' - - !------------------------------------------------------------------------------- - ! Notes: Because of the esmf_wrf_timemgr implementation with regards to - ! valid alarms in the alarm_list, we initialize name to xalarm before - ! querying the alarm name, and if the alarm is not valid, name will not - ! be updated and we can tell that the alarm is not valid and we should - ! just ignore it. - !------------------------------------------------------------------------------- - - seq_timemgr_alarmIsOn = .false. - found = .false. - - call seq_timemgr_EClockGetData(EClock, AlarmCount=AlarmCount) - allocate(EAlarm_list(AlarmCount)) - - call ESMF_ClockGetAlarmList(EClock, alarmListFlag=ESMF_ALARMLIST_ALL, & - alarmList=EAlarm_list, alarmCount=AlarmCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - do n = 1,AlarmCount - name = trim(xalarm) - call ESMF_AlarmGet(EAlarm_list(n), name=name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (trim(name) == trim(alarmname)) then - found = .true. - - seq_timemgr_alarmIsOn = ESMF_AlarmIsRinging(alarm=EAlarm_list(n),rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - ! --- make sure the datestop will always stop with dates >= stop_date - if (trim(alarmname) == trim(seq_timemgr_alarm_datestop)) then - call ESMF_ClockGet(EClock, CurrTime = ETime1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_AlarmGet(EAlarm_list(n), RingTime = ETime2, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (ETime1 >= ETime2) seq_timemgr_alarmIsOn = .true. - endif - - endif - enddo - - if (.not.found) then - write(logunit,*) subname//': ERROR alarm not valid for EClock '//trim(alarmname) - call shr_sys_abort( subname//'ERROR: alarm invalid '//trim(alarmname) ) - endif - deallocate(EAlarm_list) - - end function seq_timemgr_alarmIsOn - - !=============================================================================== - logical function seq_timemgr_restartAlarmIsOn( EClock) - - ! !DESCRIPTION: check if restart alarm is ringing - use ESMF, only : ESMF_Clock - ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_Clock) , intent(in) :: EClock ! clock/alarm - - !----- local ----- - integer :: rc ! return code - character(len=*), parameter :: subname = '(seq_timemgr_restartAlarmIsOn) ' - !------------------------------------------------------------------------------- - - seq_timemgr_restartAlarmIsOn = seq_timemgr_alarmIsOn(EClock, alarmname=seq_timemgr_alarm_restart, rc=rc) - - end function seq_timemgr_restartAlarmIsOn - - !=============================================================================== - logical function seq_timemgr_stopAlarmIsOn( EClock) - - ! !DESCRIPTION: check if stop alarm is ringing - use ESMF, only : ESMF_Clock - - ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_Clock) , intent(in) :: EClock ! clock/alarm - - !----- local ----- - integer :: rc ! return code - character(len=*), parameter :: subname = '(seq_timemgr_stopAlarmIsOn) ' - !------------------------------------------------------------------------------- - - seq_timemgr_stopAlarmIsOn = seq_timemgr_alarmIsOn(EClock, alarmname=seq_timemgr_alarm_stop, rc=rc) - - end function seq_timemgr_stopAlarmIsOn - - !=============================================================================== - logical function seq_timemgr_historyAlarmIsOn( EClock) - - ! !DESCRIPTION: check if history alarm is ringing - use ESMF, only : ESMF_Clock - - ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_Clock) , intent(in) :: EClock ! clock/alarm - - !----- local ----- - integer :: rc ! return code - character(len=*), parameter :: subname = '(seq_timemgr_historyAlarmIsOn) ' - !------------------------------------------------------------------------------- - - seq_timemgr_historyAlarmIsOn = seq_timemgr_alarmIsOn(EClock, alarmname=seq_timemgr_alarm_history, rc=rc) - - end function seq_timemgr_historyAlarmIsOn - - !=============================================================================== - logical function seq_timemgr_pauseAlarmIsOn( EClock) - - ! !DESCRIPTION: check if pause alarm is ringing - use ESMF, only : ESMF_Clock - - ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_Clock) , intent(in) :: EClock ! clock/alarm - - !----- local ----- - integer :: rc ! return code - character(len=*), parameter :: subname = '(seq_timemgr_pauseAlarmIsOn) ' - !------------------------------------------------------------------------------- - - seq_timemgr_pauseAlarmIsOn = seq_timemgr_alarmIsOn(EClock, alarmname=seq_timemgr_alarm_pause, rc=rc) - - end function seq_timemgr_pauseAlarmIsOn - - !=============================================================================== - logical function seq_timemgr_pause_active() - - ! !DESCRIPTION: Return .true. if any component is configured for pause/resume - - seq_timemgr_pause_active = ANY(pause_active) - - end function seq_timemgr_pause_active - - !=============================================================================== - integer function seq_timemgr_pause_component_index(component_name) - - ! !DESCRIPTION: Look up a component's internal index for faster processing - use shr_sys_mod, only : shr_sys_abort - - ! !INPUT/OUTPUT PARAMETERS: - character(len=*), intent(in) :: component_name - - !----- local ----- - integer :: ind - character(len=*), parameter :: subname = '(seq_timemgr_pause_component_index) ' - !------------------------------------------------------------------------------- - - seq_timemgr_pause_component_index = 0 - do ind = 1, max_clocks - if (trim(component_name) == trim(seq_timemgr_clocks(ind))) then - seq_timemgr_pause_component_index = ind - exit - end if - end do - if (seq_timemgr_pause_component_index < 1) then - if (trim(component_name) == 'cpl') then - seq_timemgr_pause_component_index = seq_timemgr_nclock_drv - end if - end if - if (seq_timemgr_pause_component_index < 1) then - call shr_sys_abort(subname//': No index for component '//trim(component_name)) - end if - - end function seq_timemgr_pause_component_index - - !=============================================================================== - logical function seq_timemgr_pause_component_active(component_index) - - ! !DESCRIPTION: Return .true. if component is active in driver pause - use shr_sys_mod, only : shr_sys_abort - - ! !INPUT/OUTPUT PARAMETERS: - integer, intent(in) :: component_index - - !----- local ----- - character(len=*), parameter :: subname = '(seq_timemgr_pause_component_active) ' - !------------------------------------------------------------------------------- - - if ((component_index < 1) .or. (component_index > max_clocks)) then - call shr_sys_abort(subname//': component_index out of range') - end if - seq_timemgr_pause_component_active = pause_active(component_index) - - end function seq_timemgr_pause_component_active - - !=============================================================================== - subroutine seq_timemgr_ETimeInit( ETime, ymd, tod, desc ) - - use shr_sys_mod , only : shr_sys_abort - use ESMF , only : ESMF_Time, ESMF_TimeSet - use shr_cal_mod , only : shr_cal_date2ymd - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use seq_comm_mct , only : logunit - - ! !DESCRIPTION: Create the ESMF_Time object corresponding to the given input time, given in - ! YMD (Year Month Day) and TOD (Time-of-day) format. - ! Set the time by an integer as YYYYMMDD and integer seconds in the day - - ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_Time) , intent(inout) :: ETime ! Time - integer , intent(in) :: ymd ! Year, month, day YYYYMMDD - integer , intent(in), optional :: tod ! Time of day in seconds - character(len=*), intent(in), optional :: desc ! Description of time to set - - !----- local ----- - character(len=*), parameter :: subname = '(seq_timemgr_ETimeInit) ' - integer :: yr, mon, day ! Year, month, day as integers - integer :: ltod ! local tod - character(CL) :: ldesc ! local desc - integer :: rc ! return code - !------------------------------------------------------------------------------- - - ltod = 0 - if (present(tod)) then - ltod = tod - endif - - ldesc = '' - if (present(desc)) then - ldesc = desc - endif - - if ( (ymd < 0) .or. (ltod < 0) .or. (ltod > SecPerDay) )then - write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & - 'time-of-day out of bounds', ymd, ltod - call shr_sys_abort( subname//'ERROR: Bad input' ) - end if - - call shr_cal_date2ymd(ymd,yr,mon,day) - - call ESMF_TimeSet( ETime, yy=yr, mm=mon, dd=day, s=ltod, calendar=seq_timemgr_cal, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - end subroutine seq_timemgr_ETimeInit - - !=============================================================================== - subroutine seq_timemgr_ETimeGet( ETime, offset, ymd, tod ) - - ! !DESCRIPTION: Get the date in YYYYMMDD format from a ESMF time object. - use shr_nuopc_methods_mod, only : shr_nuopc_methods_ChkErr - use ESMF, only : ESMF_Time, ESMF_TimeInterval, ESMF_TimeIntervalGet, ESMF_TimeIntervalSet - use ESMF, only : ESMF_TimeGet - use shr_cal_mod, only : shr_cal_ymd2date - ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_Time), intent(in) :: ETime ! Input ESMF time - integer, optional, intent(in) :: offset ! Offset from input time (sec) - integer, optional, intent(out) :: ymd ! date of day - integer, optional, intent(out) :: tod ! Time of day - - !----- local ----- - character(len=*), parameter :: subname = '(seq_timemgr_ETimeGet) ' - type(ESMF_Time) :: ETimeAdd ! ESMF time + offset - type(ESMF_TimeInterval) :: ETimeOff ! ESMF offset time-interval - integer :: year ! Year - integer :: month ! Month - integer :: day ! Day in month - integer :: sec ! Day in month - integer :: rc ! Return code - !------------------------------------------------------------------------------- - - ETimeAdd = ETime - if ( present(offset) )then - if ( offset > 0 )then - call ESMF_TimeIntervalSet( ETimeOff, s=offset, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ETimeAdd = ETime + ETimeOff - else if ( offset < 0 )then - call ESMF_TimeIntervalSet( ETimeOff, s=-offset, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - ETimeAdd = ETime - ETimeOff - end if - end if - - call ESMF_TimeGet( ETimeAdd, yy=year, mm=month, dd=day, s=sec, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - ! shr_cal has restrictions and then "stops", so override that - - if ( present(ymd) ) then - call shr_cal_ymd2date(year,month,day,ymd) - endif - if ( present(tod) ) then - tod = sec - endif - - end subroutine seq_timemgr_ETimeGet - - !=============================================================================== - subroutine seq_timemgr_EClockInit( TimeStep, StartTime, RefTime, CurrTime, EClock ) - - ! !DESCRIPTION: Setup the ESMF clock - use med_constants_mod, only : CL - use ESMF, only: ESMF_Time, ESMF_TimeInterval, ESMF_Clock - use ESMF, only: ESMF_ClockGet, ESMF_ClockAdvance, ESMF_ClockCreate - use shr_nuopc_methods_mod, only : shr_nuopc_methods_ChkErr - use seq_comm_mct, only : loglevel, logunit - ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_TimeInterval), intent(in) :: TimeStep ! Time-step of clock - type(ESMF_Time) , intent(in) :: StartTime ! Start time - type(ESMF_Time) , intent(in) :: RefTime ! Reference time - type(ESMF_Time) , intent(in) :: CurrTime ! Current time - type(ESMF_Clock) , intent(out) :: EClock ! Output ESMF clock - - !----- local ----- - integer :: rc ! ESMF return code - integer :: ymd, tod ! time info - character(len=CL) :: description ! Description of this clock - type(ESMF_Time) :: clocktime ! Current time - character(len=*), parameter :: subname = '(seq_timemgr_EClockInit) ' - !------------------------------------------------------------------------------- - - description = 'ESMF Clock' - - ! ------ Create ESMF Clock with input characteristics ------------------- - ! --- NOTE: StopTime is required in interface but not used, so use ----- - ! --- something arbitrary. Stop handled via alarm ----- - - call seq_timemgr_ETimeInit(clocktime, 99990101, 0, "artificial stop date") - - EClock = ESMF_ClockCreate(name=trim(description), & - TimeStep=TimeStep, startTime=StartTime, refTime=RefTime, stopTime=clocktime, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - ! ------ Advance clock to the current time (in case of a restart) ------- - call ESMF_ClockGet(EClock, currTime=clocktime, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - do while( clocktime < CurrTime) - call ESMF_ClockAdvance( EClock, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet( EClock, currTime=clocktime, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - end do - - if (clocktime /= CurrTime) then - if (loglevel > 0) then - write(logunit,*) trim(subname),' : WARNING clocktime and currtime inconsistent' - call seq_timemgr_ETimeGet( clocktime, ymd=ymd, tod=tod ) - write(logunit,*) trim(subname),' : clocktime = ',ymd,tod - call seq_timemgr_ETimeGet( currtime, ymd=ymd, tod=tod ) - write(logunit,*) trim(subname),' : currtime = ',ymd,tod - endif - endif - - end subroutine seq_timemgr_EClockInit - - !=============================================================================== - logical function seq_timemgr_EClockDateInSync( EClock, ymd, tod, prev) - - ! !DESCRIPTION: Check that the given input date/time is in sync with clock time - use ESMF, only : ESMF_Clock, ESMF_ClockGet, ESMF_Time - ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_Clock), intent(in) :: Eclock ! Input clock to compare - integer, intent(in) :: ymd ! Date (YYYYMMDD) - integer, intent(in) :: tod ! Time of day (sec) - logical, optional,intent(in) :: prev ! If should get previous time - - !----- local ----- - type(ESMF_Time) :: ETime - integer :: ymd1 ! Date (YYYYMMDD) - integer :: tod1 ! Time of day - logical :: previous ! If need to get previous time for comparison - integer :: rc ! error code - character(len=*), parameter :: subname = "(seq_timemgr_EClockDateInSync) " - !------------------------------------------------------------------------------- - - previous = .false. - if ( present(prev) )then - previous = prev - end if - - if (previous )then - call ESMF_ClockGet( EClock, prevTime=ETime, rc=rc) - else - call ESMF_ClockGet( EClock, currTime=ETime, rc=rc) - end if - call seq_timemgr_ETimeGet( ETime, ymd=ymd1, tod=tod1 ) - - ! --- If current dates agree return true -- else false - - if ( (ymd == ymd1) .and. (tod == tod1) )then - seq_timemgr_EClockDateInSync = .true. - else - seq_timemgr_EClockDateInSync = .false. - end if - - end function seq_timemgr_EClockDateInSync - - !=============================================================================== - subroutine seq_timemgr_clockPrint( SyncClock ) - - ! !DESCRIPTION: Print clock information out. - use med_constants_mod, only : in - use ESMF, only : ESMF_Alarm, ESMF_ClockGetAlarmList - use ESMF, only : ESMF_ALARMLIST_ALL - use shr_nuopc_methods_mod, only : shr_nuopc_methods_ChkErr - use seq_comm_mct, only : loglevel, logunit - ! !INPUT/OUTPUT PARAMETERS: - type(seq_timemgr_type), intent(in) :: SyncClock ! Input clock to print - - !----- local ----- - integer(IN) :: n - character(len=*), parameter :: F06 = "(2A,L3)" - character(len=*), parameter :: F07 = "(3A)" - character(len=*), parameter :: subname = "(seq_timemgr_clockPrint) " - !------------------------------------------------------------------------------- - ! Notes: - !------------------------------------------------------------------------------- - - if (loglevel <= 0) return - - write(logunit,F07) subname,'calendar = ', trim(seq_timemgr_calendar) - write(logunit,F06) subname,'end_restart = ', seq_timemgr_end_restart - write(logunit,F07) '' - - do n = 1,max_clocks - call seq_timemgr_EClockPrint(SyncClock%ECP(n)%EClock, n) - enddo - - end subroutine seq_timemgr_clockPrint - - !=============================================================================== - subroutine seq_timemgr_EClockPrint( EClock, n ) - use ESMF, only : ESMF_ClockGetAlarmList, ESMF_Clock, ESMF_Alarm - use ESMF, only : ESMF_ALARMLIST_ALL - use seq_comm_mct, only : loglevel, logunit - use shr_nuopc_methods_mod, only : shr_nuopc_methods_ChkErr - ! !DESCRIPTION: Print clock information out. - - ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_Clock), intent(in) :: EClock ! Input clock to print - integer, intent(in) :: n - !----- local ----- - integer(IN) :: m - integer(IN) :: curr_ymd ! Current date YYYYMMDD - integer(IN) :: curr_tod ! Current time of day (s) - integer(IN) :: StepNo ! Number of steps taken - integer(IN) :: start_ymd ! Starting date YYYYMMDD - integer(IN) :: start_tod ! Starting time-of-day (s) - integer(IN) :: stop_ymd ! Stop date YYYYMMDD - integer(IN) :: stop_tod ! Stop time-of-day (s) - integer(IN) :: ref_ymd ! Reference date YYYYMMDD - integer(IN) :: ref_tod ! Reference time-of-day (s) - integer(IN) :: DTime ! Time-step (seconds) - integer(IN) :: prev_ymd ! Prev restart alarm date (YYYYMMDD) - integer(IN) :: prev_tod ! Prev restart alarm time-of-day (sec) - integer(IN) :: next_ymd ! Next restart alarm date (YYYYMMDD) - integer(IN) :: next_tod ! Next restart alarm time-of-day (sec) - integer(IN) :: IntSec ! Alarm interval for seconds - integer(IN) :: IntMon ! Alarm interval for months - integer(IN) :: IntYrs ! Alarm interval for years - integer(IN) :: AlarmCount ! Number of valid alarms - character(len=64) :: alarmname ! Alarm name - integer(IN) :: rc ! error code - type(ESMF_Alarm), pointer :: EAlarm_list(:) ! EAlarm list associated with EClock - character(len=*), parameter :: xalarm = 'unset' - character(len=*), parameter :: F06 = "(2A,L3)" - character(len=*), parameter :: F07 = "(3A)" - character(len=*), parameter :: F08 = "(2A,I8.8,3x,I5.5)" - character(len=*), parameter :: F09 = "(2A,2I8,I12)" - character(len=*), parameter :: F10 = "(2A,I2,2x,A)" - character(len=*), parameter :: subname = "(seq_timemgr_EClockPrint) " - !------------------------------------------------------------------------------- - ! Notes: - !------------------------------------------------------------------------------- - - if (loglevel <= 0) return - - call seq_timemgr_EClockGetData( EClock, curr_ymd=curr_ymd, & - curr_tod=curr_tod, start_ymd=start_ymd, & - start_tod=start_tod, StepNo=StepNo, & - ref_ymd=ref_ymd, ref_tod=ref_tod, & - stop_ymd=stop_ymd, stop_tod=stop_tod, & - dtime = dtime, alarmcount=AlarmCount) - allocate(EAlarm_list(AlarmCount)) - call ESMF_ClockGetAlarmList(EClock, alarmListFlag=ESMF_ALARMLIST_ALL, & - alarmList=EAlarm_list, alarmCount=AlarmCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - write(logunit,F09) subname,"Clock = "//seq_timemgr_clocks(n),n - write(logunit,F08) subname," Start Time = ", start_ymd, start_tod - write(logunit,F08) subname," Curr Time = ", curr_ymd, curr_tod - write(logunit,F08) subname," Ref Time = ", ref_ymd, ref_tod - write(logunit,F08) subname," Stop Time = ", stop_ymd, stop_tod - write(logunit,F09) subname," Step number = ", StepNo - write(logunit,F09) subname," Dtime = ", DTime - - do m = 1,alarmCount - call seq_timemgr_alarmGet( EAlarm_list(m), & - next_ymd=next_ymd, next_tod=next_tod, prev_ymd=prev_ymd, prev_tod=prev_tod, & - IntSec=IntSec, IntMon=IntMon, IntYrs=IntYrs, name=alarmname ) - write(logunit,F10) subname," Alarm = ",m,trim(alarmname) - write(logunit,F08) subname," Prev Time = ", prev_ymd,prev_tod - write(logunit,F08) subname," Next Time = ", next_ymd,next_tod - write(logunit,F09) subname," Intervl yms = ", IntYrs,IntMon,IntSec - enddo - - write(logunit,*) '' - deallocate(EAlarm_list) - - end subroutine seq_timemgr_EClockPrint - - !=============================================================================== - - subroutine seq_timemgr_ESMFDebug( EClock, ETime, ETimeInterval, istring ) - - ! !DESCRIPTION: Print ESMF stuff for debugging - use med_constants_mod, only : I8 - use ESMF, only : ESMF_Time, ESMF_TimeInterval, ESMF_TimeGet, ESMF_TimeIntervalGet - use ESMF, only : ESMF_Clock, ESMF_ClockGet, ESMF_TimeIntervalGet - use shr_nuopc_methods_mod, only : shr_nuopc_methods_ChkErr - use seq_comm_mct, only : logunit - ! !INPUT/OUTPUT PARAMETERS: - type(ESMF_Clock) , optional, intent(in) :: EClock ! ESMF Clock - type(ESMF_Time) , optional, intent(inout) :: ETime ! ESMF Time - type(ESMF_TimeInterval) , optional, intent(inout) :: ETimeInterval ! ESMF Time Interval - character(len=*) , optional, intent(in) :: istring - - !----- local ----- - character(len=128) :: timestring - integer :: yy,mm,dd,s ! ymds - type(ESMF_Time) :: LTime - type(ESMF_TimeInterval) :: LTimeInterval - integer(I8) :: LStep - integer :: rc ! return code - character(len=*), parameter :: subname = '(seq_timemgr_ESMFDebug) ' - !------------------------------------------------------------------------------- - ! Notes: - !------------------------------------------------------------------------------- - - if (present(ETime)) then - write(logunit,*) subname,' ETime ',trim(istring) - call ESMF_TimeGet(ETime, yy=yy,mm=mm,dd=dd,s=s,timestring=timestring,rc=rc) - write(logunit,*) subname,rc,'ymds=',yy,mm,dd,s,trim(timestring) - endif - - if (present(ETimeInterval)) then - write(logunit,*) subname,' ETimeInterval ',trim(istring) - call ESMF_TimeIntervalGet(ETimeInterval, yy=yy,mm=mm,d=dd,s=s,timestring=timestring,rc=rc) - write(logunit,*) subname,rc,'ymds=',yy,mm,dd,s,trim(timestring) - endif - - if (present(EClock)) then - write(logunit,*) subname,' EClock ',trim(istring) - - call ESMF_ClockGet( EClock, StartTime=LTime, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(LTime, yy=yy,mm=mm,dd=dd,s=s,timestring=timestring,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,*) subname,rc,'start ymds=',yy,mm,dd,s,trim(timestring) - - call ESMF_ClockGet( EClock, CurrTime=LTime, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(LTime, yy=yy,mm=mm,dd=dd,s=s,timestring=timestring,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,*) subname,rc,'curr ymds=',yy,mm,dd,s,trim(timestring) - - call ESMF_ClockGet( EClock, StopTime=LTime, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(LTime, yy=yy,mm=mm,dd=dd,s=s,timestring=timestring,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,*) subname,rc,'stop ymds=',yy,mm,dd,s,trim(timestring) - - call ESMF_ClockGet( EClock, PrevTime=LTime, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(LTime, yy=yy,mm=mm,dd=dd,s=s,timestring=timestring,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,*) subname,rc,'prev ymds=',yy,mm,dd,s,trim(timestring) - - call ESMF_ClockGet( EClock, RefTime=LTime, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(LTime, yy=yy,mm=mm,dd=dd,s=s,timestring=timestring,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,*) subname,rc,'ref ymds=',yy,mm,dd,s,trim(timestring) - - call ESMF_ClockGet( EClock, TimeStep=LTimeInterval, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeIntervalGet(LTimeInterval, yy=yy,mm=mm,d=dd,s=s,timestring=timestring,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,*) subname,rc,'tint ymds=',yy,mm,dd,s,trim(timestring) - - call ESMF_ClockGet( EClock, AdvanceCount=LStep, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - write(logunit,*) subname,rc,'advcnt =',LStep - endif - - end subroutine seq_timemgr_ESMFDebug - - !=============================================================================== - -end module seq_timemgr_mod diff --git a/src/drivers/nuopc/shr/shr_nuopc_fldList_mod.F90 b/src/drivers/nuopc/shr/shr_nuopc_fldList_mod.F90 deleted file mode 100644 index 3b862f6915c..00000000000 --- a/src/drivers/nuopc/shr/shr_nuopc_fldList_mod.F90 +++ /dev/null @@ -1,675 +0,0 @@ -module shr_nuopc_fldList_mod - - use shr_kind_mod , only : CX => shr_kind_CX, CS=>shr_kind_CS, CL=>shr_kind_cl - - implicit none - private - - integer, parameter, public :: CSS = 256 ! use longer short character - - public :: shr_nuopc_fldList_AddFld - public :: shr_nuopc_fldList_AddMap - public :: shr_nuopc_fldList_AddMetadata - public :: shr_nuopc_fldList_GetMetadata - public :: shr_nuopc_fldList_GetFldNames - public :: shr_nuopc_fldList_GetNumFlds - public :: shr_nuopc_fldList_GetFldInfo - public :: shr_nuopc_fldList_Realize - - !----------------------------------------------- - ! Metadata array - !----------------------------------------------- - - character(len=*), parameter :: undef = 'undefined' - integer , parameter :: nmax = 1000 ! maximum number of entries in metadta_entry - integer :: n_entries = 0 ! actual number of entries in metadta_entry - character(len=CSS) :: shr_nuopc_fldList_Metadata(nmax,4) = undef - - !----------------------------------------------- - ! Maximum number of components, mappers - !----------------------------------------------- - - integer , public, parameter :: ncomps_max = 8 - integer , public, parameter :: mapunset=0 - integer , public, parameter :: nmappers=6 - integer , public, parameter :: mapbilnr=1 - integer , public, parameter :: mapconsf=2 - integer , public, parameter :: mapconsd=3 - integer , public, parameter :: mappatch=4 - integer , public, parameter :: mapfcopy=5 - integer , public, parameter :: mapfiler=6 - character(len=*) , public, parameter :: mapnames(nmappers) = (/'bilnr','consf','consd','patch','fcopy','filer'/) - - !----------------------------------------------- - ! Types and instantiations that determine fields, mappings, mergings - !----------------------------------------------- - - type shr_nuopc_fldList_entry_type - character(CS) :: stdname - character(CS) :: shortname - logical :: active = .true. - ! Mapping fldsFr data - for mediator import fields - integer :: mapindex(ncomps_max) = mapunset - character(CS) :: mapnorm(ncomps_max) = 'unset' - character(CX) :: mapfile(ncomps_max) = 'unset' - ! Merging fldsTo data - for mediator export fields - character(CX) :: merge_fields(ncomps_max) = 'unset' - character(CS) :: merge_types(ncomps_max) = 'unset' - character(CS) :: merge_fracnames(ncomps_max) = 'unset' - end type shr_nuopc_fldList_entry_type - public :: shr_nuopc_fldList_entry_type - - ! The above would be the field name to merge from - ! e.g. for Sa_z in lnd - ! merge_field(compatm) = 'Sa_z' - ! merge_type(comptm) = 'copy' (could also have 'copy_with_weighting') - - type shr_nuopc_fldList_type - type (shr_nuopc_fldList_entry_type), pointer :: flds(:) - end type shr_nuopc_fldList_type - public :: shr_nuopc_fldList_type - - interface shr_nuopc_fldList_GetFldInfo ; module procedure & - shr_nuopc_fldList_GetFldInfo_general, & - shr_nuopc_fldList_GetFldInfo_stdname, & - shr_nuopc_fldList_GetFldInfo_merging - end interface - - integer :: dbrc - character(len=CL) :: infostr - character(len=*),parameter :: u_FILE_u = & - __FILE__ - -!================================================================================ -contains -!================================================================================ - - subroutine shr_nuopc_fldList_AddMetadata(fldname , longname, stdname, units) - - use NUOPC , only : NUOPC_FieldDictionaryAddEntry, NUOPC_FieldDictionaryHasEntry - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU - use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE - - ! input/output parameters: - character(len=*), intent(in) :: fldname - character(len=*), intent(in) :: longname - character(len=*), intent(in) :: stdname - character(len=*), intent(in) :: units - - ! local variables - integer :: n - logical :: found,FDfound - integer :: rc - character(len=*),parameter :: subname = '(fldList_AddMetadata) ' - !------------------------------------------------------------------------------- - - FDfound = .true. - if (.not.NUOPC_FieldDictionaryHasEntry(fldname)) then - FDfound = .false. - call ESMF_LogWrite(subname//': Add:'//trim(fldname), ESMF_LOGMSG_INFO, rc=dbrc) - call NUOPC_FieldDictionaryAddEntry(standardName=fldname, canonicalUnits=units, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - endif - - found = .false. - ! only do the search if it was already in the FD. If it wasn't, - ! then assume it's also not in the metadata table. - if (FDfound) then - n = 1 - do while (n <= n_entries .and. .not.found) - if (fldname == shr_nuopc_fldList_Metadata(n,1)) found=.true. - n = n + 1 - enddo - endif - - if (.not. found) then - n_entries = n_entries + 1 - if (n_entries > nmax) then - write(infostr,*) subname,' ERROR: n_entries= ',n_entries,' nmax = ',nmax,' fldname= ',trim(fldname) - call ESMF_LogWrite(trim(infostr),ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) - write(infostr,*) subname,' ERROR: n_entries gt nmax' - call ESMF_LogWrite(trim(infostr),ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) - rc = ESMF_FAILURE - return - end if - shr_nuopc_fldList_Metadata(n_entries,1) = trim(fldname) - shr_nuopc_fldList_Metadata(n_entries,2) = trim(longname) - shr_nuopc_fldList_Metadata(n_entries,3) = trim(stdname ) - shr_nuopc_fldList_Metadata(n_entries,4) = trim(units ) - endif - - end subroutine shr_nuopc_fldList_AddMetadata - - !=============================================================================== - - subroutine shr_nuopc_fldList_GetMetadata(shortname, longname, stdname, units) - - use shr_string_mod , only : shr_string_lastindex - - ! input/output variables - character(len=*), intent(in) :: shortname - character(len=*),optional, intent(out) :: longname - character(len=*),optional, intent(out) :: stdname - character(len=*),optional, intent(out) :: units - - ! local variables - integer :: i,n - character(len=CSS) :: llongname, lstdname, lunits, lshortname ! local copies - character(len=*),parameter :: unknown = 'unknown' - logical :: found - character(len=*),parameter :: subname = '(shr_nuopc_fldList_GetMetadata) ' - - !--- define field metadata (name, long_name, standard_name, units) --- - - llongname = trim(unknown) - lstdname = trim(unknown) - lunits = trim(unknown) - - found = .false. - - if (.not.found) then - i = 1 - do while (i <= n_entries .and. .not.found) - lshortname = trim(shortname) - if (trim(lshortname) == trim(shr_nuopc_fldList_Metadata(i,1))) then - llongname = trim(shr_nuopc_fldList_Metadata(i,2)) - lstdname = trim(shr_nuopc_fldList_Metadata(i,3)) - lunits = trim(shr_nuopc_fldList_Metadata(i,4)) - found =.true. - end if - i = i + 1 - end do - endif - - if (.not.found) then - i = 1 - do while (i <= n_entries .and. .not.found) - n = shr_string_lastIndex(shortname,"_") - lshortname = "" - if (n < len_trim(shortname)) lshortname = shortname(n+1:len_trim(shortname)) - if (trim(lshortname) == trim(shr_nuopc_fldList_Metadata(i,1))) then - llongname = trim(shr_nuopc_fldList_Metadata(i,2)) - lstdname = trim(shr_nuopc_fldList_Metadata(i,3)) - lunits = trim(shr_nuopc_fldList_Metadata(i,4)) - found = .true. - end if - i = i + 1 - end do - endif - - if (present(longname)) then - longname = trim(llongname) - endif - if (present(stdname)) then - stdname = trim(lstdname) - endif - if (present(units)) then - units = trim(lunits) - endif - - end subroutine shr_nuopc_fldList_GetMetadata - - !================================================================================ - - subroutine shr_nuopc_fldList_AddFld(flds, stdname, shortname, fldindex, & - merge_from1, merge_field1, merge_type1, merge_fracname1, & - merge_from2, merge_field2, merge_type2, merge_fracname2, & - merge_from3, merge_field3, merge_type3, merge_fracname3, & - merge_from4, merge_field4, merge_type4, merge_fracname4) - - ! ---------------------------------------------- - ! Add an entry to to the flds array - ! Use pointers to create an extensible allocatable array. - ! to allow the size of flds to grow, the process for - ! adding a new field is: - ! 1) allocate newflds to be N (one element larger than flds) - ! 2) copy flds into first N-1 elements of newflds - ! 3) newest flds entry is Nth element of newflds - ! 4) deallocate / nullify flds - ! 5) point flds => newflds - ! ---------------------------------------------- - - type(shr_nuopc_fldList_entry_type) , pointer :: flds(:) - character(len=*) , intent(in) :: stdname - character(len=*) , intent(in) , optional :: shortname - integer , intent(out) , optional :: fldindex - integer , intent(in) , optional :: merge_from1 - character(len=*) , intent(in) , optional :: merge_field1 - character(len=*) , intent(in) , optional :: merge_type1 - character(len=*) , intent(in) , optional :: merge_fracname1 - integer , intent(in) , optional :: merge_from2 - character(len=*) , intent(in) , optional :: merge_field2 - character(len=*) , intent(in) , optional :: merge_type2 - character(len=*) , intent(in) , optional :: merge_fracname2 - integer , intent(in) , optional :: merge_from3 - character(len=*) , intent(in) , optional :: merge_field3 - character(len=*) , intent(in) , optional :: merge_type3 - character(len=*) , intent(in) , optional :: merge_fracname3 - integer , intent(in) , optional :: merge_from4 - character(len=*) , intent(in) , optional :: merge_field4 - character(len=*) , intent(in) , optional :: merge_type4 - character(len=*) , intent(in) , optional :: merge_fracname4 - - ! local variables - integer :: n,oldsize,id - type(shr_nuopc_fldList_entry_type), pointer :: newflds(:) - character(len=*), parameter :: subname='(fldList_AddFld)' - ! ---------------------------------------------- - - if (associated(flds)) then - oldsize = size(flds) - else - oldsize = 0 - end if - id = oldsize + 1 - - ! 1) allocate newfld to be size (one element larger than input flds) - allocate(newflds(id)) - - ! 2) copy flds into first N-1 elements of newflds - do n = 1,oldsize - newflds(n)%stdname = flds(n)%stdname - newflds(n)%shortname = flds(n)%shortname - newflds(n)%active = flds(n)%active - newflds(n)%mapindex(:) = flds(n)%mapindex(:) - newflds(n)%mapnorm(:) = flds(n)%mapnorm(:) - newflds(n)%mapfile(:) = flds(n)%mapfile(:) - newflds(n)%merge_fields(:) = flds(n)%merge_fields(:) - newflds(n)%merge_types(:) = flds(n)%merge_types(:) - newflds(n)%merge_fracnames(:) = flds(n)%merge_fracnames(:) - end do - - ! 3) deallocate / nullify flds - if (oldsize > 0) then - deallocate(flds) - nullify(flds) - end if - - ! 4) point flds => new_flds - flds => newflds - - ! 5) now update flds information for new entry - flds(id)%stdname = trim(stdname) - if (present(shortname)) then - flds(id)%shortname = trim(shortname) - else - flds(id)%shortname = trim(stdname) - end if - if (present(fldindex)) then - fldindex = id - end if - if (present(merge_from1) .and. present(merge_field1) .and. present(merge_type1)) then - n = merge_from1 - flds(id)%merge_fields(n) = merge_field1 - flds(id)%merge_types(n) = merge_type1 - if (present(merge_fracname1)) then - flds(id)%merge_fracnames(n) = merge_fracname1 - end if - end if - if (present(merge_from2) .and. present(merge_field2) .and. present(merge_type2)) then - n = merge_from2 - flds(id)%merge_fields(n) = merge_field2 - flds(id)%merge_types(n) = merge_type2 - if (present(merge_fracname2)) then - flds(id)%merge_fracnames(n) = merge_fracname2 - end if - end if - if (present(merge_from3) .and. present(merge_field3) .and. present(merge_type3)) then - n = merge_from3 - flds(id)%merge_fields(n) = merge_field3 - flds(id)%merge_types(n) = merge_type3 - if (present(merge_fracname3)) then - flds(id)%merge_fracnames(n) = merge_fracname3 - end if - end if - if (present(merge_from4) .and. present(merge_field4) .and. present(merge_type4)) then - n = merge_from4 - flds(id)%merge_fields(n) = merge_field4 - flds(id)%merge_types(n) = merge_type4 - if (present(merge_fracname4)) then - flds(id)%merge_fracnames(n) = merge_fracname4 - end if - end if - end subroutine shr_nuopc_fldList_AddFld - - !================================================================================ - - subroutine shr_nuopc_fldList_AddMap(fld, srccomp, destcomp, mapindex, mapnorm, mapfile) - - ! intput/output variables - type(shr_nuopc_fldList_entry_type) , intent(inout) :: fld - integer , intent(in) :: srccomp - integer , intent(in) :: destcomp - integer , intent(in) :: mapindex - character(len=*) , intent(in) :: mapnorm - character(len=*) , intent(in) :: mapfile - - ! local variables - logical :: mapset - character(len=*),parameter :: subname='(fldList_AddMap)' - ! ---------------------------------------------- - - ! Note - default values are already set for the fld entries - so only non-default - ! values need to be set below - ! If mapindex is mapfcopy - create a redistribution route handle - ! If mapfile is idmap - create a redistribution route nhandle - ! If mapfile is unset then create the mapping route handle at run time - - fld%mapindex(destcomp) = mapindex - fld%mapfile(destcomp) = trim(mapfile) - fld%mapnorm(destcomp) = trim(mapnorm) - - ! overwrite values if appropriate - if (fld%mapindex(destcomp) == mapfcopy) then - fld%mapfile(destcomp) = 'unset' - fld%mapnorm(destcomp) = 'unset' - else if (trim(fld%mapfile(destcomp)) == 'idmap') then - fld%mapindex(destcomp) = mapfcopy - fld%mapnorm(destcomp) = 'unset' - end if - end subroutine shr_nuopc_fldList_AddMap - - !================================================================================ - - subroutine shr_nuopc_fldList_Realize(state, fldList, flds_scalar_name, flds_scalar_num, & - grid, mesh, tag, rc) - - use NUOPC, only : NUOPC_GetStateMemberLists, NUOPC_IsConnected, NUOPC_Realize - use NUOPC, only : NUOPC_GetAttribute - use ESMF, only : ESMF_MeshLoc_Element, ESMF_FieldCreate, ESMF_TYPEKIND_R8 - use ESMF, only : ESMF_MAXSTR, ESMF_Field, ESMF_State, ESMF_Grid, ESMF_Mesh - use ESMF, only : ESMF_StateGet, ESMF_LogFoundError - use ESMF, only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_LOGERR_PASSTHRU - use ESMF, only : ESMF_LOGMSG_INFO, ESMF_StateRemove, ESMF_SUCCESS - use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag - - type(ESMF_State) , intent(inout) :: state - type(shr_nuopc_fldlist_type), intent(in) :: fldList - character(len=*) , intent(in) :: flds_scalar_name - integer , intent(in) :: flds_scalar_num - character(len=*) , intent(in) :: tag - integer , intent(inout) :: rc - type(ESMF_Grid) , intent(in) , optional :: grid - type(ESMF_Mesh) , intent(in) , optional :: mesh - - ! local variables - integer :: n, nflds - integer :: itemCount - type(ESMF_Field) :: field - character(CS) :: shortname - character(CS) :: stdname - character(ESMF_MAXSTR) :: transferAction - character(ESMF_MAXSTR), pointer :: StandardNameList(:) - character(ESMF_MAXSTR), pointer :: ConnectedList(:) - character(ESMF_MAXSTR), pointer :: NameSpaceList(:) - character(ESMF_MAXSTR), pointer :: itemNameList(:) - character(len=*),parameter :: subname='(shr_nuopc_fldList_Realize)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - if (present(grid) .and. present(mesh)) then - call ESMF_LogWrite(trim(subname)//trim(tag)//": ERROR both grid and mesh not allowed", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) - rc = ESMF_FAILURE - return - endif - - nullify(StandardNameList) - nullify(ConnectedList) - nullify(NameSpaceList) - nullify(ItemNameList) - - call ESMF_StateGet(state, itemCount=itemCount, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - write(infostr,'(i6)') itemCount - call ESMF_LogWrite(trim(subname)//trim(tag)//" count = "//trim(infostr), ESMF_LOGMSG_INFO, rc=dbrc) - if (itemCount > 0) then - allocate(itemNameList(itemCount)) - call ESMF_StateGet(state, itemNameList=itemNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - do n = 1,itemCount - call ESMF_LogWrite(trim(subname)//trim(tag)//" itemNameList = "//trim(itemNameList(n)), ESMF_LOGMSG_INFO, rc=dbrc) - enddo - deallocate(itemNameList) - endif - -#if (1 == 0) - call NUOPC_GetStateMemberLists(state, StandardNameList=StandardNameList, ConnectedList=ConnectedList, & - NamespaceList=NamespaceList, itemNameList=itemNameList, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - write(infostr,'(i6)') size(StandardNameList) - call ESMF_LogWrite(trim(subname)//trim(tag)//" size = "//trim(infostr), ESMF_LOGMSG_INFO, rc=dbrc) - - do n = 1,size(StandardNameList) - call ESMF_LogWrite(trim(subname)//trim(tag)//" StandardNameList = "//trim(StandardNameList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) - enddo - do n = 1,size(ConnectedList) - call ESMF_LogWrite(trim(subname)//trim(tag)//" ConnectedList = "//trim(ConnectedList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) - enddo - do n = 1,size(NamespaceList) - call ESMF_LogWrite(trim(subname)//trim(tag)//" NamespaceList = "//trim(NamespaceList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) - enddo - do n = 1,size(ItemnameList) - call ESMF_LogWrite(trim(subname)//trim(tag)//" ItemnameList = "//trim(ItemnameList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) - enddo -#endif - - nflds = size(fldList%flds) - - do n = 1, nflds - shortname = fldList%flds(n)%shortname - - if (fldList%flds(n)%active) then - ! call ESMF_LogWrite(subname//' fld = '//trim(shortname), ESMF_LOGMSG_INFO, rc=dbrc) - - if (NUOPC_IsConnected(state, fieldName=shortname)) then - - call ESMF_StateGet(state, field=field, itemName=trim(shortname), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - call NUOPC_GetAttribute(field, name="TransferActionGeomObject", value=transferAction, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - if (trim(transferAction) == "accept") then ! accept - - call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(shortname)//" is connected, grid/mesh TBD", & - ESMF_LOGMSG_INFO, rc=dbrc) - - else ! provide - - if (shortname == trim(flds_scalar_name)) then - call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(shortname)//" is connected on root pe", & - ESMF_LOGMSG_INFO, rc=dbrc) - call SetScalarField(field, flds_scalar_name, flds_scalar_num, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - elseif (present(grid)) then - call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(shortname)//" is connected using grid", & - ESMF_LOGMSG_INFO, rc=dbrc) - ! Create the field - field = ESMF_FieldCreate(grid, ESMF_TYPEKIND_R8, name=shortname,rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - elseif (present(mesh)) then - call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(shortname)//" is connected using mesh", & - ESMF_LOGMSG_INFO, rc=dbrc) - ! Create the field - field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=shortname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - else - call ESMF_LogWrite(trim(subname)//trim(tag)//": ERROR grid or mesh expected", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) - rc = ESMF_FAILURE - return - endif - - ! NOW call NUOPC_Realize - call NUOPC_Realize(state, field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - ! call ESMF_FieldPrint(field=field, rc=rc) - ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - endif - - else - - call ESMF_LogWrite(subname // trim(tag) // " Field = "// trim(shortname) // " is not connected.", & - ESMF_LOGMSG_INFO, rc=dbrc) - call ESMF_StateRemove(state, (/shortname/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - end if - - end if - end do - - call ESMF_LogWrite(subname//' done ', ESMF_LOGMSG_INFO, rc=dbrc) - - contains !- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) - ! ---------------------------------------------- - ! create a field with scalar data on the root pe - ! ---------------------------------------------- - use ESMF, only : ESMF_Field, ESMF_DistGrid, ESMF_Grid - use ESMF, only : ESMF_DistGridCreate, ESMF_GridCreate, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU - use ESMF, only : ESMF_FieldCreate, ESMF_GridCreate, ESMF_TYPEKIND_R8 - type(ESMF_Field) , intent(inout) :: field - character(len=*) , intent(in) :: flds_scalar_name - integer , intent(in) :: flds_scalar_num - integer , intent(inout) :: rc - - ! local variables - type(ESMF_Distgrid) :: distgrid - type(ESMF_Grid) :: grid - character(len=*), parameter :: subname='(SetScalarField)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - ! create a DistGrid with a single index space element, which gets mapped onto DE 0. - distgrid = ESMF_DistGridCreate(minIndex=(/1/), maxIndex=(/1/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - grid = ESMF_GridCreate(distgrid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - field = ESMF_FieldCreate(name=trim(flds_scalar_name), & - grid=grid, & - typekind=ESMF_TYPEKIND_R8, & - ungriddedLBound=(/1/), & - ungriddedUBound=(/flds_scalar_num/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - - end subroutine SetScalarField - - end subroutine shr_nuopc_fldList_Realize - - !================================================================================ - - subroutine shr_nuopc_fldList_GetFldInfo_general(fldList, fldindex, active, stdname, shortname) - ! ---------------------------------------------- - ! Get field info - ! ---------------------------------------------- - type(shr_nuopc_fldList_type) , intent(in) :: fldList - integer , intent(in) :: fldindex - logical , intent(out) :: active - character(len=*) , intent(out) :: stdname - character(len=*) , intent(out) :: shortname - - ! local variables - character(len=*), parameter :: subname='(shr_nuopc_fldList_GetFldInfo_general)' - ! ---------------------------------------------- - - active = fldList%flds(fldindex)%active - stdname = fldList%flds(fldindex)%stdname - shortname = fldList%flds(fldindex)%shortname - end subroutine shr_nuopc_fldList_GetFldInfo_general - - subroutine shr_nuopc_fldList_GetFldInfo_stdname(fldList, fldindex, stdname) - ! ---------------------------------------------- - ! Get field info - ! ---------------------------------------------- - type(shr_nuopc_fldList_type) , intent(in) :: fldList - integer , intent(in) :: fldindex - character(len=*) , intent(out) :: stdname - - ! local variables - character(len=*), parameter :: subname='(shr_nuopc_fldList_GetFldInfo_stdname)' - ! ---------------------------------------------- - - stdname = fldList%flds(fldindex)%stdname - end subroutine shr_nuopc_fldList_GetFldInfo_stdname - - subroutine shr_nuopc_fldList_GetFldInfo_merging(fldList, fldindex, compsrc, merge_field, merge_type, merge_fracname) - ! ---------------------------------------------- - ! Get field merge info - ! ---------------------------------------------- - type(shr_nuopc_fldList_type) , intent(in) :: fldList - integer , intent(in) :: fldindex - integer , intent(in) :: compsrc - character(len=*) , intent(out) :: merge_field - character(len=*) , intent(out) :: merge_type - character(len=*) , intent(out) :: merge_fracname - - ! local variables - character(len=*), parameter :: subname='(shr_nuopc_fldList_GetFldInfo_merging)' - ! ---------------------------------------------- - - merge_field = fldList%flds(fldindex)%merge_fields(compsrc) - merge_type = fldList%flds(fldindex)%merge_types(compsrc) - merge_fracname = fldList%flds(fldindex)%merge_fracnames(compsrc) - end subroutine shr_nuopc_fldList_GetFldInfo_merging - - !================================================================================ - - integer function shr_nuopc_fldList_GetNumFlds(fldList) - - ! input/output variables - type(shr_nuopc_fldList_type), intent(in) :: fldList - ! ---------------------------------------------- - - if (associated(fldList%flds)) then - shr_nuopc_fldList_GetNumFlds = size(fldList%flds) - else - shr_nuopc_fldList_GetNumFlds = 0 - end if - - end function shr_nuopc_fldList_GetNumFlds - - !================================================================================ - - subroutine shr_nuopc_fldList_GetFldNames(flds, fldnames, rc) - - use ESMF, only : ESMF_LOGMSG_INFO, ESMF_FAILURE, ESMF_SUCCESS, ESMF_LogWrite - - ! input/output variables - type(shr_nuopc_fldList_entry_type) , pointer :: flds(:) - character(len=*) , pointer :: fldnames(:) - integer, optional , intent(out) :: rc - - !local variables - integer :: n - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - if (associated(flds) .and. associated(fldnames)) then - do n = 1,size(flds) - fldnames(n) = trim(flds(n)%shortname) - end do - else - call ESMF_LogWrite("shr_nuopc_fldList_GetFldNames: ERROR either flds or fldnames have not been allocate ", & - ESMF_LOGMSG_INFO, rc=rc) - rc=ESMF_FAILURE - return - end if - - end subroutine shr_nuopc_fldList_GetFldNames - -end module shr_nuopc_fldList_mod diff --git a/src/drivers/nuopc/shr/shr_nuopc_grid_mod.F90 b/src/drivers/nuopc/shr/shr_nuopc_grid_mod.F90 deleted file mode 100644 index dae5f46c909..00000000000 --- a/src/drivers/nuopc/shr/shr_nuopc_grid_mod.F90 +++ /dev/null @@ -1,393 +0,0 @@ -!================================================================================ -module shr_nuopc_grid_mod - use shr_nuopc_utils_mod, only : shr_nuopc_utils_ChkErr - implicit none - private - - public :: shr_nuopc_grid_MeshInit - public :: shr_nuopc_grid_ArrayToState - public :: shr_nuopc_grid_StateToArray - - character(len=*), parameter :: u_FILE_u = & - __FILE__ - -!----------------------------------------------------------------------------- -contains -!----------------------------------------------------------------------------- - subroutine shr_nuopc_grid_MeshInit(gcomp, nx_global, ny_global, gindex, lon, lat, Emesh, rc) - - !----------------------------------------- - ! create an Emesh object for Fields - !----------------------------------------- - use shr_kind_mod, only : R8=>shr_kind_r8 - use ESMF, only : ESMF_GridComp, ESMF_VM, ESMF_Mesh - use ESMF, only : ESMF_VMGet, ESMF_GridCompGet, ESMF_VMBroadCast, ESMF_VMAllGatherV - use ESMF, only : ESMF_SUCCESS, ESMF_LOGMSG_INFO, ESMF_LogWrite - use ESMF, only : ESMF_VMGather, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU - use ESMF, only : ESMF_MeshCreate, ESMF_COORDSYS_SPH_DEG, ESMF_REDUCE_SUM - use ESMF, only : ESMF_VMAllReduce, ESMF_MESHELEMTYPE_QUAD - - type(ESMF_GridComp) :: gcomp - integer , intent(in) :: nx_global - integer , intent(in) :: ny_global - integer , intent(in) :: gindex(:) - real(r8), pointer , intent(in) :: lon(:) - real(r8), pointer , intent(in) :: lat(:) - type(ESMF_Mesh) , intent(inout) :: Emesh - integer , intent(inout) :: rc - - !--- local --- - integer :: n,n1,n2,de - integer :: iam - integer :: lsize - integer :: numTotElems, numNodes, numConn, nodeindx - integer :: iur,iul,ill,ilr - integer :: xid, yid, xid0, yid0 - real(r8) :: lonur, lonul, lonll, lonlr - integer, pointer :: iurpts(:) - integer, pointer :: elemIds(:) - integer, pointer :: elemTypes(:) - integer, pointer :: elemConn(:) - real(r8),pointer :: elemCoords(:) - integer, pointer :: nodeIds(:) - integer, pointer :: nodeOwners(:) - real(r8),pointer :: nodeCoords(:) - real(r8),pointer :: latG(:) - real(r8),pointer :: lonG(:) - integer ,pointer :: pes_local(:) - integer ,pointer :: pes_global(:) - integer, pointer :: recvOffsets(:) - integer, pointer :: recvCounts(:) - integer :: sendData(1) - type(ESMF_VM) :: vm - integer :: petCount - character(len=*),parameter :: subname='(shr_nuopc_grid_MeshInit)' - !-------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_LogWrite(subname, ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - lsize = size(gindex) - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, petCount=petCount, localpet=iam, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - allocate(latG(nx_global*ny_global)) - allocate(lonG(nx_global*ny_global)) - - allocate(recvoffsets(petCount)) - allocate(recvCounts(petCount)) - - sendData(1) = lsize - call ESMF_VMGather(vm, sendData=sendData, recvData=recvCounts, count=1, rootPet=0, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMBroadCast(vm, bcstData=recvCounts, count=petCount, rootPet=0, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - recvoffsets(1) = 0 - do n = 2,petCount - recvoffsets(n) = recvoffsets(n-1) + recvCounts(n-1) - end do - - call ESMF_VMAllGatherV(vm, lat, lsize, latG, recvCounts, recvOffsets, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMAllGatherV(vm, lon, lsize, lonG, recvCounts, recvOffsets, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - deallocate(recvoffsets) - deallocate(recvCounts) - - ! assumes quadrilaterals for each gridcell (element) - ! element index matches gsmap index value - ! nodeid at lower left of each gridcell matches gsmap index value - ! assumes wrap around in x direction but no wrap in y direction - ! node ids need to be described in counter clockwise direction - ! node id associated with lower left cell is assigned to local PET - ! node ids at top of y boundary assigned to the element to the right - - numTotElems = lsize - - allocate(elemIds(numTotElems)) - allocate(elemTypes(numTotElems)) - elemTypes=(/ESMF_MESHELEMTYPE_QUAD/) - allocate(elemConn(4*numTotElems)) - allocate(elemCoords(2*numTotElems)) - - allocate(nodeIds(numTotElems*4)) - nodeIds = -99 - - elemIds(:) = gindex(:) - numNodes = 0 - numConn = 0 - - do n = 1,numTotElems - elemTypes(n) = ESMF_MESHELEMTYPE_QUAD - elemCoords(2*n-1) = lon(n) - elemCoords(2*n) = lat(n) - - do n1 = 1,4 - - numNodes = numNodes + 1 - nodeindx = numNodes - if (n1 == 1 .or. n1 == 3) xid = mod(elemIds(n)-1,nx_global) + 1 - if (n1 == 2 .or. n1 == 4) xid = mod(elemIds(n) ,nx_global) + 1 - if (n1 == 1 .or. n1 == 2) yid = (elemIds(n)-1)/nx_global + 1 - if (n1 == 3 .or. n1 == 4) yid = (elemIds(n)-1)/nx_global + 2 - nodeIds(numNodes) = (yid-1) * nx_global + xid - n2 = 0 - do while (n2 < numNodes - 1 .and. nodeindx == numNodes) - n2 = n2 + 1 - if (nodeIds(numNodes) == nodeIds(n2)) nodeindx = n2 - enddo - if (nodeindx /= numNodes) then - numNodes = numNodes - 1 - endif - - numConn = numConn + 1 - elemConn(numConn) = nodeindx - enddo - enddo - - - allocate(nodeCoords(2*numNodes)) - allocate(nodeOwners(numNodes)) - allocate(iurpts(numNodes)) - - do n = 1,numNodes - - xid0 = mod(nodeIds(n)-1, nx_global) + 1 - yid0 = (nodeIds(n)-1) / nx_global + 1 - - xid = xid0 - yid = max(min(yid0,ny_global),1) - iur = (yid-1) * nx_global + xid - iurpts(n) = iur - - xid = mod(xid0 - 2 + nx_global, nx_global) + 1 - yid = max(min(yid0,ny_global),1) - iul = (yid-1) * nx_global + xid - - xid = mod(xid0 - 2 + nx_global, nx_global) + 1 - yid = max(min(yid0-1,ny_global),1) - ill = (yid-1) * nx_global + xid - - xid = xid0 - yid = max(min(yid0-1,ny_global),1) - ilr = (yid-1) * nx_global + xid - - ! write(tmpstr,'(2a,8i6)') subname,' nodecoord = ',n,nodeIds(n),xid0,yid0,iur,iul,ill,ilr - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - ! need to normalize lon values to same 360 degree setting, use lonur as reference value - lonur = lonG(iur) - lonul = lonG(iul) - lonll = lonG(ill) - lonlr = lonG(ilr) - - if (abs(lonul + 360._r8 - lonur) < abs(lonul - lonur)) lonul = lonul + 360._r8 - if (abs(lonul - 360._r8 - lonur) < abs(lonul - lonur)) lonul = lonul - 360._r8 - if (abs(lonll + 360._r8 - lonur) < abs(lonll - lonur)) lonll = lonll + 360._r8 - if (abs(lonll - 360._r8 - lonur) < abs(lonll - lonur)) lonll = lonll - 360._r8 - if (abs(lonlr + 360._r8 - lonur) < abs(lonlr - lonur)) lonlr = lonlr + 360._r8 - if (abs(lonlr - 360._r8 - lonur) < abs(lonlr - lonur)) lonlr = lonlr - 360._r8 - - nodeCoords(2*n-1) = 0.25_r8 * (lonur + lonul + lonll + lonlr) - nodeCoords(2*n) = 0.25_r8 * (latG(iur) + latG(iul) + latG(ill) + latG(ilr)) - enddo - - deallocate(lonG) - deallocate(latG) - - ! Determine the pes that own each index of iurpts (nodeOwners) - - allocate(pes_local(nx_global*ny_global)) - allocate(pes_global(nx_global*ny_global)) - pes_local(:) = 0 - do n = 1,lsize - pes_local(gindex(n)) = iam - end do - - call ESMF_VMAllReduce(vm, sendData=pes_local, recvData=pes_global, count=nx_global*ny_global, & - reduceflag=ESMF_REDUCE_SUM, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - do n = 1,numNodes - nodeOwners(n) = pes_global(iurpts(n)) - end do - deallocate(pes_local) - deallocate(pes_global) - - ! do n = 1,numtotelems - ! write(tmpstr,'(2a,2i8,2g13.6)') subname,' elemA = ',n,elemIds(n),elemCoords(2*n-1:2*n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! write(tmpstr,'(2a,6i8)') subname,' elemB = ',n,elemIds(n),nodeIds(elemConn(4*n-3)),& - ! nodeIds(elemConn(4*n-2)),nodeIds(elemConn(4*n-1)),nodeIds(elemConn(4*n)) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! enddo - ! do n = 1,numNodes - ! write(tmpstr,'(2a,3i8,2g13.6)') subname,' nodesA = ',n,nodeIds(n),nodeOwners(n),nodeCoords(2*n-1:2*n) - ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - ! enddo - - Emesh = ESMF_MeshCreate(parametricDim=2, & - spatialDim=2, & - coordSys=ESMF_COORDSYS_SPH_DEG, & - nodeIds=nodeIds(1:numNodes), & - nodeCoords=nodeCoords, & - nodeOwners=nodeOwners, & - elementIds=elemIds,& - elementTypes=elemTypes, & - elementConn=elemConn, & - elementCoords=elemCoords, & - rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - deallocate(iurpts) - deallocate(nodeIds, nodeCoords, nodeOwners) - deallocate(elemIds, elemTypes, elemConn, elemCoords) - - end subroutine shr_nuopc_grid_MeshInit - - !----------------------------------------------------------------------------- - - subroutine shr_nuopc_grid_ArrayToState(array, rList, state, grid_option, rc) - - ! copy array data to state fields - use ESMF , only : ESMF_State, ESMF_Field, ESMF_SUCCESS - use ESMF , only : ESMF_LogWrite, ESMF_FieldGet, ESMF_StateGet - use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet - use shr_kind_mod , only : R8=>shr_kind_r8, CS=>shr_kind_cs, IN=>shr_kind_in - use shr_string_mod , only : shr_string_listGetName, shr_string_listGetNum - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_reset - use med_constants_mod , only : CL, logunit => shr_log_unit - - !----- arguments ----- - real(r8) , intent(inout) :: array(:,:) - character(len=*) , intent(in) :: rList - type(ESMF_State) , intent(inout) :: state - character(len=*) , intent(in) :: grid_option - integer , intent(out) :: rc - - !----- local ----- - type(ESMF_VM) :: vm - integer :: localpet - integer(IN) :: nflds, lsize, n, nf - character(len=CS) :: fldname - type(ESMF_Field) :: lfield - real(R8), pointer :: farray1(:) - integer :: dbrc - character(len=CL) :: tmpstr - character(*),parameter :: subName = "(shr_nuopc_grid_ArrayToState)" - !---------------------------------------------------------- - - rc = ESMF_SUCCESS - call shr_nuopc_methods_State_reset(state, value = 0.0_r8, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGetCurrent(vm, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - lsize = size(array, dim=2) - nflds = shr_string_listGetNum(rList) - do nf = 1,nflds - call shr_string_listGetName(rList, nf, fldname, dbrc) - - call ESMF_StateGet(state, itemName=trim(fldname), field=lfield, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) then - ! we don't nessesarily want this message to trigger an ESMF error - if(localpet==0) write(logunit,*) trim(subname)//": fldname = "//trim(fldname)//" not found on state" - else - call ESMF_LogWrite(trim(subname)//": fldname = "//trim(fldname)//" copy", ESMF_LOGMSG_INFO, rc=dbrc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfield, farrayPtr=farray1, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - do n = 1,lsize - farray1(n) = array(nf,n) - enddo -#ifdef DEBUG - write(tmpstr,'(a,3g13.6)') trim(subname)//":"//trim(fldname)//"=",minval(farray1),maxval(farray1),sum(farray1) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return -#endif - end if - enddo - - end subroutine shr_nuopc_grid_ArrayToState - - !----------------------------------------------------------------------------- - - subroutine shr_nuopc_grid_StateToArray(state, array, rList, grid_option, rc) - - ! copy state fields to array data - use ESMF , only : ESMF_State, ESMF_Field - use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_LogFoundError, ESMF_LogWrite - use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_SUCCESS, ESMF_LOGMSG_INFO - use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet - use shr_kind_mod , only : R8=>shr_kind_r8, CS=>shr_kind_CS, IN=>shr_kind_in - use shr_string_mod , only : shr_string_listGetName, shr_string_listGetNum - use med_constants_mod , only : CL, logunit => shr_log_unit - - - !----- arguments ----- - type(ESMF_State) , intent(in) :: state - real(r8) , intent(inout) :: array(:,:) - character(len=*) , intent(in) :: rList - character(len=*) , intent(in) :: grid_option - integer , intent(out) :: rc - - !----- local ----- - type(ESMF_VM) :: vm - integer :: localpet - integer(IN) :: nflds, lsize, n, nf - character(len=CS) :: fldname - type(ESMF_Field) :: lfield - real(R8), pointer :: farray1(:) - integer :: dbrc - character(len=CL) :: tmpstr - character(*),parameter :: subName = "(shr_nuopc_grid_StateToArray)" - !---------------------------------------------------------- - - rc = ESMF_SUCCESS - call ESMF_VMGetCurrent(vm, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - nflds = shr_string_listGetNum(rList) - lsize = size(array, dim=2) - - do nf = 1,nflds - call shr_string_listGetName(rList, nf, fldname, dbrc) - call ESMF_StateGet(state, itemName=trim(fldname), field=lfield, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) then - ! we don't nessesarily want this message to trigger an ESMF error - if(localpet==0) write(logunit,*) trim(subname)//": fldname = "//trim(fldname)//" not found on state" - else - call ESMF_LogWrite(trim(subname)//": fldname = "//trim(fldname)//" copy", ESMF_LOGMSG_INFO, rc=dbrc) - call ESMF_FieldGet(lfield, farrayPtr=farray1, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - do n = 1,lsize - array(nf,n) = farray1(n) - enddo - write(tmpstr,'(a,3g13.6)') trim(subname)//":"//trim(fldname)//"=",& - minval(farray1),maxval(farray1),sum(farray1) - call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) - - endif - - enddo - - end subroutine shr_nuopc_grid_StateToArray - -end module shr_nuopc_grid_mod diff --git a/src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 b/src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 index 6ab11a94079..7c4dc6bed8a 100644 --- a/src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 +++ b/src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 @@ -51,6 +51,7 @@ module shr_nuopc_methods_mod public shr_nuopc_methods_FB_accum public shr_nuopc_methods_FB_average public shr_nuopc_methods_FB_init + public shr_nuopc_methods_FB_init_pointer public shr_nuopc_methods_FB_reset public shr_nuopc_methods_FB_clean public shr_nuopc_methods_FB_diagnose @@ -58,9 +59,10 @@ module shr_nuopc_methods_mod public shr_nuopc_methods_FB_GetFldPtr public shr_nuopc_methods_FB_getNameN public shr_nuopc_methods_FB_getFieldN - public shr_nuopc_methods_FB_Field_diagnose public shr_nuopc_methods_FB_FieldRegrid public shr_nuopc_methods_FB_getNumflds + public shr_nuopc_methods_FB_Field_diagnose + public shr_nuopc_methods_Field_diagnose public shr_nuopc_methods_State_reset public shr_nuopc_methods_State_diagnose public shr_nuopc_methods_State_GeomPrint @@ -104,11 +106,12 @@ module shr_nuopc_methods_mod private shr_nuopc_methods_State_SetFldPtr private shr_nuopc_methods_Array_diagnose - !----------------------------------------------------------------------------- - contains - !----------------------------------------------------------------------------- +!----------------------------------------------------------------------------- +contains +!----------------------------------------------------------------------------- subroutine shr_nuopc_methods_FB_RWFields(mode,fname,FB,flag,rc) + ! ---------------------------------------------- ! Read or Write Field Bundles ! ---------------------------------------------- @@ -126,18 +129,17 @@ subroutine shr_nuopc_methods_FB_RWFields(mode,fname,FB,flag,rc) character(len=ESMF_MAXSTR) :: name integer :: fieldcount, n logical :: fexists - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_RWFields)' ! ---------------------------------------------- rc = ESMF_SUCCESS if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(fname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//trim(fname)//": called", ESMF_LOGMSG_INFO) endif if (mode == 'write') then if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": write "//trim(fname), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": write "//trim(fname), ESMF_LOGMSG_INFO) end if call ESMF_FieldBundleWrite(FB, fname, & singleFile=.true., status=ESMF_FILESTATUS_REPLACE, iofmt=ESMF_IOFMT_NETCDF, rc=rc) @@ -148,7 +150,7 @@ subroutine shr_nuopc_methods_FB_RWFields(mode,fname,FB,flag,rc) inquire(file=fname,exist=fexists) if (fexists) then if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": read "//trim(fname), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": read "//trim(fname), ESMF_LOGMSG_INFO) end if !----------------------------------------------------------------------------------------------------- ! tcraig, ESMF_FieldBundleRead fails if a field is not on the field bundle, but we really want to just @@ -164,7 +166,8 @@ subroutine shr_nuopc_methods_FB_RWFields(mode,fname,FB,flag,rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldRead (field, fname, iofmt=ESMF_IOFMT_NETCDF, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=u_FILE_u)) call ESMF_LogWrite(trim(subname)//' WARNING missing field '//trim(name),rc=dbrc) + line=__LINE__, file=u_FILE_u)) call ESMF_LogWrite(trim(subname)//& + ' WARNING missing field '//trim(name)) enddo call shr_nuopc_methods_FB_diagnose(FB, 'read '//trim(fname), rc) @@ -172,41 +175,188 @@ subroutine shr_nuopc_methods_FB_RWFields(mode,fname,FB,flag,rc) endif else - call ESMF_LogWrite(trim(subname)//": mode WARNING "//trim(fname)//" mode="//trim(mode), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": mode WARNING "//trim(fname)//" mode="//trim(mode), ESMF_LOGMSG_INFO) endif if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//trim(fname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//trim(fname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_RWFields !----------------------------------------------------------------------------- - subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, STgeom, FBflds, STflds, name, rc) + subroutine shr_nuopc_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, rc) - use ESMF , only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleGet - use ESMF , only : ESMF_State, ESMF_Grid, ESMF_Mesh, ESMF_StaggerLoc, ESMF_MeshLoc - use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_FieldBundleAdd, ESMF_FieldCreate - use ESMF , only : ESMF_TYPEKIND_R8, ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID - use ESMF , only : ESMF_FIELDSTATUS_EMPTY - use med_constants_mod , only : spval_init => med_constants_spval_init + ! ---------------------------------------------- + ! Create FBout from StateIn mesh and pointer + ! ---------------------------------------------- + + use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldCreate + use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleAdd, ESMF_FieldBundleCreate + use ESMF , only : ESMF_State, ESMF_StateGet, ESMF_Mesh, ESMF_MeshLoc + use ESMF , only : ESMF_AttributeGet, ESMF_INDEX_DELOCAL + use med_constants_mod , only : R8 + + ! input/output variables + type(ESMF_State) , intent(in) :: StateIn ! input state + type(ESMF_FieldBundle), intent(inout) :: FBout ! output field bundle + character(len=*) , intent(in) :: flds_scalar_name ! name of scalar fields + character(len=*) , intent(in) :: name + integer , intent(out) :: rc + + ! local variables + logical :: isPresent + integer :: n,n1 + type(ESMF_Field) :: lfield + type(ESMF_Field) :: newfield + type(ESMF_MeshLoc) :: meshloc + type(ESMF_Mesh) :: lmesh + integer :: lrank + integer :: fieldCount + integer :: ungriddedCount + integer :: gridToFieldMapCount + integer :: ungriddedLBound(1) + integer :: ungriddedUBound(1) + integer :: gridToFieldMap(1) + real(R8), pointer :: dataptr1d(:) + real(R8), pointer :: dataptr2d(:,:) + character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_init_pointer)' + ! ---------------------------------------------- + + ! Create empty FBout + FBout = ESMF_FieldBundleCreate(name=trim(name), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Get fields from StateIn + call ESMF_StateGet(StateIn, itemCount=fieldCount, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldNameList(fieldCount)) + call ESMF_StateGet(StateIn, itemNameList=lfieldNameList, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Remove scalar field and blank fields from field bundle + do n = 1, fieldCount + if (trim(lfieldnamelist(n)) == trim(flds_scalar_name) .or. trim(lfieldnamelist(n)) == '') then + do n1 = n, fieldCount-1 + lfieldnamelist(n1) = lfieldnamelist(n1+1) + enddo + fieldCount = fieldCount - 1 + endif + enddo ! n + + ! Only create the fieldbundle if the number of non-scalar fields is > 0 + if (fieldCount > 0) then + + ! Get mesh from first non-scalar field in StateIn (assumes all the fields have the same mesh) + call ESMF_StateGet(StateIn, itemName=lfieldNameList(1), field=lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, mesh=lmesh, meshloc=meshloc, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Loop over fields in StateIn skipping the field with just scalar data + do n = 1, fieldCount + ! get field from StateIn + call ESMF_StateGet(StateIn, itemName=lfieldNameList(n), field=lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! determine rank of field + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 2) then + + ! determine ungridded lower and upper bounds for lfield + call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & + purpose="Instance", itemCount=ungriddedCount, isPresent=isPresent, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ungriddedCount /= 1) then + call ESMF_LogWrite(trim(subname)//": ERROR ungriddedCount for "// & + trim(lfieldnamelist(n))//" must be 1 if rank is 2 ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + end if + + ! set ungridded dimensions and GridToFieldMap for field + call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & + purpose="Instance", valueList=ungriddedLBound, rc=rc) + call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", & + purpose="Instance", valueList=ungriddedUBound, rc=rc) + call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", & + purpose="Instance", valueList=gridToFieldMap, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! get 2d pointer for field + call ESMF_FieldGet(lfield, farrayptr=dataptr2d, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create new field with an ungridded dimension + newfield = ESMF_FieldCreate(lmesh, dataptr2d, ESMF_INDEX_DELOCAL, & + meshloc=meshloc, name=lfieldNameList(n), & + ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, gridToFieldMap=gridtoFieldMap, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + else if (lrank == 1) then + + ! get 1d pointer for field + call ESMF_FieldGet(lfield, farrayptr=dataptr1d, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + ! create new field without an ungridded dimension + newfield = ESMF_FieldCreate(lmesh, dataptr1d, ESMF_INDEX_DELOCAL, & + meshloc=meshloc, name=lfieldNameList(n), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + else + + call ESMF_LogWrite(trim(subname)//": ERROR only rank1 and rank2 are supported for rank of fields ", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + + end if + + ! Add new field to FBout + call ESMF_FieldBundleAdd(FBout, (/newfield/), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + end do ! end of loop over input state fields + end if ! end of fieldcount > 0 + + deallocate(lfieldNameList) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": FBout from input State and field pointers", ESMF_LOGMSG_INFO, rc=rc) + end if + + end subroutine shr_nuopc_methods_FB_init_pointer + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBgeom, STgeom, FBflds, STflds, name, rc) ! ---------------------------------------------- ! Create FBout from fieldNameList, FBflds, STflds, FBgeom or STgeom in that order or priority - ! Pass in FBgeom OR STgeom, get grid/mesh from that object + ! Pass in FBgeom OR STgeom, get mesh from that object ! ---------------------------------------------- + use ESMF , only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleCreate, ESMF_FieldBundleGet + use ESMF , only : ESMF_State, ESMF_Mesh, ESMF_StaggerLoc, ESMF_MeshLoc + use ESMF , only : ESMF_StateGet, ESMF_FieldGet, ESMF_FieldBundleAdd, ESMF_FieldCreate + use ESMF , only : ESMF_TYPEKIND_R8, ESMF_FIELDSTATUS_EMPTY, ESMF_AttributeGet + use med_constants_mod , only : spval_init => med_constants_spval_init + ! input/output variables - type(ESMF_FieldBundle), intent(inout) :: FBout - character(len=*) , intent(in) :: flds_scalar_name - character(len=*) , intent(in), optional :: fieldNameList(:) - type(ESMF_FieldBundle), intent(in), optional :: FBgeom - type(ESMF_State) , intent(in), optional :: STgeom - type(ESMF_FieldBundle), intent(in), optional :: FBflds - type(ESMF_State) , intent(in), optional :: STflds - character(len=*) , intent(in), optional :: name - integer , intent(out) :: rc + type(ESMF_FieldBundle), intent(inout) :: FBout ! output field bundle + character(len=*) , intent(in) :: flds_scalar_name ! name of scalar fields + character(len=*) , intent(in), optional :: fieldNameList(:) ! names of fields to use in output field bundle + type(ESMF_FieldBundle), intent(in), optional :: FBgeom ! input field bundle geometry to use + type(ESMF_State) , intent(in), optional :: STgeom ! input state geometry to use + type(ESMF_FieldBundle), intent(in), optional :: FBflds ! input field bundle fields + type(ESMF_State) , intent(in), optional :: STflds ! input state fields + character(len=*) , intent(in), optional :: name ! name to use for output field bundle + integer , intent(out) :: rc ! local variables integer :: i,j,n,n1 @@ -214,17 +364,21 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg logical :: found character(ESMF_MAXSTR) :: lname type(ESMF_Field) :: field,lfield - type(ESMF_Grid) :: lgrid type(ESMF_Mesh) :: lmesh type(ESMF_StaggerLoc) :: staggerloc type(ESMF_MeshLoc) :: meshloc - integer :: dbrc - character(ESMF_MAXSTR),allocatable :: lfieldNameList(:) - character(len=*),parameter :: subname='(shr_nuopc_methods_FB_init)' + integer :: ungriddedCount + integer, allocatable :: ungriddedLBound(:) + integer, allocatable :: ungriddedUBound(:) + integer :: gridToFieldMapCount + integer, allocatable :: gridToFieldMap(:) + logical :: isPresent + character(ESMF_MAXSTR), allocatable :: lfieldNameList(:) + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_init)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -241,21 +395,21 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg if (present(fieldNameList) .and. present(FBflds) .and. present(STflds)) then call ESMF_LogWrite(trim(subname)//": ERROR only fieldNameList, FBflds, or STflds can be an argument", & - ESMF_LOGMSG_INFO, rc=rc) + ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return endif if (present(FBgeom) .and. present(STgeom)) then call ESMF_LogWrite(trim(subname)//": ERROR FBgeom and STgeom cannot both be arguments", & - ESMF_LOGMSG_INFO, rc=rc) + ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return endif if (.not.present(FBgeom) .and. .not.present(STgeom)) then call ESMF_LogWrite(trim(subname)//": ERROR FBgeom or STgeom must be an argument", & - ESMF_LOGMSG_INFO, rc=rc) + ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return endif @@ -267,7 +421,7 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg call ESMF_StateGet(STgeom, itemCount=fieldCountGeom, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//": ERROR FBgeom or STgeom must be passed", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": ERROR FBgeom or STgeom must be passed", ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return endif @@ -321,7 +475,7 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg end if else call ESMF_LogWrite(trim(subname)//": ERROR fieldNameList, FBflds, STflds, FBgeom, or STgeom must be passed", & - ESMF_LOGMSG_INFO, rc=rc) + ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return endif @@ -341,27 +495,26 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg enddo ! n !--------------------------------- - ! create the grid (lgrid) or mesh(lmesh) - ! that will be used for FBout fields + ! create the mesh(lmesh) that will be used for FBout fields !--------------------------------- if (fieldcount > 0 .and. fieldcountgeom > 0) then - ! Look at only the first field in either the FBgeom and STgeom to get the grid + ! Look at only the first field in either the FBgeom and STgeom to get the mesh if (present(FBgeom)) then call shr_nuopc_methods_FB_getFieldN(FBgeom, 1, lfield, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" grid/mesh from FBgeom", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" mesh from FBgeom", ESMF_LOGMSG_INFO) end if elseif (present(STgeom)) then call shr_nuopc_methods_State_getFieldN(STgeom, 1, lfield, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" grid/mesh from STgeom", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" mesh from STgeom", ESMF_LOGMSG_INFO) end if else - call ESMF_LogWrite(trim(subname)//": ERROR FBgeom or STgeom must be passed", ESMF_LOGMSG_INFO, rc=rc) + call ESMF_LogWrite(trim(subname)//": ERROR FBgeom or STgeom must be passed", ESMF_LOGMSG_INFO) rc = ESMF_FAILURE return endif @@ -371,32 +524,17 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (status == ESMF_FIELDSTATUS_EMPTY) then call ESMF_LogWrite(trim(subname)//":"//trim(lname)//": ERROR field does not have a geom yet ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif - ! Determine if first field in either FBgeom or STgeom is on a grid or a mesh - call ESMF_FieldGet(lfield, geomtype=geomtype, rc=rc) + ! Assume field is on mesh + call ESMF_FieldGet(lfield, mesh=lmesh, meshloc=meshloc, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - - if (geomtype == ESMF_GEOMTYPE_GRID) then - call ESMF_FieldGet(lfield, grid=lgrid, staggerloc=staggerloc, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" use grid", ESMF_LOGMSG_INFO, rc=rc) - end if - elseif (geomtype == ESMF_GEOMTYPE_MESH) then - call ESMF_FieldGet(lfield, mesh=lmesh, meshloc=meshloc, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" use mesh", ESMF_LOGMSG_INFO, rc=rc) - end if - else ! geomtype - call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - endif ! geomtype + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" use mesh", ESMF_LOGMSG_INFO) + end if endif ! fieldcount > 0 @@ -409,32 +547,73 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg if (fieldcountgeom > 0) then - ! Now loop over all the fields in either FBgeom or STgeom - do n = 1, fieldCount + ! Now loop over all the fields in the field name list + do n = 1, fieldCount - ! Create the field on either lgrid or lmesh - if (geomtype == ESMF_GEOMTYPE_GRID) then - field = ESMF_FieldCreate(lgrid, ESMF_TYPEKIND_R8, staggerloc=staggerloc, name=lfieldNameList(n), rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - elseif (geomtype == ESMF_GEOMTYPE_MESH) then - field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - else ! geomtype - call ESMF_LogWrite(trim(subname)//": ERROR no grid/mesh for field ", ESMF_LOGMSG_INFO, rc=rc) - rc = ESMF_FAILURE - return - endif + ! Note that input fields come from ONE of FBFlds, STflds, or fieldNamelist input argument + if (present(FBFlds) .or. present(STflds)) then - ! Add the created field bundle FBout - call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 1) then - call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" adding field "//trim(lfieldNameList(n)), & - ESMF_LOGMSG_INFO, rc=dbrc) - endif + ! ungridded dimensions might be present in the input states or field bundles + if (present(FBflds)) then + call shr_nuopc_methods_FB_getFieldN(FBflds, n, lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif (present(STflds)) then + call shr_nuopc_methods_State_getFieldN(STflds, n, lfield, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + end if - enddo ! fieldCount + ! Determine ungridded lower and upper bounds for lfield + ungriddedCount=0 ! initialize in case it was not set + call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & + purpose="Instance", itemCount=ungriddedCount, isPresent=isPresent, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! Create the field on a lmesh + if (ungriddedCount > 0) then + ! ungridded dimensions in field + allocate(ungriddedLBound(ungriddedCount), ungriddedUBound(ungriddedCount)) + call ESMF_AttributeGet(lfield, name="UngriddedLBound", convention="NUOPC", & + purpose="Instance", valueList=ungriddedLBound, rc=rc) + call ESMF_AttributeGet(lfield, name="UngriddedUBound", convention="NUOPC", & + purpose="Instance", valueList=ungriddedUBound, rc=rc) + + call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", & + purpose="Instance", itemCount=gridToFieldMapCount, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(gridToFieldMap(gridToFieldMapCount)) + call ESMF_AttributeGet(lfield, name="GridToFieldMap", convention="NUOPC", & + purpose="Instance", valueList=gridToFieldMap, rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), & + ungriddedLbound=ungriddedLbound, ungriddedUbound=ungriddedUbound, & + gridToFieldMap=gridToFieldMap) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + deallocate( ungriddedLbound, ungriddedUbound, gridToFieldMap) + else + ! No ungridded dimensions in field + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + end if + + else if (present(fieldNameList)) then + + ! Assume no ungridded dimensions if just the field name list is give + field = ESMF_FieldCreate(lmesh, ESMF_TYPEKIND_R8, meshloc=meshloc, name=lfieldNameList(n), rc=rc) + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + + end if + + ! Add the created field bundle FBout + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" adding field "//trim(lfieldNameList(n)), & + ESMF_LOGMSG_INFO) + end if + call ESMF_FieldBundleAdd(FBout, (/field/), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + enddo ! fieldCount endif ! fieldcountgeom deallocate(lfieldNameList) @@ -443,7 +622,7 @@ subroutine shr_nuopc_methods_FB_init(FBout, flds_scalar_name, fieldNameList, FBg if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_init @@ -451,10 +630,14 @@ end subroutine shr_nuopc_methods_FB_init !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_FB_getNameN(FB, fieldnum, fieldname, rc) - use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet + ! ---------------------------------------------- - ! Get name of field number fieldnum in FB + ! Get name of field number fieldnum in input field bundle FB ! ---------------------------------------------- + + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet + + ! input/output variables type(ESMF_FieldBundle), intent(in) :: FB integer , intent(in) :: fieldnum character(len=*) , intent(out) :: fieldname @@ -463,12 +646,11 @@ subroutine shr_nuopc_methods_FB_getNameN(FB, fieldnum, fieldname, rc) ! local variables integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_getNameN)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -478,7 +660,7 @@ subroutine shr_nuopc_methods_FB_getNameN(FB, fieldnum, fieldname, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldnum > fieldCount) then - call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif @@ -492,7 +674,7 @@ subroutine shr_nuopc_methods_FB_getNameN(FB, fieldnum, fieldname, rc) deallocate(lfieldnamelist) if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_getNameN @@ -500,11 +682,14 @@ end subroutine shr_nuopc_methods_FB_getNameN !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_FB_getFieldN(FB, fieldnum, field, rc) - use ESMF, only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet ! ---------------------------------------------- - ! Get field number fieldnum out of FB + ! Get field with number fieldnum in input field bundle FB ! ---------------------------------------------- + + use ESMF, only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet + + ! input/output variables type(ESMF_FieldBundle), intent(in) :: FB integer , intent(in) :: fieldnum type(ESMF_Field) , intent(inout) :: field @@ -512,12 +697,11 @@ subroutine shr_nuopc_methods_FB_getFieldN(FB, fieldnum, field, rc) ! local variables character(len=ESMF_MAXSTR) :: name - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_getFieldN)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -528,7 +712,7 @@ subroutine shr_nuopc_methods_FB_getFieldN(FB, fieldnum, field, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_getFieldN @@ -536,22 +720,25 @@ end subroutine shr_nuopc_methods_FB_getFieldN !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_FB_getFieldByName(FB, fieldname, field, rc) - use ESMF, only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet + ! ---------------------------------------------- ! Get field associated with fieldname out of FB ! ---------------------------------------------- + + use ESMF, only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet + + ! input/output variables type(ESMF_FieldBundle), intent(in) :: FB character(len=*) , intent(in) :: fieldname type(ESMF_Field) , intent(inout) :: field integer , intent(out) :: rc ! local variables - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_getFieldByName)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -559,7 +746,7 @@ subroutine shr_nuopc_methods_FB_getFieldByName(FB, fieldname, field, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_getFieldByName @@ -579,12 +766,11 @@ subroutine shr_nuopc_methods_State_getNameN(State, fieldnum, fieldname, rc) ! local variables integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_State_getNameN)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -594,7 +780,7 @@ subroutine shr_nuopc_methods_State_getNameN(State, fieldnum, fieldname, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldnum > fieldCount) then - call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif @@ -608,7 +794,7 @@ subroutine shr_nuopc_methods_State_getNameN(State, fieldnum, fieldname, rc) deallocate(lfieldnamelist) if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_getNameN @@ -631,12 +817,11 @@ subroutine shr_nuopc_methods_State_getNumFields(State, fieldnum, rc) type(ESMF_Field), pointer :: fieldList(:) type(ESMF_StateItem_Flag), pointer :: itemTypeList(:) logical, parameter :: use_NUOPC_method = .true. - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_State_getNumFields)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -671,7 +856,7 @@ subroutine shr_nuopc_methods_State_getNumFields(State, fieldnum, rc) endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_getNumFields @@ -690,12 +875,11 @@ subroutine shr_nuopc_methods_State_getFieldN(State, fieldnum, field, rc) ! local variables character(len=ESMF_MAXSTR) :: name - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_State_getFieldN)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -704,9 +888,8 @@ subroutine shr_nuopc_methods_State_getFieldN(State, fieldnum, field, rc) call ESMF_StateGet(State, itemName=name, field=field, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_getFieldN @@ -725,12 +908,11 @@ subroutine shr_nuopc_methods_State_getFieldByName(State, fieldname, field, rc) integer , intent(out) :: rc ! local variables - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_State_getFieldByName)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -738,7 +920,7 @@ subroutine shr_nuopc_methods_State_getFieldByName(State, fieldname, field, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_getFieldByName @@ -761,11 +943,10 @@ subroutine shr_nuopc_methods_FB_clean(FB, rc) integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) type(ESMF_Field) :: field - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_clean)' ! ---------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) @@ -784,7 +965,7 @@ subroutine shr_nuopc_methods_FB_clean(FB, rc) call ESMF_FieldBundleDestroy(FB, rc=rc, noGarbage=.true.) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(lfieldnamelist) - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine shr_nuopc_methods_FB_clean @@ -808,12 +989,11 @@ subroutine shr_nuopc_methods_FB_reset(FB, value, rc) integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) real(R8) :: lvalue - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_reset)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -836,7 +1016,7 @@ subroutine shr_nuopc_methods_FB_reset(FB, value, rc) deallocate(lfieldnamelist) if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_reset @@ -862,12 +1042,12 @@ subroutine shr_nuopc_methods_FB_FieldRegrid(FBin,fldin,FBout,fldout,RH,rc,zerore type(ESMF_RouteHandle), intent(inout) :: RH integer , intent(out) :: rc type(ESMF_Region_Flag), intent(in), optional :: zeroregion + ! ---------------------------------------------- ! local real(R8), pointer :: factorList(:) integer, pointer :: factorIndexList(:,:) type(ESMF_Field) :: field1, field2 - integer :: dbrc integer :: rank logical :: checkflag = .false. character(len=8) :: filename @@ -885,7 +1065,7 @@ subroutine shr_nuopc_methods_FB_FieldRegrid(FBin,fldin,FBout,fldout,RH,rc,zerore localzr = zeroregion endif - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) if (shr_nuopc_methods_FB_FldChk(FBin , trim(fldin) , rc=rc) .and. & shr_nuopc_methods_FB_FldChk(FBout, trim(fldout), rc=rc)) then @@ -902,10 +1082,10 @@ subroutine shr_nuopc_methods_FB_FieldRegrid(FBin,fldin,FBout,fldout,RH,rc,zerore if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//" field not found: "//& - trim(fldin)//","//trim(fldout), ESMF_LOGMSG_INFO, rc=dbrc) + trim(fldin)//","//trim(fldout), ESMF_LOGMSG_INFO) endif - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) call t_stopf(subname) end subroutine shr_nuopc_methods_FB_FieldRegrid @@ -931,12 +1111,11 @@ subroutine shr_nuopc_methods_State_reset(State, value, rc) integer :: fieldCount character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) real(R8) :: lvalue - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_State_reset)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -959,7 +1138,7 @@ subroutine shr_nuopc_methods_State_reset(State, value, rc) deallocate(lfieldnamelist) if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_reset @@ -967,12 +1146,15 @@ end subroutine shr_nuopc_methods_State_reset !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_FB_average(FB, count, rc) + ! ---------------------------------------------- ! Set all fields to zero in FB ! ---------------------------------------------- + use med_constants_mod , only : R8 use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet + ! input/output variables type(ESMF_FieldBundle), intent(inout) :: FB integer , intent(in) :: count integer , intent(out) :: rc @@ -983,21 +1165,20 @@ subroutine shr_nuopc_methods_FB_average(FB, count, rc) character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) real(R8), pointer :: dataPtr1(:) real(R8), pointer :: dataPtr2(:,:) - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_average)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS if (count == 0) then if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": WARNING count is 0", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": WARNING count is 0", ESMF_LOGMSG_INFO) end if - !call ESMF_LogWrite(trim(subname)//": WARNING count is 0 set avg to spval", ESMF_LOGMSG_INFO, rc=dbrc) + !call ESMF_LogWrite(trim(subname)//": WARNING count is 0 set avg to spval", ESMF_LOGMSG_INFO) !call shr_nuopc_methods_FB_reset(FB, value=spval, rc=rc) !if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1025,8 +1206,7 @@ subroutine shr_nuopc_methods_FB_average(FB, count, rc) enddo enddo else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif @@ -1036,7 +1216,7 @@ subroutine shr_nuopc_methods_FB_average(FB, count, rc) endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_average @@ -1062,11 +1242,10 @@ subroutine shr_nuopc_methods_FB_diagnose(FB, string, rc) character(len=CL) :: lstring real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_diagnose)' ! ---------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS lstring = '' @@ -1110,18 +1289,17 @@ subroutine shr_nuopc_methods_FB_diagnose(FB, string, rc) endif else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR, & - line=__LINE__, file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) enddo ! Deallocate memory deallocate(lfieldnamelist) - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine shr_nuopc_methods_FB_diagnose @@ -1144,12 +1322,11 @@ subroutine shr_nuopc_methods_Array_diagnose(array, string, rc) ! local variables character(len=CS) :: lstring real(R8), pointer :: dataPtr3d(:,:,:) - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_Array_diagnose)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -1168,11 +1345,11 @@ subroutine shr_nuopc_methods_Array_diagnose(array, string, rc) minval(dataPtr3d), maxval(dataPtr3d), sum(dataPtr3d) if (dbug_flag > 1) then - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) end if if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Array_diagnose @@ -1197,12 +1374,11 @@ subroutine shr_nuopc_methods_State_diagnose(State, string, rc) character(len=CS) :: lstring real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_State_diagnose)' ! ---------------------------------------------- if (dbug_flag > 5) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) endif lstring = '' @@ -1245,20 +1421,19 @@ subroutine shr_nuopc_methods_State_diagnose(State, string, rc) endif else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR, line=__LINE__, & - file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) enddo deallocate(lfieldnamelist) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_diagnose @@ -1285,12 +1460,11 @@ subroutine shr_nuopc_methods_FB_Field_diagnose(FB, fieldname, string, rc) character(len=CS) :: lstring real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_FieldDiagnose)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -1309,53 +1483,123 @@ subroutine shr_nuopc_methods_FB_Field_diagnose(FB, fieldname, string, rc) write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) else - write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & - " no data" + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname)," no data" endif elseif (lrank == 2) then if (size(dataPtr2d) > 0) then write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) else - write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & - " no data" + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname)," no data" endif else - call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR, line=__LINE__, & - file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_Field_diagnose !----------------------------------------------------------------------------- + subroutine shr_nuopc_methods_Field_diagnose(field, fieldname, string, rc) + + ! ---------------------------------------------- + ! Diagnose Field + ! ---------------------------------------------- + + use med_constants_mod, only : R8, CS + use ESMF , only : ESMF_Field, ESMF_FieldGet + + ! input/output variables + type(ESMF_Field) , intent(inout) :: field + character(len=*) , intent(in) :: fieldname + character(len=*) , intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: lrank + character(len=CS) :: lstring + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_FieldDiagnose)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + lstring = '' + if (present(string)) then + lstring = trim(string) + endif + + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + call ESMF_FieldGet(field, farrayPtr=dataPtr1d, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname)," no data" + endif + elseif (lrank == 2) then + call ESMF_FieldGet(field, farrayPtr=dataPtr2d, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname), & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(fieldname)," no data" + endif + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_Field_diagnose + + !----------------------------------------------------------------------------- + subroutine shr_nuopc_methods_FB_copyFB2FB(FBout, FBin, rc) + ! ---------------------------------------------- ! Copy common field names from FBin to FBout ! ---------------------------------------------- + use ESMF, only : ESMF_FieldBundle + type(ESMF_FieldBundle), intent(inout) :: FBout type(ESMF_FieldBundle), intent(in) :: FBin integer , intent(out) :: rc - - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_copyFB2FB)' + ! ---------------------------------------------- - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_SUCCESS call shr_nuopc_methods_FB_accum(FBout, FBin, copy=.true., rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_copyFB2FB @@ -1371,12 +1615,10 @@ subroutine shr_nuopc_methods_FB_copyFB2ST(STout, FBin, rc) type(ESMF_State) , intent(inout) :: STout type(ESMF_FieldBundle), intent(in) :: FBin integer , intent(out) :: rc - - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_copyFB2ST)' if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -1384,7 +1626,7 @@ subroutine shr_nuopc_methods_FB_copyFB2ST(STout, FBin, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_copyFB2ST @@ -1400,11 +1642,11 @@ subroutine shr_nuopc_methods_FB_copyST2FB(FBout, STin, rc) type(ESMF_FieldBundle), intent(inout) :: FBout type(ESMF_State) , intent(in) :: STin integer , intent(out) :: rc - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_copyST2FB)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -1412,7 +1654,7 @@ subroutine shr_nuopc_methods_FB_copyST2FB(FBout, STin, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_copyST2FB @@ -1441,11 +1683,11 @@ subroutine shr_nuopc_methods_FB_accumFB2FB(FBout, FBin, copy, rc) logical :: lcopy real(R8), pointer :: dataPtri1(:) , dataPtro1(:) real(R8), pointer :: dataPtri2(:,:), dataPtro2(:,:) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_accumFB2FB)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -1472,8 +1714,7 @@ subroutine shr_nuopc_methods_FB_accumFB2FB(FBout, FBin, copy, rc) if (lranki == 1 .and. lranko == 1) then if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtro1, dataPtri1, subname, rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif @@ -1491,8 +1732,7 @@ subroutine shr_nuopc_methods_FB_accumFB2FB(FBout, FBin, copy, rc) elseif (lranki == 2 .and. lranko == 2) then if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtro2, dataPtri2, subname, rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr2 size ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr2 size ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif @@ -1514,9 +1754,9 @@ subroutine shr_nuopc_methods_FB_accumFB2FB(FBout, FBin, copy, rc) else write(msgString,'(a,2i8)') trim(subname)//": ranki, ranko = ",lranki,lranko - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) call ESMF_LogWrite(trim(subname)//": ERROR ranki ranko not supported "//trim(lfieldnamelist(n)), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return @@ -1528,40 +1768,43 @@ subroutine shr_nuopc_methods_FB_accumFB2FB(FBout, FBin, copy, rc) deallocate(lfieldnamelist) if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_accumFB2FB !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_FB_accumST2FB(FBout, STin, copy, rc) + ! ---------------------------------------------- ! Accumulate common field names from State to FB ! If copy is passed in and true, the this is a copy ! ---------------------------------------------- - use med_constants_mod, only : R8 - use ESMF, only : ESMF_State, ESMF_FieldBundle - use ESMF, only : ESMF_StateGet, ESMF_FieldBundleGet - use ESMF, only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag + use med_constants_mod , only : R8 + use ESMF , only : ESMF_State, ESMF_FieldBundle + use ESMF , only : ESMF_StateGet, ESMF_FieldBundleGet + use ESMF , only : ESMF_STATEITEM_NOTFOUND, ESMF_StateItem_Flag + + ! input/output variables type(ESMF_FieldBundle), intent(inout) :: FBout type(ESMF_State) , intent(in) :: STin logical, optional , intent(in) :: copy integer , intent(out) :: rc ! local variables - integer :: i,j,n - integer :: fieldCount, lrankS, lrankB - logical :: lcopy - character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) - type(ESMF_StateItem_Flag) :: itemType - real(R8), pointer :: dataPtrS1(:) , dataPtrB1(:) - real(R8), pointer :: dataPtrS2(:,:), dataPtrB2(:,:) - integer :: dbrc + integer :: i,j,n + integer :: fieldCount, lrankS, lrankB + logical :: lcopy + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + type(ESMF_StateItem_Flag) :: itemType + real(R8), pointer :: dataPtrS1(:) , dataPtrB1(:) + real(R8), pointer :: dataPtrS2(:,:), dataPtrB2(:,:) character(len=*), parameter :: subname='(shr_nuopc_methods_FB_accumST2FB)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -1580,6 +1823,7 @@ subroutine shr_nuopc_methods_FB_accumST2FB(FBout, STin, copy, rc) call shr_nuopc_methods_State_GetFldPtr(STin, lfieldnamelist(n), dataPtrS1, dataPtrS2, lrankS, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBout, lfieldnamelist(n), dataPtrB1, dataPtrB2, lrankB, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1590,8 +1834,7 @@ subroutine shr_nuopc_methods_FB_accumST2FB(FBout, STin, copy, rc) elseif (lrankS == 1 .and. lrankB == 1) then if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtrS1, dataPtrB1, subname, rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr1 size ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif @@ -1609,8 +1852,7 @@ subroutine shr_nuopc_methods_FB_accumST2FB(FBout, STin, copy, rc) elseif (lrankS == 2 .and. lrankB == 2) then if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtrS2, dataPtrB2, subname, rc)) then - call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr2 size ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=rc) + call ESMF_LogWrite(trim(subname)//": ERROR in dataPtr2 size ", ESMF_LOGMSG_ERROR) rc = ESMF_FAILURE return endif @@ -1632,9 +1874,9 @@ subroutine shr_nuopc_methods_FB_accumST2FB(FBout, STin, copy, rc) else write(msgString,'(a,2i8)') trim(subname)//": rankB, ranks = ",lrankB,lrankS - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) call ESMF_LogWrite(trim(subname)//": ERROR rankB rankS not supported "//trim(lfieldnamelist(n)), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return @@ -1646,7 +1888,7 @@ subroutine shr_nuopc_methods_FB_accumST2FB(FBout, STin, copy, rc) deallocate(lfieldnamelist) if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_accumST2FB @@ -1676,11 +1918,11 @@ subroutine shr_nuopc_methods_FB_accumFB2ST(STout, FBin, copy, rc) type(ESMF_StateItem_Flag) :: itemType real(R8), pointer :: dataPtrS1(:), dataPtrB1(:) real(R8), pointer :: dataPtrS2(:,:), dataPtrB2(:,:) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_accumFB2ST)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -1751,9 +1993,9 @@ subroutine shr_nuopc_methods_FB_accumFB2ST(STout, FBin, copy, rc) else write(msgString,'(a,2i8)') trim(subname)//": rankB, ranks = ",lrankB,lrankS - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) call ESMF_LogWrite(trim(subname)//": ERROR rankB rankS not supported "//trim(lfieldnamelist(n)), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return @@ -1765,7 +2007,7 @@ subroutine shr_nuopc_methods_FB_accumFB2ST(STout, FBin, copy, rc) deallocate(lfieldnamelist) if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_accumFB2ST @@ -1786,12 +2028,11 @@ logical function shr_nuopc_methods_FB_FldChk(FB, fldname, rc) integer , intent(out) :: rc ! local variables - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_FldChk)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -1807,7 +2048,7 @@ logical function shr_nuopc_methods_FB_FldChk(FB, fldname, rc) call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), isPresent=isPresent, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) then call ESMF_LogWrite(trim(subname)//" Error checking field: "//trim(fldname), & - ESMF_LOGMSG_ERROR, rc=dbrc) + ESMF_LOGMSG_ERROR) return endif if (isPresent) then @@ -1815,7 +2056,7 @@ logical function shr_nuopc_methods_FB_FldChk(FB, fldname, rc) endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end function shr_nuopc_methods_FB_FldChk @@ -1823,15 +2064,18 @@ end function shr_nuopc_methods_FB_FldChk !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abort, rc) + ! ---------------------------------------------- ! for a field, determine rank and return fldptr1 or fldptr2 ! abort is true by default and will abort if fldptr is not yet allocated in field ! rank returns 0, 1, or 2. 0 means fldptr not allocated and abort=false ! ---------------------------------------------- + use med_constants_mod , only : R8 use ESMF , only : ESMF_Field,ESMF_Mesh, ESMF_FieldGet, ESMF_MeshGet use ESMF , only : ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_FIELDSTATUS_COMPLETE + ! input/output variables type(ESMF_Field) , intent(in) :: field real(R8), pointer , intent(inout), optional :: fldptr1(:) real(R8), pointer , intent(inout), optional :: fldptr2(:,:) @@ -1843,17 +2087,16 @@ subroutine shr_nuopc_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abor type(ESMF_Mesh) :: lmesh integer :: lrank, nnodes, nelements logical :: labort - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_Field_GetFldPtr)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif if (.not.present(rc)) then call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif @@ -1886,14 +2129,17 @@ subroutine shr_nuopc_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abor if (geomtype == ESMF_GEOMTYPE_GRID) then call ESMF_FieldGet(field, rank=lrank, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif (geomtype == ESMF_GEOMTYPE_MESH) then - lrank = 1 + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(field, mesh=lmesh, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (nnodes == 0 .and. nelements == 0) lrank = 0 - else ! geomtype + + else call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_FAILURE @@ -1902,28 +2148,31 @@ subroutine shr_nuopc_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abor if (lrank == 0) then call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) + elseif (lrank == 1) then if (.not.present(fldptr1)) then call ESMF_LogWrite(trim(subname)//": ERROR missing rank=1 array ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + elseif (lrank == 2) then if (.not.present(fldptr2)) then call ESMF_LogWrite(trim(subname)//": ERROR missing rank=2 array ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + else call ESMF_LogWrite(trim(subname)//": ERROR in rank ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif @@ -1935,7 +2184,7 @@ subroutine shr_nuopc_methods_Field_GetFldPtr(field, fldptr1, fldptr2, rank, abor endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Field_GetFldPtr @@ -1943,12 +2192,14 @@ end subroutine shr_nuopc_methods_Field_GetFldPtr !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, field, rc) + use med_constants_mod , only : R8 use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_Field ! ---------------------------------------------- ! Get pointer to a field bundle field ! ---------------------------------------------- + type(ESMF_FieldBundle) , intent(in) :: FB character(len=*) , intent(in) :: fldname real(R8), pointer , intent(inout), optional :: fldptr1(:) @@ -1960,17 +2211,16 @@ subroutine shr_nuopc_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, f ! local variables type(ESMF_Field) :: lfield integer :: lrank - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_GetFldPtr)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif if (.not.present(rc)) then call ESMF_LogWrite(trim(subname)//": ERROR rc not present "//trim(fldname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif @@ -1979,7 +2229,7 @@ subroutine shr_nuopc_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, f if (.not. shr_nuopc_methods_FB_FldChk(FB, trim(fldname), rc=rc)) then call ESMF_LogWrite(trim(subname)//": ERROR field "//trim(fldname)//" not in FB ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif @@ -1998,7 +2248,7 @@ subroutine shr_nuopc_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, f field = lfield endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_GetFldPtr @@ -2019,11 +2269,11 @@ subroutine shr_nuopc_methods_FB_SetFldPtr(FB, fldname, val, rc) integer :: lrank real(R8), pointer :: fldptr1(:) real(R8), pointer :: fldptr2(:,:) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FB_SetFldPtr)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2038,13 +2288,13 @@ subroutine shr_nuopc_methods_FB_SetFldPtr(FB, fldname, val, rc) fldptr2 = val else call ESMF_LogWrite(trim(subname)//": ERROR in rank "//trim(fldname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_SetFldPtr @@ -2068,17 +2318,16 @@ subroutine shr_nuopc_methods_State_GetFldPtr(ST, fldname, fldptr1, fldptr2, rank ! local variables type(ESMF_Field) :: lfield integer :: lrank - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_State_GetFldPtr)' ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif if (.not.present(rc)) then call ESMF_LogWrite(trim(subname)//": ERROR rc not present "//trim(fldname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif @@ -2097,7 +2346,7 @@ subroutine shr_nuopc_methods_State_GetFldPtr(ST, fldname, fldptr1, fldptr2, rank endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_GetFldPtr @@ -2118,11 +2367,11 @@ subroutine shr_nuopc_methods_State_SetFldPtr(ST, fldname, val, rc) integer :: lrank real(R8), pointer :: fldptr1(:) real(R8), pointer :: fldptr2(:,:) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_State_SetFldPtr)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2137,13 +2386,13 @@ subroutine shr_nuopc_methods_State_SetFldPtr(ST, fldname, val, rc) fldptr2 = val else call ESMF_LogWrite(trim(subname)//": ERROR in rank "//trim(fldname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_SetFldPtr @@ -2151,18 +2400,20 @@ end subroutine shr_nuopc_methods_State_SetFldPtr !----------------------------------------------------------------------------- logical function shr_nuopc_methods_FieldPtr_Compare1(fldptr1, fldptr2, cstring, rc) + use med_constants_mod, only : R8 + real(R8), pointer, intent(in) :: fldptr1(:) real(R8), pointer, intent(in) :: fldptr2(:) character(len=*) , intent(in) :: cstring integer , intent(out) :: rc ! local variables - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FieldPtr_Compare1)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2172,15 +2423,15 @@ logical function shr_nuopc_methods_FieldPtr_Compare1(fldptr1, fldptr2, cstring, call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write(msgString,*) trim(subname)//': fldptr1 ',lbound(fldptr1),ubound(fldptr1) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) write(msgString,*) trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) else shr_nuopc_methods_FieldPtr_Compare1 = .true. endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end function shr_nuopc_methods_FieldPtr_Compare1 @@ -2195,11 +2446,11 @@ logical function shr_nuopc_methods_FieldPtr_Compare2(fldptr1, fldptr2, cstring, integer , intent(out) :: rc ! local variables - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_FieldPtr_Compare2)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2211,15 +2462,15 @@ logical function shr_nuopc_methods_FieldPtr_Compare2(fldptr1, fldptr2, cstring, call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return write(msgString,*) trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) write(msgString,*) trim(subname)//': fldptr1 ',lbound(fldptr1),ubound(fldptr1) - call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) else shr_nuopc_methods_FieldPtr_Compare2 = .true. endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end function shr_nuopc_methods_FieldPtr_Compare2 @@ -2234,11 +2485,11 @@ subroutine shr_nuopc_methods_State_GeomPrint(state, string, rc) type(ESMF_Field) :: lfield integer :: fieldcount - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_State_GeomPrint)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2251,11 +2502,11 @@ subroutine shr_nuopc_methods_State_GeomPrint(state, string, rc) call shr_nuopc_methods_Field_GeomPrint(lfield, string, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO) endif ! fieldCount > 0 if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_GeomPrint @@ -2271,11 +2522,11 @@ subroutine shr_nuopc_methods_FB_GeomPrint(FB, string, rc) type(ESMF_Field) :: lfield integer :: fieldcount - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_GeomPrint)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2287,11 +2538,11 @@ subroutine shr_nuopc_methods_FB_GeomPrint(FB, string, rc) call shr_nuopc_methods_Field_GeomPrint(lfield, string, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO) endif ! fieldCount > 0 if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_GeomPrint @@ -2299,24 +2550,27 @@ end subroutine shr_nuopc_methods_FB_GeomPrint !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_Field_GeomPrint(field, string, rc) + use med_constants_mod, only : R8 use ESMF, only : ESMF_Field, ESMF_Grid, ESMF_Mesh use ESMF, only : ESMF_FieldGet, ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_FIELDSTATUS_EMPTY + ! input/output variables type(ESMF_Field), intent(in) :: field character(len=*), intent(in) :: string integer , intent(out) :: rc - type(ESMF_Grid) :: lgrid - type(ESMF_Mesh) :: lmesh - integer :: lrank + ! local variables + type(ESMF_Grid) :: lgrid + type(ESMF_Mesh) :: lmesh + integer :: lrank real(R8), pointer :: dataPtr1(:) real(R8), pointer :: dataPtr2(:,:) - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_Field_GeomPrint)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2324,7 +2578,7 @@ subroutine shr_nuopc_methods_Field_GeomPrint(field, string, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (status == ESMF_FIELDSTATUS_EMPTY) then call ESMF_LogWrite(trim(subname)//":"//trim(string)//": ERROR field does not have a geom yet ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif @@ -2366,13 +2620,13 @@ subroutine shr_nuopc_methods_Field_GeomPrint(field, string, rc) continue else call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", & - ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE return endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Field_GeomPrint @@ -2396,11 +2650,11 @@ subroutine shr_nuopc_methods_Mesh_Print(mesh, string, rc) integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) type(ESMF_MeshStatus_Flag) :: meshStatus logical :: elemDGPresent, nodeDGPresent - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_Mesh_Print)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2541,7 +2795,7 @@ subroutine shr_nuopc_methods_Mesh_Print(mesh, string, rc) endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Mesh_Print @@ -2549,10 +2803,12 @@ end subroutine shr_nuopc_methods_Mesh_Print !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_Grid_Print(grid, string, rc) + use med_constants_mod, only : R8 use ESMF, only : ESMF_Grid, ESMF_DistGrid, ESMF_StaggerLoc use ESMF, only : ESMF_GridGet, ESMF_DistGridGet, ESMF_GridGetCoord use ESMF, only : ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER + type(ESMF_Grid) , intent(in) :: grid character(len=*), intent(in) :: string integer , intent(out) :: rc @@ -2568,11 +2824,11 @@ subroutine shr_nuopc_methods_Grid_Print(grid, string, rc) real(R8), pointer :: fldptr1(:) real(R8), pointer :: fldptr2(:,:) integer :: n1,n2,n3 - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_Grid_Print)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2680,7 +2936,7 @@ subroutine shr_nuopc_methods_Grid_Print(grid, string, rc) enddo if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Grid_Print @@ -2702,13 +2958,13 @@ subroutine shr_nuopc_methods_Clock_TimePrint(clock,string,rc) type(ESMF_TimeInterval) :: timeStep character(len=CS) :: timestr character(len=CL) :: lstring - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_Clock_TimePrint)' + ! ---------------------------------------------- rc = ESMF_SUCCESS if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif if (present(string)) then @@ -2721,28 +2977,28 @@ subroutine shr_nuopc_methods_Clock_TimePrint(clock,string,rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(time,timestring=timestr,rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(lstring)//": currtime = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(lstring)//": currtime = "//trim(timestr), ESMF_LOGMSG_INFO) call ESMF_ClockGet(clock,starttime=time,rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(time,timestring=timestr,rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(lstring)//": startime = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(lstring)//": startime = "//trim(timestr), ESMF_LOGMSG_INFO) call ESMF_ClockGet(clock,stoptime=time,rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(time,timestring=timestr,rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(lstring)//": stoptime = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(lstring)//": stoptime = "//trim(timestr), ESMF_LOGMSG_INFO) call ESMF_ClockGet(clock,timestep=timestep,rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeIntervalGet(timestep,timestring=timestr,rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_LogWrite(trim(lstring)//": timestep = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(lstring)//": timestep = "//trim(timestr), ESMF_LOGMSG_INFO) if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Clock_TimePrint @@ -2765,12 +3021,12 @@ subroutine shr_nuopc_methods_Mesh_Write(mesh, string, rc) type(ESMF_Array) :: array real(R8), pointer :: rawdata(:) real(R8), pointer :: coord(:) - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_Mesh_Write)' + ! ---------------------------------------------- rc = ESMF_SUCCESS if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif #if (1 == 0) @@ -2834,11 +3090,11 @@ subroutine shr_nuopc_methods_Mesh_Write(mesh, string, rc) deallocate(rawdata,coord) #else - call ESMF_LogWrite(trim(subname)//": turned off right now", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": turned off right now", ESMF_LOGMSG_INFO) #endif if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Mesh_Write @@ -2853,11 +3109,11 @@ subroutine shr_nuopc_methods_State_GeomWrite(state, string, rc) type(ESMF_Field) :: lfield integer :: fieldcount - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_State_GeomWrite)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2870,11 +3126,11 @@ subroutine shr_nuopc_methods_State_GeomWrite(state, string, rc) call shr_nuopc_methods_Field_GeomWrite(lfield, string, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO) endif ! fieldCount > 0 if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_State_GeomWrite @@ -2890,11 +3146,11 @@ subroutine shr_nuopc_methods_FB_GeomWrite(FB, string, rc) type(ESMF_Field) :: lfield integer :: fieldcount - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_FB_GeomWrite)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS @@ -2907,11 +3163,11 @@ subroutine shr_nuopc_methods_FB_GeomWrite(FB, string, rc) call shr_nuopc_methods_Field_GeomWrite(lfield, string, rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return else - call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//":"//trim(string)//": no fields", ESMF_LOGMSG_INFO) endif ! fieldCount > 0 if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_FB_GeomWrite @@ -2919,27 +3175,30 @@ end subroutine shr_nuopc_methods_FB_GeomWrite !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_Field_GeomWrite(field, string, rc) + use ESMF, only : ESMF_Field, ESMF_Grid, ESMF_Mesh, ESMF_FIeldGet, ESMF_FIELDSTATUS_EMPTY use ESMF, only : ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID + ! input/output variables type(ESMF_Field), intent(in) :: field character(len=*), intent(in) :: string integer , intent(out) :: rc + ! local variables type(ESMF_Grid) :: lgrid type(ESMF_Mesh) :: lmesh - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_Field_GeomWrite)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS call ESMF_FieldGet(field, status=status, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (status == ESMF_FIELDSTATUS_EMPTY) then - call ESMF_LogWrite(trim(subname)//":"//trim(string)//": ERROR field does not have a geom yet ", ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//":"//trim(string)//": ERROR field does not have a geom yet ") rc = ESMF_FAILURE return endif @@ -2960,7 +3219,7 @@ subroutine shr_nuopc_methods_Field_GeomWrite(field, string, rc) endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Field_GeomWrite @@ -2983,12 +3242,12 @@ subroutine shr_nuopc_methods_Grid_Write(grid, string, rc) ! local type(ESMF_Array) :: array character(len=CS) :: name - integer :: dbrc character(len=*),parameter :: subname='(shr_nuopc_methods_Grid_Write)' + ! ---------------------------------------------- rc = ESMF_SUCCESS if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif ! -- centers -- @@ -3094,7 +3353,7 @@ subroutine shr_nuopc_methods_Grid_Write(grid, string, rc) endif if (dbug_flag > 10) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) endif end subroutine shr_nuopc_methods_Grid_Write @@ -3114,11 +3373,11 @@ logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) integer, allocatable :: minIndexPTile1(:,:), minIndexPTile2(:,:) integer, allocatable :: maxIndexPTile1(:,:), maxIndexPTile2(:,:) integer, allocatable :: elementCountPTile1(:), elementCountPTile2(:) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_Distgrid_Match)' + ! ---------------------------------------------- if (dbug_flag > 10) then - call ESMF_LogWrite(subname//": called", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//": called", ESMF_LOGMSG_INFO) endif if(present(rc)) rc = ESMF_SUCCESS @@ -3136,7 +3395,7 @@ logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) shr_nuopc_methods_Distgrid_Match = .false. if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": Grid dimCount MISMATCH ", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) endif endif @@ -3144,7 +3403,7 @@ logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) shr_nuopc_methods_Distgrid_Match = .false. if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": Grid tileCount MISMATCH ", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) endif endif @@ -3171,7 +3430,7 @@ logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) shr_nuopc_methods_Distgrid_Match = .false. if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": Grid elementCountPTile MISMATCH ", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) endif endif @@ -3179,7 +3438,7 @@ logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) shr_nuopc_methods_Distgrid_Match = .false. if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": Grid minIndexPTile MISMATCH ", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) endif endif @@ -3187,7 +3446,7 @@ logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) shr_nuopc_methods_Distgrid_Match = .false. if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": Grid maxIndexPTile MISMATCH ", & - ESMF_LOGMSG_INFO, rc=dbrc) + ESMF_LOGMSG_INFO) endif endif @@ -3200,28 +3459,30 @@ logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) ! TODO: Optionally Check Coordinates - if (dbug_flag > 10) then - call ESMF_LogWrite(subname//": done", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(subname//": done", ESMF_LOGMSG_INFO) endif end function shr_nuopc_methods_Distgrid_Match !================================================================================ - subroutine shr_nuopc_methods_State_GetScalar(State, scalar_id, value, flds_scalar_name, flds_scalar_num, rc) + subroutine shr_nuopc_methods_State_GetScalar(state, scalar_id, scalar_value, flds_scalar_name, flds_scalar_num, rc) + + ! ---------------------------------------------- + ! Get scalar data from State for a particular name and broadcast it to all other pets + ! ---------------------------------------------- + use med_constants_mod , only : R8 use ESMF , only : ESMF_SUCCESS, ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_FieldGet use ESMF , only : ESMF_FAILURE, ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_LogWrite use ESMF , only : ESMF_LOGMSG_INFO, ESMF_VM, ESMF_VMBroadCast, ESMF_VMGetCurrent use ESMF , only : ESMF_VMGet - ! ---------------------------------------------- - ! Get scalar data from State for a particular name and broadcast it to all other pets - ! ---------------------------------------------- - type(ESMF_State), intent(in) :: State + ! input/output variables + type(ESMF_State), intent(in) :: state integer, intent(in) :: scalar_id - real(R8), intent(out) :: value + real(R8), intent(out) :: scalar_value character(len=*), intent(in) :: flds_scalar_name integer, intent(in) :: flds_scalar_num integer, intent(inout) :: rc @@ -3232,8 +3493,8 @@ subroutine shr_nuopc_methods_State_GetScalar(State, scalar_id, value, flds_scala type(ESMF_Field) :: field real(R8), pointer :: farrayptr(:,:) real(r8) :: tmp(1) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_State_GetScalar)' + ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -3250,7 +3511,7 @@ subroutine shr_nuopc_methods_State_GetScalar(State, scalar_id, value, flds_scala call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u) rc = ESMF_FAILURE if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return endif @@ -3258,21 +3519,24 @@ subroutine shr_nuopc_methods_State_GetScalar(State, scalar_id, value, flds_scala endif call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return - value = tmp(1) - + scalar_value = tmp(1) end subroutine shr_nuopc_methods_State_GetScalar !================================================================================ - subroutine shr_nuopc_methods_State_SetScalar(value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) + subroutine shr_nuopc_methods_State_SetScalar(scalar_value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) + ! ---------------------------------------------- ! Set scalar data from State for a particular name ! ---------------------------------------------- + use med_constants_mod , only : R8 use ESMF , only : ESMF_Field, ESMF_State, ESMF_StateGet, ESMF_FieldGet use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet - real(R8), intent(in) :: value + + ! input/output arguments + real(R8), intent(in) :: scalar_value integer, intent(in) :: scalar_id type(ESMF_State), intent(inout) :: State character(len=*), intent(in) :: flds_scalar_name @@ -3284,8 +3548,8 @@ subroutine shr_nuopc_methods_State_SetScalar(value, scalar_id, State, flds_scala type(ESMF_Field) :: field type(ESMF_VM) :: vm real(R8), pointer :: farrayptr(:,:) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_State_SetScalar)' + ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -3302,11 +3566,11 @@ subroutine shr_nuopc_methods_State_SetScalar(value, scalar_id, State, flds_scala call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return if (scalar_id < 0 .or. scalar_id > flds_scalar_num) then - call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO, line=__LINE__, file=u_FILE_u, rc=dbrc) + call ESMF_LogWrite(trim(subname)//": ERROR in scalar_id", ESMF_LOGMSG_INFO) rc = ESMF_FAILURE - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + return endif - farrayptr(scalar_id,1) = value + farrayptr(scalar_id,1) = scalar_value endif end subroutine shr_nuopc_methods_State_SetScalar @@ -3314,9 +3578,11 @@ end subroutine shr_nuopc_methods_State_SetScalar !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_State_UpdateTimestamp(state, time, rc) + use NUOPC , only : NUOPC_GetStateMemberLists use ESMF , only : ESMF_State, ESMF_Time, ESMF_Field, ESMF_SUCCESS + ! input/output variables type(ESMF_State) , intent(inout) :: state type(ESMF_Time) , intent(in) :: time integer , intent(out) :: rc @@ -3324,8 +3590,8 @@ subroutine shr_nuopc_methods_State_UpdateTimestamp(state, time, rc) ! local variables integer :: i type(ESMF_Field),pointer :: fieldList(:) - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_State_UpdateTimestamp)' + ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -3342,16 +3608,18 @@ end subroutine shr_nuopc_methods_State_UpdateTimestamp !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_Field_UpdateTimestamp(field, time, rc) + use ESMF, only : ESMF_Field, ESMF_Time, ESMF_TimeGet, ESMF_AttributeSet, ESMF_ATTNEST_ON, ESMF_SUCCESS + ! input/output variables type(ESMF_Field) , intent(inout) :: field type(ESMF_Time) , intent(in) :: time integer , intent(out) :: rc ! local variables integer :: yy, mm, dd, h, m, s, ms, us, ns - integer :: dbrc character(len=*), parameter :: subname='(shr_nuopc_methods_Field_UpdateTimestamp)' + ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -3369,19 +3637,20 @@ end subroutine shr_nuopc_methods_Field_UpdateTimestamp !----------------------------------------------------------------------------- subroutine shr_nuopc_methods_Print_FieldExchInfo(flag, values, logunit, fldlist, nflds, istr) - use shr_nuopc_utils_mod , only : shr_nuopc_string_listGetName - use med_constants_mod , only : R8 - use ESMF , only : ESMF_MAXSTR - ! !DESCRIPTION: + ! ---------------------------------------------- ! Print out information about values to stdount ! - flag sets the level of information: ! - print out names of fields in values 2d array ! - also print out local max and min of data in values 2d array ! If optional argument istr is present, it will be output before any of the information. + ! ---------------------------------------------- + use shr_nuopc_utils_mod , only : shr_nuopc_string_listGetName + use med_constants_mod , only : R8 + use ESMF , only : ESMF_MAXSTR - ! !INPUT/OUTPUT PARAMETERS: + ! input/output variables integer , intent(in) :: flag ! info level flag real(R8) , intent(in) :: values(:,:) ! arrays sent to/recieved from mediator integer , intent(in) :: logunit @@ -3389,19 +3658,17 @@ subroutine shr_nuopc_methods_Print_FieldExchInfo(flag, values, logunit, fldlist, integer , intent(in) :: nflds character(*) , intent(in),optional :: istr ! string for print - !--- local --- + ! local variables integer :: n ! generic indicies integer :: nsize ! grid point in values array real(R8) :: minl(nflds) ! local min real(R8) :: maxl(nflds) ! local max character(len=ESMF_MAXSTR) :: name - - !--- formats --- - character(*),parameter :: subName = '(shr_nuopc_methods_Print_FieldExchInfo) ' - character(*),parameter :: F00 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',8a)" - character(*),parameter :: F01 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',a,i9)" - character(*),parameter :: F02 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',240a)" - character(*),parameter :: F03 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',a,2es11.3,i4,2x,a)" + character(*),parameter :: subName = '(shr_nuopc_methods_Print_FieldExchInfo) ' + character(*),parameter :: F00 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',8a)" + character(*),parameter :: F01 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',a,i9)" + character(*),parameter :: F02 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',240a)" + character(*),parameter :: F03 = "('(shr_nuopc_methods_Print_FieldExchInfo) ',a,2es11.3,i4,2x,a)" !------------------------------------------------------------------------------- if (flag >= 1) then @@ -3441,12 +3708,13 @@ subroutine shr_nuopc_methods_State_FldDebug(state, flds_scalar_name, prefix, ymd integer , intent(out) :: rc ! local variables - integer :: n, nfld, nlev + integer :: n, nfld, ungridded_index integer :: lsize real(R8), pointer :: dataPtr1d(:) real(R8), pointer :: dataPtr2d(:,:) integer :: fieldCount integer :: ungriddedUBound(1) + integer :: gridToFieldMap(1) character(len=ESMF_MAXSTR) :: string type(ESMF_Field) , allocatable :: lfields(:) integer , allocatable :: dimCounts(:) @@ -3456,11 +3724,14 @@ subroutine shr_nuopc_methods_State_FldDebug(state, flds_scalar_name, prefix, ymd ! Determine the list of fields and the dimension count for each field call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + allocate(fieldNameList(fieldCount)) allocate(lfields(fieldCount)) allocate(dimCounts(fieldCount)) + call ESMF_StateGet(state, itemNameList=fieldNameList, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do nfld=1, fieldCount call ESMF_StateGet(state, itemName=trim(fieldNameList(nfld)), field=lfields(nfld), rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -3487,23 +3758,31 @@ subroutine shr_nuopc_methods_State_FldDebug(state, flds_scalar_name, prefix, ymd if (trim(fieldNameList(nfld)) /= flds_scalar_name .and. dataPtr1d(n) /= 0.) then string = trim(prefix) // ' ymd, tod, index, '// trim(fieldNameList(nfld)) //' = ' write(logunit,100) trim(string), ymd, tod, n, dataPtr1d(n) -100 format(a60,3(i8,2x),d21.14) end if else if (dimCounts(nfld) == 2) then - call ESMF_FieldGet(lfields(nfld), farrayPtr=dataPtr2d, rc=rc) + call ESMF_FieldGet(lfields(nfld), ungriddedUBound=ungriddedUBound, gridtoFieldMap=gridToFieldMap, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_FieldGet(lfields(nfld), ungriddedUBound=ungriddedUBound, rc=rc) call ESMF_FieldGet(lfields(nfld), farrayPtr=dataPtr2d, rc=rc) - do nlev = 1,ungriddedUBound(1) - if (trim(fieldNameList(nfld)) /= flds_scalar_name .and. dataPtr2d(n,nlev) /= 0.) then + if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + do ungridded_index = 1,ungriddedUBound(1) + if (trim(fieldNameList(nfld)) /= flds_scalar_name) then string = trim(prefix) // ' ymd, tod, lev, index, '// trim(fieldNameList(nfld)) //' = ' - write(logunit,101) trim(string), ymd, tod, nlev, n, dataPtr2d(n,nlev) -101 format(a60,4(i8,2x),d21.14) + if (gridToFieldMap(1) == 1) then + if (dataPtr2d(n,ungridded_index) /= 0.) then + write(logunit,101) trim(string), ymd, tod, ungridded_index, n, dataPtr2d(n,ungridded_index) + end if + else if (gridToFieldMap(1) == 2) then + if (dataPtr2d(ungridded_index,n) /= 0.) then + write(logunit,101) trim(string), ymd, tod, ungridded_index, n, dataPtr2d(ungridded_index,n) + end if + end if end if end do end if end do end do +100 format(a60,3(i8,2x),d21.14) +101 format(a60,4(i8,2x),d21.14) deallocate(fieldNameList) deallocate(lfields) @@ -3527,15 +3806,12 @@ subroutine shr_nuopc_methods_FB_getNumFlds(FB, string, nflds, rc) character(len=*) , intent(in) :: string integer , intent(out) :: nflds integer , intent(inout) :: rc - - ! local variables - integer :: dbrc ! ---------------------------------------------- rc = ESMF_SUCCESS if (.not. ESMF_FieldBundleIsCreated(FB)) then - call ESMF_LogWrite(trim(string)//": has not been created, returning", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(string)//": has not been created, returning", ESMF_LOGMSG_INFO) nflds = 0 else ! Note - the scalar field has been removed from all mediator @@ -3544,7 +3820,7 @@ subroutine shr_nuopc_methods_FB_getNumFlds(FB, string, nflds, rc) call ESMF_FieldBundleGet(FB, fieldCount=nflds, rc=rc) if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return if (nflds == 0) then - call ESMF_LogWrite(trim(string)//": only has scalar data, returning", ESMF_LOGMSG_INFO, rc=dbrc) + call ESMF_LogWrite(trim(string)//": only has scalar data, returning", ESMF_LOGMSG_INFO) end if end if diff --git a/src/drivers/nuopc/shr/shr_nuopc_utils_mod.F90 b/src/drivers/nuopc/shr/shr_nuopc_utils_mod.F90 index 8d3b30f05e3..7ad4c1076a9 100644 --- a/src/drivers/nuopc/shr/shr_nuopc_utils_mod.F90 +++ b/src/drivers/nuopc/shr/shr_nuopc_utils_mod.F90 @@ -15,7 +15,10 @@ module shr_nuopc_utils_mod integer, parameter :: memdebug_level=1 character(*),parameter :: u_FILE_u = __FILE__ +!=============================================================================== contains +!=============================================================================== + subroutine shr_nuopc_memcheck(string, level, mastertask) character(len=*), intent(in) :: string integer, intent(in) :: level @@ -27,19 +30,27 @@ subroutine shr_nuopc_memcheck(string, level, mastertask) endif end subroutine shr_nuopc_memcheck +!=============================================================================== + subroutine shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - use ESMF, only : ESMF_SUCCESS, ESMF_GridComp - use NUOPC, only : NUOPC_CompAttributeGet - type(ESMF_GridComp) :: gcomp + use ESMF , only : ESMF_SUCCESS, ESMF_GridComp + use NUOPC , only : NUOPC_CompAttributeGet + + ! input/output variables + type(ESMF_GridComp) :: gcomp character(len=*), intent(out) :: inst_suffix - integer, intent(out) :: inst_index - integer :: rc - logical :: isPresent - character(len=4) :: cvalue + integer, intent(out) :: inst_index + + ! local variables + integer :: rc + logical :: isPresent + character(len=4) :: cvalue + !----------------------------------------------------------------------- call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return @@ -52,38 +63,53 @@ subroutine shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) end subroutine shr_nuopc_get_component_instance +!=============================================================================== + subroutine shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit, shrloglev) - use ESMF, only : ESMF_GridComp, ESMF_VM, ESMF_VMGet, ESMF_GridCompGet - use NUOPC, only : NUOPC_CompAttributeGet - use med_constants_mod, only : shr_file_getunit, shr_file_getLogUnit, shr_file_getLogLevel - use med_constants_mod, only : shr_file_setLogLevel, CL, shr_file_setlogunit - type(ESMF_GridComp) :: gcomp - logical, intent(in) :: mastertask + use ESMF , only : ESMF_GridComp, ESMF_VM, ESMF_VMGet, ESMF_GridCompGet + use NUOPC , only : NUOPC_CompAttributeGet + use med_constants_mod , only : shr_file_getunit, shr_file_getLogUnit + use med_constants_mod , only : shr_file_setLogLevel, CL, shr_file_setlogunit + + ! input/output variables + type(ESMF_GridComp) :: gcomp + logical, intent(in) :: mastertask integer, intent(out) :: logunit integer, intent(out) :: shrlogunit - integer, intent(out) :: shrloglev + integer, intent(out), optional :: shrloglev + ! local variables character(len=CL) :: diro character(len=CL) :: logfile - integer :: rc + integer :: rc + !----------------------------------------------------------------------- + shrlogunit = 6 + if (mastertask) then call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + open(newunit=logunit,file=trim(diro)//"/"//trim(logfile)) else logUnit = 6 endif + call shr_file_setLogUnit (logunit) + end subroutine shr_nuopc_set_component_logging +!=============================================================================== + logical function shr_nuopc_utils_ChkErr(rc, line, file, mpierr) + use mpi , only : MPI_ERROR_STRING, MPI_MAX_ERROR_STRING, MPI_SUCCESS use ESMF, only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_LOGMSG_INFO use ESMF, only : ESMF_FAILURE, ESMF_LogWrite + integer, intent(in) :: rc integer, intent(in) :: line @@ -108,7 +134,8 @@ logical function shr_nuopc_utils_ChkErr(rc, line, file, mpierr) end function shr_nuopc_utils_ChkErr - !----------------------------------------------------------------------------- +!=============================================================================== + subroutine shr_nuopc_log_clock_advance(clock, component, logunit) use ESMF, only : ESMF_Clock, ESMF_ClockPrint use med_constants_mod, only : CL @@ -133,5 +160,4 @@ subroutine shr_nuopc_log_clock_advance(clock, component, logunit) end subroutine shr_nuopc_log_clock_advance - end module shr_nuopc_utils_mod diff --git a/src/externals/pio2/cmake/FindNetCDF.cmake b/src/externals/pio2/cmake/FindNetCDF.cmake index c59684c00a7..344714b18ab 100644 --- a/src/externals/pio2/cmake/FindNetCDF.cmake +++ b/src/externals/pio2/cmake/FindNetCDF.cmake @@ -46,9 +46,11 @@ foreach (NCDFcomp IN LISTS NetCDF_FIND_VALID_COMPONENTS) initialize_paths (NetCDF_${NCDFcomp}_PATHS INCLUDE_DIRECTORIES ${MPI_${NCDFcomp}_INCLUDE_PATH} LIBRARIES ${MPI_${NCDFcomp}_LIBRARIES}) + find_package_component(NetCDF COMPONENT ${NCDFcomp} + PATHS ${NetCDF_${NCDFcomp}_PATHS}) + else () + find_package_component(NetCDF COMPONENT ${NCDFcomp}) endif () - find_package_component(NetCDF COMPONENT ${NCDFcomp} - PATHS ${NetCDF_${NCDFcomp}_PATHS}) # Continue only if component found if (NetCDF_${NCDFcomp}_FOUND)