diff --git a/cime/ChangeLog b/cime/ChangeLog index 8a755f21a4f7..2a423ce6c64e 100644 --- a/cime/ChangeLog +++ b/cime/ChangeLog @@ -1,5 +1,283 @@ ====================================================================== +Originator: Chris Fischer +Date: 4-23-2019 +Tag: cime5.8.2 +Answer Changes: None +Tests: scripts_regression_tests +Dependencies: + +Brief Summary: + - Update the ne0CONUSne30x8 mapping files. + - Allow specific tests to ignore field list differences. + - Add NLDAS grid for CTSM and MOSART. + - Merge branch for acme split 2019-04-15 + - Fix unit test. + - Introduces a new stub IAC. + - Master merge to nuopc cmeps. + +User interface changes: + +PR summary: git log --oneline --first-parent [previous_tag]..master +57cf4a5 Merge pull request #3086 from ESMCI/fischer/ne_conus +421cc98 Merge pull request #3084 from billsacks/cprnc_ignore_fieldlist_diffs +a356310 Merge pull request #3063 from billsacks/nldas_grid_v2 +14babd5 Merge pull request #3079 from ESMCI/jgfouca/branch-for-acme-split-2019-04-15 +74730fe fix for unit test +4e86cc0 Merge pull request #3055 from bishtgautam/bishtgautam/iac +279d30a Merge pull request #3075 from jedwards4b/master-merge-to-nuopc-cmeps + + +Modified files: git diff --name-status [previous_tag] +M config/cesm/config_files.xml +M config/cesm/config_grids.xml +M config/cesm/config_grids_common.xml +M config/cesm/config_grids_mct.xml +M config/cesm/machines/config_machines.xml +M config/e3sm/allactive/config_compsets.xml +M config/e3sm/allactive/config_pesall.xml +M config/e3sm/config_archive.xml +M config/e3sm/config_files.xml +M config/e3sm/config_grids.xml +M config/e3sm/machines/config_batch.xml +M config/e3sm/machines/config_compilers.xml +M config/e3sm/machines/config_machines.xml +M config/e3sm/machines/config_pio.xml +M config/e3sm/tests.py +M config/xml_schemas/entry_id_base_version3.xsd +M scripts/Tools/Makefile +M scripts/Tools/archive_metadata +M scripts/Tools/case.build +M scripts/Tools/xmlconvertors/config_pes_converter.py +M scripts/Tools/xmlconvertors/grid_xml_converter.py +M scripts/lib/CIME/Servers/wget.py +M scripts/lib/CIME/SystemTests/system_tests_common.py +M scripts/lib/CIME/SystemTests/system_tests_compare_two.py +M scripts/lib/CIME/XML/grids.py +M scripts/lib/CIME/case/case.py +M scripts/lib/CIME/case/case_submit.py +M scripts/lib/CIME/hist_utils.py +M scripts/lib/CIME/tests/SystemTests/test_system_tests_compare_two.py +M src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 +M src/components/data_comps/datm/nuopc/datm_comp_mod.F90 +M src/components/data_comps/datm/nuopc/datm_shr_mod.F90 +M src/components/data_comps/dice/nuopc/dice_comp_mod.F90 +M src/components/data_comps/dice/nuopc/dice_shr_mod.F90 +M src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 +M src/components/data_comps/dlnd/nuopc/dlnd_comp_mod.F90 +M src/components/data_comps/dlnd/nuopc/dlnd_shr_mod.F90 +M src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 +M src/components/data_comps/docn/nuopc/docn_comp_mod.F90 +M src/components/data_comps/docn/nuopc/docn_shr_mod.F90 +M src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 +M src/components/data_comps/drof/nuopc/drof_comp_mod.F90 +M src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 +M src/components/data_comps/dshr_nuopc/dshr_nuopc_mod.F90 +M src/components/data_comps/dwav/nuopc/dwav_comp_mod.F90 +M src/components/data_comps/dwav/nuopc/dwav_shr_mod.F90 +M src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 +A src/components/stub_comps/siac/cime_config/buildlib +A src/components/stub_comps/siac/cime_config/buildnml +A src/components/stub_comps/siac/cime_config/config_component.xml +A src/components/stub_comps/siac/mct/iac_comp_mct.F90 +M src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 +M src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 +M src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 +M src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 +M src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 +M src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 +M src/components/xcpl_comps/xshare/nuopc/dead_nuopc_mod.F90 +M src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 +M src/drivers/mct/cime_config/buildexe +M src/drivers/mct/cime_config/config_component.xml +M src/drivers/mct/cime_config/config_component_e3sm.xml +M src/drivers/mct/cime_config/config_compsets.xml +M src/drivers/mct/cime_config/config_pes.xml +M src/drivers/mct/cime_config/namelist_definition_drv.xml +M src/drivers/mct/cime_config/namelist_definition_modelio.xml +M src/drivers/mct/main/cime_comp_mod.F90 +M src/drivers/mct/main/component_mod.F90 +M src/drivers/mct/main/component_type_mod.F90 +M src/drivers/mct/main/prep_atm_mod.F90 +A src/drivers/mct/main/prep_iac_mod.F90 +M src/drivers/mct/main/prep_lnd_mod.F90 +M src/drivers/mct/main/seq_frac_mct.F90 +M src/drivers/mct/main/seq_hist_mod.F90 +M src/drivers/mct/main/seq_rest_mod.F90 +M src/drivers/mct/shr/seq_comm_mct.F90 +M src/drivers/mct/shr/seq_flds_mod.F90 +M src/drivers/mct/shr/seq_infodata_mod.F90 +M src/drivers/mct/shr/seq_timemgr_mod.F90 +M src/drivers/mct/unit_test/CMakeLists.txt +M src/drivers/nuopc/cime_config/buildnml +M src/drivers/nuopc/cime_config/config_component.xml +M src/drivers/nuopc/cime_config/config_component_cesm.xml +M src/drivers/nuopc/cime_config/nuopc_runseq_A +M src/drivers/nuopc/cime_config/nuopc_runseq_ADLND +M src/drivers/nuopc/cime_config/nuopc_runseq_ADWAV +M src/drivers/nuopc/cime_config/nuopc_runseq_B +D src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D +A src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_swav +A src/drivers/nuopc/cime_config/nuopc_runseq_C_G_D_ww3 +A src/drivers/nuopc/cime_config/nuopc_runseq_C_wav +M src/drivers/nuopc/cime_config/nuopc_runseq_F +M src/drivers/nuopc/cime_config/nuopc_runseq_I +M src/drivers/nuopc/cime_config/nuopc_runseq_I_mosart +M src/drivers/nuopc/cime_config/nuopc_runseq_NEMS +A src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.cold +A src/drivers/nuopc/cime_config/nuopc_runseq_NEMS.warm +M src/drivers/nuopc/cime_config/nuopc_runseq_Q +M src/drivers/nuopc/cime_config/nuopc_runseq_X +M src/drivers/nuopc/cime_config/nuopc_runseq_default +M src/drivers/nuopc/cime_driver/esmApp.F90 +M src/drivers/nuopc/cime_flds/esmFlds.F90 +M src/drivers/nuopc/cime_flds/esmFldsExchange.F90 +M src/drivers/nuopc/cime_flds/fd.yaml +M src/drivers/nuopc/cime_flds_shr/seq_drydep_mod.F90 +M src/drivers/nuopc/cime_flds_shr/shr_carma_mod.F90 +M src/drivers/nuopc/cime_flds_shr/shr_fire_emis_mod.F90 +M src/drivers/nuopc/cime_flds_shr/shr_megan_mod.F90 +M src/drivers/nuopc/cime_flds_shr/shr_ndep_mod.F90 +M src/drivers/nuopc/mediator/med.F90 +D src/drivers/nuopc/mediator/med_connectors_mod.F90 +M src/drivers/nuopc/mediator/med_fraction_mod.F90 +D src/drivers/nuopc/mediator/med_infodata_mod.F90 +M src/drivers/nuopc/mediator/med_internalstate_mod.F90 +M src/drivers/nuopc/mediator/med_io_mod.F90 +M src/drivers/nuopc/mediator/med_map_mod.F90 +M src/drivers/nuopc/mediator/med_merge_mod.F90 +M src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 +M src/drivers/nuopc/mediator/med_phases_history_mod.F90 +M src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 +M src/drivers/nuopc/mediator/med_phases_prep_atm_mod.F90 +M src/drivers/nuopc/mediator/med_phases_prep_glc_mod.F90 +M src/drivers/nuopc/mediator/med_phases_prep_ice_mod.F90 +M src/drivers/nuopc/mediator/med_phases_prep_lnd_mod.F90 +M src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 +M src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 +M src/drivers/nuopc/mediator/med_phases_prep_wav_mod.F90 +M src/drivers/nuopc/mediator/med_phases_restart_mod.F90 +M src/drivers/nuopc/shr/med_constants_mod.F90 +D src/drivers/nuopc/shr/shr_nuopc_grid_mod.F90 +M src/drivers/nuopc/shr/shr_nuopc_methods_mod.F90 +M src/drivers/nuopc/shr/shr_nuopc_utils_mod.F90 +M src/share/streams/shr_strdata_mod.F90 +M src/share/util/shr_pio_mod.F90 + +====================================================================== + +====================================================================== + +Originator: Chris Fischer +Date: 04-08-2019 +Tag: cime5.8.1 +Answer Changes: None +Tests: scripts_regression_tests, many create_newcase with mangled compset names + hand test xmllint +Dependencies: + +Brief Summary: + - Support optional components by filling in stub models for any missing component class + - Merge maint-5.6 branch. + - Fix issue with xmllint. + - Use installed pio libraries. + - Make FIELDLIST message more informative. + - ACME merge 2019-03-29 + - cprnc: allow differences in field lists for time-constant fields. + - Merge maint-5.6 branch. + - Add ne0CONUSne30x8_ne0CONUSne30x8_mg17 grid alias. + - Merge in latest nuopc-cmeps development. + - The check for an rpointer.drv file did not consider multidriver mode. + - Fix ./case.build --clean. + - PET and ERP tests were not setting compile_threaded correctly. + - Implement 'share' field of test suites. + +User interface changes: + - Stub components are now optional in compset long names. Also there is less order dependency. + +PR summary: git log --oneline --first-parent [previous_tag]..master +444b2f4 Merge pull request #3068 from gold2718/optional_components +c1a4c49 Merge branch 'maint-5.6' +150c2b5 Merge pull request #3061 from jedwards4b/fix_cesm_config_files +9b0be41 Merge pull request #3058 from jedwards4b/use_installed_libraries +ae332d4 Merge pull request #3059 from billsacks/fieldlist_differ_message +d94860f Merge pull request #3054 from ESMCI/jgfouca/branch-for-acme-split-2019-03-29 +95e117c Merge pull request #3051 from billsacks/cprnc_allow_timeconst_fielddiffs +338c143 Merge pull request #3052 from ESMCI/maint-5.6 +c82a5ee Merge pull request #3048 from ESMCI/fischer/SE_grids +1bb357c Merge pull request #3046 from jedwards4b/nuopc-cmeps +94d6da8 Merge pull request #3045 from jedwards4b/multi_driver_continue +9f5fb60 Merge pull request #3043 from ESMCI/jgfouca/fix_build_clean +ff06fd0 Merge pull request #3042 from ESMCI/jedwards/pet_test_fix +bafad7e Merge pull request #3040 from ESMCI/jgfouca/impl_share_field + + +Modified files: git diff --name-status [previous_tag] +M config/cesm/config_files.xml +M config/cesm/config_grids.xml +M config/cesm/machines/config_compilers.xml +M config/cesm/machines/config_machines.xml +M config/cesm/machines/userdefined_laptop_template/config_compilers.xml +M config/e3sm/config_grids.xml +M config/e3sm/config_inputdata.xml +M config/e3sm/machines/Depends.cetus +M config/e3sm/machines/Depends.mira +M config/e3sm/machines/Depends.summit.ibm +M config/e3sm/machines/Depends.summitdev.ibm +M config/e3sm/machines/config_batch.xml +M config/e3sm/machines/config_compilers.xml +M config/e3sm/machines/config_machines.xml +M config/e3sm/machines/config_pio.xml +M config/e3sm/machines/userdefined_laptop_template/config_compilers.xml +M config/e3sm/tests.py +M config/xml_schemas/config_batch.xsd +M config/xml_schemas/config_compilers_v2.xsd +M config/xml_schemas/config_machines.xsd +M config/xml_schemas/env_mach_specific.xsd +M doc/source/users_guide/cime-config.rst +M doc/source/users_guide/unit_testing.rst +M scripts/Tools/Makefile +M scripts/create_test +M scripts/fortran_unit_testing/run_tests.py +M scripts/lib/CIME/BuildTools/configure.py +M scripts/lib/CIME/BuildTools/valuesetting.py +M scripts/lib/CIME/XML/entry_id.py +M scripts/lib/CIME/XML/generic_xml.py +M scripts/lib/CIME/build.py +M scripts/lib/CIME/case/case.py +M scripts/lib/CIME/case/case_submit.py +M scripts/lib/CIME/case/check_input_data.py +M scripts/lib/CIME/hist_utils.py +M scripts/lib/CIME/test_scheduler.py +M scripts/lib/get_tests.py +M scripts/tests/scripts_regression_tests.py +M src/build_scripts/buildlib.gptl +M src/build_scripts/buildlib.kokkos +M src/build_scripts/buildlib.pio +M src/components/data_comps/datm/cime_config/config_component.xml +M src/components/data_comps/datm/nuopc/datm_comp_mod.F90 +M src/components/data_comps/desp/cime_config/config_component.xml +M src/drivers/mct/cime_config/namelist_definition_drv.xml +M src/drivers/mct/main/seq_flux_mct.F90 +M src/drivers/mct/shr/seq_infodata_mod.F90 +M src/share/util/shr_flux_mod.F90 +M tools/cprnc/README +M tools/cprnc/compare_vars_mod.F90.in +M tools/cprnc/cprnc.F90 +M tools/cprnc/filestruct.F90 +M tools/cprnc/run_tests +M tools/cprnc/test_inputs/README +A tools/cprnc/test_inputs/multipleTimes_someTimeless_extra_and_missing.nc +A tools/cprnc/test_inputs/noTime_extra_and_missing.nc +M tools/mapping/gen_domain_files/README +M tools/mapping/gen_domain_files/src/gen_domain.F90 +M tools/mapping/gen_mapping_files/runoff_to_ocn/src/Makefile + +====================================================================== + + +====================================================================== + Originator: Chris Fischer Date: 03-12-2019 Tag: cime5.8.0 diff --git a/cime/config/cesm/config_grids.xml b/cime/config/cesm/config_grids.xml index e90801e62f0e..5e7d79f02448 100644 --- a/cime/config/cesm/config_grids.xml +++ b/cime/config/cesm/config_grids.xml @@ -1026,6 +1026,13 @@ tx0.25v1 + + C384 + C384 + tx0.25v1 + tx0.25v1 + + ww3a @@ -1048,7 +1055,6 @@ - 1 1 domain.ocn.01col.ArcticOcean.20150824.nc @@ -1568,6 +1574,13 @@ Experimental for fv3 dycore + + + 100000 1 + C384 is a fvcubed xx-deg grid: + Experimental for fv3 dycore + + diff --git a/cime/config/cesm/machines/config_batch.xml b/cime/config/cesm/machines/config_batch.xml index 46d7f94c4dd3..4fac63301ee3 100644 --- a/cime/config/cesm/machines/config_batch.xml +++ b/cime/config/cesm/machines/config_batch.xml @@ -402,6 +402,7 @@ ssh izumi cd $CASEROOT ; qsub + (\d+.izumi.unified.ucar.edu)$ -l nodes={{ num_nodes }}:ppn={{ tasks_per_node }} -S {{ shell }} diff --git a/cime/config/cesm/machines/config_compilers.xml b/cime/config/cesm/machines/config_compilers.xml index 9e61d46eb7f6..826466cb5554 100644 --- a/cime/config/cesm/machines/config_compilers.xml +++ b/cime/config/cesm/machines/config_compilers.xml @@ -320,8 +320,16 @@ using a fortran linker. mpif90 gcc nagfor + + + -lpthread + + + FCLIBS="-Wl,--as-needed,--allow-shlib-undefined -L$(COMPILER_PATH)/lib/NAG_Fortran -lf62rts" + + -gopt -time @@ -902,19 +910,6 @@ using a fortran linker. /fs/cgd/csm/tools/pFUnit/pFUnit3.2.8_hobart_Intel15.0.2_noMPI_noOpenMP - - - - -DNO_C_SIZEOF - - - -lpthread - - - -L/usr/local/nag/lib/NAG_Fortran - - - -O0 diff --git a/cime/config/cesm/machines/config_machines.xml b/cime/config/cesm/machines/config_machines.xml index 956fdd1531b6..d14640afb560 100644 --- a/cime/config/cesm/machines/config_machines.xml +++ b/cime/config/cesm/machines/config_machines.xml @@ -312,7 +312,6 @@ This allows using a different mpirun command to launch unit tests mpiexec_mpt - -p "%g:" -np {{ total_tasks }} @@ -353,25 +352,13 @@ This allows using a different mpirun command to launch unit tests ncarenv/1.2 - intel/17.0.1 + intel/19.0.2 esmf_libs mkl pgi/17.9 - - esmf-7.1.0r-defio-mpi-g - - - esmf-7.1.0r-defio-mpi-O - - - esmf-7.1.0r-ncdfio-uni-g - - - esmf-7.1.0r-ncdfio-uni-O - gnu/7.3.0 openblas/0.2.20 @@ -385,12 +372,6 @@ This allows using a different mpirun command to launch unit tests netcdf-mpi/4.6.1 pnetcdf/1.11.0 - - pio/2.4.1 - - - pio/1.10.1 - mpt/2.19 netcdf-mpi/4.6.1 @@ -406,12 +387,12 @@ This allows using a different mpirun command to launch unit tests netcdf/4.6.1 + + netcdf/4.6.1 + netcdf/4.4.1.1 - - netcdf/4.5.0 - 256M @@ -420,11 +401,18 @@ This allows using a different mpirun command to launch unit tests 1 + + /glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libO/Linux.intel.64.mpt.default/esmf.mk + + + /glade/u/home/dunlap/ESMF-INSTALL/intel19/8.0.0bs32/lib/libg/Linux.intel.64.mpt.default/esmf.mk + - /glade/u/home/turuncu/progs/esmf-8.0.0b29/install_dir/lib/libO/Linux.intel.64.mpt.default/esmf.mk ON SUMMARY - /glade/work/dunlap/FV3GFS/benchmark-20181016/ + /glade/work/turuncu/FV3GFS/benchmark-inputs/2012010100/gfs/fcst + /glade/work/turuncu/FV3GFS/fix_am + /glade/work/turuncu/FV3GFS/addon false @@ -944,7 +932,7 @@ This allows using a different mpirun command to launch unit tests /global/project/projectdirs/ccsm1/modulefiles/edison - esmf/6.3.0rp1-defio-intel17.0-mpi-O + esmf/7.1.0r-defio-intel18.0.1.163-mpi-O esmf/6.3.0rp1-defio-intel17.0-mpiuni-O @@ -2304,18 +2292,20 @@ This allows using a different mpirun command to launch unit tests 256M + - - /work/06242/tg855414/stampede2/ESMF-INSTALL/8.0.0bs28/lib/libO/Linux.intel.64.intelmpi.default/esmf.mk - + /work/06242/tg855414/stampede2/ESMF-INSTALL/8.0.0bs29/lib/libO/Linux.intel.64.intelmpi.default/esmf.mk + ON SUMMARY - - /work/06242/tg855414/stampede2/FV3GFS/benchmark-20181016 + /work/06242/tg855414/stampede2/FV3GFS/benchmark-inputs/2012040100/gfs/fcst + /work/06242/tg855414/stampede2/FV3GFS/fix_am + /work/06242/tg855414/stampede2/FV3GFS/addon @@ -2421,13 +2411,16 @@ 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.0bs28g + yaml-cpp + esmf/8.0.0bs29g ON SUMMARY - /scratch4/NCEPDEV/nems/noscrub/Rocky.Dunlap/INPUTDATA/benchmark-20181016 + /scratch4/NCEPDEV/nems/noscrub/Rocky.Dunlap/INPUTDATA/benchmark-inputs/2012040100/gfs/fcst + /scratch4/NCEPDEV/nems/noscrub/Rocky.Dunlap/INPUTDATA/fix_am + /scratch4/NCEPDEV/nems/noscrub/Rocky.Dunlap/INPUTDATA/addon diff --git a/cime/config/cesm/machines/config_pio.xml b/cime/config/cesm/machines/config_pio.xml index 5146795b7759..426b12829e84 100644 --- a/cime/config/cesm/machines/config_pio.xml +++ b/cime/config/cesm/machines/config_pio.xml @@ -25,6 +25,13 @@ + + + 1 + + + + - Data driven ATM + Data driven ATM QIAN data set QIAN with water isotopes CRUNCEP data set CLM CRU NCEP v7 data set GSWP3v1 data set + NLDAS2 regional 0.125 degree data set over the U.S. (25-53N, 235-293E). WARNING: Garbage data will be produced for runs extending beyond this regional domain. Coupler hist data set (in this mode, it is strongly recommended that the model domain and the coupler history forcing are on the same domain) single point tower site data set COREv2 normal year forcing @@ -34,13 +35,14 @@ char - CORE2_NYF,CORE2_IAF,CLM_QIAN,CLM_QIAN_WISO,CLM1PT,CLMCRUNCEP,CLMCRUNCEPv7,CLMGSWP3v1,CPLHIST,CORE_IAF_JRA + CORE2_NYF,CORE2_IAF,CLM_QIAN,CLM_QIAN_WISO,CLM1PT,CLMCRUNCEP,CLMCRUNCEPv7,CLMGSWP3v1,CLMNLDAS2,CPLHIST,CORE_IAF_JRA CORE2_NYF run_component_datm env_run.xml Mode for data atmosphere component. CORE2_NYF (CORE2 normal year forcing) are modes used in forcing prognostic ocean/sea-ice components. - CLM_QIAN, CLMCRUNCEP, CLMCRUNCEPv7, CLMGSWP3v1 and CLM1PT are modes using observational data for forcing prognostic land components. + CLM_QIAN, CLMCRUNCEP, CLMCRUNCEPv7, CLMGSWP3v1, CLMNLDAS2 and CLM1PT are modes using observational data for forcing prognostic land components. + WARNING for CLMNLDAS2: This is a regional forcing dataset over the U.S. (25-53N, 235-293E). Garbage data will be produced for runs extending beyond this regional domain. CORE2_NYF CORE2_IAF @@ -50,6 +52,7 @@ CLMCRUNCEP CLMCRUNCEPv7 CLMGSWP3v1 + CLMNLDAS2 CLM1PT CPLHIST @@ -187,30 +190,27 @@ 1 - 1 1 1 1 - 1 + 1 1895 1901 1901 + $DATM_CLMNCEP_YR_START 1895 1901 1901 - 1 + $DATM_CLMNCEP_YR_START 2004 2005 2005 - 1 1 - 1 - 1 - 1 1 - 1 - 1 - 1 + $DATM_CLMNCEP_YR_START + $DATM_CLMNCEP_YR_START + $DATM_CLMNCEP_YR_START + $DATM_CLMNCEP_YR_START run_component_datm env_run.xml @@ -226,14 +226,17 @@ 1948 1901 1901 + 0 2000 1972 1948 1901 1901 + 0 1948 1901 1901 + 0 1948 1972 1991 @@ -247,6 +250,9 @@ 1991 2005 2002 + 1980 + 2005 + 2002 run_component_datm env_run.xml @@ -262,14 +268,17 @@ 1972 1920 1920 + -1 2004 2004 1972 1920 1920 + -1 1972 1920 1920 + -1 2004 2004 2010 @@ -283,6 +292,9 @@ 2010 2014 2003 + 2018 + 2014 + 2003 run_component_datm env_run.xml diff --git a/cime/src/components/data_comps/datm/cime_config/namelist_definition_datm.xml b/cime/src/components/data_comps/datm/cime_config/namelist_definition_datm.xml index 6c9d79c95944..a502d81ce66d 100644 --- a/cime/src/components/data_comps/datm/cime_config/namelist_definition_datm.xml +++ b/cime/src/components/data_comps/datm/cime_config/namelist_definition_datm.xml @@ -36,6 +36,7 @@ CLMCRUNCEP = Run with the CLM CRU NCEP V4 ( default ) forcing valid from 1900 to 2010 (force CLM) CLMCRUNCEPv7 = Run with the CLM CRU NCEP V7 forcing valid from 1900 to 2010 (force CLM) CLMGSWP3v1 = Run with the CLM GSWP3 V1 forcing (force CLM) + CLMNLDAS2 = Run with the CLM NLDAS2 regional forcing valid from 1980 to 2018 (force CLM) CLM1PT = Run with supplied single point data (force CLM) CORE2_NYF = CORE2 normal year forcing (for forcing POP and CICE) CORE2_IAF = CORE2 intra-annual year forcing (for forcing POP and CICE) @@ -96,6 +97,10 @@ CLMGSWP3v1.Precip CLMGSWP3v1.TPQW + CLMNLDAS2.Solar + CLMNLDAS2.Precip + CLMNLDAS2.TPQW + co2tseries.20tr co2tseries.20tr.latbnd co2tseries.rcp2.6 @@ -171,6 +176,7 @@ CLMCRUNCEP.Solar,CLMCRUNCEP.Precip,CLMCRUNCEP.TPQW CLMCRUNCEPv7.Solar,CLMCRUNCEPv7.Precip,CLMCRUNCEPv7.TPQW CLMGSWP3v1.Solar,CLMGSWP3v1.Precip,CLMGSWP3v1.TPQW + CLMNLDAS2.Solar,CLMNLDAS2.Precip,CLMNLDAS2.TPQW CORE2_NYF.GISS,CORE2_NYF.GXGXS,CORE2_NYF.NCEP CORE2_IAF.GCGCS.PREC,CORE2_IAF.GISS.LWDN,CORE2_IAF.GISS.SWDN,CORE2_IAF.GISS.SWUP,CORE2_IAF.NCEP.DN10,CORE2_IAF.NCEP.Q_10,CORE2_IAF.NCEP.SLP_,CORE2_IAF.NCEP.T_10,CORE2_IAF.NCEP.U_10,CORE2_IAF.NCEP.V_10,CORE2_IAF.CORE2.ArcFactor CORE_IAF_JRA.PREC,CORE_IAF_JRA.LWDN,CORE_IAF_JRA.SWDN,CORE_IAF_JRA.Q_10,CORE_IAF_JRA.SLP_,CORE_IAF_JRA.T_10,CORE_IAF_JRA.U_10,CORE_IAF_JRA.V_10,CORE_IAF_JRA.CORE2.ArcFactor @@ -196,6 +202,7 @@ $DIN_LOC_ROOT/share/domains/domain.clm $DIN_LOC_ROOT_CLMFORC/atm_forcing.datm7.cruncep_qianFill.0.5d.V5.c140715 $DIN_LOC_ROOT_CLMFORC/atm_forcing.datm7.GSWP3.0.5d.v1.c170516 + $DIN_LOC_ROOT/share/domains/domain.clm $DIN_LOC_ROOT/atm/datm7/NYF $DIN_LOC_ROOT/atm/datm7/CORE2 $DIN_LOC_ROOT/share/domains @@ -261,6 +268,7 @@ domain.lnd.360x720.130305.nc domain.lnd.360x720_gswp3.0v1.c170606.nc domain.lnd.360x720_gswp3.0v1.c170606.nc + domain.lnd.0.125nldas2_0.125nldas2.190410.nc nyf.giss.T62.051007.nc nyf.gxgxs.T62.051007.nc nyf.ncep.T62.050923.nc @@ -412,6 +420,9 @@ $DIN_LOC_ROOT_CLMFORC/atm_forcing.datm7.GSWP3.0.5d.v1.c170516/Solar3Hrly $DIN_LOC_ROOT_CLMFORC/atm_forcing.datm7.GSWP3.0.5d.v1.c170516/Precip3Hrly $DIN_LOC_ROOT_CLMFORC/atm_forcing.datm7.GSWP3.0.5d.v1.c170516/TPHWL3Hrly + $DIN_LOC_ROOT/atm/datm7/atm_forcing.datm7.NLDAS2.0.125d.v1/Solar + $DIN_LOC_ROOT/atm/datm7/atm_forcing.datm7.NLDAS2.0.125d.v1/Precip + $DIN_LOC_ROOT/atm/datm7/atm_forcing.datm7.NLDAS2.0.125d.v1/TPQWL $DIN_LOC_ROOT/atm/datm7/NYF $DIN_LOC_ROOT/atm/datm7/CORE2 $DIN_LOC_ROOT/ocn/iaf @@ -485,6 +496,9 @@ clmforc.GSWP3.c2011.0.5x0.5.Solr.%ym.nc clmforc.GSWP3.c2011.0.5x0.5.Prec.%ym.nc clmforc.GSWP3.c2011.0.5x0.5.TPQWL.%ym.nc + ctsmforc.NLDAS2.0.125d.v1.Solr.%ym.nc + ctsmforc.NLDAS2.0.125d.v1.Prec.%ym.nc + ctsmforc.NLDAS2.0.125d.v1.TPQWL.%ym.nc nyf.giss.T62.051007.nc nyf.gxgxs.T62.051007.nc nyf.ncep.T62.050923.nc @@ -1810,6 +1824,19 @@ PSRF pbot FLDS lwdn + + FSDS swdn + + + PRECTmms precn + + + TBOT tbot + WIND wind + QBOT shum + PSRF pbot + FLDS lwdn + lwdn lwdn swdn swdn @@ -2017,6 +2044,7 @@ $DATM_CLMNCEP_YR_ALIGN $DATM_CLMNCEP_YR_ALIGN $DATM_CLMNCEP_YR_ALIGN + $DATM_CLMNCEP_YR_ALIGN 1 1 1 @@ -2057,6 +2085,7 @@ $DATM_CLMNCEP_YR_START $DATM_CLMNCEP_YR_START $DATM_CLMNCEP_YR_START + $DATM_CLMNCEP_YR_START 1 2010 2010 @@ -2123,6 +2152,7 @@ $DATM_CLMNCEP_YR_END $DATM_CLMNCEP_YR_END $DATM_CLMNCEP_YR_END + $DATM_CLMNCEP_YR_END 1 2011 2011 @@ -2371,6 +2401,7 @@ nn copy copy + copy nn @@ -2442,6 +2473,8 @@ nearest coszen nearest + coszen + nearest nearest nearest nearest diff --git a/cime/src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 b/cime/src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 index 9c3f2d03e1c2..0917c7b9027b 100644 --- a/cime/src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 +++ b/cime/src/components/data_comps/datm/nuopc/atm_comp_nuopc.F90 @@ -5,36 +5,26 @@ module atm_comp_nuopc !---------------------------------------------------------------------------- use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - use NUOPC_Model , only : model_routine_SS => SetServices - use NUOPC_Model , only : model_label_Advance => label_Advance - 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 - 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 med_constants_mod , only : shr_cal_ymd2date, shr_cal_noleap, shr_cal_gregorian - 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 - use shr_nuopc_scalars_mod , only : flds_scalar_index_ny - use shr_nuopc_scalars_mod , only : flds_scalar_index_nextsw_cday - 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_SetScalar - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - 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, 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_advertise, datm_comp_init, datm_comp_run - use datm_comp_mod , only : datm_comp_import, datm_comp_export + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise + use NUOPC_Model , only : model_routine_SS => SetServices + use NUOPC_Model , only : model_label_Advance => label_Advance + 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 shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date + use shr_const_mod , only : SHR_CONST_SPVAL + use shr_sys_mod , only : shr_sys_abort + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize + use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData + use dshr_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck + use dshr_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance + use datm_shr_mod , only : datm_shr_read_namelists, iradsw, datm_shr_getNextRadCDay + 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 + use perf_mod , only : t_startf, t_stopf, t_barrierf implicit none private ! except @@ -50,27 +40,32 @@ 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) - - integer :: compid ! mct comp id - integer :: mpicom ! mpi communicator - 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. "lnd_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 - character(len=256) :: case_name ! case name - character(len=80) :: calendar ! calendar name - logical :: atm_prognostic ! data is sent back to datm - logical :: use_esmf_metadata = .false. - character(*),parameter :: modName = "(atm_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 = & + character(len=128) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_nextsw_cday = 0 + + integer :: fldsToAtm_num = 0 + integer :: fldsFrAtm_num = 0 + type (fld_list_type) :: fldsToAtm(fldsMax) + type (fld_list_type) :: fldsFrAtm(fldsMax) + + integer :: compid ! mct comp id + integer :: mpicom ! mpi communicator + 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. "lnd_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 + character(len=CL) :: case_name ! case name + character(len=CS) :: calendar ! calendar name + logical :: atm_prognostic ! data is sent back to datm + logical :: use_esmf_metadata = .false. + character(*),parameter :: modName = "(atm_comp_nuopc)" + integer, parameter :: debug = 0 ! if > 0 will diagnose export fields + character(*),parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -90,36 +85,36 @@ subroutine SetServices(gcomp, rc) ! 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) @@ -129,9 +124,6 @@ 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 @@ -145,13 +137,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: n integer :: ierr ! error code integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level integer :: localPet logical :: flds_co2a ! use case logical :: flds_co2b ! use case logical :: flds_co2c ! use case logical :: flds_wiso ! use case character(len=CL) :: fileName ! generic file name + character(len=CL) :: logmsg + logical :: isPresent, isSet character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -163,10 +156,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, mpiCommunicator=lmpicom, localPet=localPet, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call mpi_comm_dup(lmpicom, mpicom, ierr) call mpi_comm_rank(mpicom, my_task, ierr) @@ -175,14 +168,16 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! determine instance information !---------------------------------------------------------------------------- - call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) + call get_component_instance(gcomp, inst_suffix, inst_index, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return inst_name = "ATM"//trim(inst_suffix) !---------------------------------------------------------------------------- ! 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 set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Read input namelists and set present and prognostic flags @@ -192,37 +187,87 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call datm_shr_read_namelists(filename, mpicom, my_task, master_task, logunit, atm_prognostic) !-------------------------------- - ! determine necessary toggles for below + ! advertise import and export fields !-------------------------------- + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldName') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(logmsg,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldCount') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(logmsg,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNX') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(logmsg,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNY') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nextsw_cday + write(logmsg,*) flds_scalar_index_nextsw_cday + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nextsw_cday = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxNextSwCday') + endif + call NUOPC_CompAttributeGet(gcomp, name='flds_co2a', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2a 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2b 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_co2c 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_wiso call ESMF_LogWrite('flds_wiso = '// trim(cvalue), ESMF_LOGMSG_INFO) - !-------------------------------- - ! advertise import and export fields - !-------------------------------- - - call datm_comp_advertise(importState, exportState, & + call datm_comp_advertise(importState, exportState, flds_scalar_name, & 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) @@ -230,7 +275,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,11 +305,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) real(R8) :: nextsw_cday ! calendar of next atm sw character(len=256) :: cvalue ! character string for input config integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level logical :: read_restart ! start from restart logical :: scmMode = .false. ! single column mode - real(R8) :: scmLat = shr_const_SPVAL ! single column lat - real(R8) :: scmLon = shr_const_SPVAL ! single column lon + real(R8) :: scmLat = shr_const_spval ! single column lat + real(R8) :: scmLon = shr_const_spval ! single column lon real(R8) :: orbEccen ! orb eccentricity (unit-less) real(R8) :: orbMvelpp ! orb moving vernal eq (radians) real(R8) :: orbLambm0 ! orb mean long of perhelion (radians) @@ -285,8 +328,6 @@ 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) !-------------------------------- @@ -294,40 +335,40 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) scmlon call NUOPC_CompAttributeGet(gcomp, name='scmlat', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) scmlat call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) scmMode call NUOPC_CompAttributeGet(gcomp, name='read_restart', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) read_restart call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) compid ! Determine orbital values (these might change dynamically) call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) orbEccen call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) orbObliqr call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) orbLambm0 call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) orbMvelpp !---------------------------------------------------------------------------- @@ -335,11 +376,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, advanceCount=stepno, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet( currTime, yy=current_year, mm=current_mon, dd=current_day, s=current_tod, & calkindflag=esmf_caltype, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(current_year, current_mon, current_day, current_ymd) if (esmf_caltype == ESMF_CALKIND_NOLEAP) then @@ -353,7 +394,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if call ESMF_TimeIntervalGet( timeStep, s=modeldt, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Set nextsw_cday @@ -366,10 +407,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return Emesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, 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 write(logunit,*) " (datm_comp_nuopc): obtaining datm mesh from " // trim(cvalue) @@ -400,7 +441,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 dshr_realize( & state=importState, & @@ -410,7 +451,7 @@ 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 @@ -418,39 +459,38 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- call datm_comp_export(exportState, rc=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(nxg),flds_scalar_index_nx, exportState, & + call 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, & + call 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 - call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & + call 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 (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 + if (debug > 0) then + call State_diagnose(exportState, subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif !---------------------------------------------------------------------------- ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (use_esmf_metadata) then call ModelSetMetaData(gcomp, name='DATM', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) @@ -461,9 +501,7 @@ 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 - + ! input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -476,7 +514,6 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_Time) :: nextTime type(ESMF_TimeInterval) :: timeStep integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level real(r8) :: nextsw_cday logical :: write_restart ! restart alarm is ringing integer :: nextymd ! model date @@ -490,21 +527,21 @@ subroutine ModelAdvance(gcomp, rc) real(R8) :: orbMvelpp ! orb moving vernal eq (radians) real(R8) :: orbLambm0 ! orb mean long of perhelion (radians) real(R8) :: orbObliqr ! orb obliquity (radians) - character(len=256) :: cvalue + character(len=CL) :: cvalue character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' !------------------------------------------------------------------------------- - call t_startf(subname) + rc = ESMF_SUCCESS + + call t_startf(subname) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + call memcheck(subname, 5, my_task==master_task) - call shr_nuopc_memcheck(subname, 5, my_task==master_task) !-------------------------------- ! 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) !-------------------------------- @@ -512,12 +549,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 - call shr_nuopc_methods_Clock_TimePrint(clock,subname//'clock',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - endif + if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Unpack import state @@ -525,7 +557,7 @@ subroutine ModelAdvance(gcomp, rc) if (atm_prognostic) then call datm_comp_import(importState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if !-------------------------------- @@ -536,16 +568,16 @@ subroutine ModelAdvance(gcomp, rc) ! 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) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) orbEccen call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) orbObliqr call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) orbLambm0 call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) orbMvelpp call t_stopf('datm_get_attributes') @@ -554,13 +586,13 @@ subroutine ModelAdvance(gcomp, rc) 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return write_restart = .true. call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else write_restart = .false. endif @@ -570,15 +602,15 @@ subroutine ModelAdvance(gcomp, rc) ! shr_strdata time interpolation call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, advanceCount=stepno, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return nextTime = currTime + timeStep call ESMF_TimeGet( nextTime, yy=yr, mm=mon, dd=day, s=nexttod, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yr, mon, day, nextymd) call ESMF_TimeIntervalGet( timeStep, s=modeldt, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call t_stopf('datm_get_clockinfo') @@ -601,31 +633,30 @@ subroutine ModelAdvance(gcomp, 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') + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call t_startf('datm_export_setscalar') - call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & + call 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') + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call t_stopf('datm_export') !-------------------------------- ! 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 + if (debug > 0) then + call State_diagnose(exportState,subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (my_task == master_task) then + call log_clock_advance(clock, 'DATM', logunit, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif end if - if(my_task == master_task) then - call shr_nuopc_log_clock_advance(clock, 'DATM', logunit) - endif + !---------------------------------------------------------------------------- ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) diff --git a/cime/src/components/data_comps/datm/nuopc/datm_comp_mod.F90 b/cime/src/components/data_comps/datm/nuopc/datm_comp_mod.F90 index 2450690262fd..df6d5876ff85 100644 --- a/cime/src/components/data_comps/datm/nuopc/datm_comp_mod.F90 +++ b/cime/src/components/data_comps/datm/nuopc/datm_comp_mod.F90 @@ -1,10 +1,5 @@ -#ifdef AIX - @PROCESS ALIAS_SIZE(805306368) -#endif - module datm_comp_mod - ! !USES: 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 @@ -12,13 +7,13 @@ module datm_comp_mod use mct_mod , only : mct_gsmap_init use mct_mod , only : mct_avect, mct_avect_indexRA, mct_avect_zero, mct_aVect_nRattr use mct_mod , only : mct_avect_init, mct_avect_lsize + use shr_kind_mod , only : r8=>shr_kind_r8, cxx=>shr_kind_cxx, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_const_mod , only : SHR_CONST_SPVAL use shr_const_mod , only : SHR_CONST_TKFRZ use shr_const_mod , only : SHR_CONST_PI use shr_const_mod , only : SHR_CONST_PSTD use shr_const_mod , only : SHR_CONST_STEBOL use shr_const_mod , only : SHR_CONST_RDAIR - use med_constants_mod , only : R8, CS, CL, CXX use shr_string_mod , only : shr_string_listGetName use shr_sys_mod , only : shr_sys_abort use shr_file_mod , only : shr_file_getunit, shr_file_freeunit @@ -34,8 +29,7 @@ module datm_comp_mod use shr_strdata_mod , only : shr_strdata_advance, shr_strdata_restWrite use shr_strdata_mod , only : shr_strdata_setorbs 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_methods_mod , only : ChkErr 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 @@ -142,7 +136,7 @@ module datm_comp_mod contains !=============================================================================== - subroutine datm_comp_advertise(importState, exportState, & + subroutine datm_comp_advertise(importState, exportState, flds_scalar_name, & atm_prognostic, flds_wiso_in, flds_co2a_in, flds_co2b_in, flds_co2c_in, & fldsFrAtm_num, fldsFrAtm, fldsToAtm_num, fldsToAtm, rc) @@ -151,18 +145,19 @@ subroutine datm_comp_advertise(importState, exportState, & ! 3. determine module indices for attribute vectors ! input/output arguments - type(ESMF_State) :: importState - type(ESMF_State) :: exportState - logical , intent(in) :: atm_prognostic - 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(:) - integer , intent(out) :: rc + type(ESMF_State) , intent(inout) :: importState + type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: flds_scalar_name + logical , intent(in) :: atm_prognostic + 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(:) + integer , intent(out) :: rc ! local variables integer :: n @@ -393,13 +388,13 @@ subroutine datm_comp_advertise(importState, exportState, & do n = 1,fldsFrAtm_num call NUOPC_Advertise(exportState, standardName=fldsFrAtm(n)%stdname, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return enddo if (atm_prognostic) then do n = 1,fldsToAtm_num call NUOPC_Advertise(importState, standardName=fldsToAtm(n)%stdname, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end do end if @@ -540,24 +535,24 @@ subroutine datm_comp_init(mpicom, compid, my_task, master_task, & ! obtain the distgrid from the mesh that was read in call ESMF_MeshGet(Mesh, elementdistGrid=distGrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determin local size on my processor call ESMF_distGridGet(distGrid, localDe=0, elementCount=lsize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determine global index space for my processor allocate(gindex(lsize)) call ESMF_distGridGet(distGrid, localDe=0, seqIndexList=gindex, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determine global size of distgrid call ESMF_distGridGet(distGrid, dimCount=dimCount, deCount=deCount, tileCount=tileCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(elementCountPTile(tileCount)) call ESMF_distGridGet(distGrid, elementCountPTile=elementCountPTile, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return gsize = 0 do n = 1,size(elementCountPTile) gsize = gsize + elementCountPTile(n) @@ -591,11 +586,11 @@ subroutine datm_comp_init(mpicom, compid, my_task, master_task, & ! obtain mesh lats and lons call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(ownedElemCoords(spatialDim*numOwnedElements)) allocate(xc(numOwnedElements), yc(numOwnedElements)) call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (numOwnedElements /= lsize) then call shr_sys_abort('ERROR: numOwnedElements is not equal to lsize') end if @@ -1436,75 +1431,75 @@ subroutine datm_comp_import(importState, rc) 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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine datm_comp_import @@ -1523,124 +1518,124 @@ subroutine datm_comp_export(exportState, rc) 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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end subroutine datm_comp_export diff --git a/cime/src/components/data_comps/datm/nuopc/datm_shr_mod.F90 b/cime/src/components/data_comps/datm/nuopc/datm_shr_mod.F90 index a08b4f08aaf2..828a2fb87b46 100644 --- a/cime/src/components/data_comps/datm/nuopc/datm_shr_mod.F90 +++ b/cime/src/components/data_comps/datm/nuopc/datm_shr_mod.F90 @@ -6,11 +6,10 @@ module datm_shr_mod use shr_const_mod , only : SHR_CONST_CDAY,SHR_CONST_TKFRZ,SHR_CONST_SPVAL use shr_file_mod , only : shr_file_getlogunit, shr_file_getunit, shr_file_freeunit use shr_sys_mod , only : shr_sys_flush, shr_sys_abort - use shr_strdata_mod, only : shr_strdata_readnml - use shr_dmodel_mod , only : shr_dmodel_mapset use shr_cal_mod , only : shr_cal_date2julian + use shr_dmodel_mod , only : shr_dmodel_mapset use shr_ncread_mod , only : shr_ncread_varExists, shr_ncread_varDimSizes, shr_ncread_field4dG - use shr_strdata_mod, only : shr_strdata_type + use shr_strdata_mod, only : shr_strdata_readnml, shr_strdata_type use mct_mod ! !PUBLIC TYPES: diff --git a/cime/src/components/data_comps/dice/nuopc/dice_comp_mod.F90 b/cime/src/components/data_comps/dice/nuopc/dice_comp_mod.F90 index 387752c137c7..68062a36a11a 100644 --- a/cime/src/components/data_comps/dice/nuopc/dice_comp_mod.F90 +++ b/cime/src/components/data_comps/dice/nuopc/dice_comp_mod.F90 @@ -1,10 +1,5 @@ -#ifdef AIX -@PROCESS ALIAS_SIZE(805306368) -#endif - module dice_comp_mod - ! !USES: 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 @@ -12,7 +7,7 @@ module dice_comp_mod use mct_mod , only : mct_gsmap_init use mct_mod , only : mct_avect, mct_avect_indexRA, mct_avect_zero, mct_aVect_nRattr use mct_mod , only : mct_avect_init, mct_avect_lsize - use med_constants_mod , only : R8, CS, CXX + use shr_kind_mod , only : r8=>shr_kind_r8, cxx=>shr_kind_cxx, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_const_mod , only : shr_const_pi, shr_const_spval, shr_const_tkfrz, shr_const_latice use shr_file_mod , only : shr_file_getunit, shr_file_freeunit use shr_mpi_mod , only : shr_mpi_bcast @@ -21,8 +16,6 @@ module dice_comp_mod use shr_cal_mod , only : shr_cal_datetod2string use shr_string_mod , only : shr_string_listGetName use shr_sys_mod , only : shr_sys_abort - use shr_nuopc_scalars_mod , only : flds_scalar_name - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_strdata_mod , only : shr_strdata_init_model_domain use shr_strdata_mod , only : shr_strdata_init_streams use shr_strdata_mod , only : shr_strdata_init_mapping @@ -30,6 +23,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_methods_mod , only : ChkErr 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 @@ -43,7 +37,6 @@ module dice_comp_mod use dice_flux_atmice_mod , only : dice_flux_atmice use shr_pcdf_mod - ! !PUBLIC TYPES: implicit none private ! except @@ -124,13 +117,13 @@ module dice_comp_mod contains !=============================================================================== - subroutine dice_comp_advertise(importState, exportState, & - ice_present, ice_prognostic, & - fldsFrIce_num, fldsFrIce, fldsToIce_num, fldsToIce, rc) + subroutine dice_comp_advertise(importState, exportState, flds_scalar_name, & + ice_present, ice_prognostic, fldsFrIce_num, fldsFrIce, fldsToIce_num, fldsToIce, rc) ! input/output arguments type(ESMF_State) , intent(inout) :: importState type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: flds_scalar_name logical , intent(in) :: ice_present logical , intent(in) :: ice_prognostic integer , intent(out) :: fldsToIce_num @@ -314,14 +307,14 @@ subroutine dice_comp_advertise(importState, exportState, & do n = 1,fldsFrIce_num call NUOPC_Advertise(exportState, standardName=fldsFrIce(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 if (ice_prognostic) then do n = 1,fldsToIce_num 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 enddo end if @@ -394,24 +387,24 @@ subroutine dice_comp_init(flds_i2o_per_cat, mpicom, compid, my_task, master_task ! obtain the distgrid from the mesh that was read in call ESMF_MeshGet(Mesh, elementdistGrid=distGrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determin local size on my processor call ESMF_distGridGet(distGrid, localDe=0, elementCount=lsize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determine global index space for my processor allocate(gindex(lsize)) call ESMF_distGridGet(distGrid, localDe=0, seqIndexList=gindex, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determine global size of distgrid call ESMF_distGridGet(distGrid, dimCount=dimCount, deCount=deCount, tileCount=tileCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(elementCountPTile(tileCount)) call ESMF_distGridGet(distGrid, elementCountPTile=elementCountPTile, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return gsize = 0 do n = 1,size(elementCountPTile) gsize = gsize + elementCountPTile(n) @@ -445,11 +438,11 @@ subroutine dice_comp_init(flds_i2o_per_cat, mpicom, compid, my_task, master_task ! obtain mesh lats and lons call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(ownedElemCoords(spatialDim*numOwnedElements)) allocate(xc(numOwnedElements), yc(numOwnedElements)) call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (numOwnedElements /= lsize) then call shr_sys_abort('ERROR: numOwnedElements is not equal to lsize') end if @@ -909,65 +902,65 @@ subroutine dice_comp_import(importState, rc) 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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine dice_comp_import @@ -986,67 +979,67 @@ subroutine dice_comp_export(exportState, rc) 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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine dice_comp_export diff --git a/cime/src/components/data_comps/dice/nuopc/dice_shr_mod.F90 b/cime/src/components/data_comps/dice/nuopc/dice_shr_mod.F90 index 4cc947f5dda3..3074836cee96 100644 --- a/cime/src/components/data_comps/dice/nuopc/dice_shr_mod.F90 +++ b/cime/src/components/data_comps/dice/nuopc/dice_shr_mod.F90 @@ -1,7 +1,5 @@ module dice_shr_mod - ! !USES: - use shr_kind_mod , only : IN=>SHR_KIND_IN, R8=>SHR_KIND_R8 use shr_kind_mod , only : CS=>SHR_KIND_CS, CL=>SHR_KIND_CL use shr_file_mod , only : shr_file_getunit, shr_file_freeunit diff --git a/cime/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 b/cime/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 index c6064bdd9e77..8bc0022e4b20 100644 --- a/cime/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 +++ b/cime/src/components/data_comps/dice/nuopc/ice_comp_nuopc.F90 @@ -5,35 +5,27 @@ module ice_comp_nuopc !---------------------------------------------------------------------------- use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - use NUOPC_Model , only : model_routine_SS => SetServices - use NUOPC_Model , only : model_label_Advance => label_Advance - 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, 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 med_constants_mod , only : shr_cal_ymd2date, shr_cal_noleap, shr_cal_gregorian - 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 - 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_SetScalar - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - 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 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 dice_comp_mod , only : dice_comp_import, dice_comp_export + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise + use NUOPC_Model , only : model_routine_SS => SetServices + use NUOPC_Model , only : model_label_Advance => label_Advance + 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 shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date, shr_cal_ymd2julian + use shr_const_mod , only : SHR_CONST_SPVAL + use shr_sys_mod , only : shr_sys_abort + use shr_const_mod , only : shr_const_spval, shr_const_pi + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize + use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData + use dshr_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck + use dshr_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance + use dice_shr_mod , only : dice_shr_read_namelists + use dice_comp_mod , only : dice_comp_init, dice_comp_run, dice_comp_advertise + use dice_comp_mod , only : dice_comp_import, dice_comp_export + use perf_mod , only : t_startf, t_stopf, t_barrierf implicit none private ! except @@ -49,31 +41,36 @@ module ice_comp_nuopc ! Private module data !-------------------------------------------------------------------------- - integer :: fldsToIce_num = 0 - integer :: fldsFrIce_num = 0 - type (fld_list_type) :: fldsToIce(fldsMax) - type (fld_list_type) :: fldsFrIce(fldsMax) - - integer :: compid ! mct comp id - integer :: mpicom ! mpi communicator - 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. "lnd_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 :: read_restart ! start from restart - character(len=256) :: case_name ! case name - 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 - logical :: use_esmf_metadata = .false. - real(R8) ,parameter :: pi = shr_const_pi ! pi - character(*),parameter :: modName = "(ice_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 = & + character(len=CS) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + + integer :: fldsToIce_num = 0 + integer :: fldsFrIce_num = 0 + type (fld_list_type) :: fldsToIce(fldsMax) + type (fld_list_type) :: fldsFrIce(fldsMax) + + integer :: compid ! mct comp id + integer :: mpicom ! mpi communicator + 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. "lnd_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 :: read_restart ! start from restart + character(len=256) :: case_name ! case name + 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 + logical :: use_esmf_metadata = .false. + real(R8) ,parameter :: pi = shr_const_pi ! pi + character(*),parameter :: modName = "(ice_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__ !=============================================================================== @@ -90,37 +87,37 @@ subroutine SetServices(gcomp, rc) ! 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) @@ -129,9 +126,8 @@ 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 @@ -146,12 +142,12 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: n integer :: ierr ! error code integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - logical :: isPresent character(len=CL) :: diro character(len=CL) :: logfile integer :: localPet character(len=CL) :: fileName ! generic file name + character(len=CL) :: logmsg + logical :: isPresent, isSet character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -163,10 +159,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, mpiCommunicator=lmpicom, localPet=localPet, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call mpi_comm_dup(lmpicom, mpicom, ierr) call mpi_comm_rank(mpicom, my_task, ierr) @@ -175,14 +171,17 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! determine instance information !---------------------------------------------------------------------------- - call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) + call get_component_instance(gcomp, inst_suffix, inst_index, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + inst_name = "ICE"//trim(inst_suffix) !---------------------------------------------------------------------------- ! 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 set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Read input namelists and set present and prognostic flags @@ -196,7 +195,42 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! Advertise import and export fields !-------------------------------- - call dice_comp_advertise(importstate, exportState, & + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(logmsg,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(logmsg,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(logmsg,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call dice_comp_advertise(importstate, exportState, flds_scalar_name, & ice_present, ice_prognostic, & fldsFrIce_num, fldsFrIce, fldsToIce_num, fldsToIce, rc) @@ -205,7 +239,6 @@ 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) @@ -214,6 +247,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 @@ -225,11 +260,9 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_TimeInterval) :: timeStep type(ESMF_Calendar) :: esmf_calendar ! esmf calendar type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type - integer :: nx_global, ny_global ! global sizes integer :: n ! index character(len=256) :: cvalue ! tempoaray character string integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level logical :: scmMode = .false. ! single column mode real(R8) :: scmLat = shr_const_SPVAL ! single column lat real(R8) :: scmLon = shr_const_SPVAL ! single column lon @@ -253,8 +286,6 @@ 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) !-------------------------------- @@ -262,30 +293,30 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) scmlon call NUOPC_CompAttributeGet(gcomp, name='scmlat', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) scmlat call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) scmMode call NUOPC_CompAttributeGet(gcomp, name='read_restart', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) read_restart call NUOPC_CompAttributeGet(gcomp, name='flds_i2o_per_cat', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flds_i2o_per_cat ! module variable call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) compid !---------------------------------------------------------------------------- @@ -293,7 +324,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call ESMF_ClockGet( clock, calkindflag=esmf_caltype, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (esmf_caltype == ESMF_CALKIND_NOLEAP) then calendar = shr_cal_noleap @@ -311,10 +342,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- call NUOPC_CompAttributeGet(gcomp, name='mesh_ice', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return Emesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Initialize model @@ -338,7 +369,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 dshr_realize( & state=importState, & @@ -348,22 +379,22 @@ 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 !---------------------------------------------------------------------------- ! Set initial ice state and pack export state !---------------------------------------------------------------------------- call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet( currTime, yy=current_year, mm=current_mon, dd=current_day, s=current_tod, & calkindflag=esmf_caltype, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(current_year, current_mon, current_day, current_ymd) call ESMF_TimeIntervalGet( timeStep, s=modeldt, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2julian(0, current_mon, current_day, current_tod, jDay , calendar) ! julian day for model call shr_cal_ymd2julian(0, 9, 1, 0, jDay0, calendar) ! julian day for Sept 1 @@ -376,35 +407,34 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Pack export state call dice_comp_export(exportState, rc=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(nxg),flds_scalar_index_nx, exportState, & + call 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, & + call 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 (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 + call State_diagnose(exportState,subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif !---------------------------------------------------------------------------- ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (use_esmf_metadata) then call ModelSetMetaData(gcomp, name='DICE', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) @@ -414,7 +444,8 @@ 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 @@ -425,7 +456,6 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_TimeInterval) :: timeStep type(ESMF_State) :: importState, exportState integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level logical :: write_restart ! restart alarm is ringing logical :: read_restart ! read restart flag integer :: next_ymd ! model date @@ -441,14 +471,13 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - call shr_nuopc_memcheck(subname, 5, my_task==master_task) + call memcheck(subname, 5, my_task==master_task) + !-------------------------------- ! 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) !-------------------------------- @@ -456,18 +485,14 @@ 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_import > 0 .and. my_task == master_task) then - call shr_nuopc_methods_Clock_TimePrint(clock,subname//'clock',rc=rc) - end if + if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Unpack import state !-------------------------------- call dice_comp_import(importState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Run model @@ -476,13 +501,13 @@ subroutine ModelAdvance(gcomp, rc) ! Determine if will write restart call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return write_restart = .true. call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else write_restart = .false. endif @@ -492,11 +517,11 @@ subroutine ModelAdvance(gcomp, rc) ! shr_strdata time interpolation call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return nextTime = currTime + timeStep call ESMF_TimeGet( nextTime, yy=yr, mm=mon, dd=day, s=next_tod, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yr, mon, day, next_ymd) call shr_cal_ymd2julian(0, mon, day, next_tod, jDay , calendar) ! julian day for model @@ -515,28 +540,27 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call dice_comp_export(exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (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 + call State_diagnose(exportState,subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (my_task == master_task) then + call log_clock_advance(clock, 'DICE', logunit, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if endif - if (my_task == master_task) then - call shr_nuopc_log_clock_advance(clock, 'ICE', logunit) - end if - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) !---------------------------------------------------------------------------- ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine ModelAdvance diff --git a/cime/src/components/data_comps/dlnd/nuopc/dlnd_comp_mod.F90 b/cime/src/components/data_comps/dlnd/nuopc/dlnd_comp_mod.F90 index 55520daf7c4f..a996d01f3ace 100644 --- a/cime/src/components/data_comps/dlnd/nuopc/dlnd_comp_mod.F90 +++ b/cime/src/components/data_comps/dlnd/nuopc/dlnd_comp_mod.F90 @@ -1,10 +1,5 @@ -#ifdef AIX -@PROCESS ALIAS_SIZE(805306368) -#endif - module dlnd_comp_mod - ! !USES: 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 @@ -12,10 +7,7 @@ module dlnd_comp_mod use mct_mod , only : mct_gsmap_init use mct_mod , only : mct_avect, mct_avect_indexRA, mct_avect_zero, mct_aVect_nRattr use mct_mod , only : mct_avect_init, mct_avect_lsize - use shr_sys_mod , only : shr_sys_abort - use shr_kind_mod , only : IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL - use shr_kind_mod , only : CXX=>SHR_KIND_CXX - use shr_string_mod , only : shr_string_listGetName + use shr_kind_mod , only : r8=>shr_kind_r8, cxx=>shr_kind_cxx, cl=>shr_kind_cl, cs=>shr_kind_cs 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_bcast @@ -28,8 +20,7 @@ module dlnd_comp_mod use shr_dmodel_mod , only : shr_dmodel_translateAV use shr_cal_mod , only : shr_cal_calendarname 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_methods_mod , only : ChkErr 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 @@ -58,10 +49,10 @@ module dlnd_comp_mod 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 = '' character(len=CXX) :: flds_x2l = '' + 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 integer :: kf ! index for frac in AV integer :: glc_nec real(R8), pointer :: lfrac(:) ! land frac @@ -74,7 +65,7 @@ module dlnd_comp_mod contains !=============================================================================== - subroutine dlnd_comp_advertise(importState, exportState, & + subroutine dlnd_comp_advertise(importState, exportState, flds_scalar_name, & lnd_present, lnd_prognostic, glc_nec_in, & fldsFrLnd_num, fldsFrLnd, fldsToLnd_num, fldsToLnd, rc) @@ -84,6 +75,7 @@ subroutine dlnd_comp_advertise(importState, exportState, & ! input/output arguments type(ESMF_State) :: importState type(ESMF_State) :: exportState + character(len=*) , intent(in) :: flds_scalar_name integer , intent(in) :: glc_nec_in logical , intent(in) :: lnd_present logical , intent(in) :: lnd_prognostic @@ -138,7 +130,7 @@ subroutine dlnd_comp_advertise(importState, exportState, & 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) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end do ! The following puts all of the elevation class fields as an @@ -164,7 +156,7 @@ subroutine dlnd_comp_advertise(importState, exportState, & 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return enddo end subroutine dlnd_comp_advertise @@ -177,7 +169,7 @@ subroutine dlnd_comp_init(mpicom, compid, my_task, master_task, & ! !DESCRIPTION: initialize dlnd model - ! !INPUT/OUTPUT PARAMETERS: + ! input/output variables integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: compid ! mct comp id integer , intent(in) :: my_task ! my task in mpi communicator mpicom @@ -194,7 +186,7 @@ subroutine dlnd_comp_init(mpicom, compid, my_task, master_task, & type(ESMF_Mesh) , intent(in) :: mesh ! ESMF docn mesh integer , intent(out) :: nxg, nyg ! global size of model grid - !--- local variables --- + ! local variables integer :: n,k ! generic counters integer :: lsize ! local size logical :: exists ! file existance @@ -238,24 +230,24 @@ subroutine dlnd_comp_init(mpicom, compid, my_task, master_task, & ! obtain the distgrid from the mesh that was read in call ESMF_MeshGet(Mesh, elementdistGrid=distGrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determin local size on my processor call ESMF_distGridGet(distGrid, localDe=0, elementCount=lsize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determine global index space for my processor allocate(gindex(lsize)) call ESMF_distGridGet(distGrid, localDe=0, seqIndexList=gindex, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determine global size of distgrid call ESMF_distGridGet(distGrid, dimCount=dimCount, deCount=deCount, tileCount=tileCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(elementCountPTile(tileCount)) call ESMF_distGridGet(distGrid, elementCountPTile=elementCountPTile, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return gsize = 0 do n = 1,size(elementCountPTile) gsize = gsize + elementCountPTile(n) @@ -291,11 +283,11 @@ subroutine dlnd_comp_init(mpicom, compid, my_task, master_task, & ! obtain mesh lats and lons call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(ownedElemCoords(spatialDim*numOwnedElements)) allocate(xc(numOwnedElements), yc(numOwnedElements)) call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (numOwnedElements /= lsize) then call shr_sys_abort('ERROR: numOwnedElements is not equal to lsize') end if @@ -540,22 +532,22 @@ subroutine dlnd_comp_export(exportState, rc) 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 + if (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 + if (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 + if (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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end do end subroutine dlnd_comp_export diff --git a/cime/src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 b/cime/src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 index ba6dedacf0bf..3c12f6a33074 100644 --- a/cime/src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 +++ b/cime/src/components/data_comps/dlnd/nuopc/lnd_comp_nuopc.F90 @@ -5,33 +5,25 @@ module lnd_comp_nuopc !---------------------------------------------------------------------------- use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - use NUOPC_Model , only : model_routine_SS => SetServices - use NUOPC_Model , only : model_label_Advance => label_Advance - 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 - 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 med_constants_mod , only : shr_cal_ymd2date, shr_cal_noleap, shr_cal_gregorian - 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 - 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_SetScalar - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - 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, 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 dlnd_comp_mod , only : dlnd_comp_export + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise + use NUOPC_Model , only : model_routine_SS => SetServices + use NUOPC_Model , only : model_label_Advance => label_Advance + 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 shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date + use shr_const_mod , only : SHR_CONST_SPVAL + use shr_sys_mod , only : shr_sys_abort + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize + use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData + use dshr_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck + use dshr_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance + use dlnd_shr_mod , only : dlnd_shr_read_namelists + use dlnd_comp_mod , only : dlnd_comp_init, dlnd_comp_run, dlnd_comp_advertise + use dlnd_comp_mod , only : dlnd_comp_export implicit none private ! except @@ -47,25 +39,30 @@ module lnd_comp_nuopc ! Private module data !-------------------------------------------------------------------------- - integer :: fldsToLnd_num = 0 - integer :: fldsFrLnd_num = 0 - type (fld_list_type) :: fldsToLnd(fldsMax) - type (fld_list_type) :: fldsFrLnd(fldsMax) - - integer :: compid ! mct comp id - integer :: mpicom ! mpi communicator - 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. "lnd_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 - character(CL) :: case_name ! case name - logical :: lnd_prognostic ! data is sent back to dlnd - character(len=80) :: calendar ! calendar name - logical :: use_esmf_metadata = .false. - character(*),parameter :: modName = "(lnd_comp_nuopc)" - character(*),parameter :: u_FILE_u = & + character(len=CS) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + + integer :: fldsToLnd_num = 0 + integer :: fldsFrLnd_num = 0 + type (fld_list_type) :: fldsToLnd(fldsMax) + type (fld_list_type) :: fldsFrLnd(fldsMax) + + integer :: compid ! mct comp id + integer :: mpicom ! mpi communicator + 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. "lnd_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 + character(CL) :: case_name ! case name + logical :: lnd_prognostic ! data is sent back to dlnd + character(len=80) :: calendar ! calendar name + logical :: use_esmf_metadata = .false. + character(*),parameter :: modName = "(lnd_comp_nuopc)" + character(*),parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -84,33 +81,33 @@ subroutine SetServices(gcomp, rc) ! 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) @@ -120,9 +117,7 @@ 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 @@ -137,13 +132,13 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: n integer :: ierr ! error code integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - logical :: isPresent character(len=CL) :: diro character(len=CL) :: logfile integer :: glc_nec ! number of elevation classes integer :: localPet character(len=CL) :: fileName ! generic file name + character(len=CL) :: logmsg + logical :: isPresent, isSet character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -155,10 +150,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, mpiCommunicator=lmpicom, localPet=localPet, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call mpi_comm_dup(lmpicom, mpicom, ierr) call mpi_comm_rank(mpicom, my_task, ierr) @@ -167,14 +162,17 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! determine instance information !---------------------------------------------------------------------------- - call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) + call get_component_instance(gcomp, inst_suffix, inst_index, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + inst_name = "LND"//trim(inst_suffix) !---------------------------------------------------------------------------- ! 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 set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Read input namelists and set present and prognostic flags @@ -188,12 +186,47 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! advertise import and export fields !-------------------------------- + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(logmsg,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(logmsg,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(logmsg,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + call NUOPC_CompAttributeGet(gcomp, name='glc_nec', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) glc_nec call ESMF_LogWrite('glc_nec = '// trim(cvalue), ESMF_LOGMSG_INFO) - call dlnd_comp_advertise(importState, exportState, & + call dlnd_comp_advertise(importState, exportState, flds_scalar_name, & lnd_present, lnd_prognostic, glc_nec, & fldsFrLnd_num, fldsFrLnd, fldsToLnd_num, fldsToLnd, rc) @@ -203,7 +236,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 @@ -229,7 +261,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: current_tod ! model sec into model date character(CL) :: cvalue integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level logical :: scmMode = .false. ! single column mode real(R8) :: scmLat = shr_const_SPVAL ! single column lat real(R8) :: scmLon = shr_const_SPVAL ! single column lon @@ -246,8 +277,6 @@ 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) !-------------------------------- @@ -255,14 +284,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='read_restart', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) read_restart call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) compid !---------------------------------------------------------------------------- @@ -270,11 +299,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet( currTime, yy=current_year, mm=current_mon, dd=current_day, s=current_tod, & calkindflag=esmf_caltype, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(current_year, current_mon, current_day, current_ymd) if (esmf_caltype == ESMF_CALKIND_NOLEAP) then @@ -292,14 +321,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=cvalue, 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 write(logunit,*) " obtaining dlnd mesh from " // trim(cvalue) end if Emesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Initialize model @@ -323,7 +352,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 ! No import send for now - only export snow fields @@ -334,29 +363,28 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- call dlnd_comp_export(exportState, rc=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(nxg),flds_scalar_index_nx, exportState, & + call 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, & + call 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 !-------------------------------- - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call State_diagnose(exportState,subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (use_esmf_metadata) then call ModelSetMetaData(gcomp, name='DLND', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) @@ -367,8 +395,6 @@ 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 @@ -380,7 +406,6 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_Time) :: currTime, nextTime type(ESMF_State) :: importState, exportState integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level logical :: write_restart ! write restart integer :: nextYMD ! model date integer :: nextTOD ! model sec into model date @@ -393,11 +418,9 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - call shr_nuopc_memcheck(subname, 5, my_task==master_task) + call memcheck(subname, 5, my_task==master_task) call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -405,11 +428,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 (my_task == master_task) then - call shr_nuopc_methods_Clock_TimePrint(clock,subname//'clock',rc=rc) - endif + if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Unpack import state @@ -418,7 +437,7 @@ subroutine ModelAdvance(gcomp, rc) if (lnd_prognostic) then ! 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 + !if (ChkErr(rc,__LINE__,u_FILE_u)) return end if !-------------------------------- @@ -426,13 +445,13 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return write_restart = .true. call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else write_restart = .false. endif @@ -442,11 +461,11 @@ subroutine ModelAdvance(gcomp, rc) ! shr_strdata time interpolation call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return nextTime = currTime + timeStep call ESMF_TimeGet( nextTime, yy=yr, mm=mon, dd=day, s=nexttod, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yr, mon, day, nextymd) call dlnd_comp_run(mpicom, my_task, master_task, & @@ -458,20 +477,20 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call dlnd_comp_export(exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call State_diagnose(exportState,subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (my_task == master_task) then - call shr_nuopc_log_clock_advance(clock, 'LND', logunit) + call log_clock_advance(clock, 'DATM', logunit, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine ModelAdvance diff --git a/cime/src/components/data_comps/docn/nuopc/docn_comp_mod.F90 b/cime/src/components/data_comps/docn/nuopc/docn_comp_mod.F90 index 360f09ead97c..1b0104be91ee 100644 --- a/cime/src/components/data_comps/docn/nuopc/docn_comp_mod.F90 +++ b/cime/src/components/data_comps/docn/nuopc/docn_comp_mod.F90 @@ -1,20 +1,14 @@ -#ifdef AIX -@PROCESS ALIAS_SIZE(805306368) -#endif - module docn_comp_mod - ! !USES: 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 use ESMF , only : ESMF_State, ESMF_LOGMSG_INFO, ESMF_LogWrite - use perf_mod , only : t_startf, t_stopf - use perf_mod , only : t_adj_detailf, t_barrierf + use perf_mod , only : t_startf, t_stopf, t_adj_detailf, t_barrierf use mct_mod , only : mct_gsmap, mct_gsmap_init, mct_gsmap_lsize use mct_mod , only : mct_avect, mct_avect_indexRA, mct_avect_zero, mct_aVect_nRattr use mct_mod , only : mct_avect_init, mct_avect_lsize, mct_avect_clean - use med_constants_mod , only : R8, CS, CXX, CL + use shr_kind_mod , only : r8=>shr_kind_r8, cxx=>shr_kind_cxx, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_const_mod , only : shr_const_cpsw, shr_const_rhosw, shr_const_TkFrz use shr_const_mod , only : shr_const_TkFrzSw, shr_const_latice, shr_const_ocn_ref_sal use shr_const_mod , only : shr_const_zsrflyr, shr_const_pi @@ -25,8 +19,6 @@ module docn_comp_mod use shr_frz_mod , only : shr_frz_freezetemp use shr_cal_mod , only : shr_cal_calendarname 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 shr_strdata_mod , only : shr_strdata_init_model_domain use shr_strdata_mod , only : shr_strdata_init_streams use shr_strdata_mod , only : shr_strdata_init_mapping @@ -35,6 +27,7 @@ module docn_comp_mod use shr_strdata_mod , only : shr_strdata_advance, shr_strdata_restWrite use shr_dmodel_mod , only : shr_dmodel_translateAV use shr_pcdf_mod , only : shr_pcdf_readwrite + use dshr_methods_mod , only : ChkErr 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 @@ -107,12 +100,13 @@ module docn_comp_mod contains !=============================================================================== - subroutine docn_comp_advertise(importState, exportState, & + subroutine docn_comp_advertise(importState, exportState, flds_scalar_name, & ocn_prognostic, fldsFrOcn_num, fldsFrOcn, fldsToOcn_num, fldsToOcn, rc) ! input/output arguments type(ESMF_State) , intent(inout) :: importState type(ESMF_State) , intent(inout) :: exportState + character(len=*) , intent(in) :: flds_scalar_name logical , intent(in) :: ocn_prognostic integer , intent(out) :: fldsToOcn_num integer , intent(out) :: fldsFrOcn_num @@ -193,7 +187,7 @@ subroutine docn_comp_advertise(importState, exportState, & do n = 1,fldsFrOcn_num call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite('(ocn_comp_nuopc):(InitializeAdvertise):Fr_ocn'//trim(fldsFrOcn(n)%stdname), & ESMF_LOGMSG_INFO) enddo @@ -201,7 +195,7 @@ subroutine docn_comp_advertise(importState, exportState, & if (ocn_prognostic) then do n = 1,fldsToOcn_num call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite('(ocn_comp_nuopc):(InitializeAdvertise):To_ocn'//trim(fldsToOcn(n)%stdname), & ESMF_LOGMSG_INFO) end do @@ -304,24 +298,24 @@ subroutine docn_comp_init(mpicom, compid, my_task, master_task, & ! obtain the distgrid from the mesh that was read in call ESMF_MeshGet(Mesh, elementdistGrid=distGrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determin local size on my processor call ESMF_distGridGet(distGrid, localDe=0, elementCount=lsize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determine global index space for my processor allocate(gindex(lsize)) call ESMF_distGridGet(distGrid, localDe=0, seqIndexList=gindex, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determine global size of distgrid call ESMF_distGridGet(distGrid, dimCount=dimCount, deCount=deCount, tileCount=tileCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(elementCountPTile(tileCount)) call ESMF_distGridGet(distGrid, elementCountPTile=elementCountPTile, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return gsize = 0 do n = 1,size(elementCountPTile) gsize = gsize + elementCountPTile(n) @@ -358,11 +352,11 @@ subroutine docn_comp_init(mpicom, compid, my_task, master_task, & ! obtain mesh lats and lons call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(ownedElemCoords(spatialDim*numOwnedElements)) allocate(xc(numOwnedElements), yc(numOwnedElements)) call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (numOwnedElements /= lsize) then call shr_sys_abort('ERROR: numOwnedElements is not equal to lsize') end if @@ -862,25 +856,25 @@ subroutine docn_comp_import(importState, 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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine docn_comp_import @@ -896,28 +890,28 @@ subroutine docn_comp_export(exportState, 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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine docn_comp_export diff --git a/cime/src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 b/cime/src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 index 88bb5da6866a..a60e2ce5eb09 100644 --- a/cime/src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 +++ b/cime/src/components/data_comps/docn/nuopc/ocn_comp_nuopc.F90 @@ -5,32 +5,29 @@ module ocn_comp_nuopc !---------------------------------------------------------------------------- use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - use NUOPC_Model , only : model_routine_SS => SetServices - use NUOPC_Model , only : model_label_Advance => label_Advance - 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, 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 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 - 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_SetScalar - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - use shr_strdata_mod , only : shr_strdata_type - 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 docn_comp_mod , only : docn_comp_import, docn_comp_export + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise + use NUOPC_Model , only : model_routine_SS => SetServices + use NUOPC_Model , only : model_label_Advance => label_Advance + 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 shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date + use shr_const_mod , only : SHR_CONST_SPVAL + use shr_sys_mod , only : shr_sys_abort + use shr_const_mod , only : shr_const_spval, shr_const_pi + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize + use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData + use dshr_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck + use dshr_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance + use docn_shr_mod , only : docn_shr_read_namelists + use docn_comp_mod , only : docn_comp_init, docn_comp_run, docn_comp_advertise + use docn_comp_mod , only : docn_comp_import, docn_comp_export implicit none + private ! except public :: SetServices @@ -39,35 +36,38 @@ module ocn_comp_nuopc private :: ModelAdvance private :: ModelFinalize - private ! except - !-------------------------------------------------------------------------- ! Private module data !-------------------------------------------------------------------------- - integer :: fldsToOcn_num = 0 - integer :: fldsFrOcn_num = 0 - type (fld_list_type) :: fldsToOcn(fldsMax) - type (fld_list_type) :: fldsFrOcn(fldsMax) - - integer :: compid ! mct comp id - integer :: mpicom ! mpi communicator - 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. "lnd_0001") - character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") - integer, parameter :: master_task=0 ! task number of master task - logical :: read_restart ! start from restart - character(CL) :: case_name ! case name - character(len=80) :: calendar ! calendar name - logical :: ocn_present ! flag - logical :: ocn_prognostic ! flag - integer :: logunit ! logging unit number - logical :: use_esmf_metadata = .false. - character(*),parameter :: modName = "(ocn_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 = & + character(len=CS) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + + integer :: fldsToOcn_num = 0 + integer :: fldsFrOcn_num = 0 + type (fld_list_type) :: fldsToOcn(fldsMax) + type (fld_list_type) :: fldsFrOcn(fldsMax) + + integer :: compid ! mct comp id + integer :: mpicom ! mpi communicator + 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. "lnd_0001") + character(len=16) :: inst_suffix = "" ! char string associated with instance (ie. "_0001" or "") + integer, parameter :: master_task=0 ! task number of master task + logical :: read_restart ! start from restart + character(CL) :: case_name ! case name + character(len=80) :: calendar ! calendar name + logical :: ocn_present ! flag + logical :: ocn_prognostic ! flag + integer :: logunit ! logging unit number + logical :: use_esmf_metadata = .false. + character(*),parameter :: modName = "(ocn_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__ !=============================================================================== @@ -88,36 +88,36 @@ subroutine SetServices(gcomp, rc) ! 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) @@ -127,9 +127,6 @@ 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 @@ -140,6 +137,9 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) type(ESMF_VM) :: vm integer :: shrlogunit ! original log unit character(len=CL) :: fileName ! generic file name + character(len=CL) :: cvalue + character(len=CL) :: logmsg + logical :: isPresent, isSet character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -151,23 +151,26 @@ 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, mpiCommunicator=mpicom, localPet=my_task, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! determine instance information !---------------------------------------------------------------------------- - call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) + call get_component_instance(gcomp, inst_suffix, inst_index, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + inst_name = "OCN"//trim(inst_suffix) !---------------------------------------------------------------------------- ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit) + call set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Read input namelists and set present and prognostic flags @@ -176,15 +179,48 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) filename = "docn_in"//trim(inst_suffix) call docn_shr_read_namelists(filename, mpicom, my_task, master_task, logunit, ocn_prognostic) - write(6,*)'DEBUG: ocn_prognostic = ',ocn_prognostic - !-------------------------------- ! Advertise import and export fields !-------------------------------- - call docn_comp_advertise(importstate, exportState, & + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(logmsg,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(logmsg,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(logmsg,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call docn_comp_advertise(importstate, exportState, flds_scalar_name, & ocn_prognostic, fldsFrOcn_num, fldsFrOcn, fldsToOcn_num, fldsToOcn, 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 @@ -244,26 +280,26 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='scmlon', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) scmlon call NUOPC_CompAttributeGet(gcomp, name='scmlat', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) scmlat call NUOPC_CompAttributeGet(gcomp, name='single_column', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) scmMode call NUOPC_CompAttributeGet(gcomp, name='read_restart', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) read_restart call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) compid !---------------------------------------------------------------------------- @@ -271,11 +307,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet( currTime, yy=current_year, mm=current_mon, dd=current_day, s=current_tod, & calkindflag=esmf_caltype, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(current_year, current_mon, current_day, current_ymd) if (esmf_caltype == ESMF_CALKIND_NOLEAP) then @@ -289,21 +325,21 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) end if call ESMF_TimeIntervalGet( timeStep, s=modeldt, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Generate the mesh !-------------------------------- call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', value=cvalue, 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 write(logunit,*) " obtaining docn mesh from " // trim(cvalue) end if Emesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Initialize model @@ -328,7 +364,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 ! import fields call dshr_realize( & @@ -339,7 +375,7 @@ 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 @@ -347,23 +383,23 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- call docn_comp_export(exportState, rc=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(nxg),flds_scalar_index_nx, exportState, & + call 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, & + call 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 (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 + call State_diagnose(exportState,subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif !---------------------------------------------------------------------------- @@ -374,7 +410,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (use_esmf_metadata) then call ModelSetMetaData(gcomp, name='DOCN', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) @@ -385,8 +421,6 @@ 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 @@ -415,7 +449,7 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - call shr_nuopc_memcheck(subname, 5, my_task==master_task) + call memcheck(subname, 5, my_task==master_task) !-------------------------------- ! Reset shr logging to my log file @@ -429,11 +463,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_import > 0) then - call shr_nuopc_methods_Clock_TimePrint(clock,subname//'clock',rc=rc) - endif + if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Unpack import state @@ -441,7 +471,7 @@ subroutine ModelAdvance(gcomp, rc) if (ocn_prognostic) then call docn_comp_import(importState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if !-------------------------------- @@ -451,13 +481,13 @@ subroutine ModelAdvance(gcomp, rc) ! Determine if need to write restarts call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return write_restart = .true. call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else write_restart = .false. endif @@ -467,15 +497,15 @@ subroutine ModelAdvance(gcomp, rc) ! shr_strdata time interpolation call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return nextTime = currTime + timeStep call ESMF_TimeGet( nextTime, yy=yr, mm=mon, dd=day, s=nexttod, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yr, mon, day, nextymd) call ESMF_TimeIntervalGet( timeStep, s=modeldt, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Advance the model @@ -488,19 +518,20 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call docn_comp_export(exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (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 + call State_diagnose(exportState,subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (my_task == master_task) then + call log_clock_advance(clock, 'DICE', logunit, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if endif - 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) call shr_file_setLogUnit (shrlogunit) diff --git a/cime/src/components/data_comps/drof/nuopc/drof_comp_mod.F90 b/cime/src/components/data_comps/drof/nuopc/drof_comp_mod.F90 index 87c93dc40375..4bd43b3d0106 100644 --- a/cime/src/components/data_comps/drof/nuopc/drof_comp_mod.F90 +++ b/cime/src/components/data_comps/drof/nuopc/drof_comp_mod.F90 @@ -1,23 +1,18 @@ -#ifdef AIX -@PROCESS ALIAS_SIZE(805306368) -#endif module drof_comp_mod - ! !USES: 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 - use perf_mod , only : t_startf, t_stopf - use perf_mod , only : t_adj_detailf, t_barrierf + use perf_mod , only : t_startf, t_stopf, t_adj_detailf, t_barrierf use mct_mod , only : mct_gsmap_init use mct_mod , only : mct_avect, mct_avect_indexRA, mct_avect_zero, mct_aVect_nRattr use mct_mod , only : mct_avect_init, mct_avect_lsize + use shr_kind_mod , only : r8=>shr_kind_r8, cxx=>shr_kind_cxx, cl=>shr_kind_cl, cs=>shr_kind_cs use shr_sys_mod , only : shr_sys_abort - use med_constants_mod , only : R8, CS, CL, CXX - use shr_string_mod , only : shr_string_listGetName 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_bcast + use shr_cal_mod , only : shr_cal_calendarname, shr_cal_datetod2string use shr_strdata_mod , only : shr_strdata_init_model_domain use shr_strdata_mod , only : shr_strdata_init_streams use shr_strdata_mod , only : shr_strdata_init_mapping @@ -25,15 +20,13 @@ module drof_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 shr_cal_mod , only : shr_cal_calendarname - 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_methods_mod , only : ChkErr 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 use drof_shr_mod , only : nullstr + use drof_shr_mod , only : SDROF ! !PUBLIC TYPES: implicit none @@ -52,10 +45,14 @@ module drof_comp_mod ! Private data !-------------------------------------------------------------------------- + type(mct_aVect) :: x2r + type(mct_aVect) :: r2x + character(CXX) :: flds_r2x = '' + character(CXX) :: flds_x2r = '' + 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_r2x_mod - character(len=CXX) :: flds_x2r_mod + character(len=*), parameter :: rpfile = 'rpointer.rof' character(*) , parameter :: u_FILE_u = & __FILE__ @@ -64,10 +61,10 @@ module drof_comp_mod contains !=============================================================================== - subroutine drof_comp_advertise(importState, exportState, & + subroutine drof_comp_advertise(importState, exportState, flds_scalar_name, & rof_present, rof_prognostic, & - fldsFrRof_num, fldsFrRof, fldsToRof_num, fldsToRof, & - flds_r2x, flds_x2r, rc) + fldsFrRof_num, fldsFrRof, fldsToRof_num, fldsToRof, rc) + ! 1. determine export and import fields to advertise to mediator ! 2. determine translation of fields from streams to export/import fields @@ -75,14 +72,13 @@ subroutine drof_comp_advertise(importState, exportState, & ! input/output arguments type(ESMF_State) :: importState type(ESMF_State) :: exportState + character(len=*) , intent(in) :: flds_scalar_name logical , intent(in) :: rof_present logical , intent(in) :: rof_prognostic integer , intent(out) :: fldsFrRof_num type (fld_list_type) , intent(out) :: fldsFrRof(:) integer , intent(out) :: fldsToRof_num type (fld_list_type) , intent(out) :: fldsToRof(:) - character(len=*) , intent(out) :: flds_r2x - character(len=*) , intent(out) :: flds_x2r integer , intent(out) :: rc ! local variables @@ -116,30 +112,20 @@ subroutine drof_comp_advertise(importState, exportState, & do n = 1,fldsFrRof_num call NUOPC_Advertise(exportState, standardName=fldsFrRof(n)%stdname, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return enddo - !------------------- - ! Save flds_r2x and flds_x2r as module variables for use in debugging - !------------------- - - flds_x2r_mod = trim(flds_x2r) - flds_r2x_mod = trim(flds_r2x) - end subroutine drof_comp_advertise !=============================================================================== - subroutine drof_comp_init(x2r, r2x, & - SDROF, mpicom, compid, my_task, master_task, & + subroutine drof_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 drof model ! input/output arguments - type(mct_aVect) , intent(inout) :: x2r, r2x ! input/output attribute vectors - type(shr_strdata_type) , intent(inout) :: SDROF ! 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 @@ -151,6 +137,7 @@ subroutine drof_comp_init(x2r, r2x, & integer , intent(in) :: target_tod ! model sec into model date character(len=*) , intent(in) :: calendar ! model calendar type(ESMF_Mesh) , intent(in) :: mesh ! ESMF docn mesh + integer , intent(out) :: nxg, nyg ! local variables integer :: n,k ! generic counters @@ -196,24 +183,24 @@ subroutine drof_comp_init(x2r, r2x, & ! obtain the distgrid from the mesh that was read in call ESMF_MeshGet(Mesh, elementdistGrid=distGrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determin local size on my processor call ESMF_distGridGet(distGrid, localDe=0, elementCount=lsize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determine global index space for my processor allocate(gindex(lsize)) call ESMF_distGridGet(distGrid, localDe=0, seqIndexList=gindex, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determine global size of distgrid call ESMF_distGridGet(distGrid, dimCount=dimCount, deCount=deCount, tileCount=tileCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(elementCountPTile(tileCount)) call ESMF_distGridGet(distGrid, elementCountPTile=elementCountPTile, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return gsize = 0 do n = 1,size(elementCountPTile) gsize = gsize + elementCountPTile(n) @@ -241,11 +228,11 @@ subroutine drof_comp_init(x2r, r2x, & ! obtain mesh lats and lons call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(ownedElemCoords(spatialDim*numOwnedElements)) allocate(xc(numOwnedElements), yc(numOwnedElements)) call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (numOwnedElements /= lsize) then call shr_sys_abort('ERROR: numOwnedElements is not equal to lsize') end if @@ -288,9 +275,9 @@ subroutine drof_comp_init(x2r, r2x, & call t_startf('drof_initmctavs') if (my_task == master_task) write(logunit,F00) 'allocate AVs' - call mct_aVect_init(x2r, rList=flds_x2r_mod, lsize=lsize) + call mct_aVect_init(x2r, rList=flds_x2r, lsize=lsize) call mct_aVect_zero(x2r) - call mct_aVect_init(r2x, rList=flds_r2x_mod, lsize=lsize) + call mct_aVect_init(r2x, rList=flds_r2x, lsize=lsize) call mct_aVect_zero(r2x) call t_stopf('drof_initmctavs') @@ -307,6 +294,9 @@ subroutine drof_comp_init(x2r, r2x, & end select call t_stopf('drof_datamode') + nxg = SDROF%nxg + nyg = SDROF%nyg + !---------------------------------------------------------------------------- ! Read restart !---------------------------------------------------------------------------- @@ -366,8 +356,7 @@ subroutine drof_comp_init(x2r, r2x, & call t_adj_detailf(+2) write_restart=.false. - call drof_comp_run(x2r, r2x, & - SDROF, mpicom, compid, my_task, master_task, & + call drof_comp_run(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & target_ymd, target_tod) @@ -381,17 +370,15 @@ end subroutine drof_comp_init !=============================================================================== - subroutine drof_comp_run(x2r, r2x, & - SDROF, mpicom, compid, my_task, master_task, & + subroutine drof_comp_run(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & target_ymd, target_tod, case_name) - ! !DESCRIPTION: run method for drof model + ! ------------------------------- + ! run method for drof model + ! ------------------------------- - ! input/output arguments - type(mct_aVect) , intent(inout) :: x2r - type(mct_aVect) , intent(inout) :: r2x - type(shr_strdata_type) , intent(inout) :: SDROF + ! input/output variables integer , intent(in) :: mpicom ! mpi communicator integer , intent(in) :: compid ! mct comp id integer , intent(in) :: my_task ! my task in mpi communicator mpicom @@ -404,7 +391,7 @@ subroutine drof_comp_run(x2r, r2x, & integer , intent(in) :: target_tod ! model sec into model date character(len=*) , intent(in), optional :: case_name ! case name - ! local + ! local variables integer :: n ! indices integer :: nf ! fields loop index integer :: nu ! unit number @@ -497,12 +484,11 @@ end subroutine drof_comp_run !=============================================================================== - subroutine drof_comp_export(r2x, exportState, rc) + subroutine drof_comp_export(exportState, rc) ! input/output variables - type(mct_aVect) :: r2x - type(ESMF_State) :: exportState - integer, intent(out) :: rc + type(ESMF_State) , intent(inout) :: exportState + integer , intent(out) :: rc ! local variables integer :: k @@ -512,11 +498,11 @@ subroutine drof_comp_export(r2x, exportState, rc) 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 + if (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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine drof_comp_export diff --git a/cime/src/components/data_comps/drof/nuopc/drof_shr_mod.F90 b/cime/src/components/data_comps/drof/nuopc/drof_shr_mod.F90 index ba395bd436ed..92a56d61b348 100644 --- a/cime/src/components/data_comps/drof/nuopc/drof_shr_mod.F90 +++ b/cime/src/components/data_comps/drof/nuopc/drof_shr_mod.F90 @@ -23,6 +23,9 @@ module drof_shr_mod ! Public data !-------------------------------------------------------------------------- + ! stream data type + type(shr_strdata_type), public :: SDROF + ! input namelist variables character(CL) , public :: restfilm ! model restart file namelist character(CL) , public :: restfils ! stream restart file namelist @@ -39,7 +42,7 @@ module drof_shr_mod !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ subroutine drof_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDROF, rof_present, rof_prognostic, rofice_present, flood_present) + logunit, rof_present, rof_prognostic) ! !DESCRIPTION: Read in drof namelists implicit none @@ -50,11 +53,8 @@ subroutine drof_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) :: SDROF logical , intent(out) :: rof_present ! flag logical , intent(out) :: rof_prognostic ! flag - logical, optional , intent(out) :: rofice_present ! flag - logical, optional , intent(out) :: flood_present ! flag !--- local variables --- integer(IN) :: nunit ! unit number @@ -136,17 +136,6 @@ subroutine drof_shr_read_namelists(filename, mpicom, my_task, master_task, & rof_prognostic = .true. end if - if (present(rofice_present)) then - rofice_present = .false. - if (trim(datamode) /= 'NULL') then - rofice_present = .true. - end if - end if - - if (present(flood_present)) then - flood_present = .false. - end if - end subroutine drof_shr_read_namelists end module drof_shr_mod diff --git a/cime/src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 b/cime/src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 index 7cde9dec63d6..db27db4a0a85 100644 --- a/cime/src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 +++ b/cime/src/components/data_comps/drof/nuopc/rof_comp_nuopc.F90 @@ -5,34 +5,23 @@ module rof_comp_nuopc !---------------------------------------------------------------------------- use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - use NUOPC_Model , only : model_routine_SS => SetServices - use NUOPC_Model , only : model_label_Advance => label_Advance - 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 - 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 med_constants_mod , only : shr_cal_ymd2date, shr_cal_noleap, shr_cal_gregorian - 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 - 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_SetScalar - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - 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, 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 drof_comp_mod , only : drof_comp_export - use mct_mod , only : mct_Avect + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise + use NUOPC_Model , only : model_routine_SS => SetServices + use NUOPC_Model , only : model_label_Advance => label_Advance + 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 shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize + use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData + use dshr_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck + use dshr_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance + use drof_shr_mod , only : drof_shr_read_namelists + use drof_comp_mod , only : drof_comp_init, drof_comp_run, drof_comp_advertise + use drof_comp_mod , only : drof_comp_export implicit none private ! except @@ -48,32 +37,32 @@ module rof_comp_nuopc ! Private module data !-------------------------------------------------------------------------- - integer :: fldsToRof_num = 0 - integer :: fldsFrRof_num = 0 - type (fld_list_type) :: fldsToRof(fldsMax) - type (fld_list_type) :: fldsFrRof(fldsMax) - type(shr_strdata_type) :: SDROF - type(mct_aVect) :: x2r - type(mct_aVect) :: r2x - integer :: compid ! mct comp id - integer :: mpicom ! mpi communicator - 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. "lnd_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 :: rof_prognostic ! flag - character(CL) :: case_name ! case name - character(CL) :: tmpstr ! tmp string - character(len=80) :: calendar ! calendar name - character(CXX) :: flds_r2x = '' - character(CXX) :: flds_x2r = '' - logical :: use_esmf_metadata = .false. - character(*),parameter :: modName = "(rof_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 = & + character(len=CS) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + + integer :: fldsToRof_num = 0 + integer :: fldsFrRof_num = 0 + type (fld_list_type) :: fldsToRof(fldsMax) + type (fld_list_type) :: fldsFrRof(fldsMax) + + integer :: compid ! mct comp id + integer :: mpicom ! mpi communicator + integer :: my_task ! my task in mpi communicator mpicom + integer :: inst_index ! number of current instance (ie. 1) + 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 :: rof_prognostic ! flag + character(CL) :: case_name ! case name + character(CL) :: tmpstr ! tmp string + character(len=80) :: calendar ! calendar name + logical :: use_esmf_metadata = .false. + character(*),parameter :: modName = "(rof_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,43 +74,42 @@ subroutine SetServices(gcomp, rc) integer, intent(out) :: rc ! Local varaibles - 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) - 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=dbrc) + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine SetServices @@ -129,9 +117,6 @@ 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 @@ -146,28 +131,27 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: n integer :: ierr ! error code integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level - logical :: isPresent character(len=CL) :: diro character(len=CL) :: logfile - integer :: dbrc integer :: localPet character(len=CL) :: fileName ! generic file name + character(len=CL) :: logmsg + logical :: isPresent, isSet 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 !---------------------------------------------------------------------------- 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, mpiCommunicator=lmpicom, localPet=localPet, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call mpi_comm_dup(lmpicom, mpicom, ierr) call mpi_comm_rank(mpicom, my_task, ierr) @@ -176,14 +160,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! determine instance information !---------------------------------------------------------------------------- - call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - inst_name = "ROF"//trim(inst_suffix) + call get_component_instance(gcomp, inst_suffix, inst_index, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! 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 set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Read input namelists and set present and prognostic flags @@ -191,26 +176,59 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) filename = "drof_in"//trim(inst_suffix) call drof_shr_read_namelists(filename, mpicom, my_task, master_task, & - logunit, SDROF, rof_present, rof_prognostic) + logunit, rof_present, rof_prognostic) !-------------------------------- ! advertise export fields !-------------------------------- - call drof_comp_advertise(importState, exportState, & + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(logmsg,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(logmsg,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(logmsg,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call drof_comp_advertise(importState, exportState, flds_scalar_name, & rof_present, rof_prognostic, & - fldsFrRof_num, fldsFrRof, fldsToRof_num, fldsToRof, & - flds_r2x, flds_x2r, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + fldsFrRof_num, fldsFrRof, fldsToRof_num, fldsToRof, rc) + if (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 !---------------------------------------------------------------------------- call shr_file_setLogUnit (shrlogunit) - call shr_file_setLogLevel(shrloglev) end subroutine InitializeAdvertise @@ -230,7 +248,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) type(ESMF_CalKind_Flag) :: esmf_caltype ! esmf calendar type character(CL) :: cvalue integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level integer :: ierr ! error code integer :: current_ymd ! model date integer :: current_year ! model year @@ -238,21 +255,19 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: current_day ! model day integer :: current_tod ! model sec into model date logical :: read_restart ! start from restart - integer :: dbrc + integer :: nxg, nyg character(len=*), parameter :: F00 = "('rof_comp_nuopc: ')',8a)" 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) !-------------------------------- @@ -260,14 +275,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='read_restart', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) read_restart call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) compid !---------------------------------------------------------------------------- @@ -275,11 +290,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet( currTime, yy=current_year, mm=current_mon, dd=current_day, s=current_tod, & calkindflag=esmf_caltype, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(current_year, current_mon, current_day, current_ymd) if (esmf_caltype == ESMF_CALKIND_NOLEAP) then @@ -287,7 +302,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 @@ -297,23 +312,22 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- call NUOPC_CompAttributeGet(gcomp, name='mesh_rof', value=cvalue, 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 write(logunit,*) " obtaining drof mesh from " // trim(cvalue) end if Emesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Initialize model !---------------------------------------------------------------------------- - call drof_comp_init(x2r, r2x, & - SDROF, mpicom, compid, my_task, master_task, & + call drof_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 @@ -329,7 +343,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 ! No import state for now @@ -339,39 +353,38 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Set the coupling scalars !-------------------------------- - call drof_comp_export(r2x, exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call drof_comp_export(exportState, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(SDROF%nxg),flds_scalar_index_nx, exportState, & + call 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(SDROF%nyg),flds_scalar_index_ny, exportState, & + call 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 (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 + call State_diagnose(exportState,subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif !---------------------------------------------------------------------------- ! Reset shr logging to original values !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) if (use_esmf_metadata) then call ModelSetMetaData(gcomp, name='DROF', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (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 @@ -379,7 +392,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 type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -390,7 +403,6 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_TimeInterval) :: timeStep type(ESMF_State) :: importState, exportState integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level logical :: write_restart ! write restart logical :: read_restart ! read restart integer :: yr ! year @@ -398,21 +410,18 @@ 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 shr_nuopc_memcheck(subname, 5, my_task == master_task) + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + call memcheck(subname, 5, my_task == master_task) !-------------------------------- ! 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) !-------------------------------- @@ -420,11 +429,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_import > 0 .and. my_task == master_task) then - call shr_nuopc_methods_Clock_TimePrint(clock,subname//'clock',rc=rc) - endif + if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Unpack import state @@ -441,13 +446,13 @@ subroutine ModelAdvance(gcomp, rc) ! Determine if need to write restarts call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return write_restart = .true. call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else write_restart = .false. endif @@ -457,18 +462,17 @@ subroutine ModelAdvance(gcomp, rc) ! shr_strdata time interpolation call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return nextTime = currTime + timeStep call ESMF_TimeGet( nextTime, yy=yr, mm=mon, dd=day, s=next_tod, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yr, mon, day, next_ymd) ! Run the model read_restart = .false. - call drof_comp_run(x2r, r2x, & - SDROF, mpicom, compid, my_task, master_task, & + call drof_comp_run(mpicom, compid, my_task, master_task, & inst_suffix, logunit, read_restart, write_restart, & next_ymd, next_tod, case_name) @@ -476,27 +480,27 @@ subroutine ModelAdvance(gcomp, rc) ! Pack export state !-------------------------------- - call drof_comp_export(r2x, exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call drof_comp_export(exportState, rc=rc) + if (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 + call State_diagnose(exportState,subname//':ES',rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (my_task == master_task) then + call log_clock_advance(clock, 'DROF', logunit, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if endif - if (my_task == master_task) then - call shr_nuopc_log_clock_advance(clock, 'ROF', 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 !---------------------------------------------------------------------------- - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine ModelAdvance @@ -508,20 +512,19 @@ subroutine ModelFinalize(gcomp, rc) integer, intent(out) :: rc ! local variables - integer :: dbrc character(*), parameter :: F00 = "('(drof_comp_final) ',8a)" character(*), parameter :: F91 = "('(drof_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) 'drof : 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/cime/src/components/data_comps/dshr_nuopc/dshr_methods_mod.F90 b/cime/src/components/data_comps/dshr_nuopc/dshr_methods_mod.F90 new file mode 100644 index 000000000000..0cf4da07fcc2 --- /dev/null +++ b/cime/src/components/data_comps/dshr_nuopc/dshr_methods_mod.F90 @@ -0,0 +1,840 @@ +module dshr_methods_mod + + use ESMF , only : operator(<), operator(/=), operator(+) + use ESMF , only : operator(-), operator(*) , operator(>=) + use ESMF , only : operator(<=), operator(>), operator(==) + use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_LogFoundError, ESMF_LOGMSG_ERROR, ESMF_MAXSTR + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE + use ESMF , only : ESMF_State, ESMF_StateGet + use ESMF , only : ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_GridCompSet + use ESMF , only : ESMF_GeomType_Flag, ESMF_FieldStatus_Flag + use ESMF , only : ESMF_Mesh, ESMF_MeshGet + use ESMF , only : ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_FIELDSTATUS_COMPLETE + use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet + use ESMF , only : ESMF_ClockPrint, ESMF_ClockAdvance + use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmGet, ESMF_AlarmSet + use ESMF , only : ESMF_Calendar, ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN + use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet + use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet + use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast, ESMF_VMGetCurrent + use NUOPC , only : NUOPC_CompAttributeGet + use NUOPC_Model , only : NUOPC_ModelGet + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use shr_file_mod , only : shr_file_setlogunit, shr_file_getLogUnit + + implicit none + private + + public :: memcheck + public :: get_component_instance + public :: set_component_logging + public :: log_clock_advance + public :: state_getscalar + public :: state_setscalar + public :: state_diagnose + public :: alarmInit + public :: chkerr + + private :: timeInit + private :: field_getfldptr + + ! Clock and alarm options + character(len=*), private, parameter :: & + optNONE = "none" , & + optNever = "never" , & + optNSteps = "nsteps" , & + optNStep = "nstep" , & + optNSeconds = "nseconds" , & + optNSecond = "nsecond" , & + optNMinutes = "nminutes" , & + optNMinute = "nminute" , & + optNHours = "nhours" , & + optNHour = "nhour" , & + optNDays = "ndays" , & + optNDay = "nday" , & + optNMonths = "nmonths" , & + optNMonth = "nmonth" , & + optNYears = "nyears" , & + optNYear = "nyear" , & + optMonthly = "monthly" , & + optYearly = "yearly" , & + optDate = "date" , & + optIfdays0 = "ifdays0" + + ! Module data + integer, parameter :: SecPerDay = 86400 ! Seconds per day + integer, parameter :: memdebug_level=1 + character(len=1024) :: msgString + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine memcheck(string, level, mastertask) + + ! input/output variables + character(len=*) , intent(in) :: string + integer , intent(in) :: level + logical , intent(in) :: mastertask + + ! local variables + integer :: ierr + integer, external :: GPTLprint_memusage + !----------------------------------------------------------------------- + + if ((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then + ierr = GPTLprint_memusage(string) + endif + + end subroutine memcheck + +!=============================================================================== + + subroutine get_component_instance(gcomp, inst_suffix, inst_index, rc) + + ! input/output variables + type(ESMF_GridComp) :: gcomp + character(len=*) , intent(out) :: inst_suffix + integer , intent(out) :: inst_index + integer , intent(out) :: rc + + ! local variables + logical :: isPresent + character(len=4) :: cvalue + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + cvalue = inst_suffix(2:) + read(cvalue, *) inst_index + else + inst_suffix = "" + inst_index=1 + endif + + end subroutine get_component_instance + +!=============================================================================== + + subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) + + ! input/output variables + type(ESMF_GridComp) :: gcomp + logical, intent(in) :: mastertask + integer, intent(out) :: logunit + integer, intent(out) :: shrlogunit + integer, intent(out) :: rc + + ! local variables + character(len=CL) :: diro + character(len=CL) :: logfile + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + shrlogunit = 6 + + if (mastertask) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) + if (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 set_component_logging + +!=============================================================================== + + subroutine log_clock_advance(clock, component, logunit, rc) + + ! input/output variables + type(ESMF_Clock) :: clock + character(len=*) , intent(in) :: component + integer , intent(in) :: logunit + integer , intent(out) :: rc + + ! local variables + character(len=CL) :: cvalue, prestring + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + write(prestring, *) "------>Advancing ",trim(component)," from: " + call ESMF_ClockPrint(clock, options="currTime", unit=cvalue, preString=trim(prestring), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) + + call ESMF_ClockPrint(clock, options="stopTime", unit=cvalue, & + preString="--------------------------------> to: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) + + end subroutine log_clock_advance + +!=============================================================================== + + subroutine 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 + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State), intent(in) :: state + integer, intent(in) :: scalar_id + real(r8), intent(out) :: scalar_value + character(len=*), intent(in) :: flds_scalar_name + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask, ierr, len + type(ESMF_VM) :: vm + type(ESMF_Field) :: field + real(r8), pointer :: farrayptr(:,:) + real(r8) :: tmp(1) + character(len=*), parameter :: subname='(state_getscalar)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) + if (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 = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + endif + tmp(:) = farrayptr(scalar_id,:) + endif + call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + scalar_value = tmp(1) + + end subroutine state_getscalar + +!================================================================================ + + subroutine state_setscalar(scalar_value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) + + ! ---------------------------------------------- + ! Set scalar data from State for a particular name + ! ---------------------------------------------- + + ! 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 + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask + type(ESMF_Field) :: lfield + type(ESMF_VM) :: vm + real(r8), pointer :: farrayptr(:,:) + character(len=*), parameter :: subname='(state_setscalar)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(lfield, farrayPtr = farrayptr, rc=rc) + if (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) + rc = ESMF_FAILURE + return + endif + farrayptr(scalar_id,1) = scalar_value + endif + + end subroutine state_setscalar + +!=============================================================================== + + subroutine state_diagnose(State, string, rc) + + ! ---------------------------------------------- + ! Diagnose status of State + ! ---------------------------------------------- + + type(ESMF_State), intent(in) :: state + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + type(ESMf_Field) :: lfield + integer :: fieldCount, lrank + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(r8), pointer :: dataPtr1d(:) + real(r8), pointer :: dataPtr2d(:,:) + character(len=*),parameter :: subname='(state_diagnose)' + ! ---------------------------------------------- + + call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + call ESMF_StateGet(state, itemNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + + call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call field_getfldptr(lfield, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" + endif + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," 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) + enddo + + deallocate(lfieldnamelist) + + end subroutine state_diagnose + +!=============================================================================== + + subroutine 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 + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_Field) , intent(in) :: field + real(r8), pointer , intent(inout), optional :: fldptr1(:) + real(r8), pointer , intent(inout), optional :: fldptr2(:,:) + integer , intent(out) , optional :: rank + logical , intent(in) , optional :: abort + integer , intent(out) , optional :: rc + + ! local variables + type(ESMF_GeomType_Flag) :: geomtype + type(ESMF_FieldStatus_Flag) :: status + type(ESMF_Mesh) :: lmesh + integer :: lrank, nnodes, nelements + logical :: labort + character(len=*), parameter :: subname='(field_getfldptr)' + ! ---------------------------------------------- + + if (.not.present(rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + labort = .true. + if (present(abort)) then + labort = abort + endif + lrank = -99 + + call ESMF_FieldGet(field, status=status, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + lrank = 0 + if (labort) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + else + call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + endif + else + + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nnodes == 0 .and. nelements == 0) lrank = 0 + else + call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif ! geomtype + + if (lrank == 0) then + call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & + 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 = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) + if (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 = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) + if (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 = ESMF_FAILURE + return + endif + + endif ! status + + if (present(rank)) then + rank = lrank + endif + + end subroutine field_getfldptr + +!=============================================================================== + + subroutine alarmInit( clock, alarm, option, & + opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) + + ! Setup an alarm in a clock + ! 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. + + ! input/output variables + type(ESMF_Clock) , intent(inout) :: clock ! clock + type(ESMF_Alarm) , intent(inout) :: alarm ! alarm + character(len=*) , intent(in) :: option ! alarm option + integer , optional , intent(in) :: opt_n ! alarm freq + integer , optional , intent(in) :: opt_ymd ! alarm ymd + integer , 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 variables + type(ESMF_Calendar) :: cal ! calendar + integer :: lymd ! local ymd + integer :: ltod ! local tod + integer :: cyy,cmm,cdd,csec ! 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 + integer :: sec + character(len=*), parameter :: subname = '(set_alarmInit): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lalarmname = 'alarm_unknown' + if (present(alarmname)) lalarmname = trim(alarmname) + ltod = 0 + if (present(opt_tod)) ltod = opt_tod + lymd = -1 + if (present(opt_ymd)) lymd = opt_ymd + + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) + if (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 + + ! Determine calendar + call ESMF_ClockGet(clock, calendar=cal) + + ! Determine inputs for call to create alarm + selectcase (trim(option)) + + case (optNONE) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optNever) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optDate) + if (.not. present(opt_ymd)) then + call shr_sys_abort(subname//trim(option)//' requires opt_ymd') + end if + if (lymd < 0 .or. ltod < 0) then + call shr_sys_abort(subname//trim(option)//'opt_ymd, opt_tod invalid') + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call timeInit(NextAlarm, lymd, cal, ltod, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optIfdays0) + if (.not. present(opt_ymd)) then + call shr_sys_abort(subname//trim(option)//' requires opt_ymd') + end if + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case (optNSteps) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (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(clock, TimeStep=AlarmInterval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSeconds) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSecond) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinutes) + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinute) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHours) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHour) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDays) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDay) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonths) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonth) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optMonthly) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case (optNYears) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNYear) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optYearly) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + 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 + + alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & + ringInterval=AlarmInterval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + end subroutine alarmInit + +!=============================================================================== + + subroutine timeInit( Time, ymd, cal, tod, rc) + + ! 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) :: Time ! ESMF time + integer , intent(in) :: ymd ! year, month, day YYYYMMDD + type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar + integer , intent(in) :: tod ! time of day in seconds + integer , intent(out) :: rc + + ! local variables + integer :: year, mon, day ! year, month, day as integers + integer :: tdate ! temporary date + integer :: date ! coded-date (yyyymmdd) + character(len=*), parameter :: subname='(timeInit)' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + if ( (ymd < 0) .or. (tod < 0) .or. (tod > SecPerDay) )then + call shr_sys_abort( subname//'ERROR yymmdd is a negative number or time-of-day out of bounds' ) + end if + + tdate = abs(date) + year = int(tdate/10000) + if (date < 0) year = -year + mon = int( mod(tdate,10000)/ 100) + day = mod(tdate, 100) + + call ESMF_TimeSet( Time, yy=year, mm=mon, dd=day, s=tod, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + end subroutine timeInit + +!=============================================================================== + + logical function chkerr(rc, line, file) + + integer, intent(in) :: rc + integer, intent(in) :: line + character(len=*), intent(in) :: file + + integer :: lrc + + chkerr = .false. + lrc = rc + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + chkerr = .true. + endif + end function chkerr + +!=============================================================================== + +end module dshr_methods_mod diff --git a/cime/src/components/data_comps/dshr_nuopc/dshr_nuopc_mod.F90 b/cime/src/components/data_comps/dshr_nuopc/dshr_nuopc_mod.F90 index 9e6a85019bab..fea0711884f3 100644 --- a/cime/src/components/data_comps/dshr_nuopc/dshr_nuopc_mod.F90 +++ b/cime/src/components/data_comps/dshr_nuopc/dshr_nuopc_mod.F90 @@ -3,11 +3,10 @@ module dshr_nuopc_mod use NUOPC 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, cxx=>shr_kind_cxx - use shr_string_mod , only : shr_string_listGetIndex - use shr_sys_mod , only : shr_sys_abort + use dshr_methods_mod , only : alarmInit, chkerr + 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 @@ -272,7 +271,7 @@ subroutine dshr_realize(state, fldList, numflds, flds_scalar_name, flds_scalar_n 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 + 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 @@ -344,7 +343,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_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine ModelInitPhase @@ -376,13 +375,13 @@ subroutine ModelSetRunClock(gcomp, rc) ! query the Component for its clocks call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) - if (shr_nuopc_methods_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_methods_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_methods_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 @@ -390,41 +389,41 @@ subroutine ModelSetRunClock(gcomp, rc) mstoptime = mcurrtime + dtimestep call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) - if (shr_nuopc_methods_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_methods_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_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + 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_methods_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_methods_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_methods_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, & + call alarmInit(mclock, restart_alarm, restart_option, & opt_n = restart_n, & opt_ymd = restart_ymd, & RefTime = mcurrTime, & alarmname = 'alarm_restart', rc=rc) - if (shr_nuopc_methods_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_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -433,10 +432,10 @@ subroutine ModelSetRunClock(gcomp, rc) !-------------------------------- call ESMF_ClockAdvance(mclock,rc=rc) - if (shr_nuopc_methods_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_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) @@ -458,13 +457,13 @@ subroutine ModelSetMetadata(gcomp, name, rc) convCIM = "CIM" purpComp = "Model Component Simulation Description" call ESMF_AttributeAdd(gcomp, convention=convCIM, purpose=purpComp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_AttributeSet(gcomp, "ShortName", trim(name), convention=convCIM, purpose=purpComp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_AttributeSet(gcomp, "LongName", "Climatological SeaIce Data Model", convention=convCIM, purpose=purpComp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_AttributeSet(gcomp, "Description", & "The CIME data models perform the basic function of " // & @@ -479,22 +478,22 @@ subroutine ModelSetMetadata(gcomp, name, rc) "prognostically and have no need to receive any data " // & "from the driver.", & convention=convCIM, purpose=purpComp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_AttributeSet(gcomp, "ReleaseDate", "2010", convention=convCIM, purpose=purpComp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_AttributeSet(gcomp, "ModelType", "SeaIce", convention=convCIM, purpose=purpComp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_AttributeSet(gcomp, "Name", "TBD", convention=convCIM, purpose=purpComp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_AttributeSet(gcomp, "EmailAddress", "TBD", convention=convCIM, purpose=purpComp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_AttributeSet(gcomp, "ResponsiblePartyRole", "contact", convention=convCIM, purpose=purpComp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine ModelSetMetadata @@ -524,13 +523,13 @@ subroutine dshr_export(array, state, fldname, ungridded_index, rc) 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 + if (.not. 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 (ChkErr(rc,__LINE__,u_FILE_u)) return if (gridToFieldMap == 1) then do n = 1,lsize farray2d(n,ungridded_index) = array(n) @@ -542,7 +541,7 @@ subroutine dshr_export(array, state, fldname, ungridded_index, rc) end if else call ESMF_FieldGet(lfield, farrayPtr=farray1d, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,lsize farray1d(n) = array(n) enddo @@ -577,13 +576,13 @@ subroutine dshr_import(state, fldname, array, ungridded_index, rc) 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 + if (.not. 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 (ChkErr(rc,__LINE__,u_FILE_u)) return if (gridToFieldMap == 1) then do n = 1,lsize array(n) = farray2d(n,ungridded_index) @@ -595,7 +594,7 @@ subroutine dshr_import(state, fldname, array, ungridded_index, rc) end if else call ESMF_FieldGet(lfield, farrayPtr=farray1d, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,lsize array(n) = farray1d(n) enddo diff --git a/cime/src/components/data_comps/dwav/nuopc/dwav_comp_mod.F90 b/cime/src/components/data_comps/dwav/nuopc/dwav_comp_mod.F90 index 1de4a2a7bd5d..286d83f36c49 100644 --- a/cime/src/components/data_comps/dwav/nuopc/dwav_comp_mod.F90 +++ b/cime/src/components/data_comps/dwav/nuopc/dwav_comp_mod.F90 @@ -1,10 +1,5 @@ -#ifdef AIX -@PROCESS ALIAS_SIZE(805306368) -#endif module dwav_comp_mod - ! !USES: - 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 @@ -13,9 +8,7 @@ module dwav_comp_mod use mct_mod , only : mct_avect, mct_avect_indexRA, mct_avect_zero, mct_aVect_nRattr use mct_mod , only : mct_avect_init, mct_avect_lsize use shr_sys_mod , only : shr_sys_abort - use shr_kind_mod , only : IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS, CL=>SHR_KIND_CL - use shr_kind_mod , only : CXX=>SHR_KIND_CXX - use shr_string_mod , only : shr_string_listGetName + use shr_kind_mod , only : r8=>shr_kind_r8, cxx=>shr_kind_cxx, cl=>shr_kind_cl, cs=>shr_kind_cs 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_bcast @@ -26,10 +19,8 @@ module dwav_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 shr_cal_mod , only : shr_cal_calendarname - 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 shr_cal_mod , only : shr_cal_calendarname, shr_cal_datetod2string + use dshr_methods_mod , only : ChkErr 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 @@ -68,7 +59,7 @@ module dwav_comp_mod contains !=============================================================================== - subroutine dwav_comp_advertise(importState, exportState, & + subroutine dwav_comp_advertise(importState, exportState, flds_scalar_name, & wav_present, wav_prognostic, & fldsFrWav_num, fldsFrWav, fldsToWav_num, fldsToWav, rc) @@ -78,6 +69,7 @@ subroutine dwav_comp_advertise(importState, exportState, & ! input/output arguments type(ESMF_State) :: importState type(ESMF_State) :: exportState + character(len=*) , intent(in) :: flds_scalar_name logical , intent(in) :: wav_present logical , intent(in) :: wav_prognostic integer , intent(out) :: fldsFrWav_num @@ -120,7 +112,7 @@ subroutine dwav_comp_advertise(importState, exportState, & do n = 1,fldsFrWav_num call NUOPC_Advertise(exportState, standardName=fldsFrWav(n)%stdname, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return enddo end subroutine dwav_comp_advertise @@ -193,24 +185,24 @@ subroutine dwav_comp_init(mpicom, compid, my_task, master_task, & ! obtain the distgrid from the mesh that was read in call ESMF_MeshGet(Mesh, elementdistGrid=distGrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determin local size on my processor call ESMF_distGridGet(distGrid, localDe=0, elementCount=lsize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determine global index space for my processor allocate(gindex(lsize)) call ESMF_distGridGet(distGrid, localDe=0, seqIndexList=gindex, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! determine global size of distgrid call ESMF_distGridGet(distGrid, dimCount=dimCount, deCount=deCount, tileCount=tileCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(elementCountPTile(tileCount)) call ESMF_distGridGet(distGrid, elementCountPTile=elementCountPTile, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return gsize = 0 do n = 1,size(elementCountPTile) gsize = gsize + elementCountPTile(n) @@ -238,11 +230,11 @@ subroutine dwav_comp_init(mpicom, compid, my_task, master_task, & ! obtain mesh lats and lons call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(ownedElemCoords(spatialDim*numOwnedElements)) allocate(xc(numOwnedElements), yc(numOwnedElements)) call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (numOwnedElements /= lsize) then call shr_sys_abort('ERROR: numOwnedElements is not equal to lsize') end if @@ -385,21 +377,23 @@ 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 + ! ---------------------------- + ! run method for dwav model + ! ---------------------------- ! input/output parameters: - 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 - character(len=*) , intent(in) :: inst_suffix ! char string associated with instance - integer , intent(in) :: logunit ! logging unit number - logical , intent(in) :: read_restart ! start from restart - logical , intent(in) :: write_restart ! write restart - integer(IN) , intent(in) :: target_ymd - integer(IN) , intent(in) :: target_tod - character(CL) , intent(in), optional :: case_name ! case name - - !--- local --- + 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 + character(len=*) , intent(in) :: inst_suffix ! char string associated with instance + integer , intent(in) :: logunit ! logging unit number + logical , intent(in) :: read_restart ! start from restart + logical , intent(in) :: write_restart ! write restart + integer , intent(in) :: target_ymd + integer , intent(in) :: target_tod + character(CL) , intent(in), optional :: case_name ! case name + + ! local variables integer :: n ! indices integer :: idt ! integer timestep integer :: nu ! unit number @@ -479,9 +473,6 @@ subroutine dwav_comp_run(mpicom, my_task, master_task, & call t_stopf('dwav') - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- call t_stopf('DWAV_RUN') end subroutine dwav_comp_run @@ -502,15 +493,15 @@ subroutine dwav_comp_export(exportState, rc) 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 + if (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 + if (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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine dwav_comp_export diff --git a/cime/src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 b/cime/src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 index b910b9cd43fd..033da13b4713 100644 --- a/cime/src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 +++ b/cime/src/components/data_comps/dwav/nuopc/wav_comp_nuopc.F90 @@ -5,34 +5,25 @@ module wav_comp_nuopc !---------------------------------------------------------------------------- use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - use NUOPC_Model , only : model_routine_SS => SetServices - use NUOPC_Model , only : model_label_Advance => label_Advance - 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 - 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 med_constants_mod , only : shr_cal_ymd2date, shr_cal_noleap, shr_cal_gregorian - 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 - 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_const_mod , only : SHR_CONST_SPVAL - use shr_strdata_mod , only : shr_strdata_type - 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 dwav_comp_mod , only : dwav_comp_export - + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise + use NUOPC_Model , only : model_routine_SS => SetServices + use NUOPC_Model , only : model_label_Advance => label_Advance + 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 shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_ymd2date + use shr_const_mod , only : SHR_CONST_SPVAL + use shr_sys_mod , only : shr_sys_abort + use dshr_nuopc_mod , only : fld_list_type, fldsMax, dshr_realize + use dshr_nuopc_mod , only : ModelInitPhase, ModelSetRunClock, ModelSetMetaData + use dshr_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck + use dshr_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance + use dwav_shr_mod , only : dwav_shr_read_namelists + use dwav_comp_mod , only : dwav_comp_init, dwav_comp_run, dwav_comp_advertise + use dwav_comp_mod , only : dwav_comp_export implicit none private ! except @@ -48,24 +39,29 @@ module wav_comp_nuopc ! Private module data !-------------------------------------------------------------------------- - integer :: fldsToWav_num = 0 - integer :: fldsFrWav_num = 0 - type (fld_list_type) :: fldsToWav(fldsMax) - type (fld_list_type) :: fldsFrWav(fldsMax) - - integer :: compid ! mct comp id - integer :: mpicom ! mpi communicator - integer :: my_task ! my task in mpi communicator mpicom - 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 :: read_restart ! start from restart - character(len=256) :: case_name ! case name - character(len=80) :: calendar ! calendar name - logical :: wav_prognostic ! flag - logical :: use_esmf_metadata = .false. - character(*), parameter :: modName = "(wav_comp_nuopc)" - character(*), parameter :: u_FILE_u = & + character(len=CS) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + + integer :: fldsToWav_num = 0 + integer :: fldsFrWav_num = 0 + type (fld_list_type) :: fldsToWav(fldsMax) + type (fld_list_type) :: fldsFrWav(fldsMax) + + integer :: compid ! mct comp id + integer :: mpicom ! mpi communicator + integer :: my_task ! my task in mpi communicator mpicom + 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 :: read_restart ! start from restart + character(len=256) :: case_name ! case name + character(len=80) :: calendar ! calendar name + logical :: wav_prognostic ! flag + logical :: use_esmf_metadata = .false. + character(*), parameter :: modName = "(wav_comp_nuopc)" + character(*), parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -84,34 +80,34 @@ subroutine SetServices(gcomp, rc) ! 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) @@ -121,9 +117,7 @@ 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 @@ -137,14 +131,11 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: n 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 :: localPet - 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) + character(len=CL) :: fileName ! generic file name + character(len=CL) :: logmsg + logical :: isPresent, isSet character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -156,10 +147,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, mpiCommunicator=lmpicom, localpet=my_task, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call mpi_comm_dup(lmpicom, mpicom, ierr) @@ -167,14 +158,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! determine instance information !---------------------------------------------------------------------------- - call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - inst_name = "WAV"//trim(inst_suffix) + call get_component_instance(gcomp, inst_suffix, inst_index, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! 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 set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Read input namelists and set present and prognostic flags @@ -188,10 +180,48 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! advertise import and export fields !-------------------------------- - call dwav_comp_advertise(importState, exportState, & + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(logmsg,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(logmsg,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(logmsg,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + + write(6,*)'DEBUG: wav index nx = ', flds_scalar_index_nx + write(6,*)'DEBUG: wav index ny = ', flds_scalar_index_ny + + call dwav_comp_advertise(importState, exportState, flds_scalar_name, & wav_present, wav_prognostic, & fldsFrWav_num, fldsFrWav, fldsToWav_num, fldsToWav, 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) @@ -199,7 +229,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,7 +256,6 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) integer :: current_tod ! model sec into model date character(CL) :: cvalue integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level integer :: nxg, nyg character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- @@ -240,8 +268,6 @@ 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) !-------------------------------- @@ -249,14 +275,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='read_restart', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) read_restart call NUOPC_CompAttributeGet(gcomp, name='MCTID', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) compid !---------------------------------------------------------------------------- @@ -264,11 +290,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !---------------------------------------------------------------------------- call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet( currTime, yy=current_year, mm=current_mon, dd=current_day, s=current_tod, & calkindflag=esmf_caltype, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(current_year, current_mon, current_day, current_ymd) if (esmf_caltype == ESMF_CALKIND_NOLEAP) then @@ -286,14 +312,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- call NUOPC_CompAttributeGet(gcomp, name='mesh_wav', value=cvalue, 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 write(logunit,*) " obtaining dwav mesh from " // trim(cvalue) end if Emesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Initialize model @@ -317,27 +343,26 @@ 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 !-------------------------------- ! Pack export state !-------------------------------- call dwav_comp_export(exportState, rc=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(nxg),flds_scalar_index_nx, exportState, & + call 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, & + call 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 - call shr_nuopc_methods_State_diagnose(exportState, subname//':ES', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call State_diagnose(exportState, subname//':ES', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) !---------------------------------------------------------------------------- @@ -346,7 +371,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) if (use_esmf_metadata) then call ModelSetMetaData(gcomp, name='DWAV', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) @@ -357,8 +382,6 @@ 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 @@ -370,7 +393,6 @@ subroutine ModelAdvance(gcomp, rc) type(ESMF_TimeInterval) :: timeStep type(ESMF_State) :: importState, exportState integer :: shrlogunit ! original log unit - integer :: shrloglev ! original log level logical :: write_restart ! write a restart integer :: yr ! year integer :: mon ! month @@ -384,10 +406,8 @@ subroutine ModelAdvance(gcomp, rc) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - call shr_nuopc_memcheck(subname, 3, my_task==master_task) + call memcheck(subname, 3, my_task==master_task) call shr_file_getLogUnit (shrlogunit) - call shr_file_getLogLevel(shrloglev) - call shr_file_setLogLevel(max(shrloglev,1)) call shr_file_setLogUnit (logunit) !-------------------------------- @@ -395,7 +415,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 (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! Unpack import state @@ -412,13 +432,13 @@ subroutine ModelAdvance(gcomp, rc) ! Determine if will write restart call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return write_restart = .true. call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else write_restart = .false. endif @@ -428,11 +448,11 @@ subroutine ModelAdvance(gcomp, rc) ! shr_strdata time interpolation call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return nextTime = currTime + timeStep call ESMF_TimeGet( nextTime, yy=yr, mm=mon, dd=day, s=next_tod, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call shr_cal_ymd2date(yr, mon, day, next_ymd) call dwav_comp_run(mpicom, my_task, master_task, & @@ -444,22 +464,22 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- call dwav_comp_export(exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- - call shr_nuopc_methods_State_diagnose(exportState, subname//':ES', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call State_diagnose(exportState, subname//':ES', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (my_task == master_task) then - call shr_nuopc_log_clock_advance(clock, 'WAV', logunit) + call log_clock_advance(clock, 'DATM', logunit, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) - call shr_file_setLogLevel(shrloglev) call shr_file_setLogUnit (shrlogunit) end subroutine ModelAdvance diff --git a/cime/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 b/cime/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 index c54f1602041d..7a6ef4f0b979 100644 --- a/cime/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 +++ b/cime/src/components/xcpl_comps/xatm/nuopc/atm_comp_nuopc.F90 @@ -5,29 +5,22 @@ module atm_comp_nuopc !---------------------------------------------------------------------------- use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - use NUOPC_Model , only : model_routine_SS => SetServices - use NUOPC_Model , only : model_label_Advance => label_Advance - 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, CL, CS - use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - 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 - use shr_nuopc_scalars_mod , only : flds_scalar_index_ny - use shr_nuopc_scalars_mod , only : flds_scalar_index_nextsw_cday - 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 : 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_final_nuopc, dead_meshinit - use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock - use med_constants_mod , only : dbug => med_constants_dbug_flag + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise + use NUOPC_Model , only : model_routine_SS => SetServices + use NUOPC_Model , only : model_label_Advance => label_Advance + 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 shr_sys_mod , only : shr_sys_abort + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use dead_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck + use dead_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance + use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index + 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 : ModelInitPhase, ModelSetRunClock implicit none private ! except @@ -38,6 +31,12 @@ module atm_comp_nuopc ! Private module data !-------------------------------------------------------------------------- + character(len=CL) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_nextsw_cday = 0 + integer :: fldsToAtm_num = 0 integer :: fldsFrAtm_num = 0 type (fld_list_type) :: fldsToAtm(fldsMax) @@ -50,11 +49,12 @@ module atm_comp_nuopc 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=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 + integer :: dbug = 1 character(*),parameter :: modName = "(xatm_comp_nuopc)" character(*),parameter :: u_FILE_u = & __FILE__ @@ -112,9 +112,6 @@ 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 @@ -122,12 +119,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - 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 + type(ESMF_VM) :: vm + character(CS) :: stdname + integer :: n + integer :: lsize ! local array size + integer :: shrlogunit ! original log unit + character(CL) :: cvalue + character(len=CL) :: logmsg + logical :: isPresent, isSet character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -146,14 +145,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! determine instance information !---------------------------------------------------------------------------- - call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - inst_name = "ATM"//trim(inst_suffix) + call get_component_instance(gcomp, inst_suffix, inst_index, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit) + call set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Initialize xatm @@ -173,6 +173,60 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! advertise import and export fields !-------------------------------- + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldName') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(logmsg,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldCount') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(logmsg,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNX') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(logmsg,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNY') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nextsw_cday + write(logmsg,*) flds_scalar_index_nextsw_cday + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nextsw_cday = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxNextSwCday') + endif + if (nxg /= 0 .and. nyg /= 0) then call fld_list_add(fldsFrAtm_num, fldsFrAtm, trim(flds_scalar_name)) @@ -321,11 +375,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call state_setexport(exportState, rc=rc) - call shr_nuopc_methods_State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & + call State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & + call State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -336,7 +390,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & + call State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & flds_scalar_name, flds_scalar_num, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -345,7 +399,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- if (dbug > 1) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + call State_diagnose(exportState,subname//':ES',rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -372,15 +426,12 @@ 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 ! local variables type(ESMF_Clock) :: clock - type(ESMF_Time) :: nexttime type(ESMF_State) :: exportState real(r8) :: nextsw_cday integer :: shrlogunit ! original log unit @@ -392,7 +443,7 @@ subroutine ModelAdvance(gcomp, 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 memcheck(subname, 3, mastertask) call shr_file_getLogUnit (shrlogunit) call shr_file_setLogUnit (logunit) @@ -407,12 +458,7 @@ subroutine ModelAdvance(gcomp, rc) call state_setexport(exportState, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGetNextTime(clock, nextTime) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(nextTime, dayOfYear_r8=nextsw_cday) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call shr_nuopc_methods_State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & + call State_SetScalar(nextsw_cday, flds_scalar_index_nextsw_cday, exportState, & flds_scalar_name, flds_scalar_num, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -421,13 +467,16 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- if (dbug > 1) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + call state_diagnose(exportState,subname//':ES',rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mastertask) then - call shr_nuopc_log_clock_advance(clock, 'ATM', logunit) + call log_clock_advance(clock, 'XATM', logunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return endif endif + call shr_file_setLogUnit (shrlogunit) + if (dbug > 5) then call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) end if diff --git a/cime/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 b/cime/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 index 277bda92e183..83885a73e944 100644 --- a/cime/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 +++ b/cime/src/components/xcpl_comps/xglc/nuopc/glc_comp_nuopc.F90 @@ -3,32 +3,24 @@ module glc_comp_nuopc !---------------------------------------------------------------------------- ! This is the NUOPC cap for XGLC !---------------------------------------------------------------------------- + use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - use NUOPC_Model , only : model_routine_SS => SetServices - use NUOPC_Model , only : model_label_Advance => label_Advance - 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 : shr_file_getlogunit, shr_file_setlogunit - 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 - 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_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 : 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_final_nuopc, dead_meshinit - use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock - use med_constants_mod , only : dbug => med_constants_dbug_flag + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise + use NUOPC_Model , only : model_routine_SS => SetServices + use NUOPC_Model , only : model_label_Advance => label_Advance + 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 shr_sys_mod , only : shr_sys_abort + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use dead_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck + use dead_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance + use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index + 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 : ModelInitPhase, ModelSetRunClock implicit none private ! except @@ -39,6 +31,11 @@ module glc_comp_nuopc ! Private module data !-------------------------------------------------------------------------- + character(len=CL) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + integer :: fldsToGlc_num = 0 integer :: fldsFrGlc_num = 0 type (fld_list_type) :: fldsToGlc(fldsMax) @@ -53,11 +50,11 @@ module glc_comp_nuopc 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 + integer :: dbug = 1 character(*),parameter :: modName = "(xglc_comp_nuopc)" character(*),parameter :: u_FILE_u = & __FILE__ @@ -67,6 +64,7 @@ module glc_comp_nuopc !=============================================================================== subroutine SetServices(gcomp, rc) + type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' @@ -114,29 +112,21 @@ 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 - character(CS) :: nec_str - character(CS) :: fldname - integer :: glc_nec - integer :: num - integer :: n - integer :: lsize ! local array size - integer :: ierr ! error code - integer :: shrlogunit ! original log unit - logical :: isPresent - character(len=512) :: diro - character(len=512) :: logfile + type(ESMF_VM) :: vm + character(CS) :: stdname + integer :: n + integer :: lsize ! local array size + integer :: shrlogunit ! original log unit + character(CL) :: cvalue + character(len=CL) :: logmsg + logical :: isPresent, isSet character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -155,14 +145,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! determine instance information !---------------------------------------------------------------------------- - call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - inst_name = "GLC"//trim(inst_suffix) + call get_component_instance(gcomp, inst_suffix, inst_index, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit) + call set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Initialize xglc @@ -182,6 +173,49 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! advertise import and export fields !-------------------------------- + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldName') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(logmsg,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldCount') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(logmsg,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNX') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(logmsg,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNY') + endif + if (nxg /= 0 .and. nyg /= 0) then call fld_list_add(fldsFrGlc_num, fldsFrGlc, trim(flds_scalar_name)) @@ -292,11 +326,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) 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, & + call state_setscalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & + call state_setscalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -305,7 +339,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- if (dbug > 1) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + call state_diagnose(exportState,subname//':ES',rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -332,8 +366,6 @@ 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 @@ -348,8 +380,9 @@ subroutine ModelAdvance(gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - call shr_nuopc_memcheck(subname, 3, mastertask) + if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + call memcheck(subname, 3, mastertask) + call shr_file_getLogUnit (shrlogunit) call shr_file_setLogUnit (logunit) @@ -368,10 +401,11 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- if (dbug > 1) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + call state_diagnose(exportState,subname//':ES',rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (my_task == master_task) then - call shr_nuopc_log_clock_advance(clock, 'GLC', logunit) + call log_clock_advance(clock, 'XGLC', logunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return endif endif diff --git a/cime/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 b/cime/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 index 7aedeb6d28a1..60b5e3ff37fc 100644 --- a/cime/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 +++ b/cime/src/components/xcpl_comps/xice/nuopc/ice_comp_nuopc.F90 @@ -5,29 +5,22 @@ module ice_comp_nuopc !---------------------------------------------------------------------------- use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - use NUOPC_Model , only : model_routine_SS => SetServices - use NUOPC_Model , only : model_label_Advance => label_Advance - 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, CL, CS - use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - 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 - 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_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 : 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_final_nuopc, dead_meshinit - use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock - use med_constants_mod , only : dbug => med_constants_dbug_flag + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise + use NUOPC_Model , only : model_routine_SS => SetServices + use NUOPC_Model , only : model_label_Advance => label_Advance + 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 shr_sys_mod , only : shr_sys_abort + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use dead_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck + use dead_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance + use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index + 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 : ModelInitPhase, ModelSetRunClock implicit none private ! except @@ -38,32 +31,38 @@ module ice_comp_nuopc ! Private module data !-------------------------------------------------------------------------- - integer :: fldsToIce_num = 0 - 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(:) - 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. "ice_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 = "(xice_comp_nuopc)" - character(*),parameter :: u_FILE_u = & + character(len=CL) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + + integer :: fldsToIce_num = 0 + 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(:) + 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_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 + integer :: dbug = 1 + character(*),parameter :: modName = "(xice_comp_nuopc)" + character(*),parameter :: u_FILE_u = & __FILE__ - !=============================================================================== - contains - !=============================================================================== +!=============================================================================== +contains +!=============================================================================== + subroutine SetServices(gcomp, rc) type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -108,14 +107,11 @@ subroutine SetServices(gcomp, rc) 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 @@ -128,6 +124,8 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer :: n integer :: lsize ! local array size integer :: shrlogunit ! original log unit + character(len=CL) :: logmsg + logical :: isPresent, isSet character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -146,14 +144,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! determine instance information !---------------------------------------------------------------------------- - call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - inst_name = "ICE"//trim(inst_suffix) + call get_component_instance(gcomp, inst_suffix, inst_index, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit) + call set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Initialize xice @@ -173,6 +172,49 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! advertise import and export fields !-------------------------------- + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldName') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(logmsg,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldCount') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(logmsg,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNX') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(logmsg,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNY') + endif + if (nxg /= 0 .and. nyg /= 0) then call fld_list_add(fldsFrIce_num, fldsFrIce, trim(flds_scalar_name)) @@ -320,14 +362,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Pack export state !-------------------------------- - call state_setexport(exportState, rc=rc) + 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, & + call State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & + call State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -336,7 +378,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- if (dbug > 1) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + call State_diagnose(exportState,subname//':ES',rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -363,8 +405,6 @@ 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 @@ -378,7 +418,7 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - call shr_nuopc_memcheck(subname, 3, mastertask) + call memcheck(subname, 3, mastertask) call shr_file_getLogUnit (shrlogunit) call shr_file_setLogUnit (logunit) @@ -398,10 +438,11 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- if (dbug > 1) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + call State_diagnose(exportState,subname//':ES',rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (my_task == master_task) then - call shr_nuopc_log_clock_advance(clock, 'ICE', logunit) + call log_clock_advance(clock, 'XICE', logunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return endif endif diff --git a/cime/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 b/cime/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 index f1feb98a0ed4..229e71507891 100644 --- a/cime/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 +++ b/cime/src/components/xcpl_comps/xlnd/nuopc/lnd_comp_nuopc.F90 @@ -5,29 +5,22 @@ module lnd_comp_nuopc !---------------------------------------------------------------------------- use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - use NUOPC_Model , only : model_routine_SS => SetServices - use NUOPC_Model , only : model_label_Advance => label_Advance - 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, CL, CS - use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - 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 - 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_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 : 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_final_nuopc, dead_meshinit - use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock - use med_constants_mod , only : dbug=>med_constants_dbug_flag + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise + use NUOPC_Model , only : model_routine_SS => SetServices + use NUOPC_Model , only : model_label_Advance => label_Advance + 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 shr_sys_mod , only : shr_sys_abort + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use dead_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck + use dead_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance + use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index + 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 : ModelInitPhase, ModelSetRunClock implicit none private ! except @@ -38,27 +31,33 @@ module lnd_comp_nuopc ! Private module data !-------------------------------------------------------------------------- - integer :: fldsToLnd_num = 0 - 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(:) - 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. "lnd_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 = "(xlnd_comp_nuopc)" - character(*),parameter :: u_FILE_u = & + character(len=CL) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_nextsw_cday = 0._r8 + + integer :: fldsToLnd_num = 0 + 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(:) + 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_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 + integer :: dbug = 1 + character(*),parameter :: modName = "(xlnd_comp_nuopc)" + character(*),parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -114,9 +113,6 @@ 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 @@ -124,16 +120,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) 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 - logical :: isPresent - character(len=512) :: diro - character(len=512) :: logfile + type(ESMF_VM) :: vm + character(CS) :: stdname + integer :: n + integer :: lsize ! local array size + integer :: shrlogunit ! original log unit + character(CL) :: cvalue + character(len=CL) :: logmsg + logical :: isPresent, isSet character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -152,14 +146,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! determine instance information !---------------------------------------------------------------------------- - call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - inst_name = "LND"//trim(inst_suffix) + call get_component_instance(gcomp, inst_suffix, inst_index, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit) + call set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Initialize xlnd @@ -179,6 +174,49 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! advertise import and export fields !-------------------------------- + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldName') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(logmsg,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldCount') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(logmsg,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNX') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(logmsg,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNY') + end if + if (nxg /= 0 .and. nyg /= 0) then call fld_list_add(fldsFrLnd_num, fldsFrlnd, trim(flds_scalar_name)) @@ -249,7 +287,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) end if - !---------------------------------------------------------------------------- ! Reset shr logging to original values !---------------------------------------------------------------------------- @@ -261,6 +298,8 @@ end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + + ! intput/output variables type(ESMF_GridComp) :: gcomp type(ESMF_State) :: importState, exportState type(ESMF_Clock) :: clock @@ -324,12 +363,13 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- 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, & + call State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & + call State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -338,7 +378,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- if (dbug > 1) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + call state_diagnose(exportState,subname//':ES',rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -365,8 +405,6 @@ 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 @@ -380,7 +418,7 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - call shr_nuopc_memcheck(subname, 3, mastertask) + call memcheck(subname, 3, mastertask) call shr_file_getLogUnit (shrlogunit) call shr_file_setLogUnit (logunit) @@ -393,16 +431,18 @@ subroutine ModelAdvance(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return call state_setexport(exportState, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! diagnostics !-------------------------------- if (dbug > 1) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + call state_diagnose(exportState,subname//':ES',rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mastertask) then - call shr_nuopc_log_clock_advance(clock, 'LND', logunit) + call log_clock_advance(clock, 'LND', logunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return endif endif diff --git a/cime/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 b/cime/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 index 259121b447fa..e9786868dba5 100644 --- a/cime/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 +++ b/cime/src/components/xcpl_comps/xocn/nuopc/ocn_comp_nuopc.F90 @@ -5,28 +5,22 @@ module ocn_comp_nuopc !---------------------------------------------------------------------------- use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - use NUOPC_Model , only : model_routine_SS => SetServices - use NUOPC_Model , only : model_label_Advance => label_Advance - 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, CL, CS - use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - 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 - 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_State_SetScalar - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - 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_final_nuopc, dead_meshinit - use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock - use med_constants_mod , only : dbug=> med_constants_dbug_flag + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise + use NUOPC_Model , only : model_routine_SS => SetServices + use NUOPC_Model , only : model_label_Advance => label_Advance + 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 shr_sys_mod , only : shr_sys_abort + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use dead_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck + use dead_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance + use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index + 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 : ModelInitPhase, ModelSetRunClock implicit none private ! except @@ -37,27 +31,35 @@ module ocn_comp_nuopc ! Private module data !-------------------------------------------------------------------------- - integer :: fldsToOcn_num = 0 - 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(:) - 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. "ocn_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 = "(xocn_comp_nuopc)" - character(*),parameter :: u_FILE_u = __FILE__ + character(len=CL) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_nextsw_cday = 0._r8 + + integer :: fldsToOcn_num = 0 + 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(:) + 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. "ocn_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 + integer :: dbug = 1 + character(*),parameter :: modName = "(xocn_comp_nuopc)" + character(*),parameter :: u_FILE_u = & + __FILE__ !=============================================================================== contains @@ -112,9 +114,6 @@ 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 @@ -122,12 +121,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - type(ESMF_VM) :: vm - character(CL) :: cvalue - character(CS) :: stdname - integer :: n - integer :: lsize ! local array size - integer :: shrlogunit ! original log unit + type(ESMF_VM) :: vm + character(CS) :: stdname + integer :: n + integer :: lsize ! local array size + integer :: shrlogunit ! original log unit + character(CL) :: cvalue + character(len=CL) :: logmsg + logical :: isPresent, isSet character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -150,14 +151,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! determine instance information !---------------------------------------------------------------------------- - call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - inst_name = "OCN"//trim(inst_suffix) + call get_component_instance(gcomp, inst_suffix, inst_index, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit) + call set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Initialize xocn @@ -177,6 +179,49 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! advertise import and export fields !-------------------------------- + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldName') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(logmsg,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldCount') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(logmsg,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNX') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(logmsg,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNY') + endif + if (nxg /= 0 .and. nyg /= 0) then call fld_list_add(fldsFrOcn_num, fldsFrOcn, trim(flds_scalar_name)) @@ -302,12 +347,10 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) 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) + call State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, flds_scalar_name, flds_scalar_num, rc) 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) + call State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, flds_scalar_name, flds_scalar_num, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- @@ -315,7 +358,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- if (dbug > 1) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + call state_diagnose(exportState,subname//':ES',rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -342,8 +385,7 @@ end subroutine InitializeRealize subroutine ModelAdvance(gcomp, rc) - use shr_nuopc_utils_mod, only : shr_nuopc_memcheck, shr_nuopc_log_clock_advance - + ! intput/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -356,7 +398,7 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - call shr_nuopc_memcheck(subname, 3, mastertask) + call memcheck(subname, 3, mastertask) call shr_file_getLogUnit (shrlogunit) call shr_file_setLogUnit (logunit) @@ -376,10 +418,11 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- if (dbug > 1) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + call state_diagnose(exportState,subname//':ES',rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - if(my_task == master_task) then - call shr_nuopc_log_clock_advance(clock, 'OCN', logunit) + if (my_task == master_task) then + call log_clock_advance(clock, 'OCN', logunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return endif endif diff --git a/cime/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 b/cime/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 index d85bf0f1400d..18713967f18b 100644 --- a/cime/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 +++ b/cime/src/components/xcpl_comps/xrof/nuopc/rof_comp_nuopc.F90 @@ -5,28 +5,22 @@ module rof_comp_nuopc !---------------------------------------------------------------------------- use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - use NUOPC_Model , only : model_routine_SS => SetServices - use NUOPC_Model , only : model_label_Advance => label_Advance - 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, CL, CS - use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - 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 - 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_State_SetScalar - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - 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_final_nuopc, dead_meshinit - use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock - use med_constants_mod , only : dbug => med_constants_dbug_flag + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise + use NUOPC_Model , only : model_routine_SS => SetServices + use NUOPC_Model , only : model_label_Advance => label_Advance + 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 shr_sys_mod , only : shr_sys_abort + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use dead_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck + use dead_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance + use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index + 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 : ModelInitPhase, ModelSetRunClock implicit none private ! except @@ -37,27 +31,33 @@ module rof_comp_nuopc ! Private module data !-------------------------------------------------------------------------- - integer :: fldsToRof_num = 0 - 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(:) - integer :: nxg ! global dim i-direction - integer :: nyg ! global dim j-direction - integer :: my_task ! my task in mpi - integer :: inst_index ! number of current instance (ie. 1) - character(len=16) :: inst_name ! fullname of current instance (ie. "rof_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 = "(xrof_comp_nuopc)" - character(*),parameter :: u_FILE_u = & + character(len=CL) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_nextsw_cday = 0 + + integer :: fldsToRof_num = 0 + 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(:) + integer :: nxg ! global dim i-direction + integer :: nyg ! global dim j-direction + integer :: my_task ! my task in mpi + integer :: inst_index ! number of current instance (ie. 1) + 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 + integer :: dbug = 1 + character(*),parameter :: modName = "(xrof_comp_nuopc)" + character(*),parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -113,22 +113,21 @@ 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 + type(ESMF_VM) :: vm + character(CS) :: stdname + integer :: n + integer :: lsize ! local array size + integer :: shrlogunit ! original log unit + character(CL) :: cvalue + character(len=CL) :: logmsg + logical :: isPresent, isSet character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -147,14 +146,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! determine instance information !---------------------------------------------------------------------------- - call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - inst_name = "ROF"//trim(inst_suffix) + call get_component_instance(gcomp, inst_suffix, inst_index, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit) + call set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Initialize xrof @@ -162,7 +162,6 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) call dead_init_nuopc('rof', inst_suffix, logunit, lsize, gbuf, nxg, nyg) - allocate(gindex(lsize)) allocate(lon(lsize)) allocate(lat(lsize)) @@ -175,6 +174,49 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! advertise import and export fields !-------------------------------- + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldName') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(logmsg,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldCount') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(logmsg,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNX') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(logmsg,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNY') + endif + if (nxg /= 0 .and. nyg /= 0) then call fld_list_add(fldsFrRof_num, fldsFrRof, trim(flds_scalar_name)) @@ -221,6 +263,7 @@ 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 @@ -229,8 +272,8 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! local variables character(ESMF_MAXSTR) :: convCIM, purpComp type(ESMF_Mesh) :: Emesh - integer :: shrlogunit ! original log unit integer :: n + integer :: shrlogunit ! original log unit character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' !------------------------------------------------------------------------------- @@ -284,11 +327,11 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) 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, & + call State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & + call State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -297,7 +340,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- if (dbug > 1) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + call State_diagnose(exportState,subname//':ES',rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -324,8 +367,6 @@ 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 @@ -338,8 +379,11 @@ subroutine ModelAdvance(gcomp, rc) !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - call shr_nuopc_memcheck(subname, 3, mastertask) + + if (dbug > 5) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + end if + call memcheck(subname, 3, mastertask) call shr_file_getLogUnit (shrlogunit) call shr_file_setLogUnit (logunit) @@ -351,7 +395,7 @@ subroutine ModelAdvance(gcomp, rc) call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call state_setexport(exportState, rc=rc) + call State_SetExport(exportState, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return !-------------------------------- @@ -359,16 +403,19 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- if (dbug > 1) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + call State_diagnose(exportState,subname//':ES',rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (mastertask) then - call shr_nuopc_log_clock_advance(clock, 'ROF', logunit) + call log_clock_advance(clock, 'XROF', logunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return endif endif call shr_file_setLogUnit (shrlogunit) - 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 diff --git a/cime/src/components/xcpl_comps/xshare/mct/dead_mod.F90 b/cime/src/components/xcpl_comps/xshare/mct/dead_mod.F90 index c1cd1748c4eb..a0724fd27834 100644 --- a/cime/src/components/xcpl_comps/xshare/mct/dead_mod.F90 +++ b/cime/src/components/xcpl_comps/xshare/mct/dead_mod.F90 @@ -47,6 +47,7 @@ subroutine dead_read_inparms(model, mpicom, my_task, master_task, & !--- formats --- character(*), parameter :: F00 = "('(dead_read_inparms) ',8a)" character(*), parameter :: F01 = "('(dead_read_inparms) ',a,a,4i8)" + character(*), parameter :: F02 = "('(dead_read_inparms) ',a,L2)" character(*), parameter :: F03 = "('(dead_read_inparms) ',a,a,i8,a)" character(*), parameter :: subName = "(dead_read_inpamrs) " !------------------------------------------------------------------------------- @@ -95,7 +96,7 @@ subroutine dead_read_inparms(model, mpicom, my_task, master_task, & write(logunit,F00) model,' inst_name : ',trim(inst_name) write(logunit,F00) model,' inst_suffix : ',trim(inst_suffix) if (model.eq.'rof') then - write(logunit,F01) ' Flood mode : ',flood + write(logunit,F02) ' Flood mode : ',flood endif write(logunit,F00) model call shr_sys_flush(logunit) diff --git a/cime/src/components/xcpl_comps/xshare/nuopc/dead_methods_mod.F90 b/cime/src/components/xcpl_comps/xshare/nuopc/dead_methods_mod.F90 new file mode 100644 index 000000000000..d8b55abd8c03 --- /dev/null +++ b/cime/src/components/xcpl_comps/xshare/nuopc/dead_methods_mod.F90 @@ -0,0 +1,840 @@ +module dead_methods_mod + + use ESMF , only : operator(<), operator(/=), operator(+) + use ESMF , only : operator(-), operator(*) , operator(>=) + use ESMF , only : operator(<=), operator(>), operator(==) + use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_LogFoundError, ESMF_LOGMSG_ERROR, ESMF_MAXSTR + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE + use ESMF , only : ESMF_State, ESMF_StateGet + use ESMF , only : ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_GridCompSet + use ESMF , only : ESMF_GeomType_Flag, ESMF_FieldStatus_Flag + use ESMF , only : ESMF_Mesh, ESMF_MeshGet + use ESMF , only : ESMF_GEOMTYPE_MESH, ESMF_GEOMTYPE_GRID, ESMF_FIELDSTATUS_COMPLETE + use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet + use ESMF , only : ESMF_ClockPrint, ESMF_ClockAdvance + use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmGet, ESMF_AlarmSet + use ESMF , only : ESMF_Calendar, ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN + use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet + use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet + use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast, ESMF_VMGetCurrent + use NUOPC , only : NUOPC_CompAttributeGet + use NUOPC_Model , only : NUOPC_ModelGet + use shr_kind_mod , only : r8 => shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use shr_file_mod , only : shr_file_setlogunit, shr_file_getLogUnit + + implicit none + private + + public :: memcheck + public :: get_component_instance + public :: set_component_logging + public :: log_clock_advance + public :: state_getscalar + public :: state_setscalar + public :: state_diagnose + public :: alarmInit + public :: chkerr + + private :: timeInit + private :: field_getfldptr + + ! Clock and alarm options + character(len=*), private, parameter :: & + optNONE = "none" , & + optNever = "never" , & + optNSteps = "nsteps" , & + optNStep = "nstep" , & + optNSeconds = "nseconds" , & + optNSecond = "nsecond" , & + optNMinutes = "nminutes" , & + optNMinute = "nminute" , & + optNHours = "nhours" , & + optNHour = "nhour" , & + optNDays = "ndays" , & + optNDay = "nday" , & + optNMonths = "nmonths" , & + optNMonth = "nmonth" , & + optNYears = "nyears" , & + optNYear = "nyear" , & + optMonthly = "monthly" , & + optYearly = "yearly" , & + optDate = "date" , & + optIfdays0 = "ifdays0" + + ! Module data + integer, parameter :: SecPerDay = 86400 ! Seconds per day + integer, parameter :: memdebug_level=1 + character(len=1024) :: msgString + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine memcheck(string, level, mastertask) + + ! input/output variables + character(len=*) , intent(in) :: string + integer , intent(in) :: level + logical , intent(in) :: mastertask + + ! local variables + integer :: ierr + integer, external :: GPTLprint_memusage + !----------------------------------------------------------------------- + + if ((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then + ierr = GPTLprint_memusage(string) + endif + + end subroutine memcheck + +!=============================================================================== + + subroutine get_component_instance(gcomp, inst_suffix, inst_index, rc) + + ! input/output variables + type(ESMF_GridComp) :: gcomp + character(len=*) , intent(out) :: inst_suffix + integer , intent(out) :: inst_index + integer , intent(out) :: rc + + ! local variables + logical :: isPresent + character(len=4) :: cvalue + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (isPresent) then + call NUOPC_CompAttributeGet(gcomp, name="inst_suffix", value=inst_suffix, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + cvalue = inst_suffix(2:) + read(cvalue, *) inst_index + else + inst_suffix = "" + inst_index=1 + endif + + end subroutine get_component_instance + +!=============================================================================== + + subroutine set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) + + ! input/output variables + type(ESMF_GridComp) :: gcomp + logical, intent(in) :: mastertask + integer, intent(out) :: logunit + integer, intent(out) :: shrlogunit + integer, intent(out) :: rc + + ! local variables + character(len=CL) :: diro + character(len=CL) :: logfile + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + shrlogunit = 6 + + if (mastertask) then + call NUOPC_CompAttributeGet(gcomp, name="diro", value=diro, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(gcomp, name="logfile", value=logfile, rc=rc) + if (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 set_component_logging + +!=============================================================================== + + subroutine log_clock_advance(clock, component, logunit, rc) + + ! input/output variables + type(ESMF_Clock) :: clock + character(len=*) , intent(in) :: component + integer , intent(in) :: logunit + integer , intent(out) :: rc + + ! local variables + character(len=CL) :: cvalue, prestring + !----------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + write(prestring, *) "------>Advancing ",trim(component)," from: " + call ESMF_ClockPrint(clock, options="currTime", unit=cvalue, preString=trim(prestring), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) + + call ESMF_ClockPrint(clock, options="stopTime", unit=cvalue, & + preString="--------------------------------> to: ", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) + + end subroutine log_clock_advance + +!=============================================================================== + + subroutine 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 + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_State), intent(in) :: state + integer, intent(in) :: scalar_id + real(r8), intent(out) :: scalar_value + character(len=*), intent(in) :: flds_scalar_name + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask, ierr, len + type(ESMF_VM) :: vm + type(ESMF_Field) :: field + real(r8), pointer :: farrayptr(:,:) + real(r8) :: tmp(1) + character(len=*), parameter :: subname='(state_getscalar)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) + if (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 = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + endif + tmp(:) = farrayptr(scalar_id,:) + endif + call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + scalar_value = tmp(1) + + end subroutine state_getscalar + +!================================================================================ + + subroutine state_setscalar(scalar_value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) + + ! ---------------------------------------------- + ! Set scalar data from State for a particular name + ! ---------------------------------------------- + + ! 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 + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask + type(ESMF_Field) :: lfield + type(ESMF_VM) :: vm + real(r8), pointer :: farrayptr(:,:) + character(len=*), parameter :: subname='(state_setscalar)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(lfield, farrayPtr = farrayptr, rc=rc) + if (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) + rc = ESMF_FAILURE + return + endif + farrayptr(scalar_id,1) = scalar_value + endif + + end subroutine state_setscalar + +!=============================================================================== + + subroutine state_diagnose(State, string, rc) + + ! ---------------------------------------------- + ! Diagnose status of State + ! ---------------------------------------------- + + type(ESMF_State), intent(in) :: state + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + type(ESMf_Field) :: lfield + integer :: fieldCount, lrank + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(r8), pointer :: dataPtr1d(:) + real(r8), pointer :: dataPtr2d(:,:) + character(len=*),parameter :: subname='(state_diagnose)' + ! ---------------------------------------------- + + call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + call ESMF_StateGet(state, itemNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + + call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call field_getfldptr(lfield, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," no data" + endif + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(string)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(string)//': '//trim(lfieldnamelist(n))," 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) + enddo + + deallocate(lfieldnamelist) + + end subroutine state_diagnose + +!=============================================================================== + + subroutine 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 + ! ---------------------------------------------- + + ! input/output variables + type(ESMF_Field) , intent(in) :: field + real(r8), pointer , intent(inout), optional :: fldptr1(:) + real(r8), pointer , intent(inout), optional :: fldptr2(:,:) + integer , intent(out) , optional :: rank + logical , intent(in) , optional :: abort + integer , intent(out) , optional :: rc + + ! local variables + type(ESMF_GeomType_Flag) :: geomtype + type(ESMF_FieldStatus_Flag) :: status + type(ESMF_Mesh) :: lmesh + integer :: lrank, nnodes, nelements + logical :: labort + character(len=*), parameter :: subname='(field_getfldptr)' + ! ---------------------------------------------- + + if (.not.present(rc)) then + call ESMF_LogWrite(trim(subname)//": ERROR rc not present ", & + ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u) + rc = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + labort = .true. + if (present(abort)) then + labort = abort + endif + lrank = -99 + + call ESMF_FieldGet(field, status=status, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + lrank = 0 + if (labort) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + else + call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + endif + else + + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nnodes == 0 .and. nelements == 0) lrank = 0 + else + call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif ! geomtype + + if (lrank == 0) then + call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & + 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 = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) + if (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 = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) + if (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 = ESMF_FAILURE + return + endif + + endif ! status + + if (present(rank)) then + rank = lrank + endif + + end subroutine field_getfldptr + +!=============================================================================== + + subroutine alarmInit( clock, alarm, option, & + opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) + + ! Setup an alarm in a clock + ! 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. + + ! input/output variables + type(ESMF_Clock) , intent(inout) :: clock ! clock + type(ESMF_Alarm) , intent(inout) :: alarm ! alarm + character(len=*) , intent(in) :: option ! alarm option + integer , optional , intent(in) :: opt_n ! alarm freq + integer , optional , intent(in) :: opt_ymd ! alarm ymd + integer , 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 variables + type(ESMF_Calendar) :: cal ! calendar + integer :: lymd ! local ymd + integer :: ltod ! local tod + integer :: cyy,cmm,cdd,csec ! 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 + integer :: sec + character(len=*), parameter :: subname = '(set_alarmInit): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lalarmname = 'alarm_unknown' + if (present(alarmname)) lalarmname = trim(alarmname) + ltod = 0 + if (present(opt_tod)) ltod = opt_tod + lymd = -1 + if (present(opt_ymd)) lymd = opt_ymd + + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) + if (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 + + ! Determine calendar + call ESMF_ClockGet(clock, calendar=cal) + + ! Determine inputs for call to create alarm + selectcase (trim(option)) + + case (optNONE) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optNever) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optDate) + if (.not. present(opt_ymd)) then + call shr_sys_abort(subname//trim(option)//' requires opt_ymd') + end if + if (lymd < 0 .or. ltod < 0) then + call shr_sys_abort(subname//trim(option)//'opt_ymd, opt_tod invalid') + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call timeInit(NextAlarm, lymd, cal, ltod, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optIfdays0) + if (.not. present(opt_ymd)) then + call shr_sys_abort(subname//trim(option)//' requires opt_ymd') + end if + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case (optNSteps) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (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(clock, TimeStep=AlarmInterval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSeconds) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSecond) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinutes) + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinute) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHours) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHour) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDays) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDay) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonths) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonth) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optMonthly) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case (optNYears) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNYear) + if (.not.present(opt_n)) then + call shr_sys_abort(subname//trim(option)//' requires opt_n') + end if + if (opt_n <= 0) then + call shr_sys_abort(subname//trim(option)//' invalid opt_n') + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optYearly) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + 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 + + alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & + ringInterval=AlarmInterval, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + end subroutine alarmInit + +!=============================================================================== + + subroutine timeInit( Time, ymd, cal, tod, rc) + + ! 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) :: Time ! ESMF time + integer , intent(in) :: ymd ! year, month, day YYYYMMDD + type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar + integer , intent(in) :: tod ! time of day in seconds + integer , intent(out) :: rc + + ! local variables + integer :: year, mon, day ! year, month, day as integers + integer :: tdate ! temporary date + integer :: date ! coded-date (yyyymmdd) + character(len=*), parameter :: subname='(timeInit)' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + if ( (ymd < 0) .or. (tod < 0) .or. (tod > SecPerDay) )then + call shr_sys_abort( subname//'ERROR yymmdd is a negative number or time-of-day out of bounds' ) + end if + + tdate = abs(date) + year = int(tdate/10000) + if (date < 0) year = -year + mon = int( mod(tdate,10000)/ 100) + day = mod(tdate, 100) + + call ESMF_TimeSet( Time, yy=year, mm=mon, dd=day, s=tod, calendar=cal, rc=rc ) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + end subroutine timeInit + +!=============================================================================== + + logical function chkerr(rc, line, file) + + integer, intent(in) :: rc + integer, intent(in) :: line + character(len=*), intent(in) :: file + + integer :: lrc + + chkerr = .false. + lrc = rc + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + chkerr = .true. + endif + end function chkerr + +!=============================================================================== + +end module dead_methods_mod diff --git a/cime/src/components/xcpl_comps/xshare/nuopc/dead_nuopc_mod.F90 b/cime/src/components/xcpl_comps/xshare/nuopc/dead_nuopc_mod.F90 index 8872275aad2a..981113760082 100644 --- a/cime/src/components/xcpl_comps/xshare/nuopc/dead_nuopc_mod.F90 +++ b/cime/src/components/xcpl_comps/xshare/nuopc/dead_nuopc_mod.F90 @@ -1,15 +1,16 @@ module dead_nuopc_mod - 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(+) - + 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, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMBroadcast, ESMF_VMGet + use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VmGet + use ESMF , only : operator(/=), operator(==), operator(+) + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_sys_mod , only : shr_sys_abort + use dead_methods_mod , only : chkerr, alarmInit implicit none private @@ -50,8 +51,6 @@ module dead_nuopc_mod subroutine dead_read_inparms(model, inst_suffix, logunit, & nxg, nyg, decomp_type, nproc_x, seg_len) - use ESMF, only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMBroadcast, ESMF_VMGet - ! input/output variables character(len=*) , intent(in) :: model character(len=*) , intent(in) :: inst_suffix ! char string associated with instance @@ -134,7 +133,6 @@ subroutine dead_setNewGrid(decomp_type, nxg, nyg, logunit, lsize, gbuf, seg_len, ! 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: @@ -393,8 +391,6 @@ subroutine dead_final_nuopc(model, logunit) ! 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 @@ -425,8 +421,6 @@ end subroutine dead_final_nuopc subroutine fld_list_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound) - use ESMF, only : ESMF_LogWrite, ESMF_LOGMSG_ERROR - ! input/output variables integer , intent(inout) :: num type(fld_list_type) , intent(inout) :: fldlist(:) @@ -478,7 +472,7 @@ subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scal type(ESMF_Field) :: field character(len=80) :: stdname integer :: gridtoFieldMap=2 - character(len=*),parameter :: subname='(dshr_nuopc_mod:fld_list_realize)' + character(len=*),parameter :: subname='(dead_nuopc_mod:fld_list_realize)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -540,7 +534,7 @@ subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) ! local variables type(ESMF_Distgrid) :: distgrid type(ESMF_Grid) :: grid - character(len=*), parameter :: subname='(dshr_nuopc_mod:SetScalarField)' + character(len=*), parameter :: subname='(dead_nuopc_mod:SetScalarField)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -584,7 +578,6 @@ end subroutine ModelInitPhase subroutine ModelSetRunClock(gcomp, rc) - use shr_nuopc_time_mod , only : shr_nuopc_time_alarmInit use ESMF , only : ESMF_ClockGetAlarmList, ESMF_ALARMLIST_ALL use NUOPC_Model , only : NUOPC_ModelGet use NUOPC , only : NUOPC_CompAttributeGet @@ -605,7 +598,7 @@ subroutine ModelSetRunClock(gcomp, rc) type(ESMF_ALARM) :: restart_alarm character(len=128) :: name integer :: alarmcount - character(len=*),parameter :: subname='dshr_nuopc_mod:(ModelSetRunClock) ' + character(len=*),parameter :: subname='dead_nuopc_mod:(ModelSetRunClock) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS @@ -653,7 +646,7 @@ subroutine ModelSetRunClock(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) restart_ymd - call shr_nuopc_time_alarmInit(mclock, restart_alarm, restart_option, & + call alarmInit(mclock, restart_alarm, restart_option, & opt_n = restart_n, & opt_ymd = restart_ymd, & RefTime = mcurrTime, & @@ -687,13 +680,12 @@ subroutine dead_meshinit(gcomp, nx_global, ny_global, gindex, lon, lat, Emesh, r ! 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 + 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 @@ -730,7 +722,7 @@ subroutine dead_meshinit(gcomp, nx_global, ny_global, gindex, lon, lat, Emesh, r integer :: sendData(1) type(ESMF_VM) :: vm integer :: petCount - character(len=*),parameter :: subname='(shr_nuopc_grid_MeshInit)' + character(len=*),parameter :: subname='(dead_MeshInit)' !-------------------------------------------------------------- rc = ESMF_SUCCESS diff --git a/cime/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 b/cime/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 index 331ca704e378..5e59effb785a 100644 --- a/cime/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 +++ b/cime/src/components/xcpl_comps/xwav/nuopc/wav_comp_nuopc.F90 @@ -5,28 +5,22 @@ module wav_comp_nuopc !---------------------------------------------------------------------------- use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - use NUOPC_Model , only : model_routine_SS => SetServices - use NUOPC_Model , only : model_label_Advance => label_Advance - 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, CL, CS - use med_constants_mod , only : shr_file_getlogunit, shr_file_setlogunit - 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 - 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_State_SetScalar - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_Diagnose - 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_final_nuopc, dead_meshinit - use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - use dead_nuopc_mod , only : ModelInitPhase, ModelSetRunClock - use med_constants_mod , only : dbug => med_constants_dbug_flag + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise + use NUOPC_Model , only : model_routine_SS => SetServices + use NUOPC_Model , only : model_label_Advance => label_Advance + 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 shr_sys_mod , only : shr_sys_abort + use shr_kind_mod , only : r8=>shr_kind_r8, i8=>shr_kind_i8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_file_mod , only : shr_file_getlogunit, shr_file_setlogunit + use dead_methods_mod , only : chkerr, state_setscalar, state_diagnose, alarmInit, memcheck + use dead_methods_mod , only : set_component_logging, get_component_instance, log_clock_advance + use dead_nuopc_mod , only : dead_grid_lat, dead_grid_lon, dead_grid_index + 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 : ModelInitPhase, ModelSetRunClock implicit none private ! except @@ -37,24 +31,32 @@ module wav_comp_nuopc ! Private module data !-------------------------------------------------------------------------- - integer :: fldsToWav_num = 0 - integer :: fldsFrWav_num = 0 - type (fld_list_type) :: fldsToWav(fldsMax) - type (fld_list_type) :: fldsFrWav(fldsMax) - integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost - - 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=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 - logical :: mastertask - character(*),parameter :: modName = "(xwav_comp_nuopc)" - character(*),parameter :: u_FILE_u = & + character(len=CL) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_nextsw_cday = 0 + + integer :: fldsToWav_num = 0 + integer :: fldsFrWav_num = 0 + type (fld_list_type) :: fldsToWav(fldsMax) + type (fld_list_type) :: fldsFrWav(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_suffix = "" ! char string associated with instance (ie. "_0001" or "") + integer :: logunit ! logging unit number + logical :: mastertask + integer :: dbug = 1 + character(*),parameter :: modName = "(xwav_comp_nuopc)" + character(*),parameter :: u_FILE_u = & __FILE__ !=============================================================================== @@ -111,9 +113,6 @@ 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 @@ -121,13 +120,14 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - integer :: n - type(ESMF_VM) :: vm - character(CS) :: stdname - 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 + type(ESMF_VM) :: vm + character(CS) :: stdname + integer :: n + integer :: lsize ! local array size + integer :: shrlogunit ! original log unit + character(CL) :: cvalue + character(len=CL) :: logmsg + logical :: isPresent, isSet character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' !------------------------------------------------------------------------------- @@ -147,14 +147,15 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! determine instance information !--------------------------------------------------------------------------- - call shr_nuopc_get_component_instance(gcomp, inst_suffix, inst_index) - inst_name = "WAV"//trim(inst_suffix) + call get_component_instance(gcomp, inst_suffix, inst_index, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! set logunit and set shr logging to my log file !---------------------------------------------------------------------------- - call shr_nuopc_set_component_logging(gcomp, mastertask, logunit, shrlogunit) + call set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------------------------------------------------- ! Initialize xwav @@ -174,6 +175,49 @@ subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) ! advertise import and export fields !-------------------------------- + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldName') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(logmsg,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldCount') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(logmsg,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNX') + endif + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(logmsg,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(logmsg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + call shr_sys_abort(subname//'Need to set attribute ScalarFieldIdxGridNY') + endif + if (nxg /= 0 .and. nyg /= 0) then call fld_list_add(fldsFrWav_num, fldsFrWav, trim(flds_scalar_name)) @@ -282,14 +326,14 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Pack export state !-------------------------------- - call state_setexport(exportState, rc=rc) + 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, & + call State_SetScalar(dble(nxg),flds_scalar_index_nx, exportState, & flds_scalar_name, flds_scalar_num, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & + call State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & flds_scalar_name, flds_scalar_num, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -298,7 +342,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) !-------------------------------- if (dbug > 1) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + call State_diagnose(exportState,subname//':ES',rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return endif @@ -325,8 +369,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 type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -339,8 +382,10 @@ subroutine ModelAdvance(gcomp, rc) rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - call shr_nuopc_memcheck(subname, 3, mastertask) + if (dbug > 5) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) + end if + call memcheck(subname, 3, mastertask) call shr_file_getLogUnit (shrlogunit) call shr_file_setLogUnit (logunit) @@ -360,16 +405,19 @@ subroutine ModelAdvance(gcomp, rc) !-------------------------------- if (dbug > 1) then - call shr_nuopc_methods_State_diagnose(exportState,subname//':ES',rc=rc) + call State_diagnose(exportState,subname//':ES',rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if ( mastertask) then - call shr_nuopc_log_clock_advance(clock, 'WAV', logunit) + call log_clock_advance(clock, 'XWAV', logunit, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return endif endif call shr_file_setLogUnit (shrlogunit) - 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 diff --git a/cime/src/drivers/mct/cime_config/buildnml b/cime/src/drivers/mct/cime_config/buildnml index bc89fb435948..5606438fabe4 100755 --- a/cime/src/drivers/mct/cime_config/buildnml +++ b/cime/src/drivers/mct/cime_config/buildnml @@ -51,6 +51,7 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): config['bfbflag'] = 'on' if case.get_value('BFBFLAG') else 'off' config['continue_run'] = '.true.' if case.get_value('CONTINUE_RUN') else '.false.' config['atm_grid'] = case.get_value('ATM_GRID') + config['compocn'] = case.get_value('COMP_OCN') if case.get_value('RUN_TYPE') == 'startup': config['run_type'] = 'startup' diff --git a/cime/src/drivers/nuopc/cime_config/ExpectedTestFails.xml b/cime/src/drivers/nuopc/cime_config/ExpectedTestFails.xml new file mode 100644 index 000000000000..4fe446eb3b2b --- /dev/null +++ b/cime/src/drivers/nuopc/cime_config/ExpectedTestFails.xml @@ -0,0 +1,57 @@ + + + + + + + + + + + + FAIL + Mom restarts are offset + + + + + FAIL + Mom restarts are offset + + + + + FAIL + Mom restarts are offset + + + + + FAIL + Debug run fails due to esmf issue + + + diff --git a/cime/src/drivers/nuopc/cime_config/buildexe b/cime/src/drivers/nuopc/cime_config/buildexe index e9a4eaa61131..79d73c310191 100755 --- a/cime/src/drivers/nuopc/cime_config/buildexe +++ b/cime/src/drivers/nuopc/cime_config/buildexe @@ -31,7 +31,7 @@ def _main_func(): exeroot = case.get_value("EXEROOT") gmake = case.get_value("GMAKE") gmake_j = case.get_value("GMAKE_J") - model = case.get_value("MODEL") + cime_model = case.get_value("MODEL") num_esp = case.get_value("NUM_COMP_INST_ESP") ocn_model = case.get_value("COMP_OCN") atm_model = case.get_value("COMP_ATM") @@ -40,18 +40,31 @@ def _main_func(): if ocn_model == 'mom' or atm_model == "fv3gfs": gmake_args += "USE_FMS=TRUE" + comp_classes = case.get_values("COMP_CLASSES") + cppdefs = "" + ulibdep = "" + for comp in comp_classes: + model = case.get_value("COMP_{}".format(comp)) + stubcomp = "s{}".format(comp.lower()) + if model and model != stubcomp and comp != "CPL": + cppdefs += "-D{}_PRESENT ".format(comp) + if comp == "LND": + ulibdep += r"\$(LNDLIBDIR)/\$(LNDLIB) " + else: + ulibdep += r"\$(LIBROOT)/lib{}.a ".format(comp.lower()) + gmake_args += " USER_CPPDEFS=\"{}\" ULIBDEP=\"{}\"".format(cppdefs,ulibdep) + expect((num_esp is None) or (int(num_esp) == 1), "ESP component restricted to one instance") with open('Filepath', 'w') as out: out.write(os.path.join(caseroot, "SourceMods", "src.drv") + "\n") out.write(os.path.join(cimeroot, "src", "drivers", "nuopc", "cime_driver") + "\n") - out.write(os.path.join(cimeroot, "src", "drivers", "nuopc", "cime_flds") + "\n") - out.write(os.path.join(cimeroot, "src", "drivers", "nuopc", "mediator") + "\n") + out.write(os.path.join(cimeroot, "src", "drivers", "nuopc", "mediator") + "\n") # mediator # build model executable makefile = os.path.join(casetools, "Makefile") - exename = os.path.join(exeroot, model + ".exe") + exename = os.path.join(exeroot, cime_model + ".exe") # always relink if os.path.isfile(exename): os.remove(exename) diff --git a/cime/src/drivers/nuopc/cime_config/buildnml b/cime/src/drivers/nuopc/cime_config/buildnml index 0acc9c4ea7d4..2716b29befb6 100755 --- a/cime/src/drivers/nuopc/cime_config/buildnml +++ b/cime/src/drivers/nuopc/cime_config/buildnml @@ -72,6 +72,11 @@ def _create_drv_namelists(case, infile, confdir, nmlgen, files): #---------------------------------------------------- nmlgen.init_defaults(infile, config) + if case.get_value('MEDIATOR_READ_RESTART'): + nmlgen.set_value('mediator_read_restart', value='.true.') + else: + nmlgen.set_value('mediator_read_restart', value='.false.') + #-------------------------------- # Overwrite: set brnch_retain_casename #-------------------------------- @@ -363,7 +368,7 @@ def _create_runseq(case, coupling_times): elif (comp_atm == 'fv3gfs' and comp_ocn == "mom" and comp_ice == 'cice'): # for NEMS fully coupled - if case.get_value("CONTINUE_RUN"): + if case.get_value("CONTINUE_RUN") or case.get_value("MEDIATOR_READ_RESTART"): logger.info("NUOPC run sequence: warm start (concurrent)") runseq_input = os.path.join(input_dir, 'nuopc_runseq_NEMS.warm') else: @@ -540,7 +545,7 @@ def buildnml(case, caseroot, component): # copy fd.yaml to rundir cimeroot = case.get_value("CIMEROOT") - fd_dir = os.path.join(cimeroot, "src","drivers","nuopc","cime_flds") + fd_dir = os.path.join(cimeroot, "src","drivers","nuopc","mediator") filename = os.path.join(fd_dir,"fd.yaml") shutil.copy(filename, rundir) diff --git a/cime/src/drivers/nuopc/cime_config/config_component.xml b/cime/src/drivers/nuopc/cime_config/config_component.xml index 0ff2d12b7b0a..b090350ab717 100644 --- a/cime/src/drivers/nuopc/cime_config/config_component.xml +++ b/cime/src/drivers/nuopc/cime_config/config_component.xml @@ -465,6 +465,17 @@ + + logical + TRUE,FALSE + FALSE + run_begin_stop_restart + env_run.xml + + A setting of TRUE implies a continuation run for mediator only + + + integer 0 diff --git a/cime/src/drivers/nuopc/cime_config/namelist_definition_drv.xml b/cime/src/drivers/nuopc/cime_config/namelist_definition_drv.xml index 0dd42ec7c1b8..6765055b4c43 100644 --- a/cime/src/drivers/nuopc/cime_config/namelist_definition_drv.xml +++ b/cime/src/drivers/nuopc/cime_config/namelist_definition_drv.xml @@ -8,15 +8,6 @@ - - char - nuopc - nuopc_var - - ATM OCN ICE LND ROF GLC WAV MED - - - char nuopc @@ -37,16 +28,6 @@ - - char - nuopc - nuopc_var - - cesm - e3sm - - - char nuopc @@ -56,15 +37,6 @@ - - char - nuopc - nuopc_var - - $COMP_ATM - - - char nuopc @@ -74,15 +46,6 @@ - - char - nuopc - nuopc_var - - $COMP_OCN - - - char nuopc @@ -92,15 +55,6 @@ - - char - nuopc - nuopc_var - - $COMP_ICE - - - char nuopc @@ -110,15 +64,6 @@ - - char - nuopc - nuopc_var - - $COMP_ROF - - - char nuopc @@ -128,15 +73,6 @@ - - char - nuopc - nuopc_var - - $COMP_LND - - - char nuopc @@ -146,15 +82,6 @@ - - char - nuopc - nuopc_var - - $COMP_GLC - - - char nuopc @@ -164,15 +91,6 @@ - - char - nuopc - nuopc_var - - $COMP_WAV - - - char nuopc @@ -561,6 +479,83 @@ + + char + nuopc + nuopc_var + + Model components that are active + + + ATM OCN ICE LND ROF GLC WAV MED + + + + + char + nuopc + ALLCOMP_attributes + + cesm + + + + char + nuopc + ALLCOMP_attributes + + $COMP_ATM + + + + char + nuopc + ALLCOMP_attributes + + $COMP_OCN + + + + char + nuopc + ALLCOMP_attributes + + $COMP_ICE + + + + char + nuopc + ALLCOMP_attributes + + $COMP_ROF + + + + char + nuopc + ALLCOMP_attributes + + $COMP_LND + + + + char + nuopc + ALLCOMP_attributes + + $COMP_GLC + + + + char + nuopc + ALLCOMP_attributes + + $COMP_WAV + + + char expdef @@ -592,6 +587,15 @@ + + logical + expdef + DRIVER_attributes + + only have the mediator reads the restart file regardless of start type + + + char expdef @@ -1542,13 +1546,6 @@ n - - integer expdef @@ -1557,7 +1554,8 @@ n total number of scalars in the scalar coupling field - 15 + 3 + 4 @@ -1585,6 +1583,31 @@ n + + integer + expdef + ALLCOMP_attributes + + index of scalar containing calendar day of nextsw computation from atm + + + 3 + + + + + integer + expdef + ALLCOMP_attributes + + index of scalar containing epbal precipitation factor from ocn (only for POP) + + + 0 + 4 + + + char mapping diff --git a/cime/src/drivers/nuopc/cime_config/testdefs/testlist_drv.xml b/cime/src/drivers/nuopc/cime_config/testdefs/testlist_drv.xml index 6dd429799771..baf60122f432 100644 --- a/cime/src/drivers/nuopc/cime_config/testdefs/testlist_drv.xml +++ b/cime/src/drivers/nuopc/cime_config/testdefs/testlist_drv.xml @@ -58,7 +58,7 @@ - + @@ -68,7 +68,7 @@ - + @@ -78,7 +78,7 @@ - + @@ -88,7 +88,7 @@ - + @@ -144,7 +144,7 @@ - + @@ -154,7 +154,7 @@ - + @@ -266,7 +266,7 @@ - + @@ -276,7 +276,7 @@ - + @@ -286,7 +286,7 @@ - + @@ -296,7 +296,7 @@ - + @@ -352,7 +352,7 @@ - + @@ -362,7 +362,7 @@ - + diff --git a/cime/src/drivers/nuopc/cime_driver/ensemble_driver.F90 b/cime/src/drivers/nuopc/cime_driver/ensemble_driver.F90 index 1b78f6f4b113..a5ac49cffb81 100644 --- a/cime/src/drivers/nuopc/cime_driver/ensemble_driver.F90 +++ b/cime/src/drivers/nuopc/cime_driver/ensemble_driver.F90 @@ -6,9 +6,12 @@ module Ensemble_driver ! length of stop_time - start_time. It's purpose is to instantiate NINST copies of the ! esm driver and its components layed out concurently across mpi tasks. !----------------------------------------------------------------------------- - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag, CL - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + + use shr_kind_mod , only : cl=>shr_kind_cl + use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : mastertask + implicit none private @@ -22,12 +25,14 @@ module Ensemble_driver !================================================================================ subroutine SetServices(ensemble_driver, rc) + use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSpecialize use NUOPC_Driver , only : driver_routine_SS => SetServices use NUOPC_Driver , only : ensemble_label_SetModelServices => label_SetModelServices use ESMF , only : ESMF_GridComp, ESMF_Config, ESMF_GridCompSet, ESMF_ConfigLoadFile use ESMF , only : ESMF_ConfigCreate use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO + type(ESMF_GridComp) :: ensemble_driver integer, intent(out) :: rc @@ -44,22 +49,22 @@ subroutine SetServices(ensemble_driver, rc) ! NUOPC_Driver registers the generic methods call NUOPC_CompDerive(ensemble_driver, driver_routine_SS, 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(ensemble_driver, specLabel=ensemble_label_SetModelServices, & specRoutine=SetModelServices, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Create, open and set the config config = ESMF_ConfigCreate(rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_ConfigLoadFile(config, "nuopc.runconfig", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_GridCompSet(ensemble_driver, config=config, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) @@ -127,30 +132,30 @@ subroutine SetModelServices(ensemble_driver, rc) endif call ESMF_GridCompGet(ensemble_driver, config=config, 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=localPet, PetCount=PetCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !------------------------------------------- ! Initialize clocks !------------------------------------------- call ReadAttributes(ensemble_driver, config, "ALLCOMP_attributes::", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(ensemble_driver, config, "CLOCK_attributes::", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(ensemble_driver, config, "PELAYOUT_attributes::", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(ensemble_driver, name="cpl_rootpe", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) cpl_rootpe ! Check valid values of start type call NUOPC_CompAttributeGet(ensemble_driver, name="start_type", value=start_type, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if ((trim(start_type) /= start_type_start) .and. & (trim(start_type) /= start_type_cont ) .and. & @@ -161,9 +166,9 @@ subroutine SetModelServices(ensemble_driver, rc) end if call InitRestart(ensemble_driver, read_restart, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(ensemble_driver, name="ninst", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue, *) number_of_members !------------------------------------------- ! Extract the config object from the ensemble_driver @@ -179,7 +184,7 @@ subroutine SetModelServices(ensemble_driver, rc) allocate(petList(ntasks_per_member)) call NUOPC_CompAttributeGet(ensemble_driver, name='cpl_rootpe', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue, *) rootpe_med do inst=1,number_of_members @@ -190,38 +195,38 @@ subroutine SetModelServices(ensemble_driver, rc) enddo write(drvrinst,'(a,i4.4)') "ESM",inst call NUOPC_DriverAddComp(ensemble_driver, drvrinst, ESMSetServices, petList=petList, comp=gridcomptmp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (localpet >= petlist(1) .and. localpet <= petlist(ntasks_per_member)) then driver = gridcomptmp if(number_of_members > 1) then call NUOPC_CompAttributeAdd(driver, attrList=(/'inst_suffix'/), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return write(inst_suffix,'(a,i4.4)') '_',inst call NUOPC_CompAttributeSet(driver, name='inst_suffix', value=inst_suffix, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return else inst_suffix = '' endif write(cvalue,*) read_restart call NUOPC_CompAttributeAdd(driver, attrList=(/'read_restart'/), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(cvalue), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(driver, config, "MED_attributes::", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(driver, config, "CLOCK_attributes::", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(driver, config, "MED_modelio"//trim(inst_suffix)//"::", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Set the mediator log to the MED task 0 if (mod(localPet,ntasks_per_member)==cpl_rootpe) then call NUOPC_CompAttributeGet(driver, name="diro", value=diro, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(driver, name="logfile", value=logfile, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return logunit = shr_file_getUnit() open(logunit,file=trim(diro)//"/"//trim(logfile)) mastertask = .true. @@ -235,7 +240,7 @@ subroutine SetModelServices(ensemble_driver, rc) endif enddo call shr_nuopc_time_clockInit(ensemble_driver, driver, logunit, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return deallocate(petList) @@ -283,7 +288,7 @@ subroutine InitRestart(ensemble_driver, read_restart, rc) ! First Determine if restart is read call NUOPC_CompAttributeGet(ensemble_driver, name='start_type', value=start_type, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Check valid values of start type @@ -303,15 +308,15 @@ subroutine InitRestart(ensemble_driver, read_restart, rc) ! Add rest_case_name and read_restart to ensemble_driver attributes call NUOPC_CompAttributeAdd(ensemble_driver, attrList=(/'rest_case_name','read_restart'/), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return rest_case_name = ' ' call NUOPC_CompAttributeSet(ensemble_driver, name='rest_case_name', value=rest_case_name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return write(cvalue,*) read_restart call NUOPC_CompAttributeSet(ensemble_driver, name='read_restart', value=trim(cvalue), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine InitRestart diff --git a/cime/src/drivers/nuopc/cime_driver/esm.F90 b/cime/src/drivers/nuopc/cime_driver/esm.F90 index 6e966ee20c69..8dba1506c633 100644 --- a/cime/src/drivers/nuopc/cime_driver/esm.F90 +++ b/cime/src/drivers/nuopc/cime_driver/esm.F90 @@ -5,25 +5,14 @@ module ESM !----------------------------------------------------------------------------- use ESMF , only : ESMF_Clock - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use shr_kind_mod , only : r8=>shr_kind_r8, cl=>shr_kind_cl, cs=>shr_kind_cs + use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr use shr_nuopc_utils_mod , only : shr_nuopc_memcheck - use shr_kind_mod , only : SHR_KIND_R8, SHR_KIND_CS, SHR_KIND_CL - use shr_log_mod , only : shr_log_Unit, shr_log_Level - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use med_internalstate_mod , only : logunit, loglevel, mastertask, med_id implicit none private - character(len=512) :: msgstr - integer :: componentCount - character(len=8) :: atm_present, lnd_present, ocn_present - character(len=8) :: ice_present, rof_present, wav_present - character(len=8) :: glc_present, med_present - character(*), parameter :: nlfilename = "drv_in" ! input namelist filename - character(*), parameter :: u_FILE_u = & - __FILE__ - public :: SetServices public :: ReadAttributes ! used in ensemble_driver @@ -40,6 +29,9 @@ module ESM private :: esm_finalize private :: pretty_print_nuopc_freeformat + character(*), parameter :: u_FILE_u = & + __FILE__ + !================================================================================ contains !================================================================================ @@ -60,33 +52,30 @@ subroutine SetServices(driver, rc) integer, intent(out) :: rc ! local variables - integer :: dbrc type(ESMF_Config) :: runSeq character(len=*), parameter :: subname = "(esm.F90:SetServices)" !--------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) ! NUOPC_Driver registers the generic methods call NUOPC_CompDerive(driver, driver_routine_SS, 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(driver, specLabel=driver_label_SetModelServices, & specRoutine=SetModelServices, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompSpecialize(driver, specLabel=driver_label_SetRunSequence, & specRoutine=SetRunSequence, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! register an internal initialization method call NUOPC_CompSetInternalEntryPoint(driver, ESMF_METHOD_INITIALIZE, & phaseLabelList=(/"IPDv03p2"/), userRoutine=ModifyCplLists, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! ! This prevents the driver trying to "auto" connect to the ensemble_driver @@ -94,21 +83,19 @@ subroutine SetServices(driver, rc) ! call NUOPC_CompSetInternalEntryPoint(driver, ESMF_METHOD_INITIALIZE, & phaseLabelList=(/"IPDv05p1"/), userRoutine=InitAdvertize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Set a finalize method call NUOPC_CompSpecialize(driver, specLabel=driver_label_Finalize, & specRoutine=esm_finalize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Create, open and set the config call ESMF_GridCompSet(driver, configFile="nuopc.runconfig", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine SetServices @@ -131,40 +118,34 @@ subroutine SetModelServices(driver, rc) use shr_nuopc_methods_mod , only : shr_nuopc_methods_Clock_TimePrint use shr_file_mod , only : shr_file_setLogunit, shr_file_getunit - use med , only : med_SS => SetServices - use atm_comp_nuopc , only : ATMSetServices => SetServices - use ice_comp_nuopc , only : ICESetServices => SetServices - use lnd_comp_nuopc , only : LNDSetServices => SetServices - use ocn_comp_nuopc , only : OCNSetServices => SetServices - use wav_comp_nuopc , only : WAVSetServices => SetServices - use rof_comp_nuopc , only : ROFSetServices => SetServices - use glc_comp_nuopc , only : GLCSetServices => SetServices use pio , only : pio_file_is_open, pio_closefile, file_desc_t use perf_mod , only : t_initf use shr_mem_mod , only : shr_mem_init + use shr_file_mod , only : shr_file_setLogunit, shr_file_getunit use shr_log_mod , only : shrlogunit=> shr_log_unit + use shr_nuopc_methods_mod , only : shr_nuopc_methods_Clock_TimePrint ! input/output variables type(ESMF_GridComp) :: driver integer, intent(out) :: rc ! local variables - type(ESMF_VM) :: vm - type(ESMF_Config) :: config - integer :: n, i, stat - character(len=20) :: model, prefix - integer :: localPet, medpet - character(SHR_KIND_CL) :: meminitStr - integer :: global_comm - integer :: maxthreads - integer :: dbrc + type(ESMF_VM) :: vm + type(ESMF_Config) :: config + integer :: n, i, stat + character(len=20) :: model, prefix + integer :: localPet, medpet + character(len=CL) :: meminitStr + integer :: global_comm + integer :: maxthreads + character(len=CL) :: msgstr + integer :: componentcount character(len=*), parameter :: subname = "(esm.F90:SetModelServices)" !------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + !------------------------------------------- ! Set the io logunit to the value defined in ensemble_driver ! it may be corrected below if the med mastertask is not the driver mastertask @@ -176,20 +157,20 @@ subroutine SetModelServices(driver, rc) !------------------------------------------- call ESMF_GridCompGet(driver, vm=vm, config=config, 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=localPet, mpiCommunicator=global_comm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !------------------------------------------- ! determine the generic component labels !------------------------------------------- - componentCount = ESMF_ConfigGetLen(config,label="CESM_component_list:", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + componentCount = ESMF_ConfigGetLen(config,label="component_list:", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return if (componentCount == 0) then - write (msgstr, *) "No models were specified in CESM_component_list " + write (msgstr, *) "No models were specified in component_list " call ESMF_LogSetError(ESMF_RC_NOT_VALID, msg=msgstr, line=__LINE__, file=__FILE__, rcToReturn=rc) return ! bail out endif @@ -199,36 +180,36 @@ subroutine SetModelServices(driver, rc) !------------------------------------------- call ReadAttributes(driver, config, "DRIVER_attributes::", formatprint=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(driver, config, "FLDS_attributes::", formatprint=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(driver, config, "CLOCK_attributes::", formatprint=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(driver, config, "ALLCOMP_attributes::", formatprint=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(driver, config, "PELAYOUT_attributes::", formatprint=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call CheckAttributes(driver, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !------------------------------------------- ! Initialize other attributes (after initializing driver clock) !------------------------------------------- call InitAttributes(driver, mastertask, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !------------------------------------------- ! Initialize component pe layouts !------------------------------------------- call esm_init_pelayout(driver, maxthreads, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Print out present flags to mediator log file if (mastertask) then @@ -236,21 +217,13 @@ subroutine SetModelServices(driver, rc) call shr_mem_init(strbuf=meminitstr) write(logunit,*) trim(meminitstr) - write(logunit,*) trim(subname)//":atm_present="//trim(atm_present) - write(logunit,*) trim(subname)//":lnd_present="//trim(lnd_present) - write(logunit,*) trim(subname)//":ocn_present="//trim(ocn_present) - write(logunit,*) trim(subname)//":ice_present="//trim(ice_present) - write(logunit,*) trim(subname)//":rof_present="//trim(rof_present) - write(logunit,*) trim(subname)//":wav_present="//trim(wav_present) - write(logunit,*) trim(subname)//":glc_present="//trim(glc_present) - write(logunit,*) trim(subname)//":med_present="//trim(med_present) end if !------------------------------------------- ! Timer initialization (has to be after pelayouts are determined) !------------------------------------------- - call t_initf(nlfilename, LogPrint=.true., mpicom=global_comm, & + call t_initf('drv_in', LogPrint=.true., mpicom=global_comm, & mastertask=mastertask, MaxThreads=maxthreads) !------------------------------------------- @@ -258,11 +231,9 @@ subroutine SetModelServices(driver, rc) !------------------------------------------- call InitRestart(driver, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine SetModelServices @@ -287,14 +258,11 @@ subroutine SetRunSequence(driver, rc) integer :: localrc type(ESMF_Config) :: runSeq type(NUOPC_FreeFormat) :: runSeqFF - integer :: dbrc character(len=*), parameter :: subname = "(esm.F90:SetRunSequence)" !--------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) !-------- ! Run Sequence and Connectors @@ -303,16 +271,16 @@ subroutine SetRunSequence(driver, rc) ! read free format run sequence runSeq = ESMF_ConfigCreate(rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_ConfigLoadFile(runSeq, "nuopc.runseq", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return runSeqFF = NUOPC_FreeFormatCreate(runSeq, label="runSeq::", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_DriverIngestRunSequence(driver, runSeqFF, autoAddConnectors=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Uncomment these to add debugging information for driver ! call NUOPC_DriverPrint(driver, orderflag=.true.) @@ -322,14 +290,12 @@ subroutine SetRunSequence(driver, rc) ! return ! bail out ! call pretty_print_nuopc_freeformat(runSeqFF, 'run sequence', rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_FreeFormatDestroy(runSeqFF, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine SetRunSequence @@ -342,12 +308,13 @@ subroutine pretty_print_nuopc_freeformat(ffstuff, label, rc) ! input/output variables type(NUOPC_FreeFormat) , intent(in) :: ffstuff - character(len=*) :: label + character(len=*) , intent(in) :: label integer , intent(out) :: rc ! local variables integer :: i integer :: linecnt + integer :: dbug_flag = 5 character(len=NUOPC_FreeFormatLen), pointer :: outstr(:) !--------------------------------------- @@ -356,10 +323,10 @@ subroutine pretty_print_nuopc_freeformat(ffstuff, label, rc) if (mastertask .or. dbug_flag > 3) then write(logunit, *) 'BEGIN: ', trim(label) call NUOPC_FreeFormatGet(ffstuff, linecount=linecnt, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(outstr(linecnt)) call NUOPC_FreeFormatGet(ffstuff, stringList=outstr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return do i=1,linecnt if(len_trim(outstr(i)) > 0) then write(logunit, *) trim(outstr(i)) @@ -385,40 +352,38 @@ recursive subroutine ModifyCplLists(driver, importState, exportState, clock, rc) type(ESMF_Clock) :: clock integer, intent(out) :: rc - type(ESMF_CplComp), pointer :: connectorList(:) - integer :: i, j, cplListSize - character(len=160), allocatable :: cplList(:) - character(len=160) :: tempString - integer :: dbrc - character(len=*), parameter :: subname = "(esm.F90:ModifyCplLists)" + type(ESMF_CplComp), pointer :: connectorList(:) + integer :: i, j, cplListSize + character(len=CL), allocatable :: cplList(:) + character(len=CL) :: tempString + character(len=CL) :: msgstr + character(len=*), parameter :: subname = "(esm.F90:ModifyCplLists)" !--------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) call ESMF_LogWrite("Driver is in ModifyCplLists()", ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return nullify(connectorList) call NUOPC_DriverGetComp(driver, compList=connectorList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return write (msgstr,*) "Found ", size(connectorList), " Connectors."// " Modifying CplList Attribute...." call ESMF_LogWrite(trim(msgstr), ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return do i=1, size(connectorList) ! query the cplList for connector i call NUOPC_CompAttributeGet(connectorList(i), name="CplList", itemCount=cplListSize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (cplListSize>0) then allocate(cplList(cplListSize)) call NUOPC_CompAttributeGet(connectorList(i), name="CplList", valueList=cplList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! go through all of the entries in the cplList and set the mapping method to "redist" do j=1, cplListSize @@ -431,7 +396,7 @@ recursive subroutine ModifyCplLists(driver, importState, exportState, clock, rc) ! store the modified cplList in CplList attribute of connector i call NUOPC_CompAttributeSet(connectorList(i), name="CplList", valueList=cplList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return deallocate(cplList) endif @@ -439,9 +404,7 @@ recursive subroutine ModifyCplLists(driver, importState, exportState, clock, rc) deallocate(connectorList) - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) end subroutine ModifyCplLists @@ -459,18 +422,19 @@ function IsRestart(gcomp, rc) integer , intent(out) :: rc ! locals + character(len=CL) :: start_type ! Type of startup + character(len=CL) :: msgstr character(len=*) , parameter :: start_type_start = "startup" character(len=*) , parameter :: start_type_cont = "continue" character(len=*) , parameter :: start_type_brnch = "branch" - character(SHR_KIND_CL) :: start_type ! Type of startup - character(len=*), parameter :: subname = "(esm.F90:IsRestart)" + character(len=*) , parameter :: subname = "(esm.F90:IsRestart)" !--------------------------------------- rc = ESMF_SUCCESS ! First Determine if restart is read call NUOPC_CompAttributeGet(gcomp, name='start_type', value=start_type, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if ((trim(start_type) /= start_type_start) .and. & (trim(start_type) /= start_type_cont ) .and. & @@ -508,35 +472,33 @@ subroutine InitRestart(driver, rc) integer , intent(out) :: rc ! local variables - character(SHR_KIND_CL) :: cvalue ! temporary - logical :: read_restart ! read the restart file, based on start_type - character(SHR_KIND_CL) :: rest_case_name ! Short case identification + logical :: read_restart ! read the restart file, based on start_type + character(len=CL) :: cvalue ! temporary + character(len=CL) :: rest_case_name ! Short case identification character(len=*) , parameter :: subname = "(esm.F90:InitRestart)" !------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) !----------------------------------------------------- ! Carry out restart if appropriate !----------------------------------------------------- read_restart = IsRestart(driver, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Add rest_case_name and read_restart to driver attributes call NUOPC_CompAttributeAdd(driver, attrList=(/'rest_case_name','read_restart'/), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return rest_case_name = ' ' call NUOPC_CompAttributeSet(driver, name='rest_case_name', value=rest_case_name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return write(cvalue,*) read_restart call NUOPC_CompAttributeSet(driver, name='read_restart', value=trim(cvalue), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine InitRestart @@ -569,58 +531,55 @@ subroutine InitAttributes(driver, mastertask, rc) integer , intent(out) :: rc ! return code ! local variables - type(ESMF_Clock) :: clock - type(ESMF_Time) :: currTime - character(SHR_KIND_CL) :: errstring - character(SHR_KIND_CL) :: cvalue - logical :: reprosum_use_ddpdd ! setup reprosum, use ddpdd - real(SHR_KIND_R8) :: reprosum_diffmax ! setup reprosum, set rel_diff_max - logical :: reprosum_recompute ! setup reprosum, recompute if tolerance exceeded - integer :: year ! Current date (YYYY) - character(SHR_KIND_CS) :: tfreeze_option ! Freezing point calculation - character(SHR_KIND_CL) :: orb_mode ! orbital mode - integer :: orb_iyear ! orbital year - integer :: orb_iyear_align ! associated with model year - integer :: orb_cyear ! orbital year for current orbital computation - integer :: orb_nyear ! orbital year associated with currrent model year - integer :: orbitmp(4) ! array for integer parameter broadcast - real(SHR_KIND_R8) :: orbrtmp(6) ! array for real parameter broadcast - real(SHR_KIND_R8) :: orb_eccen ! orbital eccentricity - real(SHR_KIND_R8) :: orb_obliq ! obliquity in degrees - real(SHR_KIND_R8) :: orb_mvelp ! moving vernal equinox long - real(SHR_KIND_R8) :: orb_obliqr ! Earths obliquity in rad - real(SHR_KIND_R8) :: orb_lambm0 ! Mean long of perihelion at vernal equinox (radians) - real(SHR_KIND_R8) :: orb_mvelpp ! moving vernal equinox long - real(SHR_KIND_R8) :: wall_time_limit ! wall time limit in hours - logical :: single_column ! scm mode logical - real(SHR_KIND_R8) :: scmlon ! single column lon - real(SHR_KIND_R8) :: scmlat ! single column lat - character(SHR_KIND_CS) :: wv_sat_scheme - real(SHR_KIND_R8) :: wv_sat_transition_start - logical :: wv_sat_use_tables - real(SHR_KIND_R8) :: wv_sat_table_spacing - type(ShrWVSatTableSpec) :: liquid_spec - type(ShrWVSatTableSpec) :: ice_spec - type(ShrWVSatTableSpec) :: mixed_spec - logical :: flag - integer :: i, it, n - integer :: unitn ! Namelist unit number to read - integer :: dbrc - integer :: localPet, rootpe_med - integer , parameter :: ens1=1 ! use first instance of ensemble only - integer , parameter :: fix1=1 ! temporary hard-coding to first ensemble, needs to be fixed - real(SHR_KIND_R8), parameter :: epsilo = shr_const_mwwv/shr_const_mwdair - character(len=*) , parameter :: orb_fixed_year = 'fixed_year' - character(len=*) , parameter :: orb_variable_year = 'variable_year' - character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' - character(len=*) , parameter :: subname = '(InitAttributes)' - + type(ESMF_Clock) :: clock + type(ESMF_Time) :: currTime + character(len=CL) :: errstring + character(len=CL) :: cvalue + logical :: reprosum_use_ddpdd ! setup reprosum, use ddpdd + real(R8) :: reprosum_diffmax ! setup reprosum, set rel_diff_max + logical :: reprosum_recompute ! setup reprosum, recompute if tolerance exceeded + integer :: year ! Current date (YYYY) + character(LEN=CS) :: tfreeze_option ! Freezing point calculation + character(len=CL) :: orb_mode ! orbital mode + integer :: orb_iyear ! orbital year + integer :: orb_iyear_align ! associated with model year + integer :: orb_cyear ! orbital year for current orbital computation + integer :: orb_nyear ! orbital year associated with currrent model year + integer :: orbitmp(4) ! array for integer parameter broadcast + real(R8) :: orbrtmp(6) ! array for real parameter broadcast + real(R8) :: orb_eccen ! orbital eccentricity + real(R8) :: orb_obliq ! obliquity in degrees + real(R8) :: orb_mvelp ! moving vernal equinox long + real(R8) :: orb_obliqr ! Earths obliquity in rad + real(R8) :: orb_lambm0 ! Mean long of perihelion at vernal equinox (radians) + real(R8) :: orb_mvelpp ! moving vernal equinox long + real(R8) :: wall_time_limit ! wall time limit in hours + logical :: single_column ! scm mode logical + real(R8) :: scmlon ! single column lon + real(R8) :: scmlat ! single column lat + character(LEN=CS) :: wv_sat_scheme + real(R8) :: wv_sat_transition_start + logical :: wv_sat_use_tables + real(R8) :: wv_sat_table_spacing + type(ShrWVSatTableSpec) :: liquid_spec + type(ShrWVSatTableSpec) :: ice_spec + type(ShrWVSatTableSpec) :: mixed_spec + logical :: flag + integer :: i, it, n + integer :: unitn ! Namelist unit number to read + integer :: localPet, rootpe_med + character(len=CL) :: msgstr + integer , parameter :: ens1=1 ! use first instance of ensemble only + integer , parameter :: fix1=1 ! temporary hard-coding to first ensemble, needs to be fixed + real(R8) , parameter :: epsilo = shr_const_mwwv/shr_const_mwdair + character(len=*) , parameter :: orb_fixed_year = 'fixed_year' + character(len=*) , parameter :: orb_variable_year = 'variable_year' + character(len=*) , parameter :: orb_fixed_parameters = 'fixed_parameters' + character(len=*) , parameter :: subname = '(InitAttributes)' !---------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) call shr_nuopc_memcheck(subname, 0, mastertask) !---------------------------------------------------------- @@ -628,15 +587,15 @@ subroutine InitAttributes(driver, mastertask, rc) !---------------------------------------------------------- call NUOPC_CompAttributeGet(driver, name="reprosum_use_ddpdd", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) reprosum_use_ddpdd call NUOPC_CompAttributeGet(driver, name="reprosum_diffmax", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) reprosum_diffmax call NUOPC_CompAttributeGet(driver, name="reprosum_recompute", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) reprosum_recompute call shr_reprosum_setopts(repro_sum_use_ddpdd_in=reprosum_use_ddpdd, & @@ -647,7 +606,7 @@ subroutine InitAttributes(driver, mastertask, rc) !---------------------------------------------------------- call NUOPC_CompAttributeGet(driver, name="tfreeze_option", value=tfreeze_option, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_frz_freezetemp_init(tfreeze_option, mastertask) @@ -656,27 +615,27 @@ subroutine InitAttributes(driver, mastertask, rc) !---------------------------------------------------------- call NUOPC_CompAttributeGet(driver, name="orb_mode", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) orb_mode call NUOPC_CompAttributeGet(driver, name="orb_iyear", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) orb_iyear call NUOPC_CompAttributeGet(driver, name="orb_iyear_align", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) orb_iyear_align call NUOPC_CompAttributeGet(driver, name="orb_obliq", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) orb_obliq call NUOPC_CompAttributeGet(driver, name="orb_eccen", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) orb_eccen call NUOPC_CompAttributeGet(driver, name="orb_mvelp", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) orb_mvelp if (trim(orb_mode) == trim(orb_fixed_year)) then @@ -724,20 +683,20 @@ subroutine InitAttributes(driver, mastertask, rc) call NUOPC_CompAttributeGet(driver, name='cpl_rootpe', value=cvalue, rc=rc) read(cvalue, *) rootpe_med - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_GridCompGet(driver, localPet=localPet, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Determine orbital params if (trim(orb_mode) == trim(orb_variable_year)) then call ESMF_GridCompGet(driver, clock=clock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(CurrTime, yy=year, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return orb_cyear = orb_iyear + (year - orb_iyear_align) call shr_orb_params(orb_cyear, orb_eccen, orb_obliq, orb_mvelp, & @@ -759,23 +718,23 @@ subroutine InitAttributes(driver, mastertask, rc) ! Add updated orbital params to driver attributes call NUOPC_CompAttributeAdd(driver, attrList=(/'orb_obliqr', 'orb_lambm0', 'orb_mvelpp'/), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return write(cvalue,*) orb_eccen call NUOPC_CompAttributeSet(driver, name="orb_eccen", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return write(cvalue,*) orb_obliqr call NUOPC_CompAttributeSet(driver, name="orb_obliqr", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return write(cvalue,*) orb_lambm0 call NUOPC_CompAttributeSet(driver, name="orb_lambm0", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return write(cvalue,*) orb_mvelpp call NUOPC_CompAttributeSet(driver, name="orb_mvelpp", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! TODO: need to update orbital parameters during run time - actually - each component needs to update its orbital ! parameters to be consistent @@ -787,7 +746,7 @@ subroutine InitAttributes(driver, mastertask, rc) ! TODO: this does not seem to belong here - where should it go? call NUOPC_CompAttributeGet(driver, name="wv_sat_scheme", value=wv_sat_scheme, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (.not. shr_wv_sat_valid_idx(shr_wv_sat_get_scheme_idx(trim(wv_sat_scheme)))) then call shr_sys_abort(subname//': "'//trim(wv_sat_scheme)//'" is not a recognized saturation vapor pressure scheme name') @@ -797,19 +756,19 @@ subroutine InitAttributes(driver, mastertask, rc) end if call NUOPC_CompAttributeGet(driver, name="wv_sat_transition_start", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) wv_sat_transition_start call shr_assert_in_domain(wv_sat_transition_start, & - ge=0._SHR_KIND_R8, le=40._SHR_KIND_R8, & + ge=0._R8, le=40._R8, & varname="wv_sat_transition_start", msg="Invalid transition temperature range.") call NUOPC_CompAttributeGet(driver, name="wv_sat_use_tables", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) wv_sat_use_tables call NUOPC_CompAttributeGet(driver, name="wv_sat_table_spacing", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) wv_sat_table_spacing ! A transition range averaging method in CAM is only valid for: @@ -833,9 +792,9 @@ subroutine InitAttributes(driver, mastertask, rc) ! is why only the spacing is in the namelist. if (wv_sat_use_tables) then - liquid_spec = ShrWVSatTableSpec(ceiling(200._SHR_KIND_R8/wv_sat_table_spacing), 175._SHR_KIND_R8, wv_sat_table_spacing) - ice_spec = ShrWVSatTableSpec(ceiling(150._SHR_KIND_R8/wv_sat_table_spacing), 125._SHR_KIND_R8, wv_sat_table_spacing) - mixed_spec = ShrWVSatTableSpec(ceiling(250._SHR_KIND_R8/wv_sat_table_spacing), 125._SHR_KIND_R8, wv_sat_table_spacing) + liquid_spec = ShrWVSatTableSpec(ceiling(200._R8/wv_sat_table_spacing), 175._R8, wv_sat_table_spacing) + ice_spec = ShrWVSatTableSpec(ceiling(150._R8/wv_sat_table_spacing), 125._R8, wv_sat_table_spacing) + mixed_spec = ShrWVSatTableSpec(ceiling(250._R8/wv_sat_table_spacing), 125._R8, wv_sat_table_spacing) call shr_wv_sat_make_tables(liquid_spec, ice_spec, mixed_spec) end if @@ -847,7 +806,7 @@ subroutine InitAttributes(driver, mastertask, rc) !---------------------------------------------------------- call NUOPC_CompAttributeGet(driver, name="single_column", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) single_column ! NOTE: cam stand-alone aqua-planet model will no longer be supported here - only the data model aqua-planet @@ -855,11 +814,11 @@ subroutine InitAttributes(driver, mastertask, rc) if (single_column) then call NUOPC_CompAttributeGet(driver, name="scmlon", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) scmlon call NUOPC_CompAttributeGet(driver, name="scmlat", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) scmlat ! TODO(mvertens, 2019-01-30): need to add single column functionality @@ -883,30 +842,27 @@ subroutine CheckAttributes( driver, rc ) integer , intent(out) :: rc !----- local ----- - character(SHR_KIND_CL) :: cvalue ! temporary - character(SHR_KIND_CL) :: start_type ! Type of startup - character(SHR_KIND_CL) :: rest_case_name ! Short case identification - character(SHR_KIND_CS) :: logFilePostFix ! postfix for output log files - character(SHR_KIND_CL) :: outPathRoot ! root for output log files - character(SHR_KIND_CS) :: cime_model - integer :: dbrc + character(len=CL) :: cvalue ! temporary + character(len=CL) :: start_type ! Type of startup + character(len=CL) :: rest_case_name ! Short case identification + character(len=CS) :: logFilePostFix ! postfix for output log files + character(len=CL) :: outPathRoot ! root for output log files + character(len=CS) :: cime_model character(len=*), parameter :: subname = '(driver_attributes_check) ' !------------------------------------------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) call NUOPC_CompAttributeGet(driver, name="cime_model", value=cime_model, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if ( trim(cime_model) /= 'cesm') then call shr_sys_abort( subname//': cime_model must be set to cesm, aborting') end if ! --- LogFile ending name ----- call NUOPC_CompAttributeGet(driver, name="logFilePostFix", value=logFilePostFix, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if ( len_trim(logFilePostFix) == 0 ) then call shr_sys_abort( subname//': logFilePostFix must be set to something not blank' ) @@ -914,7 +870,7 @@ subroutine CheckAttributes( driver, rc ) ! --- Output path root directory ----- call NUOPC_CompAttributeGet(driver, name="outPathRoot", value=outPathRoot, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if ( len_trim(outPathRoot) == 0 ) then call shr_sys_abort( subname//': outPathRoot must be set' ) @@ -925,7 +881,7 @@ subroutine CheckAttributes( driver, rc ) ! --- Case name and restart case name ------ ! call NUOPC_CompAttributeGet(driver, name="rest_case_name", value=rest_case_name, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (chkerr(rc,__LINE__,u_FILE_u)) return ! if ((trim(start_type) == start_type_cont ) .and. (trim(case_name) /= trim(rest_case_name))) then ! write(logunit,'(10a)') subname,' case_name =',trim(case_name),':',' rest_case_name =',trim(rest_case_name),':' @@ -957,26 +913,26 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, r integer :: n integer :: stat integer :: inst_index - character(len=SHR_KIND_CL) :: cvalue + logical :: is_present + character(len=CL) :: cvalue character(len=32), allocatable :: compLabels(:) character(len=32), allocatable :: attrList(:) - integer :: dbrc + integer :: componentCount character(len=*), parameter :: subname = "(esm.F90:AddAttributes)" + logical :: lvalue = .false. !------------------------------------------- rc = ESMF_Success - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) !------ ! Add compid to gcomp attributes !------ write(cvalue,*) compid call NUOPC_CompAttributeAdd(gcomp, attrList=(/'MCTID'/), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeSet(gcomp, name='MCTID', value=trim(cvalue), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !------ ! Add all the other attributes in AttrList (which have already been added to driver attributes) @@ -985,12 +941,12 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, r attrList = (/"read_restart", "orb_eccen", "orb_obliqr", "orb_lambm0", "orb_mvelpp"/) call NUOPC_CompAttributeAdd(gcomp, attrList=attrList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,size(attrList) call NUOPC_CompAttributeGet(driver, name=trim(attrList(n)), value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeSet(gcomp, name=trim(attrList(n)), value=trim(cvalue), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return enddo deallocate(attrList) @@ -998,100 +954,47 @@ subroutine AddAttributes(gcomp, driver, config, compid, compname, inst_suffix, r ! Add component specific attributes !------ call ReadAttributes(gcomp, config, trim(compname)//"_attributes::", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(gcomp, config, "ALLCOMP_attributes::", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(gcomp, config, trim(compname)//"_modelio"//trim(inst_suffix)//"::", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(gcomp, config, "CLOCK_attributes::", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !------ ! Add mediator specific attributes !------ if (compname == 'MED') then call ReadAttributes(gcomp, config, "MED_history_attributes::", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(gcomp, config, "FLDS_attributes::", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - componentCount = ESMF_ConfigGetLen(config,label="CESM_component_list:", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - allocate(compLabels(componentCount), stat=stat) - if (ESMF_LogFoundAllocError(statusToCheck=stat, msg="Allocation of compLabels failed.", & - line=__LINE__, file=u_FILE_u, rcToReturn=rc)) return - - call ESMF_ConfigGetAttribute(config, valueList=compLabels, label="CESM_component_list:", & - count=componentCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompAttributeAdd(gcomp, & - attrList=(/'atm_present','lnd_present','ocn_present','ice_present',& - 'rof_present','wav_present','glc_present','med_present'/), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - - med_present = "false" - atm_present = "false" - lnd_present = "false" - ocn_present = "false" - ice_present = "false" - rof_present = "false" - wav_present = "false" - glc_present = "false" - do n=1, componentCount - if (trim(compLabels(n)) == "MED") med_present = "true" - if (trim(compLabels(n)) == "ATM") atm_present = "true" - if (trim(compLabels(n)) == "LND") lnd_present = "true" - if (trim(compLabels(n)) == "OCN") ocn_present = "true" - if (trim(compLabels(n)) == "ICE") ice_present = "true" - if (trim(compLabels(n)) == "ROF") rof_present = "true" - if (trim(compLabels(n)) == "WAV") wav_present = "true" - if (trim(compLabels(n)) == "GLC") glc_present = "true" - enddo - - call NUOPC_CompAttributeSet(gcomp, name="atm_present", value=atm_present, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="lnd_present", value=lnd_present, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="ocn_present", value=ocn_present, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="ice_present", value=ice_present, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="rof_present", value=rof_present, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="wav_present", value=wav_present, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="glc_present", value=glc_present, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name="med_present", value=med_present, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - + if (chkerr(rc,__LINE__,u_FILE_u)) return endif !------ ! Add multi-instance specific attributes !------ call NUOPC_CompAttributeAdd(gcomp, attrList=(/'inst_index'/), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! add inst_index attribute (inst_index is not required for cime internal components) ! for now hard-wire inst_index to 1 inst_index = 1 write(cvalue,*) inst_index call NUOPC_CompAttributeSet(gcomp, name='inst_index', value=trim(cvalue), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! add inst_suffix attribute if (len_trim(inst_suffix) > 0) then call NUOPC_CompAttributeAdd(gcomp, attrList=(/'inst_suffix'/), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeSet(gcomp, name='inst_suffix', value=inst_suffix, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end if end subroutine AddAttributes @@ -1114,32 +1017,29 @@ subroutine ReadAttributes(gcomp, config, label, relaxedflag, formatprint, rc) ! local variables type(NUOPC_FreeFormat) :: attrFF - integer :: dbrc character(len=*), parameter :: subname = "(esm.F90:ReadAttributes)" !------------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + if (present(relaxedflag)) then attrFF = NUOPC_FreeFormatCreate(config, label=trim(label), relaxedflag=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return else attrFF = NUOPC_FreeFormatCreate(config, label=trim(label), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end if call NUOPC_CompAttributeIngest(gcomp, attrFF, addFlag=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! if (present (formatprint)) then ! call pretty_print_nuopc_freeformat(attrFF, trim(label)//' attributes', rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (chkerr(rc,__LINE__,u_FILE_u)) return ! end if call NUOPC_FreeFormatDestroy(attrFF, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine ReadAttributes @@ -1164,14 +1064,11 @@ subroutine InitAdvertize(driver, importState, exportState, clock, rc) integer, intent(out) :: rc ! local variables - integer :: dbrc character(len=*), parameter :: subname = "(esm.F90:InitAdvertize)" !--------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) end subroutine InitAdvertize @@ -1186,20 +1083,34 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) use ESMF , only : ESMF_GridCompIsPetLocal, ESMF_MethodAdd use NUOPC , only : NUOPC_CompAttributeGet use NUOPC_Driver , only : NUOPC_DriverAddComp - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use shr_string_mod , only : toLower => shr_string_toLower use med_constants_mod , only : dbug_flag => med_constants_dbug_flag, CS, CL + use mpi , only : MPI_COMM_NULL + use mct_mod , only : mct_world_init + use shr_pio_mod , only : shr_pio_init2 + use med , only : MedSetServices => SetServices +#ifdef ATM_PRESENT use atm_comp_nuopc , only : ATMSetServices => SetServices +#endif +#ifdef ICE_PRESENT use ice_comp_nuopc , only : ICESetServices => SetServices +#endif +#ifdef LND_PRESENT use lnd_comp_nuopc , only : LNDSetServices => SetServices +#endif +#ifdef OCN_PRESENT use ocn_comp_nuopc , only : OCNSetServices => SetServices +#endif +#ifdef WAV_PRESENT use wav_comp_nuopc , only : WAVSetServices => SetServices +#endif +#ifdef ROF_PRESENT use rof_comp_nuopc , only : ROFSetServices => SetServices +#endif +#ifdef GLC_PRESENT use glc_comp_nuopc , only : GLCSetServices => SetServices - use MED , only : MEDSetServices => SetServices - use mpi , only : MPI_COMM_NULL - use mct_mod , only : mct_world_init - use shr_pio_mod , only : shr_pio_init2 +#endif + ! input/output variables type(ESMF_GridComp) :: driver @@ -1232,21 +1143,20 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) !--------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + maxthreads = 1 call ESMF_GridCompGet(driver, vm=vm, config=config, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ReadAttributes(driver, config, "PELAYOUT_attributes::", 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, petCount=petCount, mpiCommunicator=Global_Comm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - componentCount = ESMF_ConfigGetLen(config,label="CESM_component_list:", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + componentCount = ESMF_ConfigGetLen(config,label="component_list:", rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(compLabels(componentCount), stat=stat) if (ESMF_LogFoundAllocError(statusToCheck=stat, msg="Allocation of compLabels failed.", & @@ -1258,14 +1168,14 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) if (ESMF_LogFoundAllocError(statusToCheck=stat, msg="Allocation of compLabels failed.", & line=__LINE__, file=u_FILE_u, rcToReturn=rc)) return - call ESMF_ConfigGetAttribute(config, valueList=compLabels, label="CESM_component_list:", count=componentCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ConfigGetAttribute(config, valueList=compLabels, label="component_list:", count=componentCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(driver, name="inst_suffix", isPresent=isPresent, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent) then call NUOPC_CompAttributeGet(driver, name="inst_suffix", value=inst_suffix, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return else inst_suffix = "" endif @@ -1278,7 +1188,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) namestr = toLower(compLabels(i)) if (namestr == 'med') namestr = 'cpl' call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_ntasks', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) ntasks if (ntasks < 0 .or. ntasks > PetCount) then @@ -1288,13 +1198,13 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) endif call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_nthreads', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) nthrds if(nthrds > maxthreads) maxthreads = nthrds call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_rootpe', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) rootpe if (rootpe < 0 .or. rootpe > PetCount) then write (msgstr, *) "Invalid Rootpe value specified for component: ",namestr, ' rootpe: ',rootpe @@ -1308,7 +1218,7 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) endif call NUOPC_CompAttributeGet(driver, name=trim(namestr)//'_pestride', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) stride if (stride < 1 .or. rootpe+ntasks*stride > PetCount) then write (msgstr, *) "Invalid pestride value specified for component: ",namestr, ' rootpe: ',rootpe, ' pestride: ', stride @@ -1331,62 +1241,78 @@ subroutine esm_init_pelayout(driver, maxthreads, rc) comps(i+1) = i+1 - if (trim(compLabels(i)) .eq. 'MED') then + if (trim(compLabels(i)) == 'MED') then med_id = i + 1 call NUOPC_DriverAddComp(driver, trim(compLabels(i)), MEDSetServices, petList=petlist, comp=child, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return +#ifdef ATM_PRESENT elseif(trim(compLabels(i)) .eq. 'ATM') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ATMSetServices, petList=petlist, comp=child, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return +#endif +#ifdef LND_PRESENT elseif(trim(compLabels(i)) .eq. 'LND') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), LNDSetServices, PetList=petlist, comp=child, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return +#endif +#ifdef OCN_PRESENT elseif(trim(compLabels(i)) .eq. 'OCN') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), OCNSetServices, PetList=petlist, comp=child, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return +#endif +#ifdef ICE_PRESENT elseif(trim(compLabels(i)) .eq. 'ICE') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ICESetServices, PetList=petlist, comp=child, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return +#endif +#ifdef GLC_PRESENT elseif(trim(compLabels(i)) .eq. 'GLC') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), GLCSetServices, PetList=petlist, comp=child, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return +#endif +#ifdef ROF_PRESENT elseif(trim(compLabels(i)) .eq. 'ROF') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ROFSetServices, PetList=petlist, comp=child, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return +#endif +#ifdef WAV_PRESENT elseif(trim(compLabels(i)) .eq. 'WAV') then call NUOPC_DriverAddComp(driver, trim(compLabels(i)), WAVSetServices, PetList=petlist, comp=child, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return +#endif +#ifdef ESP_PRESENT elseif(trim(compLabels(i)) .eq. 'ESP') then - !call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ESPSetServices, PetList=petlist, comp=child, rc=rc) - !if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_DriverAddComp(driver, trim(compLabels(i)), ESPSetServices, PetList=petlist, comp=child, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return +#endif endif call AddAttributes(child, driver, config, i+1, trim(compLabels(i)), inst_suffix, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (ESMF_GridCompIsPetLocal(child, rc=rc)) then call ESMF_GridCompGet(child, 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, mpiCommunicator=comms(i+1), localPet=comp_comm_iam(i), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call AddAttributes(child, driver, config, i+1, trim(compLabels(i)), inst_suffix, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! This code is not supported, we need an optional arg to NUOPC_DriverAddComp to include the ! per component thread count. #3614572 in esmf_support ! call ESMF_GridCompSetVMMaxPEs(child, maxPeCountPerPet=nthrds, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (chkerr(rc,__LINE__,u_FILE_u)) return ! Attach methods for handling reading/writing of restart pointer file call ESMF_MethodAdd(child, label="GetRestartFileToWrite", & userRoutine=GetRestartFileToWrite, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MethodAdd(child, label="GetRestartFileToRead", & userRoutine=GetRestartFileToRead, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return comp_iamin(i) = .true. else comms(i+1) = MPI_COMM_NULL @@ -1411,16 +1337,14 @@ subroutine esm_finalize(driver, rc) use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM, ESMF_VMGet use ESMF , only : ESMF_SUCCESS use NUOPC , only : NUOPC_CompAttributeGet - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use perf_mod , only : t_prf, t_finalizef - use med_constants_mod , only : CL ! input/output variables type(ESMF_GridComp) :: driver integer, intent(out) :: rc ! local variables - character(CL) :: timing_dir ! timing directory + character(len=CL) :: timing_dir ! timing directory character(len=5) :: inst_suffix logical :: isPresent type(ESMF_VM) :: vm @@ -1430,23 +1354,22 @@ subroutine esm_finalize(driver, rc) rc = ESMF_SUCCESS call ESMF_GridCompGet(driver, 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, mpiCommunicator=mpicomm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(driver, name="timing_dir",value=timing_dir, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(driver, name="inst_suffix", isPresent=isPresent, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (isPresent) then call NUOPC_CompAttributeGet(driver, name="inst_suffix", value=inst_suffix, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return else inst_suffix = "" endif - call t_prf(trim(timing_dir)//'/model_timing'//trim(inst_suffix), & - mpicom=mpicomm) + call t_prf(trim(timing_dir)//'/model_timing'//trim(inst_suffix), mpicom=mpicomm) call t_finalizef() @@ -1491,7 +1414,7 @@ subroutine GetRestartFileToWrite(gcomp, rc) call NUOPC_CompAttributeGet(gcomp, name='case_name', value=casename, & isPresent=isPresent, isSet=isSet, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (.not. isPresent .or. .not. isSet) then call ESMF_LogSetError(ESMF_RC_ATTR_NOTSET, & msg=subname//": case_name attribute must be set to generate restart filename", & @@ -1500,27 +1423,27 @@ subroutine GetRestartFileToWrite(gcomp, rc) endif call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Need to use next time step since clock is ! not advanced until the end of the time interval call ESMF_ClockGetNextTime(clock, nextTime, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(nextTime, yy=year, mm=month, dd=day, s=seconds, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return write(restartname,'(A,".mom6.r.",I4.4,"-",I2.2,"-",I2.2,"-",I5.5)') & trim(casename), year, month, day, seconds call NUOPC_CompAttributeSet(gcomp, name="RestartFileToWrite", & value=trim(restartname), 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=localPet, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (localPet == 0) then ! Write name of restart file in the rpointer file @@ -1567,20 +1490,18 @@ subroutine GetRestartFileToRead(gcomp, rc) !--------------------------------------- rc = ESMF_SUCCESS - if (dbug_flag > 5) then - call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) - endif + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=rc) is_restart = IsRestart(gcomp, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (is_restart) then restartname = "" 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=localPet, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (localPet == 0) then readunit = shr_file_getUnit() @@ -1602,12 +1523,12 @@ subroutine GetRestartFileToRead(gcomp, rc) ! broadcast attribute set on master task to all tasks call ESMF_VMBroadcast(vm, restartname, count=ESMF_MAXSTR-1, rootPet=0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !write(logunit,*) trim(subname)//":restartfile after broadcast = "//trim(restartfile) call NUOPC_CompAttributeSet(gcomp, name='RestartFileToRead', & value=trim(restartname), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif call ESMF_LogWrite(trim(subname)//": returning", ESMF_LOGMSG_INFO, rc=rc) diff --git a/cime/src/drivers/nuopc/mediator/esmFlds.F90 b/cime/src/drivers/nuopc/mediator/esmFlds.F90 new file mode 100644 index 000000000000..e3b1c41863b7 --- /dev/null +++ b/cime/src/drivers/nuopc/mediator/esmFlds.F90 @@ -0,0 +1,966 @@ +module esmflds + + use med_constants_mod, only : CX, CS, CL + + implicit none + private + + !----------------------------------------------- + ! Set components + !----------------------------------------------- + + integer, public, parameter :: ncomps = 8 + integer, public, parameter :: compmed = 1 + integer, public, parameter :: compatm = 2 + integer, public, parameter :: complnd = 3 + integer, public, parameter :: compocn = 4 + integer, public, parameter :: compice = 5 + integer, public, parameter :: comprof = 6 + integer, public, parameter :: compwav = 7 + integer, public, parameter :: compglc = 8 + + character(len=*), public, parameter :: compname(ncomps) = & + (/'med','atm','lnd','ocn','ice','rof','wav','glc'/) + + !----------------------------------------------- + ! Set mappers + !----------------------------------------------- + + integer , public, parameter :: mapunset = 0 + 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 :: 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', 'nstod', 'nstod_consd', 'nstod_consf'/) + + !----------------------------------------------- + ! Set coupling mode + !----------------------------------------------- + + character(len=10), public :: coupling_mode ! valid values are [cesm,nems_orig,nems_frac] + + !----------------------------------------------- + ! PUblic methods + !----------------------------------------------- + + public :: shr_nuopc_fldList_AddFld + public :: shr_nuopc_fldList_AddMap + public :: shr_nuopc_fldList_AddMrg + 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 + public :: shr_nuopc_fldList_Document_Mapping + public :: shr_nuopc_fldList_Document_Merging + + !----------------------------------------------- + ! Metadata array + !----------------------------------------------- + + integer, public , parameter :: CSS = 256 ! use longer short character + 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 + + !----------------------------------------------- + ! Types and instantiations that determine fields, mappings, mergings + !----------------------------------------------- + + type, public :: shr_nuopc_fldList_entry_type + character(CS) :: stdname + character(CS) :: shortname + + ! Mapping fldsFr data - for mediator import fields + integer :: mapindex(ncomps) = mapunset + character(CS) :: mapnorm(ncomps) = 'unset' + character(CX) :: mapfile(ncomps) = 'unset' + + ! Merging fldsTo data - for mediator export fields + character(CS) :: merge_fields(ncomps) = 'unset' + character(CS) :: merge_types(ncomps) = 'unset' + character(CS) :: merge_fracnames(ncomps) = 'unset' + end type 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, public :: shr_nuopc_fldList_type + type (shr_nuopc_fldList_entry_type), pointer :: flds(:) + end type 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 + + !----------------------------------------------- + ! Instantiate derived types + !----------------------------------------------- + type (shr_nuopc_fldList_type), public :: fldListTo(ncomps) ! advertise fields to components + type (shr_nuopc_fldList_type), public :: fldListFr(ncomps) ! advertise fields from components + + type (shr_nuopc_fldList_type), public :: fldListMed_aoflux + type (shr_nuopc_fldList_type), public :: fldListMed_ocnalb + + 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 = '(shr_nuopc_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) + + ! 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 = index(shortname, '_',.true.) + 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) + + ! ---------------------------------------------- + ! 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 + + ! local variables + integer :: n,oldsize,id + logical :: found + type(shr_nuopc_fldList_entry_type), pointer :: newflds(:) + character(len=*), parameter :: subname='(shr_nuopc_fldList_AddFld)' + ! ---------------------------------------------- + + if (associated(flds)) then + oldsize = size(flds) + found = .false. + do n= 1,oldsize + if (trim(stdname) == trim(flds(n)%stdname)) then + found = .true. + exit + end if + end do + else + oldsize = 0 + found = .false. + end if + id = oldsize + 1 + + ! create new entry if fldname is not in original list + + if (.not. found) then + + ! 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)%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 + end if + + end subroutine shr_nuopc_fldList_AddFld + + !================================================================================ + + subroutine shr_nuopc_fldList_AddMrg(flds, fldname, & + mrg_from1, mrg_fld1, mrg_type1, mrg_fracname1, & + mrg_from2, mrg_fld2, mrg_type2, mrg_fracname2, & + mrg_from3, mrg_fld3, mrg_type3, mrg_fracname3, & + mrg_from4, mrg_fld4, mrg_type4, mrg_fracname4) + + ! ---------------------------------------------- + ! Determine mrg entry or entries in flds aray + ! ---------------------------------------------- + + use ESMF, only : ESMF_FAILURE, ESMF_LogWrite + use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGMSG_ERROR + + ! input/output variables + type(shr_nuopc_fldList_entry_type) , pointer :: flds(:) + character(len=*) , intent(in) :: fldname + integer , intent(in) , optional :: mrg_from1 + character(len=*) , intent(in) , optional :: mrg_fld1 + character(len=*) , intent(in) , optional :: mrg_type1 + character(len=*) , intent(in) , optional :: mrg_fracname1 + integer , intent(in) , optional :: mrg_from2 + character(len=*) , intent(in) , optional :: mrg_fld2 + character(len=*) , intent(in) , optional :: mrg_type2 + character(len=*) , intent(in) , optional :: mrg_fracname2 + integer , intent(in) , optional :: mrg_from3 + character(len=*) , intent(in) , optional :: mrg_fld3 + character(len=*) , intent(in) , optional :: mrg_type3 + character(len=*) , intent(in) , optional :: mrg_fracname3 + integer , intent(in) , optional :: mrg_from4 + character(len=*) , intent(in) , optional :: mrg_fld4 + character(len=*) , intent(in) , optional :: mrg_type4 + character(len=*) , intent(in) , optional :: mrg_fracname4 + + ! local variables + integer :: n, id + integer :: rc + character(len=*), parameter :: subname='(shr_nuopc_fldList_MrgFld)' + ! ---------------------------------------------- + + id = 0 + do n= 1,size(flds) + if (trim(fldname) == trim(flds(n)%stdname)) then + id = n + exit + end if + end do + if (id == 0) then + do n = 1,size(flds) + write(6,*) trim(subname)//' input flds entry is ',trim(flds(n)%stdname) + end do + call ESMF_LogWrite(subname // 'ERROR: fldname '// trim(fldname) // ' not found in input flds', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + + if (present(mrg_from1) .and. present(mrg_fld1) .and. present(mrg_type1)) then + n = mrg_from1 + flds(id)%merge_fields(n) = mrg_fld1 + flds(id)%merge_types(n) = mrg_type1 + if (present(mrg_fracname1)) then + flds(id)%merge_fracnames(n) = mrg_fracname1 + end if + end if + if (present(mrg_from2) .and. present(mrg_fld2) .and. present(mrg_type2)) then + n = mrg_from2 + flds(id)%merge_fields(n) = mrg_fld2 + flds(id)%merge_types(n) = mrg_type2 + if (present(mrg_fracname2)) then + flds(id)%merge_fracnames(n) = mrg_fracname2 + end if + end if + if (present(mrg_from3) .and. present(mrg_fld3) .and. present(mrg_type3)) then + n = mrg_from3 + flds(id)%merge_fields(n) = mrg_fld3 + flds(id)%merge_types(n) = mrg_type3 + if (present(mrg_fracname3)) then + flds(id)%merge_fracnames(n) = mrg_fracname3 + end if + end if + if (present(mrg_from4) .and. present(mrg_fld4) .and. present(mrg_type4)) then + n = mrg_from4 + flds(id)%merge_fields(n) = mrg_fld4 + flds(id)%merge_types(n) = mrg_type4 + if (present(mrg_fracname4)) then + flds(id)%merge_fracnames(n) = mrg_fracname4 + end if + end if + + end subroutine shr_nuopc_fldList_AddMrg + + !================================================================================ + + subroutine shr_nuopc_fldList_AddMap(flds, fldname, destcomp, maptype, mapnorm, mapfile) + + use ESMF, only : ESMF_LOGMSG_ERROR, ESMF_FAILURE, ESMF_LogWrite, ESMF_LOGMSG_INFO + + ! intput/output variables + type(shr_nuopc_fldList_entry_type) , intent(inout) :: flds(:) + character(len=*) , intent(in) :: fldname + integer , intent(in) :: destcomp + integer , intent(in) :: maptype + character(len=*) , intent(in) :: mapnorm + character(len=*) , intent(in) :: mapfile + + ! local variables + integer :: id, n + integer :: rc + character(len=*),parameter :: subname='(shr_nuopc_fldList_AddMap)' + ! ---------------------------------------------- + + id = 0 + do n = 1,size(flds) + if (trim(fldname) == trim(flds(n)%stdname)) then + id = n + exit + end if + end do + if (id == 0) then + do n = 1,size(flds) + write(6,*) trim(subname)//' input flds entry is ',trim(flds(n)%stdname) + end do + call ESMF_LogWrite(subname // 'ERROR: fldname '// trim(fldname) // ' not found in input flds', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + + ! 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 + + flds(id)%mapindex(destcomp) = maptype + flds(id)%mapnorm(destcomp) = trim(mapnorm) + flds(id)%mapfile(destcomp) = trim(mapfile) + + ! overwrite values if appropriate + if (flds(id)%mapindex(destcomp) == mapfcopy) then + flds(id)%mapfile(destcomp) = 'unset' + flds(id)%mapnorm(destcomp) = 'unset' + else if (trim(flds(id)%mapfile(destcomp)) == 'idmap') then + flds(id)%mapindex(destcomp) = mapfcopy + flds(id)%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 + + ! input/output variables + 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 + + ! 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 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/), & + gridToFieldMap=(/2/), & + 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, stdname, shortname) + ! ---------------------------------------------- + ! Get field info + ! ---------------------------------------------- + type(shr_nuopc_fldList_type) , intent(in) :: fldList + integer , intent(in) :: fldindex + character(len=*) , intent(out) :: stdname + character(len=*) , intent(out) :: shortname + + ! local variables + character(len=*), parameter :: subname='(shr_nuopc_fldList_GetFldInfo_general)' + ! ---------------------------------------------- + + 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 + + !================================================================================ + + subroutine shr_nuopc_fldList_Document_Mapping(logunit, med_coupling_active) + + ! input/output variables + integer, intent(in) :: logunit + logical, intent(in) :: med_coupling_active(:,:) + + ! local variables + integer :: nsrc,ndst,nf,nm,n + integer :: mapindex + character(len=CS) :: mapnorm + character(len=CL) :: mapfile + character(len=CS) :: fldname + character(len=CS) :: stdname + character(len=CX) :: merge_fields + character(len=CX) :: merge_field + character(len=CS) :: merge_type + character(len=CS) :: merge_fracname + character(len=CS) :: string + character(len=CL) :: mrgstr + character(len=CL) :: cvalue + logical :: init_mrgstr + character(len=*),parameter :: subname = '(shr_nuopc_fldList_Document_Mapping)' + !----------------------------------------------------------- + + !--------------------------------------- + ! Document mapping (also add albedo and aoflux) + !--------------------------------------- + + ! Loop over src components + do nsrc = 1,ncomps + ! Loop over all possible destination components for each src component + do ndst = 1,ncomps + if (nsrc /= ndst .and. med_coupling_active(nsrc,ndst)) then + ! Write all the mappings for fields from the src to the destination component + write(logunit,*)' ' + do n = 1,size(fldListFr(nsrc)%flds) + mapindex = fldListFr(nsrc)%flds(n)%mapindex(ndst) + if ( mapindex /= mapunset) then + fldname = trim(fldListFr(nsrc)%flds(n)%stdname) + mapnorm = trim(fldListFr(nsrc)%flds(n)%mapnorm(ndst)) + mapfile = trim(fldListFr(nsrc)%flds(n)%mapfile(ndst)) + + if (trim(mapnorm) == 'unset') then + cvalue = ' mapping '//trim(compname(nsrc))//'->'//trim(compname(ndst)) //' '//trim(fldname) // & + ' via '// trim(mapnames(mapindex)) + else + cvalue = ' mapping '//trim(compname(nsrc))//'->'//trim(compname(ndst)) //' '//trim(fldname) // & + ' via '// trim(mapnames(mapindex)) // ' with '// trim(mapnorm) // ' normalization' + end if + write(logunit,100) trim(cvalue) + if (trim(mapfile) /= 'unset' .and. trim(mapfile) /= 'idmap') then + cvalue = ' and the mapping file '// trim(mapfile) + write(logunit,101) trim(cvalue) + end if + end if + end do + + end if + end do + end do + + ! ocn-> atm mappings for atm/ocn fluxes computed in mediator on the ocn grid + nsrc = compocn + ndst = compatm + if (med_coupling_active(nsrc,ndst)) then + do n = 1,size(fldListMed_aoflux%flds) + mapindex = fldlistMed_aoflux%flds(n)%mapindex(ndst) + if ( mapindex /= mapunset) then + fldname = trim(fldlistMed_aoflux%flds(n)%stdname) + mapnorm = trim(fldlistMed_aoflux%flds(n)%mapnorm(ndst)) + mapfile = trim(fldlistMed_aoflux%flds(n)%mapfile(ndst)) + + if (trim(mapnorm) == 'unset') then + cvalue = ' mapping '//trim(compname(nsrc))//'->'//trim(compname(ndst)) //' '//trim(fldname) // & + ' via '// trim(mapnames(mapindex)) + else + cvalue = ' mapping '//trim(compname(nsrc))//'->'//trim(compname(ndst)) //' '//trim(fldname) // & + ' via '// trim(mapnames(mapindex)) // ' with '// trim(mapnorm) // ' normalization' + end if + write(logunit,100) trim(cvalue) + if (trim(mapfile) /= 'unset' .and. trim(mapfile) /= 'idmap') then + cvalue = ' and the mapping file '// trim(mapfile) + write(logunit,101) trim(cvalue) + end if + end if + end do + end if + +100 format(a) +101 format(3x,a) + + end subroutine shr_nuopc_fldList_Document_Mapping + + !================================================================================ + + subroutine shr_nuopc_fldList_Document_Merging(logunit, med_coupling_active) + + !--------------------------------------- + ! Document merging to target destination fields + !--------------------------------------- + + ! input/output variables + integer, intent(in) :: logunit + logical, intent(in) :: med_coupling_active(:,:) + + ! local variables + integer :: nsrc,ndst,nf,n + character(len=CS) :: dst_comp + character(len=CS) :: dst_field + character(len=CS) :: src_comp + character(len=CS) :: src_field + character(len=CS) :: merge_type + character(len=CS) :: merge_field + character(len=CS) :: merge_frac + character(len=CS) :: prefix + character(len=CS) :: string + character(len=CL) :: mrgstr + logical :: init_mrgstr + character(len=*),parameter :: subname = '(shr_nuopc_fldList_Document_Mapping)' + !----------------------------------------------------------- + + write(logunit,*) + + ! Loop over destination components + do ndst = 1,ncomps + dst_comp = trim(compname(ndst)) + prefix = '(merge_to_'//trim(dst_comp)//')' + + ! Loop over all flds in the destination component and determine merging data + do nf = 1,size(fldListTo(ndst)%flds) + dst_field = fldListTo(ndst)%flds(nf)%stdname + + ! Loop over all possible source components for destination component field + mrgstr = ' ' + do nsrc = 1,ncomps + + if (nsrc /= ndst .and. med_coupling_active(nsrc,ndst)) then + src_comp = compname(nsrc) + merge_field = fldListTo(ndst)%flds(nf)%merge_fields(nsrc) + merge_type = fldListTo(ndst)%flds(nf)%merge_types(nsrc) + merge_frac = fldListTo(ndst)%flds(nf)%merge_fracnames(nsrc) + + if (merge_type == 'merge' .or. merge_type == 'sum_with_weights') then + string = trim(merge_frac)//'*'//trim(merge_field)//'('//trim(src_comp)//')' + if (mrgstr == ' ') then + mrgstr = trim(prefix)//": "// trim(dst_field) //'('//trim(dst_comp)//')'//' = '//trim(string) + else + mrgstr = trim(mrgstr) //' + '//trim(string) + end if + else if (merge_type == 'sum') then + string = trim(merge_field)//'('//trim(src_comp)//')' + if (mrgstr == ' ') then + mrgstr = trim(prefix)//": "//trim(dst_field) //'('//trim(dst_comp)//')'//' = '//trim(string) + else + mrgstr = trim(mrgstr) //' + '//trim(string) + end if + else + if (merge_type == 'copy') then + mrgstr = trim(prefix)//": " // trim(dst_field) //'('//trim(dst_comp)//')'//' = '// & + trim(merge_field)//'('//trim(src_comp)//')' + else if (merge_type == 'copy_with_weights') then + mrgstr = trim(prefix)//": "// trim(dst_field) //'('//trim(dst_comp)//')'//' = '// & + trim(merge_frac)//'*'//trim(merge_field)//'('//trim(src_comp)//')' + end if + end if + end if + + end do ! end loop over nsrc + if (mrgstr /= ' ') then + write(logunit,'(a)') trim(mrgstr) + end if + end do ! end loop over nf + !write(logunit,*)' ' + end do ! end loop over ndst + + end subroutine shr_nuopc_fldList_Document_Merging + +end module esmflds diff --git a/cime/src/drivers/nuopc/mediator/esmFldsExchange.F90 b/cime/src/drivers/nuopc/mediator/esmFldsExchange.F90 new file mode 100644 index 000000000000..f1404adda151 --- /dev/null +++ b/cime/src/drivers/nuopc/mediator/esmFldsExchange.F90 @@ -0,0 +1,2123 @@ +module esmFldsExchange_mod + + !--------------------------------------------------------------------- + ! This is a mediator specific routine that determines ALL possible + ! fields exchanged between components and their associated routing, + ! mapping and merging + !--------------------------------------------------------------------- + + implicit none + public + + public :: esmFldsExchange + + character(*), parameter :: u_FILE_u = & + __FILE__ + +!================================================================================ +contains +!================================================================================ + + subroutine esmFldsExchange(gcomp, phase, rc) + + use ESMF + use NUOPC + use med_constants_mod , only : CX, CS, CL + use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_chkerr + use shr_nuopc_methods_mod , only : fldchk => shr_nuopc_methods_FB_FldChk + use med_internalstate_mod , only : InternalState + use esmFlds , only : shr_nuopc_fldList_type + use esmFlds , only : addfld => shr_nuopc_fldList_AddFld + use esmFlds , only : addmap => shr_nuopc_fldList_AddMap + use esmFlds , only : addmrg => shr_nuopc_fldList_AddMrg + 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, mapnstod, mapnstod_consd, mapnstod_consf + use esmflds , only : fldListTo, fldListFr, fldListMed_aoflux, fldListMed_ocnalb + use esmFlds , only : coupling_mode + + ! input/output parameters: + type(ESMF_GridComp) :: gcomp + character(len=*) , intent(in) :: phase + integer , intent(inout) :: rc + + ! local variables: + type(InternalState) :: is_local + logical :: flds_i2o_per_cat + integer :: dbrc + integer :: num, i, n + integer :: n1, n2, n3, n4 + logical :: isPresent + character(len=5) :: iso(2) + character(len=CL) :: cvalue + character(len=CS) :: name, fldname + 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)' + !-------------------------------------- + + rc = ESMF_SUCCESS + + iso(1) = '' + iso(2) = '_wiso' + + + !--------------------------------------- + ! Get the internal state + !--------------------------------------- + + if (phase /= 'advertise') then + nullify(is_local%wrap) + call ESMF_GridCompGetInternalState(gcomp, is_local, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + !---------------------------------------------------------- + ! Determine supported coupling model + !---------------------------------------------------------- + + if (phase /= 'advertise') then + + ! CESM Default settings + coupling_mode = 'cesm' + + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Faxx_taux', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_taux', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_taux', rc=rc)) then + + ! NEMS orig + ! atm receives merged atm/ocn fluxes computed in mediator and + ! atm/ice and fluxes computed in ice. The atm/ocn fluxes are + ! only used for gridcells that If no interpolated values can be + ! obtained over ocn/ice gridcells on the atm grid (using + ! bilinear or conservative methods), the interpolated values + ! from the nearest neighbor method will be used. + + coupling_mode = 'nems_orig' + + else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Faii_taux', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_taux', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_taux', rc=rc)) then + + ! NEMS frac + ! atm receives atm/ice fluxes computed in the ice component and returns merged + ! lnd/ice/ocn surface fluxes and states back to the mediator + + coupling_mode = 'nems_frac' + + end if + end if + + !-------------------------------------- + ! Merging arguments: + ! mrg_fromN = source component index that for the field to be merged + ! mrg_fldN = souce field name to be merged + ! mrg_typeN = merge type ('copy', 'copy_with_weights', 'sum', 'sum_with_weights', 'merge') + ! NOTE: + ! mrg_from(compmed) can either be for mediator computed fields for atm/ocn fluxes or for ocn albedos + ! + ! NOTE: + ! FBMed_aoflux_o only refer to output fields to the atm/ocn that computed in the + ! atm/ocn flux calculations. Input fields required from either the atm or the ocn for + ! these computation will use the logical 'use_med_aoflux' below. This is used to determine + ! mappings between the atm and ocn needed for these computations. + !-------------------------------------- + + 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 + !---------------------------------------------------------- + + ! to atm + + call NUOPC_CompAttributeGet(gcomp, name='ice2atm_fmapname', value=ice2atm_fmap, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call ESMF_LogWrite('ocn2wav_smapname = '// trim(ocn2wav_smap), ESMF_LOGMSG_INFO) + end if + + !===================================================================== + ! scalar information + !===================================================================== + + if (phase == 'advertise') then + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do n = 1,ncomps + call addfld(fldListFr(n)%flds, trim(cvalue)) + call addfld(fldListTo(n)%flds, trim(cvalue)) + end do + end if + + !===================================================================== + ! FIELDS TO MEDIATOR component (for fractions and atm/ocn flux calculation) + !===================================================================== + + !---------------------------------------------------------- + ! to med: masks from components + !---------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_lfrin') + call addfld(fldListFr(compocn)%flds, 'So_omask') + call addfld(fldListFr(compice)%flds, 'Si_imask') + else + call addmap(fldListFr(compocn)%flds, 'So_omask', compice, mapfcopy, 'unset', 'unset') + end if + + ! --------------------------------------------------------------------- + ! to med: atm and ocn fields required for atm/ocn flux calculation' + ! --------------------------------------------------------------------- + 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) + + call addfld(fldListFr(compatm)%flds, 'Sa_v') + call addmap(fldListFr(compatm)%flds, 'Sa_v' , compocn, mappatch, 'one', atm2ocn_vmap) + + call addfld(fldListFr(compatm)%flds, 'Sa_z') + call addmap(fldListFr(compatm)%flds, 'Sa_z' , compocn, mapbilnr, 'one', atm2ocn_smap) + + call addfld(fldListFr(compatm)%flds, 'Sa_tbot') + call addmap(fldListFr(compatm)%flds, 'Sa_tbot', compocn, mapbilnr, 'one', atm2ocn_smap) + + call addfld(fldListFr(compatm)%flds, 'Sa_pbot') + call addmap(fldListFr(compatm)%flds, 'Sa_pbot', compocn, mapbilnr, 'one', atm2ocn_smap) + + 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') + call addmap(fldListFr(compatm)%flds, 'Sa_ptem', compocn, mapbilnr, 'one', atm2ocn_smap) + end if + + if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Sa_dens', rc=rc)) then + call addfld(fldListFr(compatm)%flds, 'Sa_dens') + call addmap(fldListFr(compatm)%flds, 'Sa_dens', compocn, mapbilnr, 'one', atm2ocn_smap) + end if + end if + end if + + ! --------------------------------------------------------------------- + ! to med: swnet fluxes used for budget calculation + ! --------------------------------------------------------------------- + ! TODO (mvertens, 2019-01-11): budget implemention needs to be done in CMEPS + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Fall_swnet') + call addfld(fldListFr(compice)%flds, 'Faii_swnet') + call addfld(fldListFr(compatm)%flds, 'Faxa_swnet') + else + if (fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swnet', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swnet', compice, mapconsf, 'one' , atm2ice_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swnet', compocn, mapconsf, 'one' , atm2ocn_fmap) + end if + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_swnet', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Faii_swnet', compocn, mapfcopy, 'unset', 'unset') + end if + end if + + !===================================================================== + ! FIELDS TO LAND + !===================================================================== + + ! --------------------------------------------------------------------- + ! from atm: + ! to lnd: height at the lowest model level from atm + ! to lnd: surface height from atm + ! to lnd: zonal wind at the lowest model level from atm + ! to lnd: meridional wind at the lowest model level from atm + ! to lnd: Temperature at the lowest model level from atm + ! to lnd: potential temperature at the lowest model level from atm + ! to lnd: Pressure at the lowest model level from atm + ! to lnd: specific humidity at the lowest model level from atm + ! --------------------------------------------------------------------- + + 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)) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(complnd)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBexp(complnd) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), complnd, mapbilnr, 'one', atm2lnd_smap) + call addmrg(fldListTo(complnd)%flds, trim(fldname), & + mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to lnd: convective and large scale precipitation rate water equivalent from atm + ! to lnd: convective and large-scale (stable) snow rate from atm + ! to lnd: downward longwave heat flux from atm + ! to lnd: downward direct near-infrared incident solar radiation from atm + ! 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: 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, 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(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)) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(complnd)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBexp(complnd) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), complnd, mapconsf, 'one', atm2lnd_fmap) + call addmrg(fldListTo(complnd)%flds, trim(fldname), & + mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to lnd: river channel total water volume from rof + ! to lnd: river channel main channel water volume from rof + ! to lnd: river water flux back to land due to flooding + ! --------------------------------------------------------------------- + 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)) + if (phase == 'advertise') then + call addfld(fldListFr(comprof)%flds, trim(fldname)) + call addfld(fldListTo(complnd)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBExp(complnd) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(comprof, comprof), trim(fldname), rc=rc)) then + call addmap(fldListFr(comprof)%flds, trim(fldname), complnd, mapconsf, 'one', rof2lnd_fmap) + call addmrg(fldListTo(complnd)%flds, trim(fldname), & + mrg_from1=comprof, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to lnd: ice sheet grid coverage on global grid from glc + ! to lnd: ice sheet mask where we are potentially sending non-zero fluxes from glc + ! to lnd: fields with multiple elevation classes from glc + ! --------------------------------------------------------------------- + allocate(flds(2)) + flds = (/'Sg_icemask', 'Sg_icemask_coupled_fluxes'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compglc)%flds , trim(fldname)) + call addfld(fldListTo(complnd)%flds , trim(fldname)) + else + if ( fldchk(is_local%wrap%FBExp(complnd) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compglc, compglc), trim(fldname), rc=rc)) then + call addmap(fldListFr(compglc)%flds, trim(fldname), complnd, mapconsf, 'one', glc2lnd_smap) + call addmrg(fldListTo(complnd)%flds, trim(fldname), & + mrg_from1=compglc, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! for glc fields with multiple elevation classes in glc->lnd + ! fields from glc->med do NOT have elevation classes + ! fields from med->lnd are BROKEN into multiple elevation classes + + 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 + + !===================================================================== + ! FIELDS TO ATMOSPHERE + !===================================================================== + + !---------------------------------------------------------- + ! to atm: Fractions + !---------------------------------------------------------- + if (phase == 'advertise') then + ! the following are computed in med_phases_prep_atm + call addfld(fldListTo(compatm)%flds, 'Sl_lfrac') + call addfld(fldListTo(compatm)%flds, 'Si_ifrac') + call addfld(fldListTo(compatm)%flds, 'So_ofrac') + end if + + ! --------------------------------------------------------------------- + ! to atm: merged direct albedo (visible radiation) + ! to atm: merged diffuse albedo (visible radiation) + ! to atm: merged direct albedo (near-infrared radiation) + ! to atm: merged diffuse albedo (near-infrared radiation) + ! --------------------------------------------------------------------- + allocate(suffix(4)) + suffix = (/'avsdr', 'avsdf', 'anidr', 'anidf'/) + + do n = 1,size(suffix) + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_'//trim(suffix(n))) + call addfld(fldListFr(compice)%flds, 'Si_'//trim(suffix(n))) + call addfld(fldListMed_ocnalb%flds , 'So_'//trim(suffix(n))) + call addfld(fldListTo(compatm)%flds, 'Sx_'//trim(suffix(n))) + else + ! CESM (cam, non-aqua-planet) + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sx_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBMed_ocnalb_a , 'So_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_'//trim(suffix(n)), compatm, mapconsf, 'lfrin', lnd2atm_smap) + call addmap(fldListFr(compice)%flds, 'Si_'//trim(suffix(n)), compatm, mapconsf, 'ifrac', ice2atm_smap) + call addmap(fldListMed_ocnalb%flds , 'So_'//trim(suffix(n)), compatm, mapconsf, 'ofrac', ocn2atm_smap) + call addmrg(fldListTo(compatm)%flds, 'Sx_'//trim(suffix(n)), & + mrg_from1=complnd, mrg_fld1='Sl_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='lfrac', & + mrg_from2=compice, mrg_fld2='Si_'//trim(suffix(n)), mrg_type2='merge', mrg_fracname2='ifrac', & + mrg_from3=compmed, mrg_fld3='So_'//trim(suffix(n)), mrg_type3='merge', mrg_fracname3='ofrac') + + ! CESM (cam, aqua-planet) + else if (fldchk(is_local%wrap%FBMed_ocnalb_a, 'So_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm), 'Sx_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListMed_ocnalb%flds , 'So_'//trim(suffix(n)), compatm, mapconsf, 'ofrac', ocn2atm_smap) + call addmrg(fldListTo(compatm)%flds, 'Sx_'//trim(suffix(n)), & + mrg_from1=compmed, mrg_fld1='So_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='ofrac') + end if + end if + end do + deallocate(suffix) + + ! --------------------------------------------------------------------- + ! to atm: merged reference temperature at 2 meters + ! to atm: merged 10m wind speed + ! to atm: merged reference specific humidity at 2 meters + ! to atm: merged reference specific water isoptope humidity at 2 meters + ! --------------------------------------------------------------------- + allocate(suffix(4)) + suffix = (/'tref', 'u10', 'qref', 'qref_wiso'/) + + do n = 1,size(suffix) + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds , 'Sl_'//trim(suffix(n))) + call addfld(fldListFr(compice)%flds , 'Si_'//trim(suffix(n))) + call addfld(fldListMed_aoflux%flds , 'So_'//trim(suffix(n))) + call addfld(fldListTo(compatm)%flds , 'Sx_'//trim(suffix(n))) + else + ! CESM (cam, non-aqua-planet) + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sx_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd ), 'Sl_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice ), 'Si_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'So_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListFr(complnd)%flds , 'Sl_'//trim(suffix(n)), compatm, mapconsf, 'lfrin', lnd2atm_fmap) + call addmap(fldListFr(compice)%flds , 'Si_'//trim(suffix(n)), compatm, mapconsf, 'ifrac', ice2atm_fmap) + call addmap(fldListMed_aoflux%flds , 'So_'//trim(suffix(n)), compocn, mapbilnr, 'one' , atm2ocn_fmap) ! map atm->ocn + call addmap(fldListMed_aoflux%flds , 'So_'//trim(suffix(n)), compatm, mapconsf, 'ofrac', ocn2atm_fmap) ! map ocn->atm + call addmrg(fldListTo(compatm)%flds , 'Sx_'//trim(suffix(n)), & + mrg_from1=complnd, mrg_fld1='Sl_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='lfrac', & + mrg_from2=compice, mrg_fld2='Si_'//trim(suffix(n)), mrg_type2='merge', mrg_fracname2='ifrac', & + mrg_from3=compmed, mrg_fld3='So_'//trim(suffix(n)), mrg_type3='merge', mrg_fracname3='ofrac') + + ! NEMS-orig - merged ocn temp + else if (fldchk(is_local%wrap%FBexp(compatm) , 'Sx_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_'//trim(suffix(n)), compatm, mapnstod_consf, 'ifrac', ice2atm_fmap) + call addmap(fldListFr(compocn)%flds, 'So_'//trim(suffix(n)), compatm, mapnstod_consf, 'none' , ocn2atm_fmap) + call addmrg(fldListTo(compatm)%flds, 'Sx_'//trim(suffix(n)), & + mrg_from1=compice, mrg_fld1='Si_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='ifrac', & + mrg_from2=compocn, mrg_fld2='So_'//trim(suffix(n)), mrg_type2='merge', mrg_fracname2='ofrac') + + ! CESM (cam, aqua-planet) + else if (fldchk(is_local%wrap%FBMed_aoflux_o, 'So_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListMed_aoflux%flds , 'So_'//trim(suffix(n)), compatm, mapconsf, 'ofrac', ocn2atm_fmap) ! map ocn->atm + call addmrg(fldListTo(compatm)%flds, 'Sx_'//trim(suffix(n)), & + mrg_from1=compmed, mrg_fld1='So_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='ofrac') + end if + end if + end do + deallocate(suffix) + + ! --------------------------------------------------------------------- + ! to atm: merged zonal surface stress + ! to atm: merged meridional surface stress + ! to atm: merged surface latent heat flux + ! to atm: merged surface sensible heat flux + ! to atm: merged surface upward longwave heat flux + ! to atm: evaporation water flux from water + ! to atm: evaporation water flux from water isotopes + ! --------------------------------------------------------------------- + allocate(suffix(7)) + suffix = (/'taux', 'tauy', 'lat', 'sen', 'lwup', 'evap', 'evap_wiso'/) + + do n = 1,size(suffix) + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(suffix(n))) + call addfld(fldListFr(complnd)%flds, 'Fall_'//trim(suffix(n))) + call addfld(fldListFr(compice)%flds, 'Faii_'//trim(suffix(n))) + call addfld(fldListTo(compatm)%flds, 'Faii_'//trim(suffix(n))) ! nems-frac + call addfld(fldListTo(compatm)%flds, 'Faxx_'//trim(suffix(n))) ! cesm, nems-orig + else + ! CESM (non aqua-planet) + if ( fldchk(is_local%wrap%FBImp(complnd,complnd), 'Fall_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faxx_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListMed_aoflux%flds , 'Faox_'//trim(suffix(n)), compatm, mapconsf, 'ofrac', ocn2atm_fmap) + call addmap(fldListFr(complnd)%flds , 'Fall_'//trim(suffix(n)), compatm, mapconsf, 'lfrin', lnd2atm_fmap) + call addmap(fldListFr(compice)%flds , 'Faii_'//trim(suffix(n)), compatm, mapconsf, 'ifrac', ice2atm_fmap) + call addmrg(fldListTo(compatm)%flds , 'Faxx_'//trim(suffix(n)), & + mrg_from1=complnd, mrg_fld1='Fall_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='lfrac', & + mrg_from2=compice, mrg_fld2='Faii_'//trim(suffix(n)), mrg_type2='merge', mrg_fracname2='ifrac', & + mrg_from3=compmed, mrg_fld3='Faox_'//trim(suffix(n)), mrg_type3='merge', mrg_fracname3='ofrac') + + ! NEMS orig (here ofrac = 1.-ifrac) + else if ( fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faxx_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListMed_aoflux%flds , 'Faox_'//trim(suffix(n)), compatm, mapnstod_consf, 'none' , ocn2atm_fmap) + call addmap(fldListFr(compice)%flds , 'Faii_'//trim(suffix(n)), compatm, mapnstod_consf, 'ifrac', ice2atm_fmap) + call addmrg(fldListTo(compatm)%flds , 'Faxx_'//trim(suffix(n)), & + mrg_from1=compice, mrg_fld1='Faii_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='ifrac', & + mrg_from2=compmed, mrg_fld2='Faox_'//trim(suffix(n)), mrg_type2='merge', mrg_fracname2='ofrac') + + ! NEMS frac (merge done in fv3) + else if ( fldchk(is_local%wrap%FBImp(compice,compice), 'Faii_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm) , 'Faii_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Faii_'//trim(suffix(n)), compatm, mapconsf, 'ifrac', ice2atm_fmap) + call addmrg(fldListTo(compatm)%flds, 'Faii_'//trim(suffix(n)), & + mrg_from1=compice, mrg_fld1='Faii_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='ifrac') + + ! CESM (cam, aqua-planet) + else if (fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBexp(compatm), 'Faxx_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListMed_aoflux%flds , 'Faox_'//trim(suffix(n)), compatm, mapconsf, 'ofrac', ocn2atm_fmap) + call addmrg(fldListTo(compatm)%flds, 'Faxx_'//trim(suffix(n)), & + mrg_from1=compmed, mrg_fld1='Faox_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='ofrac') + end if + end if + end do + deallocate(suffix) + + ! --------------------------------------------------------------------- + ! to atm: merged surface temperature and unmerged temperatures from ice and ocn + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_t') + call addfld(fldListFr(compice)%flds, 'Si_t') + call addfld(fldListFr(compocn)%flds, 'So_t') + + call addfld(fldListTo(compatm)%flds, 'So_t') ! cesm, nems-frac + call addfld(fldListTo(compatm)%flds, 'Si_t') ! nems-frac + call addfld(fldListTo(compatm)%flds, 'Sx_t') ! cesm, nems-orig + else + ! CESM - merged ocn/ice/lnd temp and unmerged ocn temp + if (fldchk(is_local%wrap%FBexp(compatm) , 'Sx_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd), 'Sl_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_t', compatm, mapconsf , 'lfrin', lnd2atm_fmap) + call addmap(fldListFr(compice)%flds, 'Si_t', compatm, mapconsf , 'ifrac', ice2atm_fmap) + call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapconsf , 'ofrac', ocn2atm_fmap) + call addmrg(fldListTo(compatm)%flds, 'Sx_t', & + mrg_from1=complnd, mrg_fld1='Sl_t', mrg_type1='merge', mrg_fracname1='lfrac', & + mrg_from2=compice, mrg_fld2='Si_t', mrg_type2='merge', mrg_fracname2='ifrac', & + mrg_from3=compocn, mrg_fld3='So_t', mrg_type3='merge', mrg_fracname3='ofrac') + call addmrg(fldListTo(compatm)%flds, 'So_t', & + mrg_from1=compocn, mrg_fld1='So_t', mrg_type1='copy') + + ! NEMS-orig - merged ocn/ice temp and unmerged ocn temp + else if (fldchk(is_local%wrap%FBexp(compatm) , 'Sx_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_t', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_t', compatm, mapnstod_consf, 'ifrac', ice2atm_fmap) + call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapnstod_consf, 'none' , ocn2atm_fmap) + call addmrg(fldListTo(compatm)%flds, 'Sx_t', & + mrg_from1=compice, mrg_fld1='Si_t', mrg_type1='merge', mrg_fracname1='ifrac', & + mrg_from2=compocn, mrg_fld2='So_t', mrg_type2='merge', mrg_fracname2='ofrac') + call addmrg(fldListTo(compatm)%flds, 'So_t', & + mrg_from1=compocn, mrg_fld1='So_t', mrg_type1='copy') + + ! CESM aqua-planet - merged and unmerged ocn temp are the same + else if ( fldchk(is_local%wrap%FBexp(compatm) , 'Sx_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), 'So_t', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'So_t', compatm, mapconsf, 'ofrac', ocn2atm_fmap) + call addmrg(fldListTo(compatm)%flds, 'Sx_t', & + mrg_from1=compocn, mrg_fld1='So_t', mrg_type1='merge', mrg_fracname1='ofrac') + call addmrg(fldListTo(compatm)%flds, 'So_t', & + mrg_from1=compocn, mrg_fld1='So_t', mrg_type1='copy') + end if + + ! NEMS-frac - unmerged ice temp + if ( fldchk(is_local%wrap%FBexp(compatm) , 'Si_t', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Si_t', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Si_t', compatm, mapconsf , 'ifrac', ice2atm_fmap) + call addmrg(fldListTo(compatm)%flds, 'Si_t', & + mrg_from1=compice, mrg_fld1='Si_t', mrg_type1='copy') + end if + end if + + ! --------------------------------------------------------------------- + ! to atm: surface snow depth from ice + ! to atm: mean ice volume per unit area from ice + ! to atm: mean snow volume per unit area from ice + ! --------------------------------------------------------------------- + allocate(flds(3)) + flds = (/'Si_snowh', 'Si_vice', 'Si_vsno'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, trim(fldname)) + call addfld(fldListTo(compatm)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), trim(fldname), rc=rc)) then + if (trim(coupling_mode) == 'nems_orig') then + call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapnstod_consf, 'ifrac', ice2atm_fmap) + else + call addmap(fldListFr(compice)%flds, trim(fldname), compatm, mapconsf , 'ifrac', ice2atm_fmap) + end if + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from1=compice, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to atm: surface saturation specific humidity in ocean from med aoflux + ! to atm: square of exch. coeff (tracers) from med aoflux + ! to atm: surface fraction velocity from med aoflux + ! --------------------------------------------------------------------- + allocate(flds(3)) + flds = (/'So_ssq', 'So_re', 'So_ustar'/) + + 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)) + else + if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , trim(fldname), rc=rc)) then + call addmap(fldListMed_aoflux%flds , trim(fldname), compatm, mapconsf, 'ofrac', ocn2atm_fmap) ! map ocn->atm + call addmrg(fldListTo(compatm)%flds , trim(fldname), & + mrg_from1=compmed, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to atm: surface fraction velocity from land + ! to atm: aerodynamic resistance from land + ! to atm: surface snow water equivalent from land + ! --------------------------------------------------------------------- + allocate(flds(3)) + flds = (/'Sl_fv', 'Sl_ram1', 'Sl_snowh'/) + + 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)) + else + if ( fldchk(is_local%wrap%FBexp(compatm) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(complnd,complnd ), 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') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to atm: dust fluxes from land (4 sizes) + ! --------------------------------------------------------------------- + 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 if + + !----------------------------------------------------------------------------- + ! to atm: MEGAN emissions fluxes from land + !----------------------------------------------------------------------------- + fldname = 'Fall_voc' + 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, '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 + 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, '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' + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Sl_fztop') + call addfld(fldListTo(compatm)%flds, 'Sl_fztop') + else + if ( fldchk(is_local%wrap%FBImp(complnd, complnd), 'Sl_fztop', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compatm) , 'Sl_fztop', rc=rc)) then + call addmap(fldListFr(complnd)%flds, 'Sl_fztop', compatm, mapconsf, 'one', lnd2atm_smap) + call addmrg(fldListTo(compatm)%flds, 'Sl_fztop', & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + + !----------------------------------------------------------------------------- + ! to atm: dry deposition velocities from land + !----------------------------------------------------------------------------- + fldname = 'Sl_ddvel' + 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, 'one', lnd2atm_smap) + call addmrg(fldListTo(compatm)%flds, trim(fldname), & + mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + + !===================================================================== + ! FIELDS TO OCEAN (compocn) + !===================================================================== + + !---------------------------------------------------------- + ! to ocn: fractional ice coverage wrt ocean from ice + !---------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, 'Si_ifrac') + call addfld(fldListTo(compocn)%flds, 'Si_ifrac') + else + call addmap(fldListFr(compice)%flds, 'Si_ifrac', compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Si_ifrac', mrg_from1=compice, mrg_fld1='Si_ifrac', mrg_type1='copy') + end if + + ! --------------------------------------------------------------------- + ! to ocn: downward longwave heat flux from atm + ! to ocn: downward direct near-infrared incident solar radiation from atm + ! to ocn: downward diffuse near-infrared incident solar radiation from atm + ! to ocn: downward dirrect visible incident solar radiation from atm + ! to ocn: downward diffuse visible incident solar radiation from atm + ! --------------------------------------------------------------------- + allocate(flds(5)) + flds = (/'Faxa_lwdn', 'Faxa_swndr', 'Faxa_swndf', 'Faxa_swvdr', 'Faxa_swndf'/) + + 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)) + else + if ( fldchk(is_local%wrap%FBExp(compocn) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, mapconsf, 'one', atm2ocn_fmap) + call addmrg(fldListTo(compocn)%flds, trim(fldname), mrg_from1=compatm, mrg_fld1=trim(fldname), & + mrg_type1='copy_with_weights', mrg_fracname1='ofrac') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to ocn: surface upward longwave heat flux from mediator + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds , 'Faox_lwup') + call addfld(fldListTo(compocn)%flds , 'Foxx_lwup') ! cesm, docn + else + if ( fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_lwup', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn), 'Foxx_lwup', rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'Foxx_lwup', & + mrg_from1=compmed, mrg_fld1='Faox_lwup', mrg_type1='merge', mrg_fracname1='ofrac') + end if + end if + + ! --------------------------------------------------------------------- + ! to ocn: merged longwave net heat flux + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds , 'Faxa_lwdn') + call addfld(fldListFr(compatm)%flds , 'Faxa_lwnet') + call addfld(fldListMed_aoflux%flds , 'Faox_lwup' ) + call addfld(fldListTo(compocn)%flds , 'Foxx_lwnet') + else + ! NEMS-orig (mom6) (send longwave net to ocn via custom merge) + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_lwnet', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwnet', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn' , compocn, mapconsf, 'one' , atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_lwnet', compocn, mapconsf, 'one' , atm2ocn_fmap) + + ! CESM (mom6) (send longwave net to ocn via auto merge) + else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_lwnet', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_lwup' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_lwdn' , rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lwdn', compocn, mapconsf, 'one' , atm2ocn_fmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & + mrg_from1=compmed, mrg_fld1='Faox_lwup', mrg_type1='merge', mrg_fracname1='ofrac', & + mrg_from2=compatm, mrg_fld2='Faxa_lwdn', mrg_type2='merge', mrg_fracname2='ofrac') + + ! NEMS-frac (mom6) (send longwave net to ocean via auto merge) + else if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_lwnet', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Foxx_lwnet', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_lwnet', compocn, mapconsf, 'one' , atm2ocn_fmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_lwnet', & + mrg_from1=compatm, mrg_fld1='Foxx_lwnet', mrg_type1='merge', mrg_fracname1='ofrac') + end if + end if + + ! --------------------------------------------------------------------- + ! to ocn: net shortwave radiation from med + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Faxa_swvdr') + call addfld(fldListFr(compatm)%flds, 'Faxa_swndr') + call addfld(fldListFr(compatm)%flds, 'Faxa_swvdf') + call addfld(fldListFr(compatm)%flds, 'Faxa_swndf') + + call addfld(fldListFr(compice)%flds, 'Fioi_swpen') + call addfld(fldListFr(compice)%flds, 'Fioi_swpen_vdr') + call addfld(fldListFr(compice)%flds, 'Fioi_swpen_vdf') + call addfld(fldListFr(compice)%flds, 'Fioi_swpen_idr') + call addfld(fldListFr(compice)%flds, 'Fioi_swpen_idf') + + call addfld(fldListTo(compocn)%flds, 'Foxx_swnet') + call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_vdr') + call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_vdf') + call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_idr') + call addfld(fldListTo(compocn)%flds, 'Foxx_swnet_idf') + else + ! Net shortwave ocean (custom calculation in prep_phases_ocn_mod.F90) + ! export swpent to ocn without bands + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_swnet', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdf', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_fmap) + + ! import swpen from ice without bands + if (fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_swpen', compocn, mapfcopy, 'unset', 'unset') + end if + end if + + ! export swnet to ocn by bands + if ( fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_swnet_vdr', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_swnet_vdf', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_swnet_idr', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Foxx_swnet_idf', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdr' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swvdf' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndr' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_swndf' , rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_swvdr', compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swvdf', compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swndr', compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_swndf', compocn, mapconsf, 'one', atm2ocn_fmap) + + ! import swpen from ice by bands + if ( fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdf', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_idr', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_idf', rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_swpen_vdr', compocn, mapfcopy, 'unset', 'unset') + call addmap(fldListFr(compice)%flds, 'Fioi_swpen_vdf', compocn, mapfcopy, 'unset', 'unset') + call addmap(fldListFr(compice)%flds, 'Fioi_swpen_idr', compocn, mapfcopy, 'unset', 'unset') + call addmap(fldListFr(compice)%flds, 'Fioi_swpen_idf', compocn, mapfcopy, 'unset', 'unset') + end if + end if + end if + + ! --------------------------------------------------------------------- + ! to ocn: per ice thickness fraction and sw penetrating into ocean from ice + ! --------------------------------------------------------------------- + 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') + 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') + ! 'fractional atmosphere coverage used in radiation computations wrt ocean' (computed in med_phases_prep_ocn) + call addfld(fldListTo(compocn)%flds, 'Sf_afracr') + ! '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') + ! Note that 'Sf_afrac, 'Sf_afracr' and 'Foxx_swnet_afracr' will have explicit merging in med_phases_prep_ocn + end if + end if + + ! --------------------------------------------------------------------- + ! to ocn: precipitation rate water equivalent from atm + ! to ocn: snow rate water equivalent from atm + ! --------------------------------------------------------------------- + + 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(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,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. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_rainc'//iso(n), rc=rc) .and. & + (fldchk(is_local%wrap%FBExp(compocn) , 'Faxa_rain' //iso(n), rc=rc) & + .or. trim(coupling_mode) == 'cesm' .or. trim(coupling_mode) == 'nems_orig')) then + call addmap(fldListFr(compatm)%flds, 'Faxa_rainl'//iso(n), compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_rainc'//iso(n), compocn, mapconsf, 'one', atm2ocn_fmap) + if (iso(n) == ' ') then + call addmrg(fldListTo(compocn)%flds, 'Faxa_rain'//iso(n) , & + mrg_from1=compatm, mrg_fld1='Faxa_rainc:Faxa_rainl', & + mrg_type1='sum_with_weights', mrg_fracname1='ofrac') + else + call addmrg(fldListTo(compocn)%flds, 'Faxa_rain'//iso(n) , & + mrg_from1=compatm, mrg_fld1=trim('Faxa_rainc'//iso(n))//':'//trim('Faxa_rainl'//iso(n)), & + mrg_type1='sum_with_weights', mrg_fracname1='ofrac') + end if + else if ( fldchk(is_local%wrap%FBExp(compocn) , '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), compocn, mapconsf, 'one', atm2ocn_fmap) + call addmrg(fldListTo(compocn)%flds, 'Faxa_rain'//iso(n), mrg_from1=compatm, mrg_fld1='Faxa_rain'//iso(n), & + mrg_type1='copy') + end if + if ( fldchk(is_local%wrap%FBExp(compocn) , '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_snowl'//iso(n), compocn, mapconsf, 'one', atm2ocn_fmap) + call addmap(fldListFr(compatm)%flds, 'Faxa_snowc'//iso(n), compocn, mapconsf, 'one', atm2ocn_fmap) + if (iso(n) == ' ') then + call addmrg(fldListTo(compocn)%flds, 'Faxa_snow' //iso(n) , & + mrg_from1=compatm, mrg_fld1='Faxa_snowc:Faxa_snowl', & + mrg_type1='sum_with_weights', mrg_fracname1='ofrac') + else + call addmrg(fldListTo(compocn)%flds, 'Faxa_snow' //iso(n) , & + mrg_from1=compatm, mrg_fld1=trim('Faxa_snowc'//iso(n))//':'//trim('Faxa_snowl'//iso(n)), & + mrg_type1='sum_with_weights', mrg_fracname1='ofrac') + end if + else if ( fldchk(is_local%wrap%FBExp(compocn) , '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), compocn, mapconsf, 'one', atm2ocn_fmap) + call addmrg(fldListTo(compocn)%flds, 'Faxa_snow'//iso(n), mrg_from1=compatm, mrg_fld1='Faxa_snow'//iso(n), & + mrg_type1='copy') + end if + end do + end if + + ! --------------------------------------------------------------------- + ! to ocn: merged sensible heat flux + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds , 'Faxa_sen') + call addfld(fldListMed_aoflux%flds , 'Faox_sen') + call addfld(fldListFr(compice)%flds , 'Fioi_melth') + call addfld(fldListTo(compocn)%flds , 'Foxx_sen') + else + ! NEMS orig + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_sen' , rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_sen' , rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_melth', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_sen' , rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_sen' , compocn, mapconsf, 'one' , atm2ocn_fmap) ! map atm->ocn + call addmap(fldListFr(compice)%flds, 'Fioi_melth', compocn, mapfcopy, 'unset', 'unset') + + ! NEMS frac + else if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_sen', rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm, compatm), 'Faxa_sen', rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_sen', compocn, mapconsf, 'one' , atm2ocn_fmap) ! map atm->ocn + call addmrg(fldListTo(compocn)%flds, 'Foxx_sen', & + mrg_from1=compatm, mrg_fld1='Faxa_sen' , mrg_type1='merge', mrg_fracname1='ofrac', & + mrg_from2=compice, mrg_fld2='Fioi_melth', mrg_type2='merge', mrg_fracname2='ifrac') + + ! CESM + else if ( fldchk(is_local%wrap%FBexp(compocn), 'Foxx_sen', rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_sen', rc=rc)) then + call addmrg(fldListTo(compocn)%flds, 'Foxx_sen', & + mrg_from1=compmed, mrg_fld1='Faox_sen', mrg_type1='merge', mrg_fracname1='ofrac') + end if + end if + + ! --------------------------------------------------------------------- + ! to ocn: surface latent heat flux and evaporation water flux + ! --------------------------------------------------------------------- + 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_evap' , rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o , 'Faox_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 + + 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 if + + ! --------------------------------------------------------------------- + ! to ocn: wind speed squared at 10 meters from med + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds , 'So_duu10n') + call addfld(fldListTo(compocn)%flds, 'So_duu10n') + else + if ( fldchk(is_local%wrap%FBMed_aoflux_o, 'So_duu10n', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn), 'So_duu10n', rc=rc)) then + + call addmap(fldListMed_aoflux%flds , 'So_duu10n', compatm, mapconsf, 'ofrac', ocn2atm_fmap) ! map ocn->atm + call addmrg(fldListTo(compocn)%flds, 'So_duu10n', & + mrg_from1=compmed, mrg_fld1='So_duu10n', mrg_type1='copy') + end if + end if + + ! --------------------------------------------------------------------- + ! to ocn: sea level pressure from atm + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_pslv') + call addfld(fldListTo(compocn)%flds, 'Sa_pslv') + else + if ( fldchk(is_local%wrap%FBImp(compatm, compatm), 'Sa_pslv', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , 'Sa_pslv', rc=rc)) then + + call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compocn, mapbilnr, 'one', atm2ocn_smap) + call addmap(fldListFr(compatm)%flds, 'Sa_pslv', compice, mapbilnr, 'one', atm2ocn_smap) + + call addmrg(fldListTo(compocn)%flds, 'Sa_pslv', & + mrg_from1=compatm, mrg_fld1='Sa_pslv', mrg_type1='copy') + end if + end if + + ! --------------------------------------------------------------------- + ! 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(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compocn) , trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compocn, mapconsf, 'one', atm2ocn_fmap) + call addmrg(fldListTo(compocn)%flds, trim(fldname), & + mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='ofrac') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to ocn: merge zonal surface stress from ice and (atm or med) + ! --------------------------------------------------------------------- + allocate(suffix(2)) + suffix = (/'taux', 'tauy'/) + + do n = 1,size(suffix) + if (phase == 'advertise') then + call addfld(fldListMed_aoflux%flds , 'Faox_'//trim(suffix(n))) + call addfld(fldListFr(compice)%flds , 'Fioi_'//trim(suffix(n))) + call addfld(fldListFr(compatm)%flds , 'Faxa_'//trim(suffix(n))) + call addfld(fldListTo(compocn)%flds , 'Foxx_'//trim(suffix(n))) + else + ! NEMS orig and NEMS frac + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Foxx_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), 'Faxa_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListFr(compatm)%flds, 'Faxa_'//trim(suffix(n)), compocn, mapconsf, 'one' , atm2ocn_fmap) ! map atm->ocn + call addmap(fldListFr(compice)%flds, 'Fioi_'//trim(suffix(n)), compocn, mapfcopy, 'unset', 'unset') + + ! NEMS-frac + call addmrg(fldListTo(compocn)%flds, 'Foxx_'//trim(suffix(n)), & + mrg_from1=compatm, mrg_fld1='Faxa_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='ofrac', & + mrg_from2=compice, mrg_fld2='Fioi_'//trim(suffix(n)), mrg_type2='merge', mrg_fracname2='ifrac') + ! NEMS-orig + ! custom merge calculation in med_phases_prep_ocn will be done that will overwrite the auto-merge done above + + ! CESM + else if (fldchk(is_local%wrap%FBexp(compocn), 'Foxx_'//trim(suffix(n)), rc=rc) .and. & + fldchk(is_local%wrap%FBMed_aoflux_o, 'Faox_'//trim(suffix(n)), rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_'//trim(suffix(n)), compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Foxx_'//trim(suffix(n)), & + mrg_from1=compmed, mrg_fld1='Faox_'//trim(suffix(n)), mrg_type1='merge', mrg_fracname1='ofrac', & + mrg_from2=compice, mrg_fld2='Fioi_'//trim(suffix(n)), mrg_type2='merge', mrg_fracname2='ifrac') + end if + end if + end do + deallocate(suffix) + + ! --------------------------------------------------------------------- + ! to ocn: water flux due to melting ice from ice + ! --------------------------------------------------------------------- + do n = 1,size(iso) + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds , 'Fioi_meltw'//iso(n)) + call addfld(fldListTo(compocn)%flds , 'Fioi_meltw'//iso(n)) + else + if (coupling_mode == 'cesm') then + if ( fldchk(is_local%wrap%FBexp(compocn) , 'Fioi_meltw'//iso(n), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw'//iso(n), rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_meltw'//iso(n), compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Fioi_meltw'//iso(n), & + mrg_from1=compice, mrg_fld1='Fioi_meltw'//iso(n), mrg_type1='copy_with_weights', mrg_fracname1='ifrac') + end if + else if (coupling_mode == 'nems_orig') then + if (fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw'//iso(n), rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_meltw'//iso(n), compocn, mapfcopy, 'unset', 'unset') + ! custom merge in med_phases_prep_ocn + end if + else if (coupling_mode == 'nems_frac') then + if (fldchk(is_local%wrap%FBImp(compice, compice), 'Fioi_meltw'//iso(n), rc=rc)) then + call addmap(fldListFr(compice)%flds, 'Fioi_meltw'//iso(n), compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, 'Fioi_meltw'//iso(n), & + mrg_from1=compice, mrg_fld1='Fioi_meltw'//iso(n), mrg_type1='copy_with_weights', mrg_fracname1='ifrac') + end if + end if + end if + end do + + ! --------------------------------------------------------------------- + ! to ocn: heat flux from melting ice from ice + ! to ocn: salt flux from ice + ! to ocn: hydrophylic black carbon deposition flux from ice + ! to ocn: hydrophobic black carbon deposition flux from ice + ! to ocn: dust flux from ice + ! --------------------------------------------------------------------- + ! TODO (mvertens, 2019-01-07): is fioi_melth being handled here? + ! Is fd.yaml correctly aliasing Fioi_melth? + + allocate(flds(5)) + flds = (/'Fioi_melth', 'Fioi_salt', 'Fioi_bcphi', 'Fioi_bcpho', 'Fioi_flxdst'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compice)%flds, trim(fldname)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBExp(compocn) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compice, compice), trim(fldname), rc=rc)) then + call addmap(fldListFr(compice)%flds, trim(fldname), compocn, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compocn)%flds, trim(fldname), & + mrg_from1=compice, mrg_fld1=trim(fldname), mrg_type1='copy_with_weights', mrg_fracname1='ifrac') + end if + end if + end do + deallocate(flds) + + !----------------------------- + ! to ocn: liquid runoff from rof and glc components + ! to ocn: frozen runoff flux from rof and glc components + ! to ocn: waterflux back to ocn due to flooding from rof + !----------------------------- + + if (phase == 'advertise') then + do n = 1,size(iso) + call addfld(fldListFr(compglc)%flds, 'Fogg_rofl'//iso(n)) + call addfld(fldListFr(compglc)%flds, 'Fogg_rofi'//iso(n)) + call addfld(fldListFr(comprof)%flds, 'Forr_rofl'//iso(n)) + call addfld(fldListFr(comprof)%flds, 'Forr_rofi'//iso(n)) + call addfld(fldListTo(compocn)%flds, 'Foxx_rofl'//iso(n)) + call addfld(fldListTo(compocn)%flds, 'Foxx_rofi'//iso(n)) + end do + else + do n = 1,size(iso) + ! 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') + + ! liquid runoff from rof and flood 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) .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, 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, mapconsf, 'none', rof2ocn_liq_rmap) + call addmrg(fldListTo(compocn)%flds, 'Foxx_rofl'//iso(n), & + 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, 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 + + ! ice runoff from both rof and glc to ocn + 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, 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') + + ! 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, 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, 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 + end do + end if + + !----------------------------- + ! to ocn: Langmuir multiplier from wave + ! to ocn: Stokes drift u component from wave + ! to ocn: Stokes drift v component from wave + ! to ocn: Stokes drift depth from wave + !----------------------------- + allocate(flds(4)) + flds = (/'Sw_lamult', 'Sw_ustokes', 'Sw_vstokes', 'Sw_hstokes'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compwav)%flds, trim(fldname)) + call addfld(fldListTo(compocn)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBExp(compocn) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compwav, compwav), trim(fldname), rc=rc)) then + call addmap(fldListFr(compwav)%flds, trim(fldname), compocn, mapbilnr, 'one', wav2ocn_smap) + call addmrg(fldListTo(compocn)%flds, trim(fldname), & + mrg_from1=compwav, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + !===================================================================== + ! FIELDS TO ICE (compice) + !===================================================================== + + ! --------------------------------------------------------------------- + ! to ice: downward longwave heat flux from atm + ! to ice: downward direct near-infrared incident solar radiation from atm + ! to ice: downward direct visible incident solar radiation from atm + ! to ice: downward diffuse near-infrared incident solar radiation from atm + ! to ice: downward Diffuse visible incident solar radiation from atm + ! to ice: hydrophylic black carbon dry deposition flux from atm + ! to ice: hydrophobic black carbon dry deposition flux from atm + ! to ice: hydrophylic black carbon wet deposition flux from atm + ! to ice: hydrophylic organic carbon dry deposition flux from atm + ! to ice: hydrophobic organic carbon dry deposition flux from atm + ! to ice: hydrophylic organic carbon wet deposition flux from atm + ! to ice: dust wet deposition flux (size 1) from atm + ! to ice: dust wet deposition flux (size 2) from atm + ! to ice: dust wet deposition flux (size 3) from atm + ! to ice: dust wet deposition flux (size 4) from atm + ! to ice: dust dry deposition flux (size 1) from atm + ! to ice: dust dry deposition flux (size 2) from atm + ! to ice: dust dry deposition flux (size 3) from atm + ! to ice: dust dry deposition flux (size 4) from atm + ! --------------------------------------------------------------------- + allocate(flds(9)) + flds = (/'Faxa_lwdn' , 'Faxa_swndr' , 'Faxa_swvdr' , 'Faxa_swndf' , 'Faxa_swvdf', & + 'Faxa_bcph' , 'Faxa_ocph' , 'Faxa_dstwet' , 'Faxa_dstdry' /) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compice)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBExp(compice) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapconsf, 'one', atm2ice_fmap) + call addmrg(fldListTo(compice)%flds, trim(fldname), & + mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to ice: convective and large scale precipitation rate water equivalent from atm + ! to ice: rain and snow rate from atm + ! --------------------------------------------------------------------- + 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 (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 + 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 + ! to ice: pressure at the lowest model level fromatm + ! to ice: temperature at the lowest model level from atm + ! to ice: potential temperature at the lowest model level from atm + ! to ice: density at the lowest model level from atm + ! to ice: zonal wind at the lowest model level from atm + ! to ice: meridional wind at the lowest model level from atm + ! to ice: specific humidity at the lowest model level from atm + ! to ice: specific humidity for water isotopes at the lowest model level from atm + ! --------------------------------------------------------------------- + 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)) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compice)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), trim(fldname), rc=rc)) then + if (trim(fldname) == 'Sa_u' .or. trim(fldname) == 'Sa_v') then + call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mappatch, 'one', atm2ice_vmap) + else + call addmap(fldListFr(compatm)%flds, trim(fldname), compice, mapbilnr, 'one', atm2ice_smap) + end if + call addmrg(fldListTo(compice)%flds, trim(fldname), & + mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to ice: sea surface temperature from ocn + ! to ice: sea surface salinity from ocn + ! to ice: zonal sea water velocity from ocn + ! to ice: meridional sea water velocity from ocn + ! to ice: zonal sea surface slope from ocean + ! to ice: meridional sea surface slope from ocn + ! --------------------------------------------------------------------- + allocate(flds(6)) + flds = (/'So_t', 'So_s', 'So_u', 'So_v', 'So_dhdx', 'So_dhdy'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, trim(fldname)) + call addfld(fldListTo(compice)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBexp(compice) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compocn,compocn), trim(fldname), rc=rc)) then + call addmap(fldListFr(compocn)%flds, trim(fldname), compice, mapfcopy , 'unset', 'unset') + call addmrg(fldListTo(compice)%flds, trim(fldname), & + mrg_from1=compocn, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + ! --------------------------------------------------------------------- + ! to ice: ocean melt and freeze potential from ocn + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'Fioo_q') + call addfld(fldListTo(compice)%flds, 'Fioo_q') + else + if ( fldchk(is_local%wrap%FBImp(compocn, compocn), 'Fioo_q', rc=rc) .and. & + fldchk(is_local%wrap%FBExp(compice) , 'Fioo_q', rc=rc)) then + call addmap(fldListFr(compocn)%flds, 'Fioo_q', compice, mapfcopy, 'unset', 'unset') + call addmrg(fldListTo(compice)%flds, 'Fioo_q', mrg_from1=compocn, mrg_fld1='Fioo_q', mrg_type1='copy') + 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 + ! --------------------------------------------------------------------- + do n = 1,size(iso) + if (phase == 'advertise') then + call addfld(fldListFr(comprof)%flds, 'Firr_rofi'//iso(n)) ! water flux into sea ice due to runoff (frozen) + call addfld(fldListFr(compglc)%flds, 'Figg_rofi'//iso(n)) ! glc frozen runoff_iceberg flux to ice + call addfld(fldListTo(compice)%flds, 'Fixx_rofi'//iso(n)) ! total frozen water flux into sea ice + 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) .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, 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') + + 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, 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 + end if + end do + + !===================================================================== + ! FIELDS TO WAVE (compwav) + !===================================================================== + + !---------------------------------------------------------- + ! to wav: fractional ice coverage wrt ocean from ice + !---------------------------------------------------------- + if (phase == 'advertise') then + 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 + ! --------------------------------------------------------------------- + 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 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(3)) + flds = (/'Sa_u', 'Sa_v', 'Sa_tbot'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, trim(fldname)) + call addfld(fldListTo(compwav)%flds, trim(fldname)) + else + if ( fldchk(is_local%wrap%FBexp(compwav) , trim(fldname), rc=rc) .and. & + fldchk(is_local%wrap%FBImp(compatm,compatm ), trim(fldname), rc=rc)) then + call addmap(fldListFr(compatm)%flds, trim(fldname), compwav, mapbilnr, 'one', atm2wav_smap) + call addmrg(fldListTo(compwav)%flds, trim(fldname), & + mrg_from1=compatm, mrg_fld1=trim(fldname), mrg_type1='copy') + end if + end if + end do + deallocate(flds) + + !===================================================================== + ! FIELDS TO RIVER (comprof) + !===================================================================== + + ! --------------------------------------------------------------------- + ! to rof: water flux from land (liquid surface) + ! to rof: water flux from land (liquid glacier, wetland, and lake) + ! to rof: water flux from land (liquid subsurface) + ! to rof: water flux from land direct to ocean + ! 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(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'/) + + do n = 1,size(flds) + fldname = trim(flds(n)) + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, trim(fldname)) + call addfld(fldListTo(comprof)%flds, trim(fldname)) + 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, '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 + end if + end do + deallocate(flds) + + !===================================================================== + ! FIELDS TO LAND-ICE (compglc) + !===================================================================== + + !----------------------------- + ! to glc: from land + !----------------------------- + ! - fields sent from lnd->med ARE in multiple elevation classes + ! - fields sent from med->glc do NOT have elevation classes + + ! 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) + ! Note : Sl_topo is sent from lnd -> med, but is NOT sent to glc (only used for the remapping in the mediator) + + 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 + + !===================================================================== + ! CO2 EXCHANGE + !===================================================================== + + 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) + + 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) + + 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) + + if (flds_co2a) then + ! --------------------------------------------------------------------- + ! to lnd and ocn: prognostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_co2prog') + call addfld(fldListTo(complnd)%flds, 'Sa_co2prog') + call addfld(fldListTo(compocn)%flds, 'Sa_co2prog') + else + call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_smap) + call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_smap) + + call addmrg(fldListTo(complnd)%flds, 'Sa_co2prog', & + mrg_from1=compatm, mrg_fld1='Sa_co2prog', mrg_type1='copy') + call addmrg(fldListTo(compocn)%flds, 'Sa_co2prog', & + mrg_from1=compatm, mrg_fld1='Sa_co2prog', mrg_type1='copy') + end if + + ! --------------------------------------------------------------------- + ! to lnd and ocn: diagnostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_co2diag') + call addfld(fldListTo(complnd)%flds, 'Sa_co2diag') + call addfld(fldListTo(compocn)%flds, 'Sa_co2diag') + else + call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_smap) + call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_smap) + + call addmrg(fldListTo(complnd)%flds, 'Sa_co2diag', & + mrg_from1=compatm, mrg_fld1='Sa_co2diag', mrg_type1='copy') + call addmrg(fldListTo(compocn)%flds, 'Sa_co2diag', & + mrg_from1=compatm, mrg_fld1='Sa_co2diag', mrg_type1='copy') + end if + + else if (flds_co2b) then + + ! --------------------------------------------------------------------- + ! to lnd: prognostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_co2prog') + call addfld(fldListTo(complnd)%flds, 'Sa_co2prog') + else + call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_smap) + call addmrg(fldListTo(complnd)%flds, 'Sa_co2prog', & + mrg_from1=compatm, mrg_fld1='Sa_co2prog', mrg_type1='copy') + end if + + ! --------------------------------------------------------------------- + ! to lnd: diagnostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_co2diag') + call addfld(fldListTo(complnd)%flds, 'Sa_co2diag') + else + call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_smap) + call addmrg(fldListTo(complnd)%flds, 'Sa_co2diag', & + mrg_from1=compatm, mrg_fld1='Sa_co2diag', mrg_type1='copy') + end if + + ! --------------------------------------------------------------------- + ! to atm: surface flux of CO2 from land + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Fall_fco2_lnd') + call addfld(fldListTo(compatm)%flds, 'Fall_fco2_lnd') + else + call addmap(fldListFr(complnd)%flds, 'Fall_fco2_lnd', compatm, mapconsf, 'one', atm2lnd_smap) + call addmrg(fldListTo(compatm)%flds, 'Fall_fco2_lnd', & + mrg_from1=complnd, mrg_fld1='Fall_fco2_lnd', mrg_type1='copy_with_weights', mrg_fracname1='lfrac') + end if + + else if (flds_co2c) then + + ! --------------------------------------------------------------------- + ! to lnd and ocn: prognostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_co2prog') + call addfld(fldListTo(complnd)%flds, 'Sa_co2prog') + call addfld(fldListTo(compocn)%flds, 'Sa_co2prog') + else + call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', complnd, mapbilnr, 'one', atm2lnd_smap) + call addmap(fldListFr(compatm)%flds, 'Sa_co2prog', compocn, mapbilnr, 'one', atm2ocn_smap) + + call addmrg(fldListTo(complnd)%flds, 'Sa_co2prog', & + mrg_from1=compatm, mrg_fld1='Sa_co2prog', mrg_type1='copy') + call addmrg(fldListTo(compocn)%flds, 'Sa_co2prog', & + mrg_from1=compatm, mrg_fld1='Sa_co2prog', mrg_type1='copy') + end if + + ! --------------------------------------------------------------------- + ! to lnd and ocn: diagnostic CO2 at the lowest atm model level + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compatm)%flds, 'Sa_co2diag') + call addfld(fldListTo(complnd)%flds, 'Sa_co2diag') + call addfld(fldListTo(compocn)%flds, 'Sa_co2diag') + else + call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', complnd, mapbilnr, 'one', atm2lnd_smap) + call addmap(fldListFr(compatm)%flds, 'Sa_co2diag', compocn, mapbilnr, 'one', atm2ocn_smap) + + call addmrg(fldListTo(complnd)%flds, 'Sa_co2diag', & + mrg_from1=compatm, mrg_fld1='Sa_co2diag', mrg_type1='copy') + call addmrg(fldListTo(compocn)%flds, 'Sa_co2diag', & + mrg_from1=compatm, mrg_fld1='Sa_co2diag', mrg_type1='copy') + end if + + ! --------------------------------------------------------------------- + ! to atm: surface flux of CO2 from land + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(complnd)%flds, 'Fall_fco2_lnd') + call addfld(fldListTo(compatm)%flds, 'Fall_fco2_lnd') + else + call addmap(fldListFr(complnd)%flds, 'Fall_fco2_lnd', compatm, mapconsf, 'one', atm2lnd_smap) + call addmrg(fldListTo(compatm)%flds, 'Fall_fco2_lnd', & + mrg_from1=complnd, mrg_fld1='Fall_fco2_lnd', mrg_type1='copy_with_weights', mrg_fracname1='lfrac') + end if + + ! --------------------------------------------------------------------- + ! to atm: surface flux of CO2 from ocn + ! --------------------------------------------------------------------- + if (phase == 'advertise') then + call addfld(fldListFr(compocn)%flds, 'Faoo_fco2_ocn') + call addfld(fldListTo(compatm)%flds, 'Faoo_fco2_ocn') + else + call addmap(fldListFr(complnd)%flds, 'Faoo_fco2_ocn', compatm, mapconsf, 'one', atm2lnd_smap) + ! custom merge in med_phases_prep_atm + end if + endif + + !----------------------------------------------------------------------------- + ! CARMA fields (volumetric soil water) + !----------------------------------------------------------------------------- + ! TODO: add this + ! if (carma_flds /= ' ') then + ! do n = 1,shr_string_listGetNum(carma_flds) + ! call addfld(fldListFr(complnd)%flds, trim(fldname)) + ! call addmap(fldListFr(complnd)%flds, trim(fldname), compatm, mapconsf, 'one',lnd2atm_smap) + ! call addfld(fldListTo(compatm)%flds, trim(fldname), mrg_from1=complnd, mrg_fld1=trim(fldname), mrg_type1='copy') + ! enddo + ! endif + + end subroutine esmFldsExchange + +end module esmFldsExchange_mod diff --git a/cime/src/drivers/nuopc/mediator/fd.yaml b/cime/src/drivers/nuopc/mediator/fd.yaml new file mode 100644 index 000000000000..3936273fcdaf --- /dev/null +++ b/cime/src/drivers/nuopc/mediator/fd.yaml @@ -0,0 +1,1443 @@ + 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: + # + #----------------------------------- + # section: mediator export for atm/ocn flux calculation + #----------------------------------- + # + - standard_name: Faox_evap + alias: mean_evap_rate_atm_into_ocn + canonical_units: kg m-2 s-1 + description: mediator export + atm/ocn evaporation water flux + # + - 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: 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 + # + #----------------------------------- + # section: land export + #----------------------------------- + # + - standard_name: Fall_evap + canonical_units: kg m-2 s-1 + description: land export + # + - standard_name: Fall_evap_wiso + 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_fire + canonical_units: kg/m2/sec + description: land export + wild fire emission fluxes (1->10) + # + - standard_name: Fall_flxdst + canonical_units: kg m-2 s-1 + description: land export + dust fluxes from land (sizes 1->4) + # + - 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_voc + canonical_units: molecules/m2/sec + description: land export + MEGAN voc emission fluxes from land (1->20) + # + - 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_ddvel + canonical_units: cm/sec + description: land export + dry deposition velocities from (1->80) + # + - 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_wiso + 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_wiso + canonical_units: m + description: land export + # + - standard_name: Sl_t + canonical_units: K + description: land export + # + - standard_name: Sl_topo_elev + canonical_units: m + description: land export to mediator in elevation classes (1->glc_nec) + # + - standard_name: Sl_topo + canonical_units: m + description: mediator export to glc - no levation classes + # + - standard_name: Sl_tsrf_elev + canonical_units: deg C + description: land export to mediator in elevation classes (1->glc_nec) + # + - standard_name: Sl_tsrf + canonical_units: deg C + description: mediator export to gcl with no elevation classes + # + - standard_name: Sl_tref + canonical_units: K + description: mediator export to glc - no levation classes + # + - standard_name: Sl_u10 + canonical_units: m + description: land export + # + #----------------------------------- + # section: atmosphere export + #----------------------------------- + # + - standard_name: Faxa_bcph + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_ocph + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_dstdry + canonical_units: kg m-2 s-1 + description: atmosphere export + # + - standard_name: Faxa_dstwet + 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: Faxa_lwnet + alias: mean_net_lw_flx_atm + canonical_units: W m-2 + description: atmosphere export + mean merge longwave flux from atm (NEMS) + # + - 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_atm + 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_ndep + canonical_units: kg(N)/m2/sec + description: atmosphere export to land and ocean + currently nhx and noy + # + - standard_name: Faxa_prec_wiso + 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_wiso + alias: mean_prec_rate_wiso + 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_wiso + 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_wiso + 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_wiso + 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_wiso + 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_wiso + 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_wiso + alias: inst_spec_humid_height_lowest_wiso + canonical_units: kg kg-1 + description: atmosphere export + bottom layer specific humidity 16O, 18O, 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 + +### FV3 work - NEMS S2S benchmark (not including fractional branch) + + - standard_name: mean_up_lw_flx + alias: Faxx_lwup + canonical_units: W m-2 + description: atmosphere import - merged ocn/ice flux + +############ + # + #----------------------------------- + # section: atmosphere import + #----------------------------------- + # + - standard_name: Faxx_evap + canonical_units: kg m-2 s-1 + description: atmosphere import + # + - standard_name: Faxx_evap_wiso + 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 + 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_wiso + 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 + # + #----------------------------------- + # section: 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: Figg_rofi_wiso + canonical_units: kg m-2 s-1 + description: land-ice export + glc frozen runoff_iceberg flux to ice for 16O, 18O, HDO + # + - standard_name: Flgg_hflx + canonical_units: W m-2 + description: land-ice export to mediator (no elevatino classes) + Downward heat flux from glacier interior, from mediator, elev class 0 + # + - standard_name: Flgg_hflx_elev + canonical_units: W m-2 + 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: Sg_ice_covered + canonical_units: 1 + description: land-ice export to mediator (no elevation classes) + # + - standard_name: Sg_ice_covered_elev + canonical_units: 1 + description: mediator land-ice export to lnd (elevation classes 1->glc_nec) + # + - 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 to mediator (no elevation classes) + # + - standard_name: Sg_topo_elev + canonical_units: m + 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_wiso + canonical_units: kg m-2 s-1 + description: land-ice export + 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_wiso + canonical_units: kg m-2 s-1 + description: land-ice export + glacier_frozen_runoff_flux_to_ocean for 16O, 18O, HDO + # + #----------------------------------- + # section: 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_wiso + canonical_units: kg m-2 s-1 + description: sea-ice export for 16O, 18O, HDO + # + - 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_wiso + canonical_units: kg m-2 s-1 + description: sea-ice export to ocean + isotope head flux to ocean for 16O, 18O, HDO + # + - 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_wiso + alias: mean_fresh_water_to_ocean_rate_wiso + canonical_units: kg m-2 s-1 + 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 + 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_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_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_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_sw_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 + alias: ice_fraction_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_wiso + canonical_units: kg kg-1 + description: sea-ice export to atm + 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 + # + #----------------------------------- + # section: ocean export to mediator + #----------------------------------- + # + - 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 (cesm only) + # + - standard_name: So_anidf + canonical_units: 1 + description: ocean export (cesm only) + # + - standard_name: So_anidr + canonical_units: 1 + description: ocean export (cesm only) + # + - standard_name: So_avsdf + canonical_units: 1 + description: ocean export (cesm only) + # + - standard_name: So_avsdr + canonical_units: 1 + description: ocean export (cesm only) + # + - 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 + alias: ocean_mask + canonical_units: 1 + description: ocean export + # + - standard_name: So_qref + canonical_units: kg kg-1 + description: ocean export + # + - standard_name: So_qref_wiso + canonical_units: kg kg-1 + description: ocean export + # + - standard_name: So_re + canonical_units: 1 + description: ocean export + # + - standard_name: So_qref_wiso + canonical_units: kg kg-1 + description: ocean export + # + - standard_name: So_roce_wiso + canonical_units: unitless + 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 + # + #----------------------------------- + # section: river export + #----------------------------------- + # + - standard_name: Firr_rofi + canonical_units: kg m-2 s-1 + description: river export + water flux into sea ice due to runoff (frozen) + # + - 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, 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_wiso + canonical_units: kg m-2 s-1 + description: frozen runoff to ice from river and land-ice for 16O, 18O, HDO + # + #----------------------------------- + # section: lnd export to glc + #----------------------------------- + # + - standard_name: Flgl_qice + canonical_units: kg m-2 s-1 + description: mediator export to glc no elevation classes + # + - standard_name: Flgl_qice_elev + canonical_units: kg m-2 s-1 + description: land export to mediator in elevation classes (1->glc_nec) + # + #----------------------------------- + # section: 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 + # + #----------------------------------- + # section: 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_flood_wiso + canonical_units: kg m-2 s-1 + description: river export to land + 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_wiso + canonical_units: m + description: river export to land + 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_wiso + canonical_units: m + description: river export to land + 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_wiso + canonical_units: kg m-2 s-1 + description: river export to ocean + 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_wiso + canonical_units: kg m-2 s-1 + description: river export to ocean + Water flux due to runoff (frozen) for 16O, 18O, HDO + # + #----------------------------------- + # section: 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_wiso + alias: mean_evap_rate_wiso + canonical_units: kg m-2 s-1 + description: ocean import + 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_wiso + canonical_units: W m-2 + description: ocean import + latent heat flux into ocean for 16O, 18O, HDO (cesm only) + # + - standard_name: Foxx_lat + canonical_units: W m-2 + description: ocean import + latent heat flux into ocean for HDO (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: mean_runoff_rate + canonical_units: kg m-2 s-1 + description: ocean import + total runoff to ocean + # + - standard_name: mean_runoff_heat_flux + canonical_units: kg m-2 s-1 + description: ocean import + heat content of runoff + # + - standard_name: mean_calving_rate + canonical_units: kg m-2 s-1 + description: ocean import + total calving to ocean + # + - standard_name: mean_calving_heat_flux + canonical_units: kg m-2 s-1 + description: ocean import + heat content of calving + # + - standard_name: Foxx_rofi + canonical_units: kg m-2 s-1 + description: ocean import + water flux due to runoff (frozen) + # + - standard_name: Foxx_rofi_wiso + canonical_units: kg m-2 s-1 + description: ocean import + water flux due to runoff (frozen) for 16O, 18O, HDO + # + - standard_name: Foxx_rofl + alias: mean_runoff_rate + canonical_units: kg m-2 s-1 + description: ocean import + water flux due to runoff (liquid) + # + - standard_name: Foxx_rofl_wiso + canonical_units: kg m-2 s-1 + description: ocean import + water flux due to runoff (liquid) for 16O, 18O, HDO + # + - 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 + 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 + 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/cime/src/drivers/nuopc/mediator/med.F90 b/cime/src/drivers/nuopc/mediator/med.F90 index 631c5153ab36..0ea2d2d22d54 100644 --- a/cime/src/drivers/nuopc/mediator/med.F90 +++ b/cime/src/drivers/nuopc/mediator/med.F90 @@ -4,13 +4,28 @@ module MED ! Mediator Component. !----------------------------------------------------------------------------- - use med_constants_mod , only: CX, R8, CL - use med_constants_mod , only: dbug_flag => med_constants_dbug_flag - use med_constants_mod , only: spval_init => med_constants_spval_init - use med_constants_mod , only: spval => med_constants_spval - use med_constants_mod , only: czero => med_constants_czero - use med_constants_mod , only: ispval_mask => med_constants_ispval_mask - use shr_nuopc_methods_mod , only: shr_nuopc_methods_ChkErr + use med_constants_mod , only : CX, R8, CL, CS + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_constants_mod , only : spval_init => med_constants_spval_init + use med_constants_mod , only : spval => med_constants_spval + use med_constants_mod , only : czero => med_constants_czero + use med_constants_mod , only : ispval_mask => med_constants_ispval_mask + use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr + use shr_nuopc_methods_mod , only : Field_GeomPrint => shr_nuopc_methods_Field_GeomPrint + use shr_nuopc_methods_mod , only : State_GeomPrint => shr_nuopc_methods_State_GeomPrint + use shr_nuopc_methods_mod , only : State_GeomWrite => shr_nuopc_methods_State_GeomWrite + use shr_nuopc_methods_mod , only : State_reset => shr_nuopc_methods_State_reset + use shr_nuopc_methods_mod , only : State_getNumFields => shr_nuopc_methods_State_getNumFields + use shr_nuopc_methods_mod , only : State_GetScalar => shr_nuopc_methods_State_GetScalar + use shr_nuopc_methods_mod , only : FB_Init => shr_nuopc_methods_FB_init + use shr_nuopc_methods_mod , only : FB_Init_pointer => shr_nuopc_methods_FB_Init_pointer + use shr_nuopc_methods_mod , only : FB_Reset => shr_nuopc_methods_FB_Reset + use shr_nuopc_methods_mod , only : FB_Copy => shr_nuopc_methods_FB_Copy + use shr_nuopc_methods_mod , only : FB_FldChk => shr_nuopc_methods_FB_FldChk + use shr_nuopc_methods_mod , only : clock_timeprint => shr_nuopc_methods_clock_timeprint + use shr_nuopc_time_mod , only : set_stop_alarm => shr_nuopc_time_set_component_stop_alarm + use shr_nuopc_time_mod , only : alarmInit => shr_nuopc_time_alarmInit + use shr_nuopc_utils_mod , only : memcheck => shr_nuopc_memcheck implicit none private @@ -35,6 +50,7 @@ module MED !----------------------------------------------------------------------------- subroutine SetServices(gcomp, rc) + use ESMF , only: ESMF_SUCCESS, ESMF_GridCompSetEntryPoint, ESMF_METHOD_INITIALIZE, ESMF_METHOD_RUN use ESMF , only: ESMF_GridComp, ESMF_MethodRemove use NUOPC , only: NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize, NUOPC_NOOP @@ -74,7 +90,7 @@ subroutine SetServices(gcomp, rc) !------------------ call NUOPC_CompDerive(gcomp, mediator_routine_SS, 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 @@ -83,7 +99,7 @@ subroutine SetServices(gcomp, rc) call ESMF_GridCompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & InitializeP0, phase=0, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! IPDv03p1: advertise Fields @@ -96,7 +112,7 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & phaseLabelList=(/"IPDv03p1"/), userRoutine=InitializeIPDv03p1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! IPDv03p3: realize connected Fields with transfer action "provide" @@ -104,7 +120,7 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & phaseLabelList=(/"IPDv03p3"/), userRoutine=InitializeIPDv03p3, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! IPDv03p4: optionally modify the decomp/distr of transferred Grid/Mesh @@ -112,7 +128,7 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & phaseLabelList=(/"IPDv03p4"/), userRoutine=InitializeIPDv03p4, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! IPDv03p5: realize all Fields with transfer action "accept" @@ -120,7 +136,7 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, & phaseLabelList=(/"IPDv03p5"/), userRoutine=InitializeIPDv03p5, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! attach specializing method for DataInitialize @@ -128,7 +144,7 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_DataInitialize, & specRoutine=DataInitialize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! setup mediator history phase @@ -136,10 +152,10 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_history_write"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_phases_history_write", specRoutine=med_phases_history_write, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! setup mediator restart phase @@ -147,10 +163,10 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_restart_write"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_phases_restart_write", specRoutine=med_phases_restart_write, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! setup mediator profile phase @@ -158,10 +174,10 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_profile"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_phases_profile", specRoutine=med_phases_profile, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! prep routines for atm @@ -169,10 +185,10 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_prep_atm"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_phases_prep_atm", specRoutine=med_phases_prep_atm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! prep routines for ocn @@ -180,31 +196,31 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_prep_ocn_map"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_phases_prep_ocn_map", specRoutine=med_phases_prep_ocn_map, 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_RUN, & phaseLabelList=(/"med_phases_prep_ocn_merge"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_phases_prep_ocn_merge", specRoutine=med_phases_prep_ocn_merge, 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_RUN, & phaseLabelList=(/"med_phases_prep_ocn_accum_fast"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_phases_prep_ocn_accum_fast", specRoutine=med_phases_prep_ocn_accum_fast, 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_RUN, & phaseLabelList=(/"med_phases_prep_ocn_accum_avg"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_phases_prep_ocn_accum_avg", specRoutine=med_phases_prep_ocn_accum_avg, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! prep routines for ice @@ -212,10 +228,10 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_prep_ice"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_phases_prep_ice", specRoutine=med_phases_prep_ice, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! prep routines for lnd @@ -223,10 +239,10 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_prep_lnd"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_phases_prep_lnd", specRoutine=med_phases_prep_lnd, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! prep routines for rof @@ -234,17 +250,17 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_prep_rof_avg"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_phases_prep_rof_avg", specRoutine=med_phases_prep_rof_avg, 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_RUN, & phaseLabelList=(/"med_phases_prep_rof_accum_fast"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_phases_prep_rof_accum_fast", specRoutine=med_phases_prep_rof_accum_fast, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! prep routines for wav @@ -252,10 +268,10 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_prep_wav"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_phases_prep_wav", specRoutine=med_phases_prep_wav, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! prep routines for glc @@ -263,10 +279,10 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_prep_glc"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_phases_prep_glc", specRoutine=med_phases_prep_glc, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! phase routine for ocean albedo computation @@ -274,10 +290,10 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_ocnalb_run"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_phases_ocnalb_run", specRoutine=med_phases_ocnalb_run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! phase routine for ocn/atm flux computation @@ -285,10 +301,10 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_phases_aofluxes_run"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_phases_aofluxes_run", specRoutine=med_phases_aofluxes_run, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! phase routine for updating fractions @@ -296,10 +312,10 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_RUN, & phaseLabelList=(/"med_fraction_set"/), userRoutine=mediator_routine_Run, 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=mediator_label_Advance, & specPhaseLabel="med_fraction_set", specRoutine=med_fraction_set, 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) @@ -307,9 +323,9 @@ subroutine SetServices(gcomp, rc) !------------------ call ESMF_MethodRemove(gcomp, mediator_label_CheckImport, 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=mediator_label_CheckImport, specRoutine=NUOPC_NoOp, 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) @@ -317,9 +333,9 @@ subroutine SetServices(gcomp, rc) !------------------ call ESMF_MethodRemove(gcomp, mediator_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=mediator_label_SetRunClock, specRoutine=SetRunClock, 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) @@ -328,7 +344,7 @@ subroutine SetServices(gcomp, rc) call NUOPC_CompSpecialize(gcomp, specLabel=mediator_label_Finalize, & specRoutine=med_finalize, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end subroutine SetServices @@ -358,15 +374,15 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) rc = ESMF_SUCCESS 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=localPet, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return mastertask = .false. if (localPet == 0) mastertask=.true. call ESMF_AttributeGet(gcomp, name="Verbosity", value=value, defaultValue="max", & convention="NUOPC", purpose="Instance", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": Mediator verbosity is "//trim(value), ESMF_LOGMSG_INFO) @@ -376,7 +392,7 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) ! 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) @@ -392,15 +408,15 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_SUCCESS, ESMF_LogFoundAllocError use ESMF , only : ESMF_LogMsg_Info, ESMF_LogWrite use NUOPC , only : NUOPC_AddNamespace, NUOPC_Advertise - use med_constants_mod , only : CS - use med_internalstate_mod , only : InternalState - use shr_nuopc_scalars_mod , only : flds_scalar_name, flds_scalar_num + use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_CompAttributeSet, NUOPC_CompAttributeAdd + use med_internalstate_mod , only : InternalState, logunit use esmFlds , only : ncomps, compmed, compatm, compocn use esmFlds , only : compice, complnd, comprof, compwav, compglc, compname use esmFlds , only : fldListFr, fldListTo use esmFlds , only : shr_nuopc_fldList_GetNumFlds use esmFlds , only : shr_nuopc_fldList_GetFldInfo use esmFldsExchange_mod , only : esmFldsExchange + use med_internalstate_mod , only : mastertask ! input/output variables type(ESMF_GridComp) :: gcomp @@ -412,8 +428,14 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) character(len=CS) :: stdname, shortname integer :: n, n1, n2, ncomp, nflds character(len=CS) :: transferOffer + character(len=CS) :: cvalue type(InternalState) :: is_local integer :: stat + character(len=8) :: atm_present, lnd_present + character(len=8) :: ice_present, rof_present + character(len=8) :: glc_present, med_present + character(len=8) :: ocn_present, wav_present + character(len=32) :: attrList(8) character(len=*),parameter :: subname='(module_MED:InitializeIPDv03p1)' !----------------------------------------------------------- @@ -431,7 +453,7 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) end if call ESMF_GridCompSetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! add a namespace (i.e. nested state) for each import and export component state in the mediator's InternalState @@ -475,7 +497,101 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) !------------------ call esmFldsExchange(gcomp, phase='advertise', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------ + ! Determine component present indices + !------------------ + + call NUOPC_CompAttributeAdd(gcomp, & + attrList=(/'atm_present','lnd_present','ocn_present','ice_present',& + 'rof_present','wav_present','glc_present','med_present'/), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + med_present = "true" + atm_present = "true" + lnd_present = "true" + ocn_present = "true" + ice_present = "true" + rof_present = "true" + wav_present = "true" + glc_present = "true" + + call NUOPC_CompAttributeGet(gcomp, name='ATM_model', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(cvalue) == 'satm') atm_present = "false" + call NUOPC_CompAttributeGet(gcomp, name='LND_model', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(cvalue) == 'slnd') lnd_present = "false" + call NUOPC_CompAttributeGet(gcomp, name='OCN_model', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(cvalue) == 'socn') ocn_present = "false" + call NUOPC_CompAttributeGet(gcomp, name='ICE_model', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(cvalue) == 'sice') ice_present = "false" + call NUOPC_CompAttributeGet(gcomp, name='ROF_model', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(cvalue) == 'srof') rof_present = "false" + call NUOPC_CompAttributeGet(gcomp, name='WAV_model', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(cvalue) == 'swav') wav_present = "false" + call NUOPC_CompAttributeGet(gcomp, name='GLC_model', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (trim(cvalue) == 'sglc') glc_present = "false" + + call NUOPC_CompAttributeSet(gcomp, name="atm_present", value=atm_present, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name="lnd_present", value=lnd_present, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name="ocn_present", value=ocn_present, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name="ice_present", value=ice_present, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name="rof_present", value=rof_present, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name="wav_present", value=wav_present, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name="glc_present", value=glc_present, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeSet(gcomp, name="med_present", value=med_present, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (mastertask) then + write(logunit,*) + write(logunit,*) "atm_present="//trim(atm_present) + write(logunit,*) "lnd_present="//trim(lnd_present) + write(logunit,*) "ocn_present="//trim(ocn_present) + write(logunit,*) "ice_present="//trim(ice_present) + write(logunit,*) "rof_present="//trim(rof_present) + write(logunit,*) "wav_present="//trim(wav_present) + write(logunit,*) "glc_present="//trim(glc_present) + write(logunit,*) "med_present="//trim(med_present) + write(logunit,*) + end if + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + is_local%wrap%flds_scalar_name = trim(cvalue) + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue, *) is_local%wrap%flds_scalar_num + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) is_local%wrap%flds_scalar_index_nx + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) is_local%wrap%flds_scalar_index_ny + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxNextSwCday", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) is_local%wrap%flds_scalar_index_nextsw_cday + + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxPrecipFactor", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) is_local%wrap%flds_scalar_index_precip_factor !------------------ ! Advertise import/export mediator field names @@ -486,32 +602,32 @@ subroutine InitializeIPDv03p1(gcomp, importState, exportState, clock, rc) nflds = shr_nuopc_fldList_GetNumFlds(fldListFr(ncomp)) do n = 1,nflds call shr_nuopc_fldList_GetFldInfo(fldListFr(ncomp), n, stdname, shortname) - if (trim(shortname) == flds_scalar_name) then + if (trim(shortname) == is_local%wrap%flds_scalar_name) then transferOffer = 'will provide' else transferOffer = 'cannot provide' end if call NUOPC_Advertise(is_local%wrap%NStateImp(ncomp), standardName=stdname, shortname=shortname, name=shortname, & TransferOfferGeomObject=transferOffer) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(subname//':Fr_'//trim(compname(ncomp))//': '//trim(shortname), ESMF_LOGMSG_INFO) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end do nflds = shr_nuopc_fldList_GetNumFlds(fldListTo(ncomp)) do n = 1,nflds call shr_nuopc_fldList_GetFldInfo(fldListTo(ncomp), n, stdname, shortname) - if (trim(shortname) == flds_scalar_name) then + if (trim(shortname) == is_local%wrap%flds_scalar_name) then transferOffer = 'will provide' else transferOffer = 'cannot provide' end if 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 + if (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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end do end if end do ! end of ncomps loop @@ -529,12 +645,10 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_GridComp, ESMF_State, ESMF_Clock, ESMF_VM, ESMF_SUCCESS use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_TimeInterval use ESMF , only : ESMF_VMGet, ESMF_StateIsCreated, ESMF_GridCompGet - use med_constants_mod , only : CL, R8 use med_internalstate_mod , only : InternalState use esmFlds , only : ncomps, compname use esmFlds , only : fldListFr, fldListTo use esmFlds , only : shr_nuopc_fldList_Realize - use shr_nuopc_scalars_mod , only : flds_scalar_name, flds_scalar_num ! Input/output variables type(ESMF_GridComp) :: gcomp @@ -555,24 +669,26 @@ subroutine InitializeIPDv03p3(gcomp, importState, exportState, clock, rc) ! 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return is_local%wrap%vm = vm ! Realize States do n = 1,ncomps if (ESMF_StateIsCreated(is_local%wrap%NStateImp(n), rc=rc)) then - call shr_nuopc_fldList_Realize(is_local%wrap%NStateImp(n), fldListFr(n), flds_scalar_name, flds_scalar_num, & + call shr_nuopc_fldList_Realize(is_local%wrap%NStateImp(n), fldListFr(n), & + is_local%wrap%flds_scalar_name, is_local%wrap%flds_scalar_num, & tag=subname//':Fr_'//trim(compname(n)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n), rc=rc)) then - call shr_nuopc_fldList_Realize(is_local%wrap%NStateExp(n), fldListTo(n), flds_scalar_name, flds_scalar_num, & + call shr_nuopc_fldList_Realize(is_local%wrap%NStateExp(n), fldListTo(n), & + is_local%wrap%flds_scalar_name, is_local%wrap%flds_scalar_num, & tag=subname//':To_'//trim(compname(n)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif enddo @@ -590,7 +706,6 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_GRIDCOMP, ESMF_CLOCK, ESMF_STATE use ESMF , only : ESMF_StateIsCreated use med_internalstate_mod , only : InternalState - use med_constants_mod , only : CL use esmFlds , only : ncomps, compname ! input/output variables @@ -602,15 +717,6 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) ! local variables type(InternalState) :: is_local integer :: n1,n2 - ! type(ESMF_Field) :: field - ! type(ESMF_Grid) :: grid - ! integer :: localDeCount - ! type(ESMF_DistGrid) :: distgrid - ! integer :: dimCount, tileCount, petCount - ! integer :: deCountPTile, extraDEs - ! integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) - ! integer, allocatable :: regDecompPTile(:,:) - ! integer :: i, j, n, n1 character(len=*),parameter :: subname='(module_MED:realizeConnectedGrid)' !----------------------------------------------------------- @@ -620,7 +726,7 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) ! Get the internal state from the mediator gridded component. nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !------------------ ! Recieve Grids @@ -630,11 +736,11 @@ subroutine InitializeIPDv03p4(gcomp, importState, exportState, clock, rc) 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif if (ESMF_StateIsCreated(is_local%wrap%NStateExp(n1),rc=rc)) then call realizeConnectedGrid(is_local%wrap%NStateExp(n1), trim(compname(n1))//'Exp', rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif call ESMF_LogWrite(trim(subname)//": finished for component "//trim(compname(n1)), ESMF_LOGMSG_INFO) enddo @@ -653,7 +759,6 @@ subroutine realizeConnectedGrid(State,string,rc) use ESMF , only : ESMF_LogMsg_Warning use ESMF , only : ESMF_FieldStatus_Empty, ESMF_FieldStatus_Complete, ESMF_FieldStatus_GridSet use ESMF , only : ESMF_GeomType_Mesh, ESMF_MeshGet, ESMF_Mesh, ESMF_MeshEmptyCreate - use shr_nuopc_methods_mod , only: shr_nuopc_methods_Field_GeomPrint type(ESMF_State) , intent(inout) :: State character(len=*) , intent(in) :: string @@ -696,14 +801,14 @@ subroutine realizeConnectedGrid(State,string,rc) rc = ESMF_Success call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(fieldNameList(fieldCount)) call ESMF_StateGet(State, itemNameList=fieldNameList, 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, petCount=petCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! do not loop here, assuming that all fields share the ! same grid/mesh and because it is more efficient - if @@ -712,14 +817,14 @@ subroutine realizeConnectedGrid(State,string,rc) do n=1, min(fieldCount, 1) call ESMF_StateGet(State, field=field, itemName=fieldNameList(n), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(field, status=fieldStatus, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !call NUOPC_GetAttribute(field, name="TransferActionGeomObject", & ! value=transferAction, rc=rc) - !if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + !if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldStatus==ESMF_FIELDSTATUS_GRIDSET) then @@ -728,18 +833,18 @@ subroutine realizeConnectedGrid(State,string,rc) ! While this is still an empty field, it does now hold a Grid/Mesh with DistGrid call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (geomtype == ESMF_GEOMTYPE_GRID) then !if (dbug_flag > 1) then - ! call shr_nuopc_methods_Field_GeomPrint(field,trim(fieldNameList(n))//'_orig',rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! call Field_GeomPrint(field,trim(fieldNameList(n))//'_orig',rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return !end if call ESMF_AttributeGet(field, name="ArbDimCount", value=arbDimCount, & convention="NUOPC", purpose="Instance", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": geomtype is ESMF_GEOMTYPE_GRID for "//trim(fieldnameList(n)), & ESMF_LOGMSG_INFO) @@ -770,25 +875,25 @@ subroutine realizeConnectedGrid(State,string,rc) call ESMF_AttributeGet(field, name="MinIndex", & valueList=minIndexPTile(:,1), & convention="NUOPC", purpose="Instance", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_AttributeGet(field, name="MaxIndex", & valueList=maxIndexPTile(:,1), & convention="NUOPC", purpose="Instance", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! create default regDecomp DistGrid distgrid = ESMF_DistGridCreate(minIndexPTile=minIndexPTile, & maxIndexPTile=maxIndexPTile, connectionList=connectionList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Create default regDecomp Grid grid = ESMF_GridCreate(distgrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! swap out the transferred grid for the newly created one call ESMF_FieldEmptySet(field, grid=grid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return do i1 = 1,arbDimCount write(msgString,'(A,3i8)') trim(subname)//':PTile =',i1,minIndexPTile(i1,1),maxIndexPTile(i1,1) call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) @@ -811,7 +916,7 @@ subroutine realizeConnectedGrid(State,string,rc) call ESMF_LogWrite(trim(subname)//trim(string)//": ERROR grid_arbopt setting = "//trim(grid_arbopt), & ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_FAILURE - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! grid_arbopt @@ -825,10 +930,10 @@ subroutine realizeConnectedGrid(State,string,rc) 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_GridGet(grid, localDeCount=localDeCount, distgrid=distgrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Create a custom DistGrid, based on the minIndex, maxIndex of the ! accepted DistGrid, but with a default regDecomp for the current VM @@ -837,7 +942,7 @@ subroutine realizeConnectedGrid(State,string,rc) ! get dimCount and tileCount call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, & connectionCount=connectionCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount allocate(minIndexPTile(dimCount, tileCount), maxIndexPTile(dimCount, tileCount)) @@ -846,7 +951,7 @@ subroutine realizeConnectedGrid(State,string,rc) ! get minIndex and maxIndex arrays, and connectionList call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & maxIndexPTile=maxIndexPTile, connectionList=connectionList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! construct a default regDecompPTile -> TODO: move this into ESMF as default @@ -878,10 +983,10 @@ subroutine realizeConnectedGrid(State,string,rc) ! nxg = maxIndexPTile(1,1) - minIndexPTile(1,1) + 1 ! write(msgstring,*) trim(subname)//trim(string),': connlist nxg = ',nxg ! call ESMF_LogWrite(trim(msgstring), 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_DistGridConnectionSet(connectionList(1), tileIndexA=1, & ! tileIndexB=1, positionVector=(/nxg, 0/), rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! create the new DistGrid with the same minIndexPTile and maxIndexPTile, ! but with a default regDecompPTile @@ -891,25 +996,25 @@ subroutine realizeConnectedGrid(State,string,rc) distgrid = ESMF_DistGridCreate(minIndexPTile=minIndexPTile, & maxIndexPTile=maxIndexPTile, regDecompPTile=regDecompPTile, & connectionList=connectionList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//trim(string)//': distgrid with dimcount=2', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Create a new Grid on the new DistGrid and swap it in the Field grid = ESMF_GridCreate(distgrid, gridEdgeLWidth=(/0,0/), gridEdgeUWidth=(/0,1/), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else distgrid = ESMF_DistGridCreate(minIndexPTile=minIndexPTile, & maxIndexPTile=maxIndexPTile, regDecompPTile=regDecompPTile, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//trim(string)//': distgrid with dimcount=1', ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Create a new Grid on the new DistGrid and swap it in the Field grid = ESMF_GridCreate(distgrid, gridEdgeLWidth=(/0/), gridEdgeUWidth=(/0/), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! local clean-up @@ -922,27 +1027,27 @@ subroutine realizeConnectedGrid(State,string,rc) do n1=1, fieldCount ! access a field in the State and set the Grid call ESMF_StateGet(State, field=field, itemName=fieldNameList(n1), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(field, status=fieldStatus, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldStatus==ESMF_FIELDSTATUS_EMPTY .or. fieldStatus==ESMF_FIELDSTATUS_GRIDSET) then call ESMF_FieldEmptySet(field, grid=grid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//trim(string)//": attach grid for "//trim(fieldNameList(n1)), & ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call shr_nuopc_methods_Field_GeomPrint(field,trim(fieldNameList(n1))//'_new',rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call Field_GeomPrint(field,trim(fieldNameList(n1))//'_new',rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if else call ESMF_LogWrite(trim(subname)//trim(string)//": NOT replacing grid for field: "//& trim(fieldNameList(n1)), ESMF_LOGMSG_WARNING, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif enddo @@ -953,57 +1058,57 @@ subroutine realizeConnectedGrid(State,string,rc) ESMF_LOGMSG_INFO) if (dbug_flag > 1) then - call shr_nuopc_methods_Field_GeomPrint(field,trim(fieldNameList(n))//'_orig',rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call Field_GeomPrint(field,trim(fieldNameList(n))//'_orig',rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call ESMF_FieldGet(field, mesh=mesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_MeshGet(mesh, elementDistGrid=elemDistGrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return newelemDistGrid = ESMF_DistGridCreate(elemDistGrid, balanceflag=.true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! call ESMF_MeshGet(mesh, nodalDistGrid=nodalDistGrid, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! newnodalDistGrid = ESMF_DistGridCreate(nodalDistGrid, balanceflag=.true., rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Create a new Grid on the new DistGrid and swap it in the Field ! newmesh = ESMF_MeshEmptyCreate(elementDistGrid=newelemDistGrid, nodalDistGrid=newnodalDistGrid, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return newmesh = ESMF_MeshEmptyCreate(elementDistGrid=newelemDistGrid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Swap all the Meshes in the State do n1=1, fieldCount ! access a field in the State and set the Mesh call ESMF_StateGet(State, field=field, itemName=fieldNameList(n1), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(field, status=fieldStatus, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldStatus==ESMF_FIELDSTATUS_EMPTY .or. fieldStatus==ESMF_FIELDSTATUS_GRIDSET) then call ESMF_FieldEmptySet(field, mesh=newmesh, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//trim(string)//": attach mesh for "//& trim(fieldNameList(n1)), ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call shr_nuopc_methods_Field_GeomPrint(field,trim(fieldNameList(n1))//'_new',rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call Field_GeomPrint(field,trim(fieldNameList(n1))//'_new',rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if else call ESMF_LogWrite(trim(subname)//trim(string)//": NOT replacing mesh for field: "//& trim(fieldNameList(n1)), ESMF_LOGMSG_WARNING, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif enddo @@ -1051,9 +1156,6 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) use ESMF , only : ESMF_SUCCESS, ESMF_LOGMSG_INFO, ESMF_StateIsCreated use med_internalstate_mod , only: InternalState use esmFlds , only: ncomps, compname - use shr_nuopc_methods_mod , only: shr_nuopc_methods_State_reset - use shr_nuopc_methods_mod , only: shr_nuopc_methods_State_GeomPrint - use shr_nuopc_methods_mod , only: shr_nuopc_methods_State_GeomWrite !---------------------------------------------------------- ! realize all Fields with transfer action "accept" @@ -1077,7 +1179,7 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) ! 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--- Finish initializing the State Fields !--- Write out grid information @@ -1088,27 +1190,27 @@ subroutine InitializeIPDv03p5(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(subname)//": calling completeFieldInitialize import states from "//trim(compname(n1)), & ESMF_LOGMSG_INFO) call completeFieldInitialization(is_local%wrap%NStateImp(n1), 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_reset(is_local%wrap%NStateImp(n1), value=spval_init, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call State_reset(is_local%wrap%NStateImp(n1), value=spval_init, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif 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) call completeFieldInitialization(is_local%wrap%NStateExp(n1), 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_reset(is_local%wrap%NStateExp(n1), value=spval_init, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call State_reset(is_local%wrap%NStateExp(n1), value=spval_init, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call shr_nuopc_methods_State_GeomPrint(is_local%wrap%NStateExp(n1),'gridExp'//trim(compname(n1)),rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call State_GeomPrint(is_local%wrap%NStateExp(n1),'gridExp'//trim(compname(n1)),rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_State_GeomWrite(is_local%wrap%NStateExp(n1), 'grid_med_'//trim(compname(n1)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call State_GeomWrite(is_local%wrap%NStateExp(n1), 'grid_med_'//trim(compname(n1)), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if endif enddo @@ -1126,9 +1228,6 @@ subroutine completeFieldInitialization(State,rc) 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 - use shr_nuopc_methods_mod , only : shr_nuopc_methods_Field_GeomPrint ! input/output variables type(ESMF_State) , intent(inout) :: State @@ -1153,40 +1252,40 @@ subroutine completeFieldInitialization(State,rc) call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) rc = ESMF_Success - call shr_nuopc_methods_State_GetNumFields(State, fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call State_GetNumFields(State, fieldCount, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (fieldCount > 0) then nullify(fieldList) call NUOPC_getStateMemberLists(State, fieldList=fieldList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return do n=1, fieldCount call ESMF_FieldGet(fieldList(n), status=fieldStatus, name=fieldName, & geomtype=geomtype, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return - if (geomtype == ESMF_GEOMTYPE_GRID .and. fieldName /= flds_scalar_name) then + if (geomtype == ESMF_GEOMTYPE_GRID .and. fieldName /= is_local%wrap%flds_scalar_name) then ! Grab grid if (dbug_flag > 1) then - call shr_nuopc_methods_Field_GeomPrint(fieldList(n),trim(fieldName)//'_premesh',rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call Field_GeomPrint(fieldList(n),trim(fieldName)//'_premesh',rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if call ESMF_FieldGet(fieldList(n), grid=grid, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Convert grid to mesh mesh = ESMF_GridToMeshCell(grid,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Swap grid for mesh, at this point, only connected fields are in the state call NUOPC_Realize(State, field=meshField, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif if (fieldStatus==ESMF_FIELDSTATUS_GRIDSET) then @@ -1195,16 +1294,16 @@ subroutine completeFieldInitialization(State,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 + if (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 + if (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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(ungriddedLBound(ungriddedCount), ungriddedUBound(ungriddedCount)) if (ungriddedCount > 0) then @@ -1220,8 +1319,8 @@ subroutine completeFieldInitialization(State,rc) deallocate(gridToFieldMap, ungriddedLbound, ungriddedUbound) endif ! fieldStatus - 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 + call Field_GeomPrint(fieldList(n), trim(subname)//':'//trim(fieldName), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return enddo deallocate(fieldList) @@ -1273,7 +1372,6 @@ subroutine DataInitialize(gcomp, rc) use med_internalstate_mod , only : InternalState use med_internalstate_mod , only : med_coupling_allowed, logunit use med_internalstate_mod , only : mastertask - use shr_sys_mod , only : shr_sys_flush use esmFlds , only : ncomps, compname, ncomps, compmed, compatm, compocn use esmFlds , only : compice, complnd, comprof, compwav, compglc, compname use esmFlds , only : fldListMed_ocnalb, fldListMed_aoflux @@ -1282,15 +1380,6 @@ subroutine DataInitialize(gcomp, rc) use esmFlds , only : shr_nuopc_fldList_Document_Mapping 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 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 @@ -1336,20 +1425,20 @@ subroutine DataInitialize(gcomp, rc) rc = ESMF_SUCCESS call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! query the Component for its clock, importState and exportState call ESMF_GridCompGet(gcomp, clock=clock, importState=importState, exportState=exportState, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (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_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! get the current time out of the clock call ESMF_ClockGet(clock, currTime=time, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- ! Beginning of first_call block @@ -1368,7 +1457,7 @@ subroutine DataInitialize(gcomp, rc) do n1 = 1,ncomps call ESMF_AttributeGet(gcomp, name=trim(compname(n1))//"_present", value=value, defaultValue="false", & convention="NUOPC", purpose="Instance", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return is_local%wrap%comp_present(n1) = (value == "true") write(msgString,'(A,L4)') trim(subname)//' comp_present(comp'//trim(compname(n1))//') = ',& @@ -1389,14 +1478,14 @@ subroutine DataInitialize(gcomp, rc) 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_GetNumFields(is_local%wrap%NStateImp(n1), cntn1, rc=rc) ! Import Field Count - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call State_GetNumFields(is_local%wrap%NStateImp(n1), cntn1, rc=rc) ! Import Field Count + if (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. & 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 + call State_GetNumFields(is_local%wrap%NStateExp(n2), cntn2, rc=rc) ! Import Field Count + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (cntn2 > 0) then is_local%wrap%med_coupling_active(n1,n2) = .true. endif @@ -1420,7 +1509,6 @@ subroutine DataInitialize(gcomp, rc) write(logunit,'(A)') trim(msgString) enddo write(logunit,*) ' ' - call shr_sys_flush(logunit) endif if (dbug_flag >= 0) then @@ -1436,7 +1524,6 @@ subroutine DataInitialize(gcomp, rc) write(logunit,'(A)') trim(msgString) enddo write(logunit,*) ' ' - call shr_sys_flush(logunit) endif endif @@ -1459,35 +1546,34 @@ subroutine DataInitialize(gcomp, rc) if (mastertask) write(logunit,*) subname,' initializing FBs for '//trim(compname(n1)) ! 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 + call FB_init_pointer(is_local%wrap%NStateImp(n1), is_local%wrap%FBImp(n1,n1), & + is_local%wrap%flds_scalar_name, name='FBImp'//trim(compname(n1)), rc=rc) + if (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 + call FB_init_pointer(is_local%wrap%NStateExp(n1), is_local%wrap%FBExp(n1), & + is_local%wrap%flds_scalar_name, name='FBExp'//trim(compname(n1)), rc=rc) + if (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, & + call FB_init(is_local%wrap%FBImpAccum(n1,n1), is_local%wrap%flds_scalar_name, & 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_reset(is_local%wrap%FBImpAccum(n1,n1), value=czero, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return is_local%wrap%FBImpAccumCnt(n1) = 0 ! Create export accumulation field bundles - call shr_nuopc_methods_FB_init(is_local%wrap%FBExpAccum(n1), flds_scalar_name, & + call FB_init(is_local%wrap%FBExpAccum(n1), is_local%wrap%flds_scalar_name, & 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) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_reset(is_local%wrap%FBExpAccum(n1), value=czero, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return is_local%wrap%FBExpAccumCnt(n1) = 0 endif - if (mastertask) call shr_sys_flush(logunit) ! The following are FBImp and FBImpAccum mapped to different grids. ! FBImp(n1,n1) and FBImpAccum(n1,n1) are handled above @@ -1501,28 +1587,26 @@ subroutine DataInitialize(gcomp, rc) if (mastertask) write(logunit,*) subname,' initializing FBs for '//& trim(compname(n1))//'_'//trim(compname(n2)) - call shr_nuopc_methods_FB_init(is_local%wrap%FBImp(n1,n2), flds_scalar_name, & + call FB_init(is_local%wrap%FBImp(n1,n2), is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(n2), & STflds=is_local%wrap%NStateImp(n1), & name='FBImp'//trim(compname(n1))//'_'//trim(compname(n2)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_init(is_local%wrap%FBImpAccum(n1,n2), flds_scalar_name, & + call FB_init(is_local%wrap%FBImpAccum(n1,n2), is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(n2), & STflds=is_local%wrap%NStateImp(n1), & name='FBImpAccum'//trim(compname(n1))//'_'//trim(compname(n2)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_reset(is_local%wrap%FBImpAccum(n1,n2), value=czero, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_reset(is_local%wrap%FBImpAccum(n1,n2), value=czero, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif 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 !--------------------------------------- @@ -1547,27 +1631,27 @@ subroutine DataInitialize(gcomp, rc) if (fieldCount > 0) then allocate(fldnames(fieldCount)) call shr_nuopc_fldList_getfldnames(fldListMed_ocnalb%flds, fldnames, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_ocnalb_a, flds_scalar_name, & + call FB_init(is_local%wrap%FBMed_ocnalb_a, is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compatm), fieldnamelist=fldnames, name='FBMed_ocnalb_a', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (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, & + call FB_init(is_local%wrap%FBMed_ocnalb_o, is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(compocn), fieldnamelist=fldnames, name='FBMed_ocnalb_o', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (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, & + call FB_init(is_local%wrap%FBImp(compatm,compocn), is_local%wrap%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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (mastertask) write(logunit,*) subname,' initializing FBs for '// & trim(compname(compatm))//'_'//trim(compname(compocn)) @@ -1578,16 +1662,16 @@ subroutine DataInitialize(gcomp, rc) if (fieldCount > 0) then allocate(fldnames(fieldCount)) call shr_nuopc_fldList_getfldnames(fldListMed_aoflux%flds, fldnames, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_init(is_local%wrap%FBMed_aoflux_a, flds_scalar_name, & + call FB_init(is_local%wrap%FBMed_aoflux_a, is_local%wrap%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 (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, & + call FB_init(is_local%wrap%FBMed_aoflux_o, is_local%wrap%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 (ChkErr(rc,__LINE__,u_FILE_u)) return if (mastertask) write(logunit,*) subname,' initializing FB FBMed_aoflux_o' deallocate(fldnames) end if @@ -1598,7 +1682,7 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- call esmFldsExchange(gcomp, phase='initialize', 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_fldList_Document_Mapping(logunit, is_local%wrap%med_coupling_active) @@ -1610,15 +1694,15 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- call med_map_RouteHandles_init(gcomp, logunit, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_map_MapNorm_init(gcomp, logunit, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return first_call = .false. call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return return endif ! end first_call if-block @@ -1629,31 +1713,31 @@ subroutine DataInitialize(gcomp, 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 do n1 = 1,ncomps LocalDone = .true. if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(fieldNameList(fieldCount)) call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemNameList=fieldNameList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return do n=1, fieldCount call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemName=fieldNameList(n), field=field, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (atCorrectTime) then - if (fieldNameList(n) == flds_scalar_name) then + if (fieldNameList(n) == is_local%wrap%flds_scalar_name) then 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif else LocalDone=.false. @@ -1662,12 +1746,9 @@ 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) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (n1 == compocn) ocnDone = .true. if (n1 == compatm) atmDone = .true. endif @@ -1682,9 +1763,9 @@ subroutine DataInitialize(gcomp, rc) !---------------------------------------------------------- call med_fraction_init(gcomp,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_fraction_set(gcomp,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- ! Carry out data dependency for atm initialization if needed @@ -1697,19 +1778,19 @@ subroutine DataInitialize(gcomp, rc) atmDone = .true. ! reset if an item is found that is not done call ESMF_StateGet(is_local%wrap%NStateImp(compatm), itemCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(fieldNameList(fieldCount)) call ESMF_StateGet(is_local%wrap%NStateImp(compatm), itemNameList=fieldNameList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return do n=1, fieldCount call ESMF_StateGet(is_local%wrap%NStateImp(compatm), itemName=fieldNameList(n), field=field, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (.not. atCorrectTime) then ! If any atm import fields are not time stamped correctly, then dependency is not satisified - must return to atm call ESMF_LogWrite("MED - Initialize-Data-Dependency from ATM NOT YET SATISFIED!!!", ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return atmdone = .false. exit ! break out of the loop when first not satisfied found endif @@ -1719,35 +1800,35 @@ subroutine DataInitialize(gcomp, rc) if (.not. atmdone) then ! atmdone is not true ! Update fractions again in case any import fields have changed call med_fraction_init(gcomp,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_fraction_set(gcomp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Initialize ocean albedo module and compute ocean albedos call med_phases_ocnalb_run(gcomp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! do the merge to the atmospheric component call med_phases_prep_atm(gcomp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(fieldNameList(fieldCount)) call ESMF_StateGet(is_local%wrap%NStateExp(compatm), itemNameList=fieldNameList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return do n=1, fieldCount call ESMF_StateGet(is_local%wrap%NStateExp(compatm), itemName=fieldNameList(n), field=field, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_SetAttribute(field, name="Updated", value="true", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end do deallocate(fieldNameList) ! Connectors will be automatically called between the mediator and atm until allDone is true 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif @@ -1756,15 +1837,15 @@ subroutine DataInitialize(gcomp, rc) if (is_local%wrap%comp_present(n1) .and. ESMF_StateIsCreated(is_local%wrap%NStateImp(n1),rc=rc)) then call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemCount=fieldCount, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return allocate(fieldNameList(fieldCount)) call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemNameList=fieldNameList, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return do n=1, fieldCount call ESMF_StateGet(is_local%wrap%NStateImp(n1), itemName=fieldNameList(n), field=field, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return atCorrectTime = NUOPC_IsAtTime(field, time, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (.not. atCorrectTime) then allDone=.false. endif @@ -1779,10 +1860,10 @@ subroutine DataInitialize(gcomp, rc) if (allDone) then call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="true", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- ! Create component dimensions in mediator internal state @@ -1791,12 +1872,16 @@ subroutine DataInitialize(gcomp, rc) 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) + call State_GetScalar(scalar_value=real_nx, & + scalar_id=is_local%wrap%flds_scalar_index_nx, & + state=is_local%wrap%NstateImp(n1), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) + call State_GetScalar(scalar_value=real_ny, & + scalar_id=is_local%wrap%flds_scalar_index_ny, & + state=is_local%wrap%NstateImp(n1), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%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) @@ -1819,23 +1904,23 @@ subroutine DataInitialize(gcomp, rc) !--------------------------------------- call NUOPC_CompAttributeGet(gcomp, name="read_restart", value=cvalue, 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//' read_restart = '//trim(cvalue), ESMF_LOGMSG_INFO, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) read_restart if (read_restart) then call med_phases_restart_read(gcomp, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif call med_phases_profile(gcomp, rc) else call NUOPC_CompAttributeSet(gcomp, name="InitializeDataComplete", value="false", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite("MED - Initialize-Data-Dependency allDone check Failed, another loop is required", 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 if if (dbug_flag > 5) then @@ -1855,9 +1940,6 @@ subroutine SetRunClock(gcomp, rc) use ESMF , only : ESMF_AlarmCreate, ESMF_AlarmSet, ESMF_ClockAdvance use NUOPC , only : NUOPC_CompCheckSetClock, NUOPC_CompAttributeGet use NUOPC_Mediator , only : NUOPC_MediatorGet - use shr_nuopc_time_mod , only : shr_nuopc_time_alarmInit - use shr_nuopc_methods_mod , only : shr_nuopc_methods_clock_timeprint - use shr_nuopc_time_mod , only : shr_nuopc_time_set_component_stop_alarm ! input/output variables type(ESMF_GridComp) :: gcomp @@ -1889,27 +1971,27 @@ subroutine SetRunClock(gcomp, rc) ! query the Mediator for clocks call NUOPC_MediatorGet(gcomp, mediatorClock=mediatorClock, & driverClock=driverClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call shr_nuopc_methods_Clock_TimePrint(driverClock ,trim(subname)//'driver clock1',rc) - call shr_nuopc_methods_Clock_TimePrint(mediatorClock,trim(subname)//'mediat clock1',rc) + call Clock_TimePrint(driverClock ,trim(subname)//'driver clock1',rc) + call Clock_TimePrint(mediatorClock,trim(subname)//'mediat clock1',rc) endif ! set the mediatorClock to have the current start time as the driverClock call ESMF_ClockGet(driverClock, currTime=currTime, timeStep=timeStep, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockSet(mediatorClock, currTime=currTime, timeStep=timeStep, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call shr_nuopc_methods_Clock_TimePrint(driverClock ,trim(subname)//'driver clock2',rc) - call shr_nuopc_methods_Clock_TimePrint(mediatorClock,trim(subname)//'mediat clock2',rc) + call Clock_TimePrint(driverClock ,trim(subname)//'driver clock2',rc) + call Clock_TimePrint(mediatorClock,trim(subname)//'mediat clock2',rc) endif ! check and set the component clock against the driver clock call NUOPC_CompCheckSetClock(gcomp, driverClock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- ! set restart alarm, med log summary alarm and glc averaging alarm if appropriate @@ -1920,58 +2002,58 @@ subroutine SetRunClock(gcomp, rc) ! Set mediator restart alarm call NUOPC_CompAttributeGet(gcomp, name="restart_option", value=restart_option, rc=rc) - if (shr_nuopc_methods_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_methods_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_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) restart_ymd - call shr_nuopc_time_alarmInit(mediatorclock, restart_alarm, restart_option, & + call alarmInit(mediatorclock, restart_alarm, restart_option, & opt_n = restart_n, & opt_ymd = restart_ymd, & RefTime = currTime, & alarmname = 'alarm_restart', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_AlarmSet(restart_alarm, clock=mediatorclock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Set mediator profile alarm - HARD CODED to daily - call shr_nuopc_time_alarmInit(mediatorclock, med_profile_alarm, 'ndays', & + call alarmInit(mediatorclock, med_profile_alarm, 'ndays', & opt_n = 1, alarmname = 'med_profile_alarm', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_AlarmSet(med_profile_alarm, clock=mediatorclock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Set glc averaging alarm if appropriate call NUOPC_CompAttributeGet(gcomp, name="glc_present", value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return glc_present = (cvalue == "true") if (glc_present) then call NUOPC_CompAttributeGet(gcomp, name="glc_avg_period", value=glc_avg_period, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (trim(glc_avg_period) == 'hour') then - call shr_nuopc_time_alarmInit(mediatorclock, glc_avg_alarm, 'nhours', & + call alarmInit(mediatorclock, glc_avg_alarm, 'nhours', & opt_n = 1, alarmname = 'alarm_glc_avg', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(glc_avg_period) == 'day') then - call shr_nuopc_time_alarmInit(mediatorclock, glc_avg_alarm, 'ndays', & + call alarmInit(mediatorclock, glc_avg_alarm, 'ndays', & opt_n = 1, alarmname = 'alarm_glc_avg', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else if (trim(glc_avg_period) == 'yearly') then - call shr_nuopc_time_alarmInit(mediatorclock, glc_avg_alarm, 'nyears', & + call alarmInit(mediatorclock, glc_avg_alarm, 'nyears', & opt_n = 1, alarmname = 'alarm_glc_avg', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else call ESMF_LogWrite(trim(subname)//& @@ -1981,11 +2063,11 @@ subroutine SetRunClock(gcomp, rc) RETURN end if call ESMF_AlarmSet(glc_avg_alarm, clock=mediatorclock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call shr_nuopc_time_set_component_stop_alarm(gcomp, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call set_stop_alarm(gcomp, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return first_time = .false. end if @@ -1995,10 +2077,10 @@ subroutine SetRunClock(gcomp, rc) !-------------------------------- call ESMF_ClockAdvance(mediatorClock,rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockSet(mediatorClock, currTime=currtime, timeStep=timestep, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) @@ -2011,15 +2093,12 @@ subroutine med_finalize(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_SUCCESS use med_internalstate_mod , only : logunit, mastertask use med_phases_profile_mod , only : med_phases_profile_finalize - use shr_nuopc_utils_mod , only : shr_nuopc_memcheck - use shr_file_mod , only : shr_file_setlogunit type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc - call shr_file_setlogunit(logunit) rc = ESMF_SUCCESS - call shr_nuopc_memcheck("med_finalize", 0, mastertask) + call memcheck("med_finalize", 0, mastertask) if (mastertask) then write(logunit,*)' SUCCESSFUL TERMINATION OF CMEPS' call med_phases_profile_finalize() diff --git a/cime/src/drivers/nuopc/mediator/med_constants_mod.F90 b/cime/src/drivers/nuopc/mediator/med_constants_mod.F90 new file mode 100644 index 000000000000..f64e377734bc --- /dev/null +++ b/cime/src/drivers/nuopc/mediator/med_constants_mod.F90 @@ -0,0 +1,30 @@ +module med_constants_mod + + use shr_kind_mod , only : R8=>SHR_KIND_R8 + use shr_kind_mod , only : R4=>SHR_KIND_R4 + use shr_kind_mod , only : IN=>SHR_KIND_IN + use shr_kind_mod , only : I8=>SHR_KIND_I8 + use shr_kind_mod , only : CL=>SHR_KIND_CL + use shr_kind_mod , only : CS=>SHR_KIND_CS + use shr_kind_mod , only : CX=>SHR_KIND_CX + use shr_kind_mod , only : CXX=>SHR_KIND_CXX + + use shr_cal_mod , only : med_constants_noleap => shr_cal_noleap + use shr_cal_mod , only : med_constants_gregorian => shr_cal_gregorian + use shr_cal_mod , only : shr_cal_ymd2date + use shr_cal_mod , only : shr_cal_noleap + use shr_cal_mod , only : shr_cal_gregorian + + implicit none + + logical, parameter :: med_constants_statewrite_flag = .false. + real(R8), parameter :: med_constants_spval_init = 0.0_R8 ! spval for initialization + real(R8), parameter :: med_constants_spval = 0.0_R8 ! spval + real(R8), parameter :: med_constants_czero = 0.0_R8 ! spval + integer, parameter :: med_constants_ispval_mask = -987987 ! spval for RH mask values + integer, parameter :: med_constants_SecPerDay = 86400 ! Seconds per day + + !----------------------------------------------------------------------------- + integer :: med_constants_dbug_flag = 0 + +end module med_constants_mod diff --git a/cime/src/drivers/nuopc/mediator/med_fraction_mod.F90 b/cime/src/drivers/nuopc/mediator/med_fraction_mod.F90 index a7524da754cc..d50384747bb2 100644 --- a/cime/src/drivers/nuopc/mediator/med_fraction_mod.F90 +++ b/cime/src/drivers/nuopc/mediator/med_fraction_mod.F90 @@ -112,9 +112,17 @@ module med_fraction_mod ! !----------------------------------------------------------------------------- - use med_constants_mod, only : R8 - use med_constants_mod, only : dbug_flag => med_constants_dbug_flag - use esmFlds , only : ncomps + use esmFlds , only : ncomps + use med_constants_mod , only : R8 + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_constants_mod , only : czero => med_constants_czero + use shr_nuopc_utils_mod , only : chkErr => shr_nuopc_utils_ChkErr + use shr_nuopc_methods_mod , only : FB_init => shr_nuopc_methods_FB_init + use shr_nuopc_methods_mod , only : FB_reset => shr_nuopc_methods_FB_reset + use shr_nuopc_methods_mod , only : FB_getFldPtr => shr_nuopc_methods_FB_getFldPtr + use shr_nuopc_methods_mod , only : FB_FieldRegrid => shr_nuopc_methods_FB_FieldRegrid + use shr_nuopc_methods_mod , only : FB_diagnose => shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : FB_fldChk => shr_nuopc_methods_FB_fldChk implicit none private @@ -166,18 +174,9 @@ subroutine med_fraction_init(gcomp, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_GridCompGet, ESMF_StateIsCreated, ESMF_RouteHandleIsCreated use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleDestroy - use med_constants_mod , only : czero=>med_constants_czero use esmFlds , only : compatm, compocn, compice, complnd use esmFlds , only : comprof, compglc, compwav, compname use esmFlds , only : mapconsf, mapfcopy - use shr_nuopc_scalars_mod , only : flds_scalar_name - 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_reset - 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_fldChk use med_map_mod , only : med_map_Fractions_init use med_internalstate_mod , only : InternalState use perf_mod , only : t_startf, t_stopf @@ -217,7 +216,7 @@ subroutine med_fraction_init(gcomp, rc) ! 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (first_call) then @@ -243,13 +242,13 @@ subroutine med_fraction_init(gcomp, rc) 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_FB_init(is_local%wrap%FBfrac(n1), flds_scalar_name, & + call FB_init(is_local%wrap%FBfrac(n1), is_local%wrap%flds_scalar_name, & STgeom=is_local%wrap%NStateImp(n1), fieldNameList=fraclist(:,n1), & name='FBfrac'//trim(compname(n1)), rc=rc) ! zero out FBfracs - call shr_nuopc_methods_FB_reset(is_local%wrap%FBfrac(n1), value=czero, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_reset(is_local%wrap%FBfrac(n1), value=czero, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end do first_call = .false. @@ -262,8 +261,8 @@ subroutine med_fraction_init(gcomp, rc) if (is_local%wrap%comp_present(compatm)) then ! Set 'afrac' for FBFrac(compatm) to 1 - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'afrac', afrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'afrac', afrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return afrac(:) = 1.0_R8 ! Set 'afrac' for FBFrac(compice), FBFrac(compocn) and FBFrac(complnd) @@ -279,14 +278,14 @@ subroutine med_fraction_init(gcomp, rc) FBSrc=is_local%wrap%FBImp(compatm,compatm), & FBDst=is_local%wrap%FBImp(compatm,n), & RouteHandle=is_local%wrap%RH(compatm,n,mapconsf), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end if - call shr_nuopc_methods_FB_FieldRegrid(& + call FB_FieldRegrid(& is_local%wrap%FBfrac(compatm), 'afrac', & is_local%wrap%FBfrac(n), 'afrac', & is_local%wrap%RH(compatm,n,maptype), rc=rc) - if(shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if(ChkErr(rc,__LINE__,u_FILE_u)) return endif end if end do @@ -301,10 +300,10 @@ subroutine med_fraction_init(gcomp, rc) if (is_local%wrap%comp_present(complnd)) then ! Set 'lfrin' for FBFrac(complnd) - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImp(complnd,complnd) , 'Sl_lfrin' , Sl_lfrin, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(complnd), 'lfrin', lfrin, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBImp(complnd,complnd) , 'Sl_lfrin' , Sl_lfrin, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(complnd), 'lfrin', lfrin, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return lfrin(:) = Sl_lfrin(:) ! Set 'lfrin for FBFrac(compatm) @@ -313,11 +312,11 @@ subroutine med_fraction_init(gcomp, rc) ! Create a temporary field bundle if one does not exists if (.not. ESMF_FieldBundleIsCreated(is_local%wrap%FBImp(complnd,compatm))) then - call shr_nuopc_methods_FB_init(FBout=FBtemp, & - flds_scalar_name=flds_scalar_name, & + call FB_init(FBout=FBtemp, & + flds_scalar_name=is_local%wrap%flds_scalar_name, & FBgeom=is_local%wrap%FBImp(compatm,compatm), & fieldNameList=(/'Fldtemp'/), name='FBtemp', rc=rc) - if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + if (chkerr(rc,__line__,u_file_u)) return end if ! Determine map type @@ -334,27 +333,27 @@ subroutine med_fraction_init(gcomp, rc) FBSrc=is_local%wrap%FBImp(complnd,complnd), & FBDst=is_local%wrap%FBImp(complnd,compatm), & RouteHandle=is_local%wrap%RH(complnd,compatm,maptype), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else call med_map_Fractions_init( gcomp, complnd, compatm, & FBSrc=is_local%wrap%FBImp(complnd,complnd), & FBDst=FBtemp, & RouteHandle=is_local%wrap%RH(complnd,compatm,maptype), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end if ! Regrid 'lfrin' from FBFrac(complnd) -> FBFrac(compatm) - call shr_nuopc_methods_FB_FieldRegrid(& + call FB_FieldRegrid(& is_local%wrap%FBfrac(complnd), 'lfrin', & is_local%wrap%FBfrac(compatm), 'lfrin', & is_local%wrap%RH(complnd,compatm,maptype), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Destroy temporary field bundle if created if (ESMF_FieldBundleIsCreated(FBTemp)) then call ESMF_FieldBundleDestroy(FBtemp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end if end if @@ -366,10 +365,10 @@ subroutine med_fraction_init(gcomp, rc) if (is_local%wrap%comp_present(compice)) then ! Set 'ifrac' FBFrac(compice) - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImp(compice,compice) , 'Si_imask' , Si_imask, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compice), 'ifrac', ifrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBImp(compice,compice) , 'Si_imask' , Si_imask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(compice), 'ifrac', ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ifrac(:) = Si_imask(:) @@ -385,14 +384,14 @@ subroutine med_fraction_init(gcomp, rc) FBSrc=is_local%wrap%FBImp(compice,compice), & FBDst=is_local%wrap%FBImp(compice,compatm), & RouteHandle=is_local%wrap%RH(compice,compatm,maptype), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end if - call shr_nuopc_methods_FB_FieldRegrid(& + call FB_FieldRegrid(& is_local%wrap%FBfrac(compice), 'ifrac', & is_local%wrap%FBfrac(compatm), 'ifrac', & is_local%wrap%RH(compice,compatm,maptype), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if endif endif @@ -403,10 +402,10 @@ subroutine med_fraction_init(gcomp, rc) if (is_local%wrap%comp_present(compocn)) then - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImp(compocn,compocn) , 'So_omask', So_omask, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac', ofrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBImp(compocn,compocn) , 'So_omask', So_omask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac', ofrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ofrac(:) = So_omask(:) @@ -416,13 +415,13 @@ subroutine med_fraction_init(gcomp, rc) FBSrc=is_local%wrap%FBImp(compocn,compocn), & FBDst=is_local%wrap%FBImp(compocn,compatm), & RouteHandle=is_local%wrap%RH(compocn,compatm,mapconsf), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call shr_nuopc_methods_FB_FieldRegrid(& + call FB_FieldRegrid(& is_local%wrap%FBfrac(compocn), 'ofrac', & is_local%wrap%FBfrac(compatm), 'ofrac', & is_local%wrap%RH(compocn,compatm,mapconsf), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end if @@ -439,8 +438,8 @@ subroutine med_fraction_init(gcomp, rc) if (is_local%wrap%comp_present(compatm)) then if (is_local%wrap%comp_present(compocn) .or. is_local%wrap%comp_present(compice)) then - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) + call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) + call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) if (.not. is_local%wrap%comp_present(complnd)) then lfrac(:) = 0.0_R8 @@ -462,9 +461,9 @@ subroutine med_fraction_init(gcomp, rc) else if (is_local%wrap%comp_present(complnd)) then ! If the ocean or ice are absent, then simply set 'lfrac' to 'lfrin' for FBFrac(compatm) - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrin', lfrin, rc=rc) - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) + call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrin', lfrin, rc=rc) + call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) + call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) do n = 1,size(lfrac) lfrac(n) = lfrin(n) ofrac(n) = 1.0_R8 - lfrac(n) @@ -494,20 +493,20 @@ subroutine med_fraction_init(gcomp, rc) FBSrc=is_local%wrap%FBImp(compatm,compatm), & FBDst=is_local%wrap%FBImp(compatm,complnd), & RouteHandle=is_local%wrap%RH(compatm,complnd,mapconsf), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call shr_nuopc_methods_FB_FieldRegrid(& + call FB_FieldRegrid(& is_local%wrap%FBfrac(compatm), 'lfrac', & is_local%wrap%FBfrac(complnd), 'lfrac', & is_local%wrap%RH(compatm,complnd,mapconsf), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if else ! If the atm ->lnd coupling is not active - simply set 'lfrac' to 'lfrin' - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(complnd), 'lfrin', lfrin, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(complnd), 'lfrac', lfrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(complnd), 'lfrin', lfrin, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(complnd), 'lfrac', lfrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return lfrac(:) = lfrin(:) endif @@ -520,15 +519,15 @@ subroutine med_fraction_init(gcomp, rc) if (is_local%wrap%comp_present(comprof)) then ! Set 'rfrac' in FBFrac(comprof) - if ( shr_nuopc_methods_FB_FldChk(is_local%wrap%FBfrac(comprof) , 'rfrac', rc=rc) .and. & - shr_nuopc_methods_FB_FldChk(is_local%wrap%FBImp(comprof, comprof), 'frac' , rc=rc)) then - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(comprof) , 'rfrac', rfrac, rc=rc) - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImp(comprof,comprof), 'frac' , frac, rc=rc) + if ( FB_FldChk(is_local%wrap%FBfrac(comprof) , 'rfrac', rc=rc) .and. & + FB_FldChk(is_local%wrap%FBImp(comprof, comprof), 'frac' , rc=rc)) then + call FB_getFldPtr(is_local%wrap%FBfrac(comprof) , 'rfrac', rfrac, rc=rc) + call FB_getFldPtr(is_local%wrap%FBImp(comprof,comprof), 'frac' , frac, rc=rc) rfrac(:) = frac(:) else ! Set 'rfrac' in FBfrac(comprof) to 1. - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(comprof), 'rfrac', rfrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(comprof), 'rfrac', rfrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return rfrac(:) = 1.0_R8 endif @@ -539,13 +538,13 @@ subroutine med_fraction_init(gcomp, rc) FBSrc=is_local%wrap%FBImp(complnd,complnd), & FBDst=is_local%wrap%FBImp(complnd,comprof), & RouteHandle=is_local%wrap%RH(complnd,comprof,mapconsf), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call shr_nuopc_methods_FB_FieldRegrid(& + call FB_FieldRegrid(& is_local%wrap%FBfrac(complnd), 'lfrac', & is_local%wrap%FBfrac(comprof), 'lfrac', & is_local%wrap%RH(complnd,comprof,mapconsf), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif @@ -555,15 +554,15 @@ subroutine med_fraction_init(gcomp, rc) if (is_local%wrap%comp_present(compglc)) then ! Set 'gfrac' in FBFrac(compglc) - if ( shr_nuopc_methods_FB_FldChk(is_local%wrap%FBfrac(compglc) , 'gfrac', rc=rc) .and. & - shr_nuopc_methods_FB_FldChk(is_local%wrap%FBImp(compglc, compglc), 'frac' , rc=rc)) then - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compglc) , 'gfrac', gfrac, rc=rc) - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImp(compglc,compglc), 'frac' , frac, rc=rc) + if ( FB_FldChk(is_local%wrap%FBfrac(compglc) , 'gfrac', rc=rc) .and. & + FB_FldChk(is_local%wrap%FBImp(compglc, compglc), 'frac' , rc=rc)) then + call FB_getFldPtr(is_local%wrap%FBfrac(compglc) , 'gfrac', gfrac, rc=rc) + call FB_getFldPtr(is_local%wrap%FBImp(compglc,compglc), 'frac' , frac, rc=rc) gfrac(:) = frac(:) else ! Set 'gfrac' in FBfrac(compglc) to 1. - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compglc), 'gfrac', gfrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(compglc), 'gfrac', gfrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return gfrac(:) = 1.0_R8 endif @@ -574,13 +573,13 @@ subroutine med_fraction_init(gcomp, rc) FBSrc=is_local%wrap%FBImp(complnd,complnd), & FBDst=is_local%wrap%FBImp(complnd,compglc), & RouteHandle=is_local%wrap%RH(complnd,compglc,mapconsf), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call shr_nuopc_methods_FB_FieldRegrid(& + call FB_FieldRegrid(& is_local%wrap%FBfrac(complnd), 'lfrac', & is_local%wrap%FBfrac(compglc), 'lfrac', & is_local%wrap%RH(complnd,compglc,mapconsf), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif @@ -590,8 +589,8 @@ subroutine med_fraction_init(gcomp, rc) if (is_local%wrap%comp_present(compwav)) then ! Set 'wfrac' in FBfrac(compwav) to 1. - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compwav), 'wfrac', wfrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(compwav), 'wfrac', wfrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return wfrac(:) = 1.0_R8 endif @@ -602,9 +601,9 @@ subroutine med_fraction_init(gcomp, rc) 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), & + call 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end do end if @@ -632,12 +631,6 @@ subroutine med_fraction_set(gcomp, rc) use esmFlds , only : coupling_mode use med_internalstate_mod , only : InternalState use med_map_mod , only : med_map_Fractions_init - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - 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 @@ -665,7 +658,7 @@ subroutine med_fraction_set(gcomp, rc) ! 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- ! Update FBFrac(compice), FBFrac(compocn) and FBFrac(compatm) field bundles @@ -674,31 +667,31 @@ subroutine med_fraction_set(gcomp, rc) 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, & + call FB_init(is_local%wrap%FBImp(compice,compocn), is_local%wrap%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 + if (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), & RouteHandle=is_local%wrap%RH(compice,compocn,mapfcopy), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (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, & + call FB_init(is_local%wrap%FBImp(compocn,compice), is_local%wrap%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 + if (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), & RouteHandle=is_local%wrap%RH(compocn,compice,mapfcopy), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end if @@ -711,15 +704,15 @@ subroutine med_fraction_set(gcomp, rc) ! Si_imask is the ice domain mask which is constant over time ! Si_ifrac is the time evolving ice fraction on the ice grid - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImp(compice,compice) , 'Si_ifrac', Si_ifrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImp(compice,compice) , 'Si_imask' , Si_imask, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBImp(compice,compice) , 'Si_ifrac', Si_ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBImp(compice,compice) , 'Si_imask' , Si_imask, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compice), 'ifrac', ifrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compice), 'ofrac', ofrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(compice), 'ifrac', ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(compice), 'ofrac', ofrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! set ifrac = Si_ifrac * Si_imask ifrac(:) = Si_ifrac(:) * Si_imask(:) @@ -739,18 +732,18 @@ subroutine med_fraction_set(gcomp, rc) if (is_local%wrap%comp_present(compocn)) then ! Map 'ifrac' from FBfrac(compice) to FBfrac(compocn) - call shr_nuopc_methods_FB_FieldRegrid(& + call 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Map 'ofrac' from FBfrac(compice) to FBfrac(compocn) - call shr_nuopc_methods_FB_FieldRegrid(& + call FB_FieldRegrid(& is_local%wrap%FBfrac(compice), 'ofrac', & is_local%wrap%FBfrac(compocn), 'ofrac', & is_local%wrap%RH(compice,compocn,mapfcopy), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! ------------------------------------------- @@ -761,27 +754,27 @@ subroutine med_fraction_set(gcomp, rc) if (trim(coupling_mode) == 'nems_orig') then ! Map 'ifrac' from FBfrac(compice) to FBfrac(compatm) - call shr_nuopc_methods_FB_FieldRegrid(& + call FB_FieldRegrid(& is_local%wrap%FBfrac(compice), 'ifrac', & is_local%wrap%FBfrac(compatm), 'ifrac', & is_local%wrap%RH(compice,compatm,mapnstod), & zeroregion=ESMF_REGION_TOTAL, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_FieldRegrid(& + call FB_FieldRegrid(& is_local%wrap%FBfrac(compice), 'ifrac', & is_local%wrap%FBfrac(compatm), 'ifrac', & is_local%wrap%RH(compice,compatm,mapconsf), & zeroregion=ESMF_REGION_SELECT, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Now set ofrac=1-ifrac and lfrac=0 on the atm grid - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ifrac', ifrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ifrac', ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return ofrac = 1.0_R8 - ifrac lfrac = 0.0_R8 @@ -790,20 +783,20 @@ subroutine med_fraction_set(gcomp, rc) ! Map 'ifrac' from FBfrac(compice) to FBfrac(compatm) if (is_local%wrap%med_coupling_active(compice,compatm)) then - call shr_nuopc_methods_FB_FieldRegrid(& + call FB_FieldRegrid(& is_local%wrap%FBfrac(compice), 'ifrac', & is_local%wrap%FBfrac(compatm), 'ifrac', & is_local%wrap%RH(compice,compatm,mapconsf), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Map 'ofrac' from FBfrac(compice) to FBfrac(compatm) if (is_local%wrap%med_coupling_active(compocn,compatm)) then - call shr_nuopc_methods_FB_FieldRegrid(& + call FB_FieldRegrid(& is_local%wrap%FBfrac(compice), 'ofrac', & is_local%wrap%FBfrac(compatm), 'ofrac', & is_local%wrap%RH(compice,compatm,mapconsf), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Note: 'lfrac' from FBFrac(compatm) is just going to be in the init @@ -811,14 +804,14 @@ subroutine med_fraction_set(gcomp, rc) is_local%wrap%med_coupling_active(compocn,compatm) ) then if (atm_frac_correct) then - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ifrac', ifrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ifrac', ifrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'ofrac', ofrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFldPtr(is_local%wrap%FBfrac(compatm), 'lfrac', lfrac, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return where (ifrac + ofrac > 0.0_R8) ifrac = ifrac * ((1.0_R8 - lfrac)/(ofrac+ifrac)) ofrac = ofrac * ((1.0_R8 - lfrac)/(ofrac+ifrac)) @@ -840,9 +833,9 @@ subroutine med_fraction_set(gcomp, rc) 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), & + call 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if enddo end if diff --git a/cime/src/drivers/nuopc/mediator/med_internalstate_mod.F90 b/cime/src/drivers/nuopc/mediator/med_internalstate_mod.F90 index fa565718cf06..332cc8c48019 100644 --- a/cime/src/drivers/nuopc/mediator/med_internalstate_mod.F90 +++ b/cime/src/drivers/nuopc/mediator/med_internalstate_mod.F90 @@ -4,9 +4,10 @@ module med_internalstate_mod ! Mediator Internal State Datatype. !----------------------------------------------------------------------------- - use ESMF , only : ESMF_RouteHandle, ESMF_FieldBundle, ESMF_State - use ESMF , only : ESMF_VM - use esmFlds , only : ncomps, nmappers + use ESMF , only : ESMF_RouteHandle, ESMF_FieldBundle, ESMF_State + use ESMF , only : ESMF_VM + use esmFlds , only : ncomps, nmappers + use med_constants_mod , only : CL implicit none private @@ -50,17 +51,25 @@ 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 + ! Present/Active logical flags + logical :: comp_present(ncomps) ! comp present flag + logical :: med_coupling_active(ncomps,ncomps) ! computes the active coupling + + ! 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 + ! Import/Export Scalars + character(len=CL) :: flds_scalar_name = '' + integer :: flds_scalar_num = 0 + integer :: flds_scalar_index_nx = 0 + integer :: flds_scalar_index_ny = 0 + integer :: flds_scalar_index_nextsw_cday = 0 + integer :: flds_scalar_index_precip_factor = 0 - ! Import/export States and field bundles + ! Import/export States and field bundles (the field bundles have the scalar fields removed) type(ESMF_State) :: NStateImp(ncomps) ! Import data from various component, on their grid type(ESMF_State) :: NStateExp(ncomps) ! Export data to various component, on their grid type(ESMF_FieldBundle) :: FBImp(ncomps,ncomps) ! Import data from various components interpolated to various grids diff --git a/cime/src/drivers/nuopc/mediator/med_io_mod.F90 b/cime/src/drivers/nuopc/mediator/med_io_mod.F90 index f5ba2091ff05..bcc5a91d4e6a 100644 --- a/cime/src/drivers/nuopc/mediator/med_io_mod.F90 +++ b/cime/src/drivers/nuopc/mediator/med_io_mod.F90 @@ -2,10 +2,15 @@ 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, ESMF_LogWrite, ESMF_LOGMSG_INFO + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE + use pio , only : file_desc_t, iosystem_desc_t + use med_constants_mod , only : R4, R8, CL + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr + use shr_nuopc_methods_mod , only : FB_getFieldN => shr_nuopc_methods_FB_getFieldN + use shr_nuopc_methods_mod , only : FB_getFldPtr => shr_nuopc_methods_FB_getFldPtr + use shr_nuopc_methods_mod , only : FB_getNameN => shr_nuopc_methods_FB_getNameN implicit none private @@ -87,7 +92,7 @@ logical function med_io_file_exists(vm, iam, filename) if (med_io_file_exists) tmp(1) = 1 call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if(tmp(1) == 1) med_io_file_exists = .true. @@ -120,7 +125,6 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) use pio , only : pio_openfile, pio_createfile, PIO_GLOBAL, pio_enddef use PIO , only : pio_put_att, pio_redef, pio_get_att use pio , only : pio_seterrorhandling, pio_file_is_open, pio_clobber, pio_write, pio_noclobber - use shr_sys_mod , only : shr_sys_abort use med_internalstate_mod , only : logunit ! input/output arguments @@ -201,7 +205,9 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) ! filename is open, better match open filename if(iam==0) write(logunit,*) subname,' different filename currently open ',trim(filename) if(iam==0) write(logunit,*) subname,' different wfilename currently open ',trim(wfilename) - call shr_sys_abort(subname//'different file currently open '//trim(filename)) + call ESMF_LogWrite(subname//'different file currently open '//trim(filename), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return else ! filename is already open, just return endif @@ -209,7 +215,7 @@ subroutine med_io_wopen(filename, vm, iam, clobber, file_ind, model_doi_url) end subroutine med_io_wopen !=============================================================================== - subroutine med_io_close(filename, iam, file_ind) + subroutine med_io_close(filename, iam, file_ind, rc) !--------------- ! close netcdf file @@ -217,18 +223,20 @@ subroutine med_io_close(filename, iam, file_ind) use pio, only: pio_file_is_open, pio_closefile use med_internalstate_mod, only : logunit - use shr_sys_mod, only : shr_sys_abort ! input/output variables - character(*), intent(in) :: filename - integer, intent(in) :: iam - integer,optional, intent(in) :: file_ind + character(*), intent(in) :: filename + integer, intent(in) :: iam + integer,optional, intent(in) :: file_ind + integer , intent(out) :: rc ! local variables integer :: lfile_ind character(*),parameter :: subName = '(med_io_close) ' !------------------------------------------------------------------------------- + rc = ESMF_SUCCESS + lfile_ind = 0 if (present(file_ind)) lfile_ind=file_ind @@ -241,7 +249,9 @@ subroutine med_io_close(filename, iam, file_ind) ! different filename is open, abort if (iam==0) write(logunit,*) subname,' different filename currently open, aborting ',trim(filename) if (iam==0) write(logunit,*) subname,' different wfilename currently open, aborting ',trim(wfilename) - call shr_sys_abort(subname//'different file currently open, aborting '//trim(filename)) + call ESMF_LogWrite(subname//'different file currently open, aborting '//trim(filename), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return endif wfilename = '' end subroutine med_io_close @@ -298,13 +308,13 @@ character(len=24) function med_io_date2yyyymmdd (date) end function med_io_date2yyyymmdd !=============================================================================== - character(len=8) function med_io_sec2hms (seconds) + character(len=8) function med_io_sec2hms (seconds, rc) - use shr_sys_mod , only : shr_sys_abort use med_internalstate_mod , only : logunit ! input arguments - integer, intent(in) :: seconds + integer, intent(in) :: seconds + integer, intent(out) :: rc ! local variables integer :: hours ! hours of hh:mm:ss @@ -312,9 +322,13 @@ character(len=8) function med_io_sec2hms (seconds) integer :: secs ! seconds of hh:mm:ss !---------------------------------------------------------------------- + rc = ESMF_SUCCESS + if (seconds < 0 .or. seconds > 86400) then write(logunit,*)'med_io_sec2hms: bad input seconds:', seconds - call shr_sys_abort('med_io_sec2hms: bad input seconds') + call ESMF_LogWrite('med_io_sec2hms: bad input seconds', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return end if hours = seconds / 3600 @@ -323,12 +337,16 @@ character(len=8) function med_io_sec2hms (seconds) if (minutes < 0 .or. minutes > 60) then write(logunit,*)'med_io_sec2hms: bad minutes = ',minutes - call shr_sys_abort('med_io_sec2hms: bad minutes') + call ESMF_LogWrite('med_io_sec2hms: bad minutes', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return end if if (secs < 0 .or. secs > 60) then write(logunit,*)'med_io_sec2hms: bad secs = ',secs - call shr_sys_abort('med_io_sec2hms: bad secs') + call ESMF_LogWrite('med_io_sec2hms: bad secs', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return end if write(med_io_sec2hms,80) hours, minutes, secs @@ -348,11 +366,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & 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 med_constants_mod , only : R4, R8, dbug_flag=>med_constants_dbug_flag use shr_const_mod , only : fillvalue=>SHR_CONST_SPVAL - 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 @@ -472,21 +486,21 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & return endif - call shr_nuopc_methods_FB_getFieldN(FB, 1, field, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call FB_getFieldN(FB, 1, field, rc=rc) + if (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 + if (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 + if (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 + if (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 + if (chkerr(rc,__LINE__,u_FILE_u)) return ! write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile ! call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) @@ -534,20 +548,20 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & 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 + call FB_getNameN(FB, k, itemc, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! 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 + if (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 (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 if (rank == 2) then call ESMF_FieldGet(lfield, ungriddedUBound=ungriddedUBound, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (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) @@ -609,7 +623,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & ! 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 + if (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) @@ -622,12 +636,12 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & 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 FB_getNameN(FB, k, itemc, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(FB, itemc, & + call FB_getFldPtr(FB, itemc, & fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (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 @@ -635,9 +649,9 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & ! 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 + if (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 (chkerr(rc,__LINE__,u_FILE_u)) return ! Output for each ungriddedUbound index do n = 1,ungriddedUBound(1) @@ -673,7 +687,7 @@ subroutine med_io_write_FB(filename, iam, FB, whead, wdata, nx, ny, nt, & end subroutine med_io_write_FB !=============================================================================== - subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind) + subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind, rc) 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 @@ -683,13 +697,14 @@ subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind) !--------------- ! intput/output variables - character(len=*),intent(in) :: filename ! file - integer ,intent(in) :: iam ! local pet - integer ,intent(in) :: idata ! data to be written - character(len=*),intent(in) :: dname ! name of data - logical,optional,intent(in) :: whead ! write header - logical,optional,intent(in) :: wdata ! write data - integer,optional,intent(in) :: file_ind + character(len=*) ,intent(in) :: filename ! file + integer ,intent(in) :: iam ! local pet + integer ,intent(in) :: idata ! data to be written + character(len=*) ,intent(in) :: dname ! name of data + logical,optional ,intent(in) :: whead ! write header + logical,optional ,intent(in) :: wdata ! write data + integer,optional ,intent(in) :: file_ind + integer ,intent(out):: rc ! local variables integer :: rcode @@ -702,6 +717,8 @@ subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind) character(*),parameter :: subName = '(med_io_write_int) ' !------------------------------------------------------------------------------- + rc = ESMF_SUCCESS + lwhead = .true. lwdata = .true. if (present(whead)) lwhead = whead @@ -735,7 +752,7 @@ subroutine med_io_write_int(filename, iam, idata, dname, whead, wdata, file_ind) end subroutine med_io_write_int !=============================================================================== - subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_ind) + subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_ind, rc) !--------------- ! Write 1d integer array to netcdf file @@ -754,6 +771,7 @@ subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_in logical,optional,intent(in) :: whead ! write header logical,optional,intent(in) :: wdata ! write data integer,optional,intent(in) :: file_ind + integer , intent(out) :: rc ! local variables integer :: rcode @@ -768,6 +786,8 @@ subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_in character(*),parameter :: subName = '(med_io_write_int1d) ' !------------------------------------------------------------------------------- + rc = ESMF_SUCCESS + lwhead = .true. lwdata = .true. if (present(whead)) lwhead = whead @@ -802,13 +822,12 @@ subroutine med_io_write_int1d(filename, iam, idata, dname, whead, wdata, file_in end subroutine med_io_write_int1d !=============================================================================== - subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind) + subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind, rc) !--------------- ! 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 @@ -821,6 +840,7 @@ subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind) logical,optional,intent(in) :: whead ! write header logical,optional,intent(in) :: wdata ! write data integer,optional,intent(in) :: file_ind + integer ,intent(out):: rc ! local variables integer :: rcode @@ -833,6 +853,8 @@ subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind) character(*),parameter :: subName = '(med_io_write_r8) ' !------------------------------------------------------------------------------- + rc = ESMF_SUCCESS + lwhead = .true. if (present(whead)) lwhead = whead lwdata = .true. @@ -866,13 +888,12 @@ subroutine med_io_write_r8(filename, iam, rdata, dname, whead, wdata, file_ind) end subroutine med_io_write_r8 !=============================================================================== - subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind) + subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind, rc) !--------------- ! 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 use pio , only : pio_inq_varid, pio_put_var, pio_double, pio_put_att use esmFlds , only : shr_nuopc_fldList_GetMetadata @@ -885,6 +906,7 @@ subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind logical,optional,intent(in) :: whead ! write header logical,optional,intent(in) :: wdata ! write data integer,optional,intent(in) :: file_ind + integer ,intent(out):: rc ! local variables integer :: rcode @@ -899,6 +921,8 @@ subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind character(*),parameter :: subName = '(med_io_write_r81d) ' !------------------------------------------------------------------------------- + rc = ESMF_SUCCESS + lwhead = .true. if (present(whead)) lwhead = whead lwdata = .true. @@ -930,7 +954,7 @@ subroutine med_io_write_r81d(filename, iam, rdata, dname, whead, wdata, file_ind end subroutine med_io_write_r81d !=============================================================================== - subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind) + subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind, rc) !--------------- ! Write char string to netcdf file @@ -948,6 +972,7 @@ subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind logical,optional,intent(in) :: whead ! write header logical,optional,intent(in) :: wdata ! write data integer,optional,intent(in) :: file_ind + integer ,intent(out):: rc ! local variables integer :: rcode @@ -963,6 +988,8 @@ subroutine med_io_write_char(filename, iam, rdata, dname, whead, wdata, file_ind character(*),parameter :: subName = '(med_io_write_char) ' !------------------------------------------------------------------------------- + rc = ESMF_SUCCESS + lwhead = .true. if (present(whead)) lwhead = whead lwdata = .true. @@ -995,13 +1022,12 @@ 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) + whead, wdata, tbnds, file_ind, rc) !--------------- ! 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 use shr_cal_mod , only : shr_cal_gregorian @@ -1021,6 +1047,7 @@ subroutine med_io_write_time(filename, iam, time_units, time_cal, time_val, nt,& logical, optional, intent(in) :: wdata ! write data real(r8), optional, intent(in) :: tbnds(2) ! time bounds integer, optional, intent(in) :: file_ind + integer , intent(out):: rc ! local variables integer :: rcode @@ -1035,6 +1062,8 @@ subroutine med_io_write_time(filename, iam, time_units, time_cal, time_val, nt,& character(*),parameter :: subName = '(med_io_write_time) ' !------------------------------------------------------------------------------- + rc = ESMF_SUCCESS + lwhead = .true. if (present(whead)) lwhead = whead lwdata = .true. @@ -1100,7 +1129,6 @@ 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 use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS @@ -1113,9 +1141,6 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) use pio , only : pio_double, pio_get_att, pio_seterrorhandling, pio_freedecomp, pio_closefile 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 ! input/output arguments character(len=*) ,intent(in) :: filename ! file @@ -1151,7 +1176,7 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) !------------------------------------------------------------------------------- rc = ESMF_Success call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return lpre = ' ' if (present(pre)) then @@ -1164,25 +1189,25 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) endif if (.not. ESMF_FieldBundleIsCreated(FB,rc=rc)) then 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 (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif return endif call ESMF_FieldBundleGet(FB, fieldCount=nf, rc=rc) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return write(tmpstr,*) subname//' field count = '//trim(lpre),nf call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (nf < 1) then call ESMF_LogWrite(trim(subname)//" FB "//trim(lpre)//" empty", ESMF_LOGMSG_INFO) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 5) then call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return endif return endif @@ -1190,7 +1215,7 @@ 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) - if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + if (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) @@ -1202,42 +1227,42 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) 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 FB_getNameN(FB, k, itemc, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! 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 + if (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 (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 + if (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 + if (chkerr(rc,__LINE__,u_FILE_u)) return ! 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, & + call FB_getFldPtr(FB, itemc, & fldptr1=fldptr1, fldptr2=fldptr2, rank=rank, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (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 + if (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 (chkerr(rc,__LINE__,u_FILE_u)) return if (gridToFieldMap(1) == 1) then lsize = size(fldptr2, dim=1) @@ -1255,7 +1280,7 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) 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 + if (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) @@ -1283,7 +1308,7 @@ subroutine med_io_read_FB(filename, vm, iam, FB, pre, frame, rc) 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 + if (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) @@ -1321,7 +1346,6 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) 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 @@ -1375,22 +1399,22 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) 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 FB_getFieldN(FB, 1, field, rc=rc) + if (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 + if (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 + if (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 + if (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 + if (chkerr(rc,__LINE__,u_FILE_u)) return !write(tmpstr,*) subname,' counts = ',dimcount,tilecount,minindexptile,maxindexptile !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) @@ -1403,7 +1427,7 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) endif call ESMF_DistGridGet(distgrid, localDE=0, elementCount=ns, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return allocate(dof(ns)) call ESMF_DistGridGet(distgrid, localDE=0, seqIndexList=dof, rc=rc) @@ -1420,7 +1444,7 @@ subroutine med_io_read_init_iodesc(FB, name1, pioid, iodesc, rc) end subroutine med_io_read_init_iodesc !=============================================================================== - subroutine med_io_read_int(filename, vm, iam, idata, dname) + subroutine med_io_read_int(filename, vm, iam, idata, dname, rc) !--------------- ! Read scalar integer from netcdf file @@ -1432,25 +1456,27 @@ subroutine med_io_read_int(filename, vm, iam, idata, dname) integer , intent(in) :: iam integer , intent(inout) :: idata ! integer data character(len=*) , intent(in) :: dname ! name of data + integer , intent(out) :: rc ! local variables integer :: i1d(1) character(*),parameter :: subName = '(med_io_read_int) ' !------------------------------------------------------------------------------- - call med_io_read_int1d(filename, vm, iam, i1d, dname) + rc = ESMF_SUCCESS + call med_io_read_int1d(filename, vm, iam, i1d, dname, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return idata = i1d(1) end subroutine med_io_read_int !=============================================================================== - subroutine med_io_read_int1d(filename, vm, iam, idata, dname) + subroutine med_io_read_int1d(filename, vm, iam, idata, dname, rc) !--------------- ! Read 1d integer array from netcdf file !--------------- - use shr_sys_mod , only : shr_sys_abort use med_constants_mod , only : R8 use pio , only : var_desc_t, file_desc_t, PIO_BCAST_ERROR, PIO_INTERNAL_ERROR, pio_seterrorhandling use pio , only : pio_get_var, pio_inq_varid, pio_get_att, pio_openfile @@ -1464,6 +1490,7 @@ subroutine med_io_read_int1d(filename, vm, iam, idata, dname) integer, intent(in) :: iam integer , intent(inout) :: idata(:) ! integer data character(len=*), intent(in) :: dname ! name of data + integer , intent(out) :: rc ! local variables integer :: rcode @@ -1471,10 +1498,11 @@ subroutine med_io_read_int1d(filename, vm, iam, idata, dname) type(var_desc_t) :: varid character(CL) :: lversion character(CL) :: name1 - integer :: rc character(*),parameter :: subName = '(med_io_read_int1d) ' !------------------------------------------------------------------------------- + rc = ESMF_SUCCESS + lversion=trim(version) if (med_io_file_exists(vm, iam, filename)) then @@ -1484,7 +1512,9 @@ subroutine med_io_read_int1d(filename, vm, iam, idata, dname) call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) else if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) - call shr_sys_abort(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname)) + call ESMF_LogWrite(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return endif if (trim(lversion) == trim(version)) then @@ -1499,7 +1529,7 @@ subroutine med_io_read_int1d(filename, vm, iam, idata, dname) end subroutine med_io_read_int1d !=============================================================================== - subroutine med_io_read_r8(filename, vm, iam, rdata, dname) + subroutine med_io_read_r8(filename, vm, iam, rdata, dname, rc) use med_constants_mod, only : R8 !--------------- @@ -1512,29 +1542,33 @@ subroutine med_io_read_r8(filename, vm, iam, rdata, dname) integer , intent(in) :: iam real(r8) , intent(inout) :: rdata ! real data character(len=*) , intent(in) :: dname ! name of data + integer , intent(out) :: rc ! local variables real(r8) :: r1d(1) character(*),parameter :: subName = '(med_io_read_r8) ' !------------------------------------------------------------------------------- - call med_io_read_r81d(filename, vm, iam, r1d,dname) + rc = ESMF_SUCCESS + call med_io_read_r81d(filename, vm, iam, r1d,dname, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + rdata = r1d(1) + end subroutine med_io_read_r8 !=============================================================================== - subroutine med_io_read_r81d(filename, vm, iam, rdata, dname) + subroutine med_io_read_r81d(filename, vm, iam, rdata, dname, rc) !--------------- ! 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 + 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 ! input/output arguments character(len=*), intent(in) :: filename ! file @@ -1542,17 +1576,19 @@ subroutine med_io_read_r81d(filename, vm, iam, rdata, dname) integer , intent(in) :: iam real(r8) , intent(inout) :: rdata(:) ! real data character(len=*), intent(in) :: dname ! name of data + integer , intent(out) :: rc ! local variables integer :: rcode type(file_desc_T) :: pioid type(var_desc_t) :: varid - integer :: rc character(CL) :: lversion character(CL) :: name1 character(*),parameter :: subName = '(med_io_read_r81d) ' !------------------------------------------------------------------------------- + rc = ESMF_SUCCESS + lversion=trim(version) if (med_io_file_exists(vm, iam, filename)) then @@ -1562,7 +1598,9 @@ subroutine med_io_read_r81d(filename, vm, iam, rdata, dname) call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) else if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) - call shr_sys_abort(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname)) + call ESMF_LogWrite(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return endif if (trim(lversion) == trim(version)) then @@ -1577,7 +1615,7 @@ subroutine med_io_read_r81d(filename, vm, iam, rdata, dname) end subroutine med_io_read_r81d !=============================================================================== - subroutine med_io_read_char(filename, vm, iam, rdata, dname) + subroutine med_io_read_char(filename, vm, iam, rdata, dname, rc) !--------------- ! Read char string from netcdf file @@ -1587,7 +1625,6 @@ subroutine med_io_read_char(filename, vm, iam, rdata, dname) 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 @@ -1595,18 +1632,20 @@ subroutine med_io_read_char(filename, vm, iam, rdata, dname) integer, intent(in) :: iam character(len=*), intent(inout) :: rdata ! character data character(len=*), intent(in) :: dname ! name of data + integer , intent(out) :: rc ! local variables integer :: rcode type(file_desc_T) :: pioid type(var_desc_t) :: varid - integer :: rc character(CL) :: lversion character(CL) :: name1 character(CL) :: charvar ! buffer for string read/write character(*),parameter :: subName = '(med_io_read_char) ' !------------------------------------------------------------------------------- + rc = ESMF_SUCCESS + lversion=trim(version) if (med_io_file_exists(vm, iam, filename)) then @@ -1617,7 +1656,9 @@ subroutine med_io_read_char(filename, vm, iam, rdata, dname) call pio_seterrorhandling(pioid,PIO_INTERNAL_ERROR) else if(iam==0) write(logunit,*) subname,' ERROR: file invalid ',trim(filename),' ',trim(dname) - call shr_sys_abort(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname)) + call ESMF_LogWrite(trim(subname)//'ERROR: file invalid '//trim(filename)//' '//trim(dname), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return endif if (trim(lversion) == trim(version)) then diff --git a/cime/src/drivers/nuopc/mediator/med_map_mod.F90 b/cime/src/drivers/nuopc/mediator/med_map_mod.F90 index b71758f7aa06..8187e2e45327 100644 --- a/cime/src/drivers/nuopc/mediator/med_map_mod.F90 +++ b/cime/src/drivers/nuopc/mediator/med_map_mod.F90 @@ -1,13 +1,24 @@ module med_map_mod - use med_constants_mod , only : CX, CS, CL, R8 - 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 - + use esmFlds , only : mapbilnr, mapconsf, mapconsd, mappatch, mapfcopy + use esmFlds , only : mapunset, mapnames + use esmFlds , only : mapnstod, mapnstod_consd, mapnstod_consf + use med_constants_mod , only : CX, CS, CL, R8 + 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 shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr + use shr_nuopc_utils_mod , only : memcheck => shr_nuopc_memcheck + use shr_nuopc_methods_mod , only : FB_getFieldN => shr_nuopc_methods_FB_getFieldN + use shr_nuopc_methods_mod , only : FB_init => shr_nuopc_methods_FB_Init + use shr_nuopc_methods_mod , only : FB_reset => shr_nuopc_methods_FB_Reset + use shr_nuopc_methods_mod , only : FB_Clean => shr_nuopc_methods_FB_Clean + use shr_nuopc_methods_mod , only : FB_GetFldPtr => shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : FB_FieldRegrid => shr_nuopc_methods_FB_FieldRegrid + use shr_nuopc_methods_mod , only : FB_Field_diagnose => shr_nuopc_methods_FB_Field_diagnose + use shr_nuopc_methods_mod , only : FB_FldChk => shr_nuopc_methods_FB_FldChk + use shr_nuopc_methods_mod , only : Field_diagnose => shr_nuopc_methods_Field_diagnose + implicit none private @@ -24,6 +35,7 @@ module med_map_mod ! private module variables + character(len=CS) :: flds_scalar_name integer :: srcTermProcessing_Value = 0 ! should this be a module variable? logical :: mastertask character(*), parameter :: u_FILE_u = & @@ -73,8 +85,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 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 use perf_mod , only : t_startf, t_stopf @@ -125,7 +135,7 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) ! 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Create the necessary route handles if (mastertask) write(llogunit,*) ' ' @@ -149,11 +159,11 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) if (is_local%wrap%med_coupling_active(n1,n2)) then ! If coupling is active between n1 and n2 - call shr_nuopc_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n1), 1, fldsrc, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFieldN(is_local%wrap%FBImp(n1,n1), 1, fldsrc, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFieldN(is_local%wrap%FBImp(n1,n2), 1, flddst, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFieldN(is_local%wrap%FBImp(n1,n2), 1, flddst, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Loop over fields do nf = 1,size(fldListFr(n1)%flds) @@ -178,7 +188,7 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) else if (ESMF_RouteHandleIsCreated(is_local%wrap%RH(n1,n2,mapindex), rc=rc)) then mapexists = .true. end if - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (.not. mapexists) then @@ -195,7 +205,7 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return else if (mapfile /= 'unset') then ! Get route handle from mapping file if (mastertask) then @@ -208,7 +218,7 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return else ! Create route handle on the fly if (mastertask) write(llogunit,'(3A)') subname,trim(string),& @@ -281,10 +291,10 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & rc=rc) end if - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (rhprint_flag .and. mapindex /= mapnstod_consd .and. mapindex /= mapnstod_consf) then call NUOPC_Write(factorList, "array_med_"//trim(string)//"_consf.nc", rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end if !if (associated(unmappedDstList)) then ! write(logMsg,*) trim(subname),trim(string),' number of unmapped dest points = ', size(unmappedDstList) @@ -295,9 +305,9 @@ subroutine med_map_RouteHandles_init(gcomp, llogunit, rc) call ESMF_LogWrite(trim(subname)//trim(string)//": printing RH for "//trim(mapname), & 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return endif - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Check that a valid route handle has been created if ( mapindex /= mapnstod_consd .and. mapindex /= mapnstod_consf .and. & .not. ESMF_RouteHandleIsCreated(is_local%wrap%RH(n1,n2,mapindex), rc=rc)) then @@ -322,6 +332,11 @@ end subroutine med_map_RouteHandles_init subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) + !--------------------------------------------- + ! Initialize initialize additional route handles + ! for mapping fractions + !--------------------------------------------- + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_LogFlush use ESMF , only : ESMF_GridComp, ESMF_FieldBundle, ESMF_RouteHandle, ESMF_Field use ESMF , only : ESMF_FieldRedistStore, ESMF_FieldSMMStore, ESMF_FieldRegridStore @@ -329,13 +344,7 @@ subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) use NUOPC , only : NUOPC_CompAttributeGet use esmFlds , only : ncomps, compice, compocn, compname use esmflds , only : mapnames, mapconsf - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFieldN use perf_mod , only : t_startf, t_stopf - !--------------------------------------------- - ! Initialize initialize additional route handles - ! for mapping fractions - !--------------------------------------------- type(ESMF_GridComp) :: gcomp integer , intent(in) :: n1 @@ -367,11 +376,11 @@ subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) rc = ESMF_SUCCESS - call shr_nuopc_methods_FB_getFieldN(FBsrc, 1, fldsrc, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFieldN(FBsrc, 1, fldsrc, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFieldN(FBDst, 1, flddst, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getFieldN(FBDst, 1, flddst, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return dstMaskValue = ispval_mask srcMaskValue = ispval_mask @@ -394,7 +403,7 @@ subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) call ESMF_FieldRedistStore(fldsrc, flddst, & routehandle=RouteHandle, & ignoreUnmatchedIndices = .true., rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (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) @@ -402,7 +411,7 @@ subroutine med_map_Fractions_init(gcomp, n1, n2, FBSrc, FBDst, RouteHandle, rc) routehandle=RouteHandle, & ignoreUnmatchedIndices=.true., & srcTermProcessing=srcTermProcessing_Value, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (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) @@ -439,13 +448,6 @@ subroutine med_map_MapNorm_init(gcomp, llogunit, rc) use esmFlds , only: ncomps, compice, compocn, compname use esmFlds , only: mapnames, nmappers use med_internalstate_mod , only: InternalState - use shr_nuopc_scalars_mod , only: flds_scalar_name, flds_scalar_num - use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_Init - 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_GetFldPtr - 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 @@ -474,7 +476,10 @@ subroutine med_map_MapNorm_init(gcomp, llogunit, rc) ! 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Initialize module variables + flds_scalar_name = is_local%wrap%flds_scalar_name ! Create the normalization field bundles normname = 'one' @@ -490,33 +495,33 @@ subroutine med_map_MapNorm_init(gcomp, llogunit, rc) //compname(n1)//'->'//compname(n2)//'with mapping '//mapnames(m), & ESMF_LOGMSG_INFO) endif - call shr_nuopc_methods_FB_init(FBout=is_local%wrap%FBNormOne(n1,n2,m), & + call FB_init(FBout=is_local%wrap%FBNormOne(n1,n2,m), & flds_scalar_name=flds_scalar_name, & FBgeom=is_local%wrap%FBImp(n1,n2), & fieldNameList=(/trim(normname)/), name='FBNormOne', rc=rc) - if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + if (chkerr(rc,__line__,u_file_u)) return - call shr_nuopc_methods_FB_reset(is_local%wrap%FBNormOne(n1,n2,m), value=czero, rc=rc) - if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + call FB_reset(is_local%wrap%FBNormOne(n1,n2,m), value=czero, rc=rc) + if (chkerr(rc,__line__,u_file_u)) return - call shr_nuopc_methods_FB_init(FBout=FBTmp, & + call FB_init(FBout=FBTmp, & flds_scalar_name=flds_scalar_name, & STgeom=is_local%wrap%NStateImp(n1), & fieldNameList=(/trim(normname)/), name='FBTmp', rc=rc) - if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + if (chkerr(rc,__line__,u_file_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBTmp, trim(normname), fldptr1=dataPtr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(FBTmp, trim(normname), fldptr1=dataPtr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return dataptr(:) = 1.0_R8 - call shr_nuopc_methods_FB_FieldRegrid(& + call FB_FieldRegrid(& FBTmp , normname, & is_local%wrap%FBNormOne(n1,n2,m), normname, & is_local%wrap%RH(n1,n2,m), rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_clean(FBTmp, rc=rc) - if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + call FB_clean(FBTmp, rc=rc) + if (chkerr(rc,__line__,u_file_u)) return end if end do end if @@ -551,16 +556,6 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & use esmFlds , only: mapnames, mapfcopy, mapconsd, mapconsf, mapnstod use esmFlds , only: mapnstod_consd, mapnstod_consf use esmFlds , only: shr_nuopc_fldList_entry_type - use shr_nuopc_scalars_mod , only: flds_scalar_name - use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_Init - 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_GetFldPtr - use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_FieldRegrid - use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_FldChk - use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_Field_diagnose - use shr_nuopc_methods_mod , only: shr_nuopc_methods_ChkErr - use shr_nuopc_utils_mod , only: shr_nuopc_memcheck use perf_mod , only: t_startf, t_stopf ! input/output variables @@ -595,7 +590,7 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & call t_startf('MED:'//subname) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - call shr_nuopc_memcheck(subname, 1, mastertask) + call memcheck(subname, 1, mastertask) !--------------------------------------- @@ -611,8 +606,8 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & ! First - reset the field bundle on the destination grid to zero !--------------------------------------- - call shr_nuopc_methods_FB_reset(FBDst, value=czero, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_reset(FBDst, value=czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- ! Loop over all fields in the source field bundle and map them to @@ -634,12 +629,12 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & 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 (.not. 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 + else if (.not. 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 @@ -650,9 +645,9 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & ! Error checks ! ------------------- - if (.not. shr_nuopc_methods_FB_FldChk(FBSrc, fldname, rc=rc)) then + if (.not. FB_FldChk(FBSrc, fldname, rc=rc)) then 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 + else if (.not. FB_FldChk(FBDst, fldname, rc=rc)) then 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. & @@ -688,17 +683,17 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & 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 + if (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 + if (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 + call FB_FieldRegrid(FBSrc, fldname, FBDst, fldname, RouteHandles(mapindex), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return else ! Determine the normalization for the map @@ -712,8 +707,8 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & !------------------------------------------------- ! 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 + call FB_GetFldPtr(FBSrc, fldname, data_src, rc=rc) + if (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 @@ -725,8 +720,8 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & ! 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(FBFracSrc, trim(mapnorm), data_frac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(FBFracSrc, trim(mapnorm), data_frac, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! regrid FBSrc to FBDst ! - copy data_src to data_srctmp @@ -736,12 +731,12 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return data_src = data_srctmp ! 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 + call FB_GetFldPtr(FBFracDst, mapnorm, data_norm, rc=rc) + if (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) @@ -754,14 +749,14 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & ! 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return ! 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_FieldGet(lfield, farrayPtr=data_norm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call norm_field_dest(trim(fldname), dstfield, data_norm, rc) end if ! mapnorm is 'one' @@ -770,9 +765,9 @@ subroutine med_map_FB_Regrid_Norm_All(fldsSrc, srccomp, destcomp, & end if ! mapindex is not mapfcopy and field exists !if (dbug_flag > 1) then - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldname, & + call 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return !end if end do ! loop over fields @@ -797,8 +792,6 @@ subroutine map_field_src2dst (fldname, srcfield, dstfield, RouteHandles, mapinde 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 ! input/output variables character(len=*) , intent(in) :: fldname @@ -823,14 +816,14 @@ subroutine map_field_src2dst (fldname, srcfield, dstfield, RouteHandles, mapinde 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) + call 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) + call Field_diagnose(dstfield, fldname, " --> after consd: ", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if else if (mapindex == mapnstod_consf) then @@ -838,14 +831,14 @@ subroutine map_field_src2dst (fldname, srcfield, dstfield, RouteHandles, mapinde 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) + call 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) + call Field_diagnose(dstfield, fldname, " --> after consf: ", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if else @@ -865,10 +858,8 @@ subroutine norm_field_dest (fldname, dstfield, frac, rc) ! mapped fraction or 'one' ! ------------------------------------------------ - 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 + use ESMF , only : ESMF_Field, ESMF_FieldGet + use ESMF , only : ESMF_SUCCESS ! input/output variables character(len=*) , intent(in) :: fldname @@ -926,7 +917,7 @@ subroutine norm_field_dest (fldname, dstfield, frac, rc) end do end if - call shr_nuopc_methods_Field_diagnose(dstfield, fldname, " --> after frac: ", rc=rc) + call Field_diagnose(dstfield, fldname, " --> after frac: ", rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end subroutine norm_field_dest @@ -944,16 +935,6 @@ subroutine med_map_FB_Regrid_Norm_Frac(fldnames, FBSrc, FBDst, & use ESMF , only: ESMF_LOGMSG_ERROR, ESMF_FAILURE use ESMF , only: ESMF_FieldBundle, ESMF_FieldBundleIsCreated, ESMF_FieldBundleGet use ESMF , only: ESMF_RouteHandle, ESMF_RouteHandleIsCreated, ESMF_Field - use shr_nuopc_scalars_mod , only: flds_scalar_name - use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_Init - 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_GetFldPtr - use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_FieldRegrid - use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_FldChk - use shr_nuopc_methods_mod , only: shr_nuopc_methods_FB_Field_diagnose - use shr_nuopc_methods_mod , only: shr_nuopc_methods_ChkErr - use shr_nuopc_utils_mod , only: shr_nuopc_memcheck use perf_mod , only: t_startf, t_stopf ! input/output variables @@ -988,7 +969,7 @@ subroutine med_map_FB_Regrid_Norm_Frac(fldnames, FBSrc, FBDst, & call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) - call shr_nuopc_memcheck(subname, 1, mastertask) + call memcheck(subname, 1, mastertask) if (present(string)) then lstring = trim(string) @@ -1001,50 +982,50 @@ subroutine med_map_FB_Regrid_Norm_Frac(fldnames, FBSrc, FBDst, & ! the destination field bundle accordingly !------------------------------------------------- - call shr_nuopc_methods_FB_reset(FBDst, value=czero, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_reset(FBDst, value=czero, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,size(fldnames) ! get pointer to source field data in FBSrc - call shr_nuopc_methods_FB_GetFldPtr(FBSrc, trim(fldnames(n)), data_src, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(FBSrc, trim(fldnames(n)), data_src, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! create a new temporary field bundle, FBSrcTmp that will contain field data on the source grid if (.not. ESMF_FieldBundleIsCreated(FBSrcTmp)) then - call shr_nuopc_methods_FB_init(FBSrcTmp, flds_scalar_name, & + call FB_init(FBSrcTmp, flds_scalar_name, & FBgeom=FBSrc, fieldNameList=(/'data_srctmp'/), name='data_srctmp', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBSrcTmp, 'data_srctmp', data_srctmp, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(FBSrcTmp, 'data_srctmp', data_srctmp, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if ! create a temporary field bundle that will contain normalization on the source grid if (.not. ESMF_FieldBundleIsCreated(FBNormSrc)) then - call shr_nuopc_methods_FB_init(FBout=FBNormSrc, flds_scalar_name=flds_scalar_name, & + call FB_init(FBout=FBNormSrc, flds_scalar_name=flds_scalar_name, & FBgeom=FBSrc, fieldNameList=(/trim(mapnorm)/), name='normsrc', rc=rc) - if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + if (chkerr(rc,__line__,u_file_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBNormSrc, trim(mapnorm), data_srcnorm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(FBNormSrc, trim(mapnorm), data_srcnorm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return endif - call shr_nuopc_methods_FB_reset(FBNormSrc, value=czero, rc=rc) - if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + call FB_reset(FBNormSrc, value=czero, rc=rc) + if (chkerr(rc,__line__,u_file_u)) return ! create a temporary field bundle that will contain normalization on the destination grid if (.not. ESMF_FieldBundleIsCreated(FBNormDst)) then - call shr_nuopc_methods_FB_init(FBout=FBNormDst, flds_scalar_name=flds_scalar_name, & + call FB_init(FBout=FBNormDst, flds_scalar_name=flds_scalar_name, & FBgeom=FBDst, fieldNameList=(/trim(mapnorm)/), name='normdst', rc=rc) - if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + if (chkerr(rc,__line__,u_file_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBFrac, trim(mapnorm), data_frac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(FBFrac, trim(mapnorm), data_frac, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return endif - call shr_nuopc_methods_FB_reset(FBNormDst, value=czero, rc=rc) - if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + call FB_reset(FBNormDst, value=czero, rc=rc) + if (chkerr(rc,__line__,u_file_u)) return ! error checks if (size(data_srcnorm) /= size(data_frac)) then @@ -1079,19 +1060,19 @@ subroutine med_map_FB_Regrid_Norm_Frac(fldnames, FBSrc, FBDst, & call ESMF_LogWrite(trim(subname)//trim(lstring)//": skip : fld="//trim(fldnames(n)), & 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 + call FB_FieldRegrid( FBSrcTmp, 'data_srctmp', FBDst, fldnames(n), RouteHandle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if - call shr_nuopc_methods_FB_FieldRegrid(FBNormSrc, mapnorm, FBNormDst, mapnorm, RouteHandle, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_FieldRegrid(FBNormSrc, mapnorm, FBNormDst, mapnorm, RouteHandle, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return ! multiply interpolated field (FBDst) by reciprocal of fraction on destination grid (FBNormDst) - call shr_nuopc_methods_FB_GetFldPtr(FBNormDst, trim(mapnorm), data_dstnorm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(FBNormDst, trim(mapnorm), data_dstnorm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBDst, trim(fldnames(n)), data_dst, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(FBDst, trim(fldnames(n)), data_dst, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return do i= 1,size(data_dst) if (data_dstnorm(i) == 0.0_R8) then @@ -1102,25 +1083,25 @@ subroutine med_map_FB_Regrid_Norm_Frac(fldnames, FBSrc, FBDst, & end do if (dbug_flag > 1) then - call shr_nuopc_methods_FB_Field_diagnose(FBDst, fldnames(n), & + call FB_Field_diagnose(FBDst, fldnames(n), & string=trim(subname) //' Mapping (' // trim(fldnames(n)) // trim(lstring), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end if end do ! loop over fields ! Clean up temporary field bundles if (ESMF_FieldBundleIsCreated(FBSrcTmp)) then - call shr_nuopc_methods_FB_clean(FBSrcTmp, rc=rc) - if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + call FB_clean(FBSrcTmp, rc=rc) + if (chkerr(rc,__line__,u_file_u)) return end if if (ESMF_FieldBundleIsCreated(FBNormSrc)) then - call shr_nuopc_methods_FB_clean(FBNormSrc, rc=rc) - if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + call FB_clean(FBNormSrc, rc=rc) + if (chkerr(rc,__line__,u_file_u)) return end if if (ESMF_FieldBundleIsCreated(FBNormDst)) then - call shr_nuopc_methods_FB_clean(FBNormDst, rc=rc) - if (shr_nuopc_methods_chkerr(rc,__line__,u_file_u)) return + call FB_clean(FBNormDst, rc=rc) + if (chkerr(rc,__line__,u_file_u)) return end if call t_stopf('MED:'//subname) diff --git a/cime/src/drivers/nuopc/mediator/med_merge_mod.F90 b/cime/src/drivers/nuopc/mediator/med_merge_mod.F90 index 7343fd957b5a..8a5ffc451685 100644 --- a/cime/src/drivers/nuopc/mediator/med_merge_mod.F90 +++ b/cime/src/drivers/nuopc/mediator/med_merge_mod.F90 @@ -5,11 +5,16 @@ module med_merge_mod !----------------------------------------------------------------------------- use med_constants_mod , only : R8 - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag - use med_constants_mod , only : spval_init => med_constants_spval_init - use med_constants_mod , only : spval => med_constants_spval - use med_constants_mod , only : czero => med_constants_czero - use shr_nuopc_methods_mod , only : ChkErr => shr_nuopc_methods_ChkErr + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_constants_mod , only : spval_init => med_constants_spval_init + use med_constants_mod , only : spval => med_constants_spval + use med_constants_mod , only : czero => med_constants_czero + use shr_nuopc_utils_mod , only : ChkErr => shr_nuopc_utils_ChkErr + use shr_nuopc_methods_mod , only : FB_FldChk => shr_nuopc_methods_FB_FldChk + use shr_nuopc_methods_mod , only : FB_GetNameN => shr_nuopc_methods_FB_GetNameN + use shr_nuopc_methods_mod , only : FB_Reset => shr_nuopc_methods_FB_reset + use shr_nuopc_methods_mod , only : FB_GetFldPtr => shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : FieldPtr_Compare => shr_nuopc_methods_FieldPtr_Compare implicit none private @@ -44,9 +49,6 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, use esmFlds , only : shr_nuopc_fldList_type use esmFlds , only : shr_nuopc_fldList_GetNumFlds use esmFlds , only : shr_nuopc_fldList_GetFldInfo - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetNameN - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset use med_internalstate_mod , only : logunit use perf_mod , only : t_startf, t_stopf @@ -80,7 +82,7 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO, rc=dbrc) rc = ESMF_SUCCESS - call shr_nuopc_methods_FB_reset(FBOut, value=czero, rc=rc) + call FB_reset(FBOut, value=czero, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Want to loop over all of the fields in FBout here - and find the corresponding index in fldListTo(compxxx) @@ -93,7 +95,7 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, do n = 1,cnt ! Get the nth field name in FBexp - call shr_nuopc_methods_FB_getNameN(FBOut, n, fldname, rc) + call FB_getNameN(FBOut, n, fldname, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Loop over the field in fldListTo @@ -135,12 +137,12 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, line=__LINE__, file=u_FILE_u, rcToReturn=rc) return endif - if (shr_nuopc_methods_FB_FldChk(FBMed1, trim(merge_field), rc=rc)) then + if (FB_FldChk(FBMed1, trim(merge_field), rc=rc)) then call med_merge_auto_field(trim(merge_type), & FBOut, fldname, FB=FBMed1, FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - else if (shr_nuopc_methods_FB_FldChk(FBMed2, trim(merge_field), rc=rc)) then + else if (FB_FldChk(FBMed2, trim(merge_field), rc=rc)) then call med_merge_auto_field(trim(merge_type), & FBOut, fldname, FB=FBMed2, FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -159,7 +161,7 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, line=__LINE__, file=u_FILE_u, rcToReturn=rc) return endif - if (shr_nuopc_methods_FB_FldChk(FBMed1, trim(merge_field), rc=rc)) then + if (FB_FldChk(FBMed1, trim(merge_field), rc=rc)) then call med_merge_auto_field(trim(merge_type), & FBOut, fldname, FB=FBMed1, FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -174,7 +176,7 @@ subroutine med_merge_auto(compout_name, FBOut, FBfrac, FBImp, fldListTo, FBMed1, else if (ESMF_FieldBundleIsCreated(FBImp(compsrc), rc=rc)) then - if (shr_nuopc_methods_FB_FldChk(FBImp(compsrc), trim(merge_field), rc=rc)) then + if (FB_FldChk(FBImp(compsrc), trim(merge_field), rc=rc)) then call med_merge_auto_field(trim(merge_type), & FBOut, fldname, FB=FBImp(compsrc), FBFld=merge_field, FBw=FBfrac, fldw=trim(merge_fracname), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -206,8 +208,6 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld 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_sys_mod , only : shr_sys_abort ! input/output variables character(len=*) ,intent(in) :: merge_type @@ -246,7 +246,7 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld rc = ESMF_FAILURE return end if - if (.not. shr_nuopc_methods_FB_FldChk(FBw, trim(fldw), rc=rc)) then + if (.not. 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 = ESMF_FAILURE @@ -292,9 +292,13 @@ subroutine med_merge_auto_field(merge_type, FBout, FBoutfld, FB, FBfld, FBw, fld ! error checks if (ungriddedUBound_output(1) /= ungriddedUBound_input(1)) then - call shr_sys_abort("ungriddedUBound_input not equal to ungriddedUBound_output") + call ESMF_LogWrite(trim(subname)//"ungriddedUBound_input not equal to ungriddedUBound_output", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return else if (gridToFieldMap_input(1) /= gridToFieldMap_output(1)) then - call shr_sys_abort("gridToFieldMap_input not equal to gridToFieldMap_output") + call ESMF_LOGWrite(trim(subname)//"gridToFieldMap_input not equal to gridToFieldMap_output", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return end if ! Get pointer to weights that weights are only rank 1 @@ -360,12 +364,9 @@ subroutine med_merge_field_1D(FBout, fnameout, & FBinD, fnameD, wgtD, & FBinE, fnameE, wgtE, rc) - use ESMF , only : ESMF_FieldBundle, ESMF_LogWrite - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_ERROR - use ESMF , only : ESMF_LOGMSG_WARNING, ESMF_LOGMSG_INFO - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FieldPtr_Compare - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk + use ESMF , only : ESMF_FieldBundle, ESMF_LogWrite + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_LOGMSG_WARNING, ESMF_LOGMSG_INFO ! ---------------------------------------------- ! Supports up to a five way merge @@ -418,13 +419,13 @@ subroutine med_merge_field_1D(FBout, fnameout, & return endif - if (.not. shr_nuopc_methods_FB_FldChk(FBout, trim(fnameout), rc=rc)) then + if (.not. FB_FldChk(FBout, trim(fnameout), rc=rc)) then call ESMF_LogWrite(trim(subname)//": WARNING field not in FBout, skipping merge "//trim(fnameout), & ESMF_LOGMSG_WARNING, line=__LINE__, file=u_FILE_u, rc=dbrc) return endif - call shr_nuopc_methods_FB_GetFldPtr(FBout, trim(fnameout), fldptr1=dataOut, rc=rc) + call FB_GetFldPtr(FBout, trim(fnameout), fldptr1=dataOut, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return lb1 = lbound(dataOut,1) ub1 = ubound(dataOut,1) @@ -435,16 +436,16 @@ subroutine med_merge_field_1D(FBout, fnameout, & ! check that each field passed in actually exists, if not DO NOT do any merge FBinfound = .true. if (present(FBinB)) then - if (.not. shr_nuopc_methods_FB_FldChk(FBinB, trim(fnameB), rc=rc)) FBinfound = .false. + if (.not. FB_FldChk(FBinB, trim(fnameB), rc=rc)) FBinfound = .false. endif if (present(FBinC)) then - if (.not. shr_nuopc_methods_FB_FldChk(FBinC, trim(fnameC), rc=rc)) FBinfound = .false. + if (.not. FB_FldChk(FBinC, trim(fnameC), rc=rc)) FBinfound = .false. endif if (present(FBinD)) then - if (.not. shr_nuopc_methods_FB_FldChk(FBinD, trim(fnameD), rc=rc)) FBinfound = .false. + if (.not. FB_FldChk(FBinD, trim(fnameD), rc=rc)) FBinfound = .false. endif if (present(FBinE)) then - if (.not. shr_nuopc_methods_FB_FldChk(FBinE, trim(fnameE), rc=rc)) FBinfound = .false. + if (.not. FB_FldChk(FBinE, trim(fnameE), rc=rc)) FBinfound = .false. endif if (.not. FBinfound) then call ESMF_LogWrite(trim(subname)//": WARNING field not found in FBin, skipping merge "//trim(fnameout), & @@ -459,14 +460,14 @@ subroutine med_merge_field_1D(FBout, fnameout, & if (n == 1) then FBinfound = .true. - call shr_nuopc_methods_FB_GetFldPtr(FBinA, trim(fnameA), fldptr1=dataPtr, rc=rc) + call FB_GetFldPtr(FBinA, trim(fnameA), fldptr1=dataPtr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return wgtfound = .true. wgt => wgtA elseif (n == 2 .and. present(FBinB)) then FBinfound = .true. - call shr_nuopc_methods_FB_GetFldPtr(FBinB, trim(fnameB), fldptr1=dataPtr, rc=rc) + call FB_GetFldPtr(FBinB, trim(fnameB), fldptr1=dataPtr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtB)) then wgtfound = .true. @@ -475,7 +476,7 @@ subroutine med_merge_field_1D(FBout, fnameout, & elseif (n == 3 .and. present(FBinC)) then FBinfound = .true. - call shr_nuopc_methods_FB_GetFldPtr(FBinC, trim(fnameC), fldptr1=dataPtr, rc=rc) + call FB_GetFldPtr(FBinC, trim(fnameC), fldptr1=dataPtr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtC)) then wgtfound = .true. @@ -484,7 +485,7 @@ subroutine med_merge_field_1D(FBout, fnameout, & elseif (n == 4 .and. present(FBinD)) then FBinfound = .true. - call shr_nuopc_methods_FB_GetFldPtr(FBinD, trim(fnameD), fldptr1=dataPtr, rc=rc) + call FB_GetFldPtr(FBinD, trim(fnameD), fldptr1=dataPtr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtD)) then wgtfound = .true. @@ -493,7 +494,7 @@ subroutine med_merge_field_1D(FBout, fnameout, & elseif (n == 5 .and. present(FBinE)) then FBinfound = .true. - call shr_nuopc_methods_FB_GetFldPtr(FBinE, trim(fnameE), fldptr1=dataPtr, rc=rc) + call FB_GetFldPtr(FBinE, trim(fnameE), fldptr1=dataPtr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtE)) then wgtfound = .true. @@ -503,7 +504,7 @@ subroutine med_merge_field_1D(FBout, fnameout, & endif if (FBinfound) then - if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtr, dataOut, subname, rc)) then + if (.not.FieldPtr_Compare(dataPtr, dataOut, subname, rc)) then call ESMF_LogWrite(trim(subname)//": ERROR FBin wrong size", & ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) rc = ESMF_FAILURE @@ -511,7 +512,7 @@ subroutine med_merge_field_1D(FBout, fnameout, & endif if (wgtfound) then - if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtr, wgt, subname, rc)) then + if (.not.FieldPtr_Compare(dataPtr, wgt, subname, rc)) then call ESMF_LogWrite(trim(subname)//": ERROR wgt wrong size", & ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) rc = ESMF_FAILURE @@ -544,12 +545,9 @@ subroutine med_merge_field_2D(FBout, fnameout, & FBinD, fnameD, wgtD, & FBinE, fnameE, wgtE, rc) - use ESMF , only : ESMF_FieldBundle, ESMF_LogWrite - use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_ERROR - use ESMF , only : ESMF_LOGMSG_WARNING, ESMF_LOGMSG_INFO - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FieldPtr_Compare - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk + use ESMF , only : ESMF_FieldBundle, ESMF_LogWrite + use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_LOGMSG_WARNING, ESMF_LOGMSG_INFO ! ---------------------------------------------- ! Supports up to a five way merge @@ -590,13 +588,13 @@ subroutine med_merge_field_2D(FBout, fnameout, & endif rc=ESMF_SUCCESS - if (.not. shr_nuopc_methods_FB_FldChk(FBout, trim(fnameout), rc=rc)) then + if (.not. FB_FldChk(FBout, trim(fnameout), rc=rc)) then call ESMF_LogWrite(trim(subname)//": WARNING field not in FBout, skipping merge "//& trim(fnameout), ESMF_LOGMSG_WARNING, line=__LINE__, file=u_FILE_u, rc=dbrc) return endif - call shr_nuopc_methods_FB_GetFldPtr(FBout, trim(fnameout), fldptr2=dataOut, rc=rc) + call FB_GetFldPtr(FBout, trim(fnameout), fldptr2=dataOut, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return lb1 = lbound(dataOut,1) ub1 = ubound(dataOut,1) @@ -620,16 +618,16 @@ subroutine med_merge_field_2D(FBout, fnameout, & ! check that each field passed in actually exists, if not DO NOT do any merge FBinfound = .true. if (present(FBinB)) then - if (.not. shr_nuopc_methods_FB_FldChk(FBinB, trim(fnameB), rc=rc)) FBinfound = .false. + if (.not. FB_FldChk(FBinB, trim(fnameB), rc=rc)) FBinfound = .false. endif if (present(FBinC)) then - if (.not. shr_nuopc_methods_FB_FldChk(FBinC, trim(fnameC), rc=rc)) FBinfound = .false. + if (.not. FB_FldChk(FBinC, trim(fnameC), rc=rc)) FBinfound = .false. endif if (present(FBinD)) then - if (.not. shr_nuopc_methods_FB_FldChk(FBinD, trim(fnameD), rc=rc)) FBinfound = .false. + if (.not. FB_FldChk(FBinD, trim(fnameD), rc=rc)) FBinfound = .false. endif if (present(FBinE)) then - if (.not. shr_nuopc_methods_FB_FldChk(FBinE, trim(fnameE), rc=rc)) FBinfound = .false. + if (.not. FB_FldChk(FBinE, trim(fnameE), rc=rc)) FBinfound = .false. endif if (.not. FBinfound) then call ESMF_LogWrite(trim(subname)//": WARNING field not found in FBin, skipping merge "//trim(fnameout), & @@ -644,14 +642,14 @@ subroutine med_merge_field_2D(FBout, fnameout, & if (n == 1) then FBinfound = .true. - call shr_nuopc_methods_FB_GetFldPtr(FBinA, trim(fnameA), fldptr2=dataPtr, rc=rc) + call FB_GetFldPtr(FBinA, trim(fnameA), fldptr2=dataPtr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return wgtfound = .true. wgt => wgtA elseif (n == 2 .and. present(FBinB)) then FBinfound = .true. - call shr_nuopc_methods_FB_GetFldPtr(FBinB, trim(fnameB), fldptr2=dataPtr, rc=rc) + call FB_GetFldPtr(FBinB, trim(fnameB), fldptr2=dataPtr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtB)) then wgtfound = .true. @@ -660,7 +658,7 @@ subroutine med_merge_field_2D(FBout, fnameout, & elseif (n == 3 .and. present(FBinC)) then FBinfound = .true. - call shr_nuopc_methods_FB_GetFldPtr(FBinC, trim(fnameC), fldptr2=dataPtr, rc=rc) + call FB_GetFldPtr(FBinC, trim(fnameC), fldptr2=dataPtr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtC)) then wgtfound = .true. @@ -669,7 +667,7 @@ subroutine med_merge_field_2D(FBout, fnameout, & elseif (n == 4 .and. present(FBinD)) then FBinfound = .true. - call shr_nuopc_methods_FB_GetFldPtr(FBinD, trim(fnameD), fldptr2=dataPtr, rc=rc) + call FB_GetFldPtr(FBinD, trim(fnameD), fldptr2=dataPtr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtD)) then wgtfound = .true. @@ -678,7 +676,7 @@ subroutine med_merge_field_2D(FBout, fnameout, & elseif (n == 5 .and. present(FBinE)) then FBinfound = .true. - call shr_nuopc_methods_FB_GetFldPtr(FBinE, trim(fnameE), fldptr2=dataPtr, rc=rc) + call FB_GetFldPtr(FBinE, trim(fnameE), fldptr2=dataPtr, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (present(wgtE)) then wgtfound = .true. @@ -688,7 +686,7 @@ subroutine med_merge_field_2D(FBout, fnameout, & endif if (FBinfound) then - if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtr, dataOut, subname, rc)) then + if (.not.FieldPtr_Compare(dataPtr, dataOut, subname, rc)) then call ESMF_LogWrite(trim(subname)//": ERROR FBin wrong size", & ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) rc = ESMF_FAILURE @@ -696,7 +694,7 @@ subroutine med_merge_field_2D(FBout, fnameout, & endif if (wgtfound) then - if (.not.shr_nuopc_methods_FieldPtr_Compare(dataPtr, wgt, subname, rc)) then + if (.not. FieldPtr_Compare(dataPtr, wgt, subname, rc)) then call ESMF_LogWrite(trim(subname)//": ERROR wgt wrong size", & ESMF_LOGMSG_ERROR, line=__LINE__, file=u_FILE_u, rc=dbrc) rc = ESMF_FAILURE diff --git a/cime/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 b/cime/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 index ef127088cd57..7fdbd66418b2 100644 --- a/cime/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 +++ b/cime/src/drivers/nuopc/mediator/med_phases_aofluxes_mod.F90 @@ -1,11 +1,14 @@ 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, 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 + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use shr_nuopc_utils_mod , only : memcheck => shr_nuopc_memcheck + use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_chkerr + use shr_nuopc_methods_mod , only : FB_fldchk => shr_nuopc_methods_FB_FldChk + use shr_nuopc_methods_mod , only : FB_GetFldPtr => shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : FB_diagnose => shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : FB_init => shr_nuopc_methods_FB_init implicit none private @@ -95,9 +98,6 @@ subroutine med_phases_aofluxes_run(gcomp, rc) use med_map_mod , only : med_map_FB_Regrid_Norm 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 !----------------------------------------------------------------------- @@ -155,10 +155,10 @@ subroutine med_phases_aofluxes_run(gcomp, rc) call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif - call shr_nuopc_memcheck(subname, 5, mastertask) + call memcheck(subname, 5, mastertask) ! 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, & @@ -176,7 +176,7 @@ subroutine med_phases_aofluxes_run(gcomp, 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, & + call 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 @@ -189,13 +189,12 @@ end subroutine med_phases_aofluxes_run subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, rc) - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError - use ESMF , only : ESMF_SUCCESS, ESMF_LOGERR_PASSTHRU - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM - use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldBundle, ESMF_VMGet - use NUOPC , only : NUOPC_CompAttributeGet - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr - use perf_mod , only : t_startf, t_stopf + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_LogFoundError + use ESMF , only : ESMF_SUCCESS, ESMF_LOGERR_PASSTHRU + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_VM + use ESMF , only : ESMF_Field, ESMF_FieldGet, ESMF_FieldBundle, ESMF_VMGet + use NUOPC , only : NUOPC_CompAttributeGet + use perf_mod , only : t_startf, t_stopf !----------------------------------------------------------------------- ! Initialize pointers to the module variables @@ -226,7 +225,7 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) endif rc = ESMF_SUCCESS - call shr_nuopc_memcheck(subname, 5, mastertask) + call memcheck(subname, 5, mastertask) !---------------------------------- ! get attributes that are set as module variables @@ -240,39 +239,39 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, ! atm/ocn fields !---------------------------------- - call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='So_tref', fldptr1=aoflux%tref, rc=rc) + call FB_GetFldPtr(FBMed_aoflux, fldname='So_tref', fldptr1=aoflux%tref, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='So_qref', fldptr1=aoflux%qref, rc=rc) + call FB_GetFldPtr(FBMed_aoflux, fldname='So_qref', fldptr1=aoflux%qref, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='So_ustar', fldptr1=aoflux%ustar, rc=rc) + call FB_GetFldPtr(FBMed_aoflux, fldname='So_ustar', fldptr1=aoflux%ustar, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='So_re', fldptr1=aoflux%re, rc=rc) + call FB_GetFldPtr(FBMed_aoflux, fldname='So_re', fldptr1=aoflux%re, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='So_ssq', fldptr1=aoflux%ssq, rc=rc) + call FB_GetFldPtr(FBMed_aoflux, fldname='So_ssq', fldptr1=aoflux%ssq, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='So_u10', fldptr1=aoflux%u10, rc=rc) + call FB_GetFldPtr(FBMed_aoflux, fldname='So_u10', fldptr1=aoflux%u10, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='So_duu10n', fldptr1=aoflux%duu10n, rc=rc) + call FB_GetFldPtr(FBMed_aoflux, fldname='So_duu10n', fldptr1=aoflux%duu10n, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_taux', fldptr1=aoflux%taux, rc=rc) + call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_taux', fldptr1=aoflux%taux, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_tauy', fldptr1=aoflux%tauy, rc=rc) + call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_tauy', fldptr1=aoflux%tauy, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_lat', fldptr1=aoflux%lat, rc=rc) + call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_lat', fldptr1=aoflux%lat, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_sen', fldptr1=aoflux%sen, rc=rc) + call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_sen', fldptr1=aoflux%sen, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_evap', fldptr1=aoflux%evap, rc=rc) + call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_evap', fldptr1=aoflux%evap, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return lsize = size(aoflux%evap) if (flds_wiso) then - call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_evap_16O', fldptr1=aoflux%evap_16O, rc=rc) + call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_evap_16O', fldptr1=aoflux%evap_16O, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_evap_18O', fldptr1=aoflux%evap_18O, rc=rc) + call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_evap_18O', fldptr1=aoflux%evap_18O, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_evap_HDO', fldptr1=aoflux%evap_HDO, rc=rc) + call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_evap_HDO', fldptr1=aoflux%evap_HDO, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else allocate(aoflux%evap_16O(lsize)); aoflux%evap_16O(:) = 0._R8 @@ -280,27 +279,27 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, allocate(aoflux%evap_HDO(lsize)); aoflux%evap_HDO(:) = 0._R8 end if - call shr_nuopc_methods_FB_GetFldPtr(FBMed_aoflux, fldname='Faox_lwup', fldptr1=aoflux%lwup, rc=rc) + call FB_GetFldPtr(FBMed_aoflux, fldname='Faox_lwup', fldptr1=aoflux%lwup, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------- ! Ocn import fields !---------------------------------- - call shr_nuopc_methods_FB_GetFldPtr(FBOcn, fldname='So_omask', fldptr1=aoflux%rmask, rc=rc) + call FB_GetFldPtr(FBOcn, fldname='So_omask', fldptr1=aoflux%rmask, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBOcn, fldname='So_t', fldptr1=aoflux%tocn, rc=rc) + call FB_GetFldPtr(FBOcn, fldname='So_t', fldptr1=aoflux%tocn, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBOcn, fldname='So_u', fldptr1=aoflux%uocn, rc=rc) + call FB_GetFldPtr(FBOcn, fldname='So_u', fldptr1=aoflux%uocn, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBOcn, fldname='So_v', fldptr1=aoflux%vocn, rc=rc) + call FB_GetFldPtr(FBOcn, fldname='So_v', fldptr1=aoflux%vocn, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (flds_wiso) then - call shr_nuopc_methods_FB_GetFldPtr(FBOcn, fldname='So_roce_16O', fldptr1=aoflux%roce_16O, rc=rc) + call FB_GetFldPtr(FBOcn, fldname='So_roce_16O', fldptr1=aoflux%roce_16O, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBOcn, fldname='So_roce_18O', fldptr1=aoflux%roce_18O, rc=rc) + call FB_GetFldPtr(FBOcn, fldname='So_roce_18O', fldptr1=aoflux%roce_18O, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBOcn, fldname='So_roce_HDO', fldptr1=aoflux%roce_HDO, rc=rc) + call FB_GetFldPtr(FBOcn, fldname='So_roce_HDO', fldptr1=aoflux%roce_HDO, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else allocate(aoflux%roce_16O(lsize)); aoflux%roce_16O(:) = 0._R8 @@ -312,18 +311,18 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, ! Atm import fields !---------------------------------- - call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_z', fldptr1=aoflux%zbot, rc=rc) + call FB_GetFldPtr(FBAtm, fldname='Sa_z', fldptr1=aoflux%zbot, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_u', fldptr1=aoflux%ubot, rc=rc) + call FB_GetFldPtr(FBAtm, fldname='Sa_u', fldptr1=aoflux%ubot, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_v', fldptr1=aoflux%vbot, rc=rc) + call FB_GetFldPtr(FBAtm, fldname='Sa_v', fldptr1=aoflux%vbot, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_tbot', fldptr1=aoflux%tbot, rc=rc) + call FB_GetFldPtr(FBAtm, fldname='Sa_tbot', fldptr1=aoflux%tbot, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! bottom level potential temperature will need to be computed if not received from the atm - if (fldchk(FBAtm, 'Sa_ptem', rc=rc)) then - call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_ptem', fldptr1=aoflux%thbot, rc=rc) + if (FB_fldchk(FBAtm, 'Sa_ptem', rc=rc)) then + call FB_GetFldPtr(FBAtm, fldname='Sa_ptem', fldptr1=aoflux%thbot, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return compute_atm_thbot = .false. else @@ -332,8 +331,8 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, end if ! bottom level density will need to be computed if not received from the atm - if (fldchk(FBAtm, 'Sa_dens', rc=rc)) then - call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_dens', fldptr1=aoflux%dens, rc=rc) + if (FB_fldchk(FBAtm, 'Sa_dens', rc=rc)) then + call FB_GetFldPtr(FBAtm, fldname='Sa_dens', fldptr1=aoflux%dens, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return compute_atm_dens = .false. else @@ -343,18 +342,18 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, ! if either density or potential temperature are computed, will need bottom level pressure if (compute_atm_dens .or. compute_atm_thbot) then - call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_pbot', fldptr1=aoflux%pbot, rc=rc) + call FB_GetFldPtr(FBAtm, fldname='Sa_pbot', fldptr1=aoflux%pbot, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if - call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_shum', fldptr1=aoflux%shum, rc=rc) + call FB_GetFldPtr(FBAtm, fldname='Sa_shum', fldptr1=aoflux%shum, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return if (flds_wiso) then - call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_shum_16O', fldptr1=aoflux%shum_16O, rc=rc) + call FB_GetFldPtr(FBAtm, fldname='Sa_shum_16O', fldptr1=aoflux%shum_16O, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_shum_18O', fldptr1=aoflux%shum_18O, rc=rc) + call FB_GetFldPtr(FBAtm, fldname='Sa_shum_18O', fldptr1=aoflux%shum_18O, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Sa_shum_HDO', fldptr1=aoflux%shum_HDO, rc=rc) + call FB_GetFldPtr(FBAtm, fldname='Sa_shum_HDO', fldptr1=aoflux%shum_HDO, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else allocate(aoflux%shum_16O(lsize)); aoflux%shum_16O(:) = 0._R8 @@ -363,8 +362,8 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, end if ! Optional field used for gust parameterization - if ( fldchk(FBAtm, 'Faxa_rainc', rc=rc)) then - call shr_nuopc_methods_FB_GetFldPtr(FBAtm, fldname='Faxa_rainc', fldptr1=aoflux%prec_gust, rc=rc) + if ( FB_fldchk(FBAtm, 'Faxa_rainc', rc=rc)) then + call FB_GetFldPtr(FBAtm, fldname='Faxa_rainc', fldptr1=aoflux%prec_gust, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return aoflux%prec_gust(:) = 0.0_R8 end if @@ -394,9 +393,9 @@ subroutine med_aofluxes_init(gcomp, aoflux, FBAtm, FBOcn, FBFrac, FBMed_aoflux, ! TODO: need to check if this logic is correct ! then check ofrac + ifrac - ! call shr_nuopc_methods_FB_getFldPtr(FBFrac , fldname='ofrac' , fldptr1=ofrac, rc=rc) + ! call FB_getFldPtr(FBFrac , fldname='ofrac' , fldptr1=ofrac, rc=rc) ! if (chkerr(rc,__LINE__,u_FILE_u)) return - ! call shr_nuopc_methods_FB_getFldPtr(FBFrac , fldname='ifrac' , fldptr1=ifrac, rc=rc) + ! call FB_getFldPtr(FBFrac , fldname='ifrac' , fldptr1=ifrac, rc=rc) ! if (chkerr(rc,__LINE__,u_FILE_u)) return ! where (ofrac(:) + ifrac(:) <= 0.0_R8) mask(:) = 0 @@ -528,7 +527,7 @@ subroutine med_aofluxes_run(gcomp, aoflux, rc) end if call shr_flux_atmocn (& - lsize, aoflux%zbot, aoflux%ubot, aoflux%vbot, aoflux%thbot, aoflux%prec_gust, gust_fac, & + lsize, aoflux%zbot, aoflux%ubot, aoflux%vbot, aoflux%thbot, & aoflux%shum, aoflux%shum_16O, aoflux%shum_HDO, aoflux%shum_18O, aoflux%dens , & aoflux%tbot, aoflux%uocn, aoflux%vocn, & aoflux%tocn, aoflux%mask, aoflux%sen, aoflux%lat, aoflux%lwup, & diff --git a/cime/src/drivers/nuopc/mediator/med_phases_history_mod.F90 b/cime/src/drivers/nuopc/mediator/med_phases_history_mod.F90 index be58ec543ece..cfef2313607d 100644 --- a/cime/src/drivers/nuopc/mediator/med_phases_history_mod.F90 +++ b/cime/src/drivers/nuopc/mediator/med_phases_history_mod.F90 @@ -9,12 +9,13 @@ module med_phases_history_mod implicit none private - character(*) , parameter :: u_FILE_u = __FILE__ - type(ESMF_Alarm) :: AlarmHist - type(ESMF_Alarm) :: AlarmHistAvg - public :: med_phases_history_write + type(ESMF_Alarm) :: AlarmHist + type(ESMF_Alarm) :: AlarmHistAvg + character(*), parameter :: u_FILE_u = & + __FILE__ + !=============================================================================== contains !=============================================================================== @@ -31,20 +32,18 @@ subroutine med_phases_history_write(gcomp, rc) use ESMF , only : operator(==), operator(-) use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_MAXSTR, ESMF_ClockPrint, ESMF_AlarmIsCreated use NUOPC , only : NUOPC_CompAttributeGet - use shr_cal_mod , only : shr_cal_ymd2date use esmFlds , only : compatm, complnd, compocn, compice, comprof, compglc, ncomps, compname use esmFlds , only : fldListFr, fldListTo - use shr_nuopc_scalars_mod , only : flds_scalar_index_nx, flds_scalar_index_ny - use shr_nuopc_scalars_mod , only : flds_scalar_name, flds_scalar_num - 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_diagnose - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_accum - use shr_nuopc_methods_mod , only : shr_nuopc_methods_State_GetScalar - 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 shr_cal_mod , only : shr_cal_ymd2date + use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr + use shr_nuopc_methods_mod , only : FB_reset => shr_nuopc_methods_FB_reset + use shr_nuopc_methods_mod , only : FB_diagnose => shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : FB_GetFldPtr => shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : FB_accum => shr_nuopc_methods_FB_accum + use shr_nuopc_methods_mod , only : State_GetScalar => shr_nuopc_methods_State_GetScalar + use shr_nuopc_time_mod , only : alarmInit => 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 use med_constants_mod , only : med_constants_noleap, med_constants_gregorian use med_map_mod , only : med_map_FB_Regrid_Norm @@ -107,10 +106,10 @@ subroutine med_phases_history_write(gcomp, 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=iam, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- ! --- Get the internal state @@ -118,16 +117,16 @@ subroutine med_phases_history_write(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if(isPresent) then call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else cpl_inst_tag = "" endif @@ -136,16 +135,16 @@ subroutine med_phases_history_write(gcomp, rc) !--------------------------------------- call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(clock, currtime=currtime, reftime=reftime, starttime=starttime, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(clock, calkindflag=calkindflag, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (calkindflag == ESMF_CALKIND_GREGORIAN) then calendar = med_constants_gregorian @@ -158,14 +157,14 @@ subroutine med_phases_history_write(gcomp, rc) endif call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=dbrc) endif call ESMF_TimeGet(nexttime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO, rc=dbrc) @@ -177,8 +176,8 @@ subroutine med_phases_history_write(gcomp, rc) call ESMF_TimeGet(reftime, yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) call shr_cal_ymd2date(yr,mon,day,start_ymd) start_tod = sec - time_units = 'days since ' & - // trim(med_io_date2yyyymmdd(start_ymd)) // ' ' // med_io_sec2hms(start_tod) + time_units = 'days since ' // trim(med_io_date2yyyymmdd(start_ymd)) // ' ' // med_io_sec2hms(start_tod, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- ! --- History Alarms @@ -187,30 +186,30 @@ subroutine med_phases_history_write(gcomp, rc) if (.not. ESMF_AlarmIsCreated(AlarmHist, rc=rc)) then ! Set instantaneous history output alarm call NUOPC_CompAttributeGet(gcomp, name='history_option', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return freq_option = cvalue call NUOPC_CompAttributeGet(gcomp, name='history_n', value=cvalue, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) freq_n call ESMF_LogWrite(trim(subname)//" init history alarm with option, n = "//& trim(freq_option)//","//trim(cvalue), ESMF_LOGMSG_INFO, rc=dbrc) - call shr_nuopc_time_alarmInit(clock, AlarmHist, option=freq_option, opt_n=freq_n, & + call alarmInit(clock, AlarmHist, option=freq_option, opt_n=freq_n, & RefTime=RefTime, alarmname='history', rc=rc) endif if (ESMF_AlarmIsRinging(AlarmHist, rc=rc)) then - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return alarmIsOn = .true. call ESMF_AlarmRingerOff( AlarmHist, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return #if DEBUG if (mastertask) then call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//& " history alarm for: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if #endif else @@ -220,19 +219,19 @@ subroutine med_phases_history_write(gcomp, rc) ! Set average history output alarm TODO: fix the following ! if (.not. ESMF_AlarmIsCreated(AlarmHistAvg, rc=rc)) then ! call NUOPC_CompAttributeGet(gcomp, name="histavg_option", value=histavg_option, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! freq_option = cvalue ! call NUOPC_CompAttributeGet(gcomp, name="histavg_n", value=cvalue, rc=rc) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! read(cvalue,*) freq_n - ! call shr_nuopc_time_alarmInit(clock, AlarmHistAvg, option=freq_option, opt_n=freq_n, & + ! call alarmInit(clock, AlarmHistAvg, option=freq_option, opt_n=freq_n, & ! RefTime=RefTime, alarmname='history_avg', rc=rc) ! end if ! if (ESMF_AlarmIsRinging(AlarmHistAvg, rc=rc)) then - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! alarmIsOn = .true. ! call ESMF_AlarmRingerOff( AlarmHist, rc=rc ) - ! if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return ! else ! alarmisOn = .false. ! endif @@ -265,11 +264,13 @@ subroutine med_phases_history_write(gcomp, rc) if (tbnds(1) >= tbnds(2)) then call med_io_write(hist_file, iam, & time_units=time_units, time_cal=calendar, time_val=dayssince, & - whead=whead, wdata=wdata) + whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return else call med_io_write(hist_file, iam, & time_units=time_units, time_cal=calendar, time_val=dayssince, & - whead=whead, wdata=wdata, tbnds=tbnds) + whead=whead, wdata=wdata, tbnds=tbnds, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif do n = 1,ncomps @@ -279,21 +280,22 @@ subroutine med_phases_history_write(gcomp, rc) 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif if (ESMF_FieldBundleIsCreated(is_local%wrap%FBexp(n),rc=rc)) then 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif enddo enddo - call med_io_close(hist_file, iam) + call med_io_close(hist_file, iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif diff --git a/cime/src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 b/cime/src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 index e9b01e4de9dc..dfb3bcdbde3d 100644 --- a/cime/src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 +++ b/cime/src/drivers/nuopc/mediator/med_phases_ocnalb_mod.F90 @@ -1,6 +1,7 @@ module med_phases_ocnalb_mod - use med_constants_mod, only : R8 + use med_constants_mod , only : R8 + use shr_nuopc_utils_mod, only : chkerr => shr_nuopc_utils_chkerr implicit none private @@ -56,7 +57,6 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) use ESMF , only : operator(==) use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFieldN - use shr_nuopc_utils_mod , only : shr_nuopc_utils_chkerr use med_internalstate_mod , only : InternalState use med_constants_mod , only : CL, R8 use med_constants_mod , only : dbug_flag =>med_constants_dbug_flag @@ -92,15 +92,15 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) ! The following is for debugging call ESMF_GridCompGet(gcomp, vm=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=iam, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Get the internal state from gcomp nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------- ! Set pointers to fields needed for albedo calculations @@ -110,13 +110,13 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) ! The following sets pointers to the module arrays call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, fldname='So_avsdr', fldptr1=ocnalb%avsdr, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, fldname='So_avsdf', fldptr1=ocnalb%avsdf, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, fldname='So_anidr', fldptr1=ocnalb%anidr, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, fldname='So_anidf', fldptr1=ocnalb%anidf, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !---------------------------------- ! Get lat, lon, which are time-invariant @@ -125,18 +125,18 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) ! The following assumes that all fields in FBMed_ocnalb_o have the same grid - so ! only need to query field 1 call shr_nuopc_methods_FB_getFieldN(is_local%wrap%FBMed_ocnalb_o, fieldnum=1, field=lfield, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Determine if first field is on a grid or a mesh - default will be mesh call ESMF_FieldGet(lfield, geomtype=geomtype, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (geomtype == ESMF_GEOMTYPE_MESH) then call ESMF_LogWrite(trim(subname)//" : FBAtm is on a mesh ", ESMF_LOGMSG_INFO, rc=rc) call ESMF_FieldGet(lfield, mesh=lmesh, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_MeshGet(lmesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return lsize = size(ocnalb%anidr) if (numOwnedElements /= lsize) then write(tempc1,'(i10)') numOwnedElements @@ -150,7 +150,7 @@ subroutine med_phases_ocnalb_init(gcomp, ocnalb, rc) allocate(ocnalb%lons(numOwnedElements)) allocate(ocnalb%lats(numOwnedElements)) call ESMF_MeshGet(lmesh, ownedElemCoords=ownedElemCoords) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,lsize ocnalb%lons(n) = ownedElemCoords(2*n-1) ocnalb%lats(n) = ownedElemCoords(2*n) @@ -178,25 +178,21 @@ 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_LogWrite, ESMF_LogFoundError + use ESMF , only : ESMf_SUCCESS, ESMF_FAILURE, ESMF_LOGMSG_INFO use ESMF , only : ESMF_RouteHandleIsCreated, ESMF_FieldBundleIsCreated use ESMF , only : operator(+) use NUOPC , only : NUOPC_CompAttributeGet use shr_const_mod , only : shr_const_pi - use shr_sys_mod , only : shr_sys_abort use shr_orb_mod , only : shr_orb_cosz, shr_orb_decl use esmFlds , only : mapconsf, mapnames use shr_nuopc_methods_mod , only : 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_State_GetScalar use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FieldRegrid - use shr_nuopc_utils_mod , only : shr_nuopc_utils_chkerr use med_constants_mod , only : CS, CL, R8 use med_constants_mod , only : dbug_flag =>med_constants_dbug_flag use med_internalstate_mod , only : InternalState, logunit - 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_nextsw_cday use esmFlds , only : compatm, compocn use perf_mod , only : t_startf, t_stopf @@ -246,7 +242,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Determine if ocnalb data type will be initialized - and if not return if (first_call) then @@ -276,10 +272,10 @@ subroutine med_phases_ocnalb_run(gcomp, rc) 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='start_type', 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,*) starttype if (trim(starttype) == trim('startup')) then @@ -289,22 +285,27 @@ subroutine med_phases_ocnalb_run(gcomp, rc) else if (trim(starttype) == trim('branch')) then runtype = "continue" else - call shr_sys_abort( subname//' ERROR: unknown starttype' ) + call ESMF_LogWrite( subname//' ERROR: unknown starttype', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return end if call ESMF_GridCompGet(gcomp, clock=clock) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet( clock, currTime=currTime, timeStep=timeStep, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return if (trim(runtype) == 'initial') then call ESMF_TimeGet( currTime, dayOfYear_r8=nextsw_cday, rc=rc ) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return else - 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, scalar_value=nextsw_cday, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_State_GetScalar(& + state=is_local%wrap%NstateImp(compatm), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, & + scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & + scalar_value=nextsw_cday, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if first_call = .false. @@ -312,28 +313,31 @@ 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(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, scalar_value=nextsw_cday, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_State_GetScalar(& + state=is_local%wrap%NstateImp(compatm), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, & + scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & + scalar_value=nextsw_cday, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if call NUOPC_CompAttributeGet(gcomp, name='flux_albav', value=cvalue, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return read(cvalue,*) flux_albav call NUOPC_CompAttributeGet(gcomp, name='orb_eccen', 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,*) eccen call NUOPC_CompAttributeGet(gcomp, name='orb_obliqr', 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,*) obliqr call NUOPC_CompAttributeGet(gcomp, name='orb_lambm0', 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,*) lambm0 call NUOPC_CompAttributeGet(gcomp, name='orb_mvelpp', 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,*) mvelpp ! Calculate ocean albedos on the ocean grid @@ -383,13 +387,13 @@ subroutine med_phases_ocnalb_run(gcomp, rc) ! Update current ifrad/ofrad values if albedo was updated in field bundle if (update_alb) then call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compocn), fldname='ifrac', fldptr1=ifrac, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compocn), fldname='ifrad', fldptr1=ifrad, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compocn), fldname='ofrac', fldptr1=ofrac, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBfrac(compocn), fldname='ofrad', fldptr1=ofrad, rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ifrad(:) = ifrac(:) ofrad(:) = ofrac(:) endif @@ -397,7 +401,7 @@ subroutine med_phases_ocnalb_run(gcomp, rc) 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) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return end if call t_stopf('MED:'//subname) @@ -413,7 +417,6 @@ subroutine med_phases_ocnalb_mapo2a(gcomp, rc) use ESMF , only : ESMF_GridComp use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use shr_nuopc_utils_mod , only : shr_nuopc_utils_chkerr use med_map_mod , only : med_map_FB_Regrid_Norm use med_internalstate_mod , only : InternalState use med_constants_mod , only : R8 @@ -421,6 +424,7 @@ subroutine med_phases_ocnalb_mapo2a(gcomp, rc) use esmFlds , only : fldListMed_ocnalb use esmFlds , only : compatm, compocn use perf_mod , only : t_startf, t_stopf + ! Arguments type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -440,7 +444,7 @@ subroutine med_phases_ocnalb_mapo2a(gcomp, rc) ! Get the internal state from gcomp nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return ! Map the field bundle from the ocean to the atm grid call med_map_FB_Regrid_Norm( & @@ -452,7 +456,7 @@ subroutine med_phases_ocnalb_mapo2a(gcomp, rc) is_local%wrap%FBNormOne(compocn,compatm,:), & is_local%wrap%RH(compocn,compatm,:), & string='FBMed_ocnalb_o_To_FBMed_ocnalb_a', rc=rc) - if (shr_nuopc_utils_chkerr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return call t_stopf('MED:'//subname) end subroutine med_phases_ocnalb_mapo2a diff --git a/cime/src/drivers/nuopc/mediator/med_phases_prep_atm_mod.F90 b/cime/src/drivers/nuopc/mediator/med_phases_prep_atm_mod.F90 index ba91ff76a302..8a48f3d5bd76 100644 --- a/cime/src/drivers/nuopc/mediator/med_phases_prep_atm_mod.F90 +++ b/cime/src/drivers/nuopc/mediator/med_phases_prep_atm_mod.F90 @@ -21,19 +21,22 @@ subroutine med_phases_prep_atm(gcomp, rc) 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 - use med_constants_mod , only : R8 use esmFlds , only : compatm, compocn, compice, ncomps, compname use esmFlds , only : fldListFr, fldListTo use esmFlds , only : fldListMed_aoflux use esmFlds , only : coupling_mode - 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_reset - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_GetFldPtr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_FldChk - use shr_nuopc_utils_mod , only : shr_nuopc_memcheck - use med_constants_mod , only : dbug_flag=>med_constants_dbug_flag + use med_constants_mod , only : R8 + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use shr_nuopc_utils_mod , only : memcheck => shr_nuopc_memcheck + use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr + use shr_nuopc_methods_mod , only : FB_fldchk => shr_nuopc_methods_FB_FldChk + use shr_nuopc_methods_mod , only : FB_GetFldPtr => shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : FB_diagnose => shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : FB_init => shr_nuopc_methods_FB_init + use shr_nuopc_methods_mod , only : FB_rest => shr_nuopc_methods_FB_reset + use shr_nuopc_methods_mod , only : FB_getNumFlds => shr_nuopc_methods_FB_getNumFlds + use shr_nuopc_methods_mod , only : State_GetScalar => shr_nuopc_methods_State_GetScalar + use shr_nuopc_methods_mod , only : State_SetScalar => shr_nuopc_methods_State_SetScalar 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 @@ -61,7 +64,7 @@ subroutine med_phases_prep_atm(gcomp, rc) if (dbug_flag > 5) then call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) end if - call shr_nuopc_memcheck(subname, 3, mastertask) + call memcheck(subname, 3, mastertask) !--------------------------------------- ! --- Get the internal state @@ -69,7 +72,7 @@ subroutine med_phases_prep_atm(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- !--- Count the number of fields outside of scalar data, if zero, then return @@ -79,7 +82,7 @@ subroutine med_phases_prep_atm(gcomp, rc) ! fieldCount is 0 and not 1 here call ESMF_FieldBundleGet(is_local%wrap%FBExp(compatm), fieldCount=ncnt, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ncnt == 0) then call ESMF_LogWrite(trim(subname)//": only scalar data is present in FBexp(compatm), returning", & @@ -90,17 +93,17 @@ subroutine med_phases_prep_atm(gcomp, rc) !--- Get the current time from the clock !--------------------------------------- call ESMF_GridCompGet(gcomp, clock=clock) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (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 + if (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 (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_LogWrite(trim(subname)//": time = "//trim(timestr), ESMF_LOGMSG_INFO, rc=dbrc) if (dbug_flag > 1) then 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if end if @@ -118,7 +121,7 @@ subroutine med_phases_prep_atm(gcomp, rc) is_local%wrap%FBNormOne(n1,compatm,:), & is_local%wrap%RH(n1,compatm,:), & string=trim(compname(n1))//'2'//trim(compname(compatm)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif enddo @@ -144,7 +147,7 @@ subroutine med_phases_prep_atm(gcomp, rc) is_local%wrap%FBNormOne(compocn,compatm,:), & is_local%wrap%RH(compocn,compatm,:), & string='FBMed_aoflux_o_To_FBMEd_aoflux_a', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif !--------------------------------------- @@ -156,24 +159,24 @@ subroutine med_phases_prep_atm(gcomp, rc) is_local%wrap%FBImp(:,compatm), fldListTo(compatm), & FBMed1=is_local%wrap%FBMed_ocnalb_a, & FBMed2=is_local%wrap%FBMed_aoflux_a, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (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, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (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), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compatm), & + call 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 (ChkErr(rc,__LINE__,u_FILE_u)) return end if !--------------------------------------- @@ -181,29 +184,29 @@ subroutine med_phases_prep_atm(gcomp, rc) !--------------------------------------- ! set fractions to send back to atm - if (shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compatm), 'So_ofrac', rc=rc)) then - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'So_ofrac', dataptr1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'ofrac', dataptr2, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (FB_FldChk(is_local%wrap%FBExp(compatm), 'So_ofrac', rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'So_ofrac', dataptr1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'ofrac', dataptr2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,size(dataptr1) dataptr1(n) = dataptr2(n) end do end if - if (shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compatm), 'Si_ifrac', rc=rc)) then - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Si_ifrac', dataptr1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'ifrac', dataptr2, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Si_ifrac', rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Si_ifrac', dataptr1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'ifrac', dataptr2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,size(dataptr1) dataptr1(n) = dataptr2(n) end do end if - if (shr_nuopc_methods_FB_FldChk(is_local%wrap%FBExp(compatm), 'Sl_lfrac', rc=rc)) then - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Sl_lfrac', dataptr1, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'lfrac', dataptr2, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (FB_FldChk(is_local%wrap%FBExp(compatm), 'Sl_lfrac', rc=rc)) then + call FB_GetFldPtr(is_local%wrap%FBExp(compatm), 'Sl_lfrac', dataptr1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_GetFldPtr(is_local%wrap%FBFrac(compatm), 'lfrac', dataptr2, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,size(dataptr1) dataptr1(n) = dataptr2(n) end do diff --git a/cime/src/drivers/nuopc/mediator/med_phases_prep_glc_mod.F90 b/cime/src/drivers/nuopc/mediator/med_phases_prep_glc_mod.F90 index d6cba2895f27..f1073b5d431b 100644 --- a/cime/src/drivers/nuopc/mediator/med_phases_prep_glc_mod.F90 +++ b/cime/src/drivers/nuopc/mediator/med_phases_prep_glc_mod.F90 @@ -18,26 +18,27 @@ module med_phases_prep_glc_mod subroutine med_phases_prep_glc(gcomp, rc) + ! Prepares the GLC 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 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_constants_mod , only : dbug_flag => med_constants_dbug_flag + use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr + use shr_nuopc_methods_mod , only : FB_diagnose => shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : FB_getNumFlds => shr_nuopc_methods_FB_getNumFlds 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 - ! Prepares the GLC import Fields. - ! local variables type(ESMF_Clock) :: clock type(ESMF_Time) :: time @@ -60,7 +61,7 @@ subroutine med_phases_prep_glc(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- ! --- Count the number of fields outside of scalar data, if zero, then return @@ -69,8 +70,8 @@ subroutine med_phases_prep_glc(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 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 + call FB_getNumFlds(is_local%wrap%FBExp(compglc), trim(subname)//"FBexp(compglc)", ncnt, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ncnt > 0) then @@ -79,20 +80,20 @@ subroutine med_phases_prep_glc(gcomp, rc) !--------------------------------------- call ESMF_GridCompGet(gcomp, clock=clock) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (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 + if (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 (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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if !--------------------------------------- @@ -110,7 +111,7 @@ subroutine med_phases_prep_glc(gcomp, rc) is_local%wrap%FBNormOne(n1,compglc,:), & is_local%wrap%RH(n1,compglc,:), & string=trim(compname(n1))//'2'//trim(compname(compglc)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif enddo @@ -123,12 +124,11 @@ subroutine med_phases_prep_glc(gcomp, rc) 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 (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) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_diagnose(is_local%wrap%FBExp(compglc), string=trim(subname)//' FBexp(compglc) ', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if !--------------------------------------- diff --git a/cime/src/drivers/nuopc/mediator/med_phases_prep_ice_mod.F90 b/cime/src/drivers/nuopc/mediator/med_phases_prep_ice_mod.F90 index a991b84b583f..20b5177aef67 100644 --- a/cime/src/drivers/nuopc/mediator/med_phases_prep_ice_mod.F90 +++ b/cime/src/drivers/nuopc/mediator/med_phases_prep_ice_mod.F90 @@ -17,27 +17,25 @@ module med_phases_prep_ice_mod subroutine med_phases_prep_ice(gcomp, rc) - use ESMF , only : ESMF_GridComp, ESMF_GridCompGet + use ESMF , only : operator(/=) + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_StateGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_FieldBundleGet, ESMF_RouteHandleIsCreated use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_FAILURE + use ESMF , only : ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND use NUOPC , only : NUOPC_IsConnected 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_FieldRegrid - 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 shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr + use shr_nuopc_methods_mod , only : fldchk => shr_nuopc_methods_FB_FldChk + use shr_nuopc_methods_mod , only : FB_GetFldPtr => shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : FB_diagnose => shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : FB_FieldRegrid => shr_nuopc_methods_FB_FieldRegrid + use shr_nuopc_methods_mod , only : FB_getNumFlds => shr_nuopc_methods_FB_getNumFlds + use shr_nuopc_methods_mod , only : State_GetScalar => shr_nuopc_methods_State_GetScalar + use shr_nuopc_methods_mod , only : State_SetScalar => shr_nuopc_methods_State_SetScalar + 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 @@ -48,7 +46,7 @@ subroutine med_phases_prep_ice(gcomp, rc) integer, intent(out) :: rc ! local variables - character(len=64) :: timestr + type(ESMF_StateItem_Flag) :: itemType type(InternalState) :: is_local integer :: i,n,n1,ncnt character(len=CS) :: fldname @@ -79,7 +77,7 @@ subroutine med_phases_prep_ice(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (chkerr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- !--- Count the number of fields outside of scalar data, if zero, then return @@ -88,8 +86,8 @@ 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 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 + call FB_getNumFlds(is_local%wrap%FBExp(compice), trim(subname)//"FBexp(compice)", ncnt, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return if (ncnt > 0) then @@ -108,7 +106,7 @@ subroutine med_phases_prep_ice(gcomp, rc) 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return end if enddo @@ -119,7 +117,7 @@ subroutine med_phases_prep_ice(gcomp, rc) 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- !--- custom calculations @@ -144,7 +142,7 @@ subroutine med_phases_prep_ice(gcomp, rc) 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return dataptr(:) = dataptr(:) * precip_fact end if end do @@ -164,18 +162,18 @@ subroutine med_phases_prep_ice(gcomp, rc) rc = ESMF_FAILURE return end if - call shr_nuopc_methods_FB_FieldRegrid( & + call 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return end if 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return ! 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return end if ! compute air density as a custom calculation @@ -183,9 +181,9 @@ subroutine med_phases_prep_ice(gcomp, rc) call ESMF_LogWrite(trim(subname)//": computing air density as a custom calculation", ESMF_LOGMSG_INFO) 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 + if (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 + if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,size(temperature) if (temperature(n) /= 0._R8) then @@ -201,7 +199,7 @@ subroutine med_phases_prep_ice(gcomp, rc) call ESMF_LogWrite(trim(subname)//": computing potential temp as a custom calculation", ESMF_LOGMSG_INFO) 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 + if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1,size(temperature) if (pressure(n) /= 0._R8) then @@ -213,26 +211,33 @@ subroutine med_phases_prep_ice(gcomp, rc) 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 + call FB_diagnose(is_local%wrap%FBExp(compice), string=trim(subname)//' FBexp(compice) ', rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return end if !--------------------------------------- !--- update 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 - + call ESMF_StateGet(is_local%wrap%NStateImp(compatm), trim(is_local%wrap%flds_scalar_name), itemType, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (itemType /= ESMF_STATEITEM_NOTFOUND) then + ! send nextsw_cday to ice - first obtain it from atm import + call State_GetScalar(& + scalar_value=nextsw_cday, & + scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & + state=is_local%wrap%NstateImp(compatm), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call State_SetScalar(& + scalar_value=nextsw_cday, & + scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & + state=is_local%wrap%NstateExp(compice), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if !--------------------------------------- !--- clean up diff --git a/cime/src/drivers/nuopc/mediator/med_phases_prep_lnd_mod.F90 b/cime/src/drivers/nuopc/mediator/med_phases_prep_lnd_mod.F90 index 150d498ff4c6..16d5adaf538f 100644 --- a/cime/src/drivers/nuopc/mediator/med_phases_prep_lnd_mod.F90 +++ b/cime/src/drivers/nuopc/mediator/med_phases_prep_lnd_mod.F90 @@ -18,21 +18,21 @@ module med_phases_prep_lnd_mod subroutine med_phases_prep_lnd(gcomp, rc) + use ESMF , only : operator(/=) 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 ESMF , only : ESMF_StateGet, ESMF_StateItem_Flag, ESMF_STATEITEM_NOTFOUND 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 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 shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr + use shr_nuopc_methods_mod , only : FB_init => shr_nuopc_methods_FB_init + use shr_nuopc_methods_mod , only : FB_diagnose => shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : FB_getNumFlds => shr_nuopc_methods_FB_getNumFlds + use shr_nuopc_methods_mod , only : State_GetScalar => shr_nuopc_methods_State_GetScalar + use shr_nuopc_methods_mod , only : State_SetScalar => shr_nuopc_methods_State_SetScalar + 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 @@ -43,9 +43,10 @@ subroutine med_phases_prep_lnd(gcomp, rc) integer, intent(out) :: rc ! local variables - type(InternalState) :: is_local - integer :: n1,ncnt - real(r8) :: nextsw_cday + type(ESMF_StateItem_Flag) :: itemType + type(InternalState) :: is_local + integer :: n1,ncnt + real(r8) :: nextsw_cday character(len=*), parameter :: subname='(med_phases_prep_lnd)' !--------------------------------------- @@ -62,7 +63,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- !--- Count the number of fields outside of scalar data, if zero, then return @@ -71,8 +72,8 @@ 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 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 + call FB_getNumFlds(is_local%wrap%FBExp(complnd), trim(subname)//"FBexp(complnd)", ncnt, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ncnt > 0) then @@ -91,7 +92,7 @@ subroutine med_phases_prep_lnd(gcomp, rc) is_local%wrap%FBNormOne(n1,complnd,:), & is_local%wrap%RH(n1,complnd,:), & string=trim(compname(n1))//'2'//trim(compname(complnd)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif enddo @@ -104,12 +105,12 @@ subroutine med_phases_prep_lnd(gcomp, rc) 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(complnd), & + call 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 (ChkErr(rc,__LINE__,u_FILE_u)) return end if !--------------------------------------- @@ -120,17 +121,25 @@ subroutine med_phases_prep_lnd(gcomp, rc) !--- update 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(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 + call ESMF_StateGet(is_local%wrap%NStateImp(compatm), trim(is_local%wrap%flds_scalar_name), itemType, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (itemType /= ESMF_STATEITEM_NOTFOUND) then + ! send nextsw_cday to land - first obtain it from atm import + call State_GetScalar(& + scalar_value=nextsw_cday, & + scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & + state=is_local%wrap%NstateImp(compatm), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call State_SetScalar(& + scalar_value=nextsw_cday, & + scalar_id=is_local%wrap%flds_scalar_index_nextsw_cday, & + state=is_local%wrap%NstateExp(complnd), & + flds_scalar_name=is_local%wrap%flds_scalar_name, & + flds_scalar_num=is_local%wrap%flds_scalar_num, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if !--------------------------------------- !--- clean up diff --git a/cime/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 b/cime/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 index cae6dc9aa951..05bf4fdc5cf8 100644 --- a/cime/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 +++ b/cime/src/drivers/nuopc/mediator/med_phases_prep_ocn_mod.F90 @@ -4,9 +4,18 @@ 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 + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use shr_nuopc_utils_mod , only : memcheck => shr_nuopc_memcheck + use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr + use shr_nuopc_methods_mod , only : FB_diagnose => shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : FB_getNumFlds => shr_nuopc_methods_FB_getNumFlds + use shr_nuopc_methods_mod , only : FB_fldchk => shr_nuopc_methods_FB_FldChk + use shr_nuopc_methods_mod , only : FB_GetFldPtr => shr_nuopc_methods_FB_GetFldPtr + use shr_nuopc_methods_mod , only : FB_accum => shr_nuopc_methods_FB_accum + use shr_nuopc_methods_mod , only : FB_average => shr_nuopc_methods_FB_average + use shr_nuopc_methods_mod , only : FB_copy => shr_nuopc_methods_FB_copy + use shr_nuopc_methods_mod , only : FB_reset => shr_nuopc_methods_FB_reset implicit none private @@ -34,8 +43,6 @@ subroutine med_phases_prep_ocn_map(gcomp, rc) use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_TimeGet, ESMF_ClockPrint use ESMF , only : ESMF_FieldBundleGet use med_internalstate_mod , only : InternalState - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds use med_map_mod , only : med_map_FB_Regrid_Norm use esmFlds , only : fldListFr use esmFlds , only : compocn, ncomps, compname @@ -57,7 +64,7 @@ subroutine med_phases_prep_ocn_map(gcomp, rc) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) end if rc = ESMF_SUCCESS - call shr_nuopc_memcheck(subname, 5, mastertask) + call memcheck(subname, 5, mastertask) !--------------------------------------- ! --- Get the internal state @@ -65,13 +72,13 @@ subroutine med_phases_prep_ocn_map(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- ! --- Count the number of fields outside of scalar data, if zero, then return !--------------------------------------- - 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 + call FB_getNumFlds(is_local%wrap%FBExp(compocn), trim(subname)//"FBexp(compocn)", ncnt, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ncnt > 0) then @@ -90,7 +97,7 @@ subroutine med_phases_prep_ocn_map(gcomp, rc) is_local%wrap%FBNormOne(n1,compocn,:), & is_local%wrap%RH(n1,compocn,:), & string=trim(compname(n1))//'2'//trim(compname(compocn)), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif enddo endif @@ -109,11 +116,6 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) use ESMF , only : ESMF_GridComp, ESMF_FieldBundleGet use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_FAILURE, ESMF_LOGMSG_ERROR - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_methods_mod , only : fldchk => shr_nuopc_methods_FB_FldChk - 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, CS use med_internalstate_mod , only : InternalState, mastertask, logunit use med_merge_mod , only : med_merge_auto, med_merge_field @@ -181,7 +183,7 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=dbrc) end if rc = ESMF_SUCCESS - call shr_nuopc_memcheck(subname, 5, mastertask) + call memcheck(subname, 5, mastertask) !--------------------------------------- ! --- Get the internal state @@ -189,14 +191,14 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- ! --- Count the number of fields outside of scalar data, if zero, then return !--------------------------------------- - 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 + call FB_getNumFlds(is_local%wrap%FBExp(compocn), trim(subname)//"FBexp(compocn)", ncnt, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ncnt > 0) then @@ -209,12 +211,12 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) is_local%wrap%FBExp(compocn), is_local%wrap%FBFrac(compocn), & is_local%wrap%FBImp(:,compocn), fldListTo(compocn), & FBMed1=is_local%wrap%FBMed_aoflux_o, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (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), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if !--------------------------------------- @@ -229,84 +231,84 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) ! Input from atm call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdr', Faxa_swvdr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndr', Faxa_swndr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swvdf', Faxa_swvdf, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBImp(compatm,compocn), 'Faxa_swndf', Faxa_swndf, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return lsize = size(Faxa_swvdr) ! Input from mediator, ice-covered ocean and open ocean fractions call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrac' , ifrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrac' , ofrac, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return ! Input from mediator, ocean albedos if (trim(coupling_mode) == 'cesm') then call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdr' , avsdr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidr' , anidr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_avsdf' , avsdf, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBMed_ocnalb_o, 'So_anidf' , anidf, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ifrad' , ifracr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBfrac(compocn), 'ofrad' , ofracr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! Input from ice if (is_local%wrap%comp_present(compice)) then call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen', Fioi_swpen, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return - if (fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (FB_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_vdr', rc=rc)) then import_swpen_by_bands = .true. call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdr', Fioi_swpen_vdr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_vdf', Fioi_swpen_vdf, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_idr', Fioi_swpen_idr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBImp(compice,compocn), 'Fioi_swpen_idf', Fioi_swpen_idf, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else import_swpen_by_bands = .false. end if end if ! Output to ocean swnet - if (fldchk(is_local%wrap%FBExp(compocn), 'Foxx_swnet', rc=rc)) then + if (FB_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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return else 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 + if (FB_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) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_vdf', Foxx_swnet_vdf, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idr', Foxx_swnet_idr, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call FB_GetFldPtr(is_local%wrap%FBExp(compocn), 'Foxx_swnet_idf', Foxx_swnet_idf, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else 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 + if ( FB_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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return export_swnet_afracr = .true. else export_swnet_afracr = .false. @@ -382,35 +384,35 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) 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 + if ( FB_fldchk(is_local%wrap%FBImp(compice,compice), 'Si_ifrac_n', rc=rc) .and. & + FB_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 + if (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 + if (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 + if ( FB_fldchk(is_local%wrap%FBImp(compice,compice), 'Fioi_swpen_ifrac_n', rc=rc) .and. & + FB_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 + if (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 + if (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 + if ( FB_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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return dataptr_o(:) = ofrac(:) end if - if ( fldchk(is_local%wrap%FBExp(compocn), 'Sf_afracr', rc=rc)) then + if ( FB_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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return dataptr_o(:) = ofracr(:) end if @@ -429,9 +431,9 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) 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 + if (FB_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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return dataptr(:) = dataptr(:) * precip_fact end if end do @@ -452,7 +454,7 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) customwgt(:) = - 1._r8 / const_lhvap call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_evap', & FBinA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_lat', wgtA=customwgt, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return deallocate(customwgt) end if @@ -515,7 +517,7 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_evap', & FBinA=is_local%wrap%FBMed_aoflux_o , fnameA='Faox_evap', wgtA=ocnwgt1, & FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_lat' , wgtB=customwgt, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_sen', & FBinA=is_local%wrap%FBMed_aoflux_o , fnameA='Faox_sen ' , wgtA=ocnwgt1, & @@ -537,7 +539,14 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) call med_merge_field(is_local%wrap%FBExp(compocn), 'Foxx_lwnet', & FBinA=is_local%wrap%FBMed_aoflux_o , fnameA='Faox_lwup ', wgtA=ocnwgt1, & FBinB=is_local%wrap%FBImp(compatm,compocn), fnameB='Faxa_lwdn' , wgtB=ocnwgt1, & - FBinC=is_local%wrap%FBImp(compatm,compocn), fnameC='Faxa_lwup' , wgtc=wgtp01, rc=rc) + FBinC=is_local%wrap%FBImp(compatm,compocn), fnameC='Faxa_lwnet' , wgtc=wgtp01, rc=rc) + + call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_rain' , & + FBInA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_rain' , wgtA=ofrac, & + FBInB=is_local%wrap%FBImp(compice,compocn), fnameB='Fioi_meltw', wgtB=ifrac, rc=rc) + + call med_merge_field(is_local%wrap%FBExp(compocn), 'Faxa_snow' , & + FBInA=is_local%wrap%FBImp(compatm,compocn), fnameA='Faxa_snow' , wgtA=ofrac, rc=rc) deallocate(ocnwgt1) deallocate(icewgt1) @@ -552,9 +561,9 @@ subroutine med_phases_prep_ocn_merge(gcomp, rc) !--------------------------------------- if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compocn), & + call 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 (ChkErr(rc,__LINE__,u_FILE_u)) return end if ! TODO (mvertens, 2018-12-16): document above custom calculation @@ -582,10 +591,6 @@ subroutine med_phases_prep_ocn_accum_fast(gcomp, rc) 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 shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_accum - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds use med_internalstate_mod , only : InternalState, mastertask use esmFlds , only : compocn use perf_mod , only : t_startf, t_stopf @@ -616,13 +621,13 @@ subroutine med_phases_prep_ocn_accum_fast(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- ! --- Count the number of fields outside of scalar data, if zero, then return !--------------------------------------- - 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 + call FB_getNumFlds(is_local%wrap%FBExp(compocn), trim(subname)//"FBexp(compocn)", ncnt, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ncnt > 0) then @@ -630,15 +635,15 @@ subroutine med_phases_prep_ocn_accum_fast(gcomp, rc) !--- ocean accumulator !--------------------------------------- - call shr_nuopc_methods_FB_accum(is_local%wrap%FBExpAccum(compocn), is_local%wrap%FBExp(compocn), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_accum(is_local%wrap%FBExpAccum(compocn), is_local%wrap%FBExp(compocn), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return is_local%wrap%FBExpAccumCnt(compocn) = is_local%wrap%FBExpAccumCnt(compocn) + 1 if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExpAccum(compocn), & + call 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 (ChkErr(rc,__LINE__,u_FILE_u)) return end if !--------------------------------------- @@ -664,12 +669,6 @@ subroutine med_phases_prep_ocn_accum_avg(gcomp, rc) use ESMF , only : ESMF_FieldBundleGet use med_constants_mod , only : czero=>med_constants_czero use med_internalstate_mod , only : InternalState - 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_average - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_copy - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getNumFlds use esmFlds , only : compocn use perf_mod , only : t_startf, t_stopf @@ -699,13 +698,13 @@ subroutine med_phases_prep_ocn_accum_avg(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- ! --- Count the number of fields outside of scalar data, if zero, then return !--------------------------------------- - call shr_nuopc_methods_FB_getNumFlds(is_local%wrap%FBExpAccum(compocn), trim(subname)//"FBExpAccum(compocn)", ncnt, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_getNumFlds(is_local%wrap%FBExpAccum(compocn), trim(subname)//"FBExpAccum(compocn)", ncnt, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ncnt > 0) then @@ -714,27 +713,27 @@ subroutine med_phases_prep_ocn_accum_avg(gcomp, rc) !--------------------------------------- if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExpAccum(compocn), & + call 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 (ChkErr(rc,__LINE__,u_FILE_u)) return end if - call shr_nuopc_methods_FB_average(is_local%wrap%FBExpAccum(compocn), & + call 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBExp(compocn), & + call 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 (ChkErr(rc,__LINE__,u_FILE_u)) return end if !--------------------------------------- !--- copy to FBExp(compocn) !--------------------------------------- - call shr_nuopc_methods_FB_copy(is_local%wrap%FBExp(compocn), is_local%wrap%FBExpAccum(compocn), rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_copy(is_local%wrap%FBExp(compocn), is_local%wrap%FBExpAccum(compocn), rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- !--- zero accumulator @@ -742,8 +741,8 @@ subroutine med_phases_prep_ocn_accum_avg(gcomp, rc) is_local%wrap%FBExpAccumFlag(compocn) = .true. is_local%wrap%FBExpAccumCnt(compocn) = 0 - call shr_nuopc_methods_FB_reset(is_local%wrap%FBExpAccum(compocn), value=czero, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + call FB_reset(is_local%wrap%FBExpAccum(compocn), value=czero, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if diff --git a/cime/src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 b/cime/src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 index aeb9ca62000d..d54a8724b687 100644 --- a/cime/src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 +++ b/cime/src/drivers/nuopc/mediator/med_phases_prep_rof_mod.F90 @@ -13,8 +13,19 @@ module med_phases_prep_rof_mod 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 : dbug_flag=>med_constants_dbug_flag - use shr_nuopc_methods_mod , only : chkerr => shr_nuopc_methods_chkerr + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr + use shr_nuopc_methods_mod , only : FB_init => shr_nuopc_methods_FB_init + use shr_nuopc_methods_mod , only : FB_diagnose => shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : FB_getNumFlds => shr_nuopc_methods_FB_getNumFlds + use shr_nuopc_methods_mod , only : FB_accum => shr_nuopc_methods_FB_accum + use shr_nuopc_methods_mod , only : FB_getFldPtr => shr_nuopc_methods_FB_getFldPtr + use shr_nuopc_methods_mod , only : FB_average => shr_nuopc_methods_FB_average + use shr_nuopc_methods_mod , only : FB_reset => shr_nuopc_methods_FB_reset + use shr_nuopc_methods_mod , only : FB_clean => shr_nuopc_methods_FB_clean + use shr_nuopc_methods_mod , only : FB_FieldRegrid => shr_nuopc_methods_FB_FieldRegrid + use shr_nuopc_methods_mod , only : State_GetScalar => shr_nuopc_methods_State_GetScalar + use shr_nuopc_methods_mod , only : State_SetScalar => shr_nuopc_methods_State_SetScalar use perf_mod , only : t_startf, t_stopf implicit none @@ -55,8 +66,6 @@ subroutine med_phases_prep_rof_accum_fast(gcomp, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_FieldBundleGet, ESMF_StateIsCreated, ESMF_StateGet use ESMF , only : ESMF_FieldBundleIsCreated - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_accum - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_diagnose use med_internalstate_mod , only : InternalState ! input/output variables @@ -108,7 +117,7 @@ subroutine med_phases_prep_rof_accum_fast(gcomp, rc) !--------------------------------------- if (ncnt > 0) then - call shr_nuopc_methods_FB_accum(& + call FB_accum(& is_local%wrap%FBImpAccum(complnd,complnd), & is_local%wrap%FBImp(complnd,complnd), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return @@ -116,7 +125,7 @@ subroutine med_phases_prep_rof_accum_fast(gcomp, rc) is_local%wrap%FBImpAccumCnt(complnd) = is_local%wrap%FBImpAccumCnt(complnd) + 1 if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBImpAccum(complnd,complnd), & + call 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 @@ -142,10 +151,6 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_FieldBundleGet use esmFlds , only : fldListTo, fldListFr - use shr_nuopc_methods_mod , only : 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_average - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_reset 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 @@ -198,12 +203,12 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) !--- average import from land accumuled FB !--------------------------------------- - call shr_nuopc_methods_FB_average(is_local%wrap%FBImpAccum(complnd,complnd), & + call FB_average(is_local%wrap%FBImpAccum(complnd,complnd), & is_local%wrap%FBImpAccumCnt(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), & + call 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 @@ -229,7 +234,7 @@ subroutine med_phases_prep_rof_avg(gcomp, 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), & + call 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 @@ -240,7 +245,7 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return else ! This will ensure that no irrig is sent from the land - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImpAccum(complnd,comprof), & + call FB_getFldPtr(is_local%wrap%FBImpAccum(complnd,comprof), & trim(irrig_flux_field), dataptr, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return dataptr(:) = 0._r8 @@ -252,7 +257,7 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) !--------------------------------------- if (dbug_flag > 1) then - call shr_nuopc_methods_FB_diagnose(is_local%wrap%FBFrac(comprof), & + call 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 @@ -265,7 +270,7 @@ subroutine med_phases_prep_rof_avg(gcomp, 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), & + call FB_diagnose(is_local%wrap%FBExp(comprof), & string=trim(subname)//' FBexp(comprof) ', rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return end if @@ -276,7 +281,7 @@ subroutine med_phases_prep_rof_avg(gcomp, rc) is_local%wrap%FBImpAccumCnt(complnd) = 0 - call shr_nuopc_methods_FB_reset(is_local%wrap%FBImpAccum(complnd,complnd), value=czero, rc=rc) + call FB_reset(is_local%wrap%FBImpAccum(complnd,complnd), value=czero, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- @@ -325,12 +330,6 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) use ESMF , only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated use ESMF , only : ESMF_SUCCESS, ESMF_FAILURE, ESMF_RouteHandleIsCreated use ESMF , only : ESMF_LOGMSG_INFO, ESMF_LogWrite - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_getFldPtr - use shr_nuopc_methods_mod , only : shr_nuopc_methods_FB_init - 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_scalars_mod , only : flds_scalar_name use med_internalstate_mod , only : InternalState, mastertask use med_map_mod , only : med_map_FB_Regrid_norm @@ -390,22 +389,26 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) .not. ESMF_FieldBundleIsCreated(FBlndIrrig) .and. & .not. ESMF_FieldBundleIsCreated(FBrofIrrig)) then - call shr_nuopc_methods_FB_init(FBout=FBlndVolr, flds_scalar_name=flds_scalar_name, & + call FB_init(FBout=FBlndVolr, & + flds_scalar_name=is_local%wrap%flds_scalar_name, & FBgeom=is_local%wrap%FBImp(complnd,complnd), & fieldNameList=(/trim(volr_field)/), rc=rc) if (chkerr(rc,__line__,u_file_u)) return - call shr_nuopc_methods_FB_init(FBout=FBrofVolr, flds_scalar_name=flds_scalar_name, & + call FB_init(FBout=FBrofVolr, & + flds_scalar_name=is_local%wrap%flds_scalar_name, & FBgeom=is_local%wrap%FBImp(comprof,comprof), & fieldNameList=(/trim(volr_field)/), rc=rc) if (chkerr(rc,__line__,u_file_u)) return - call shr_nuopc_methods_FB_init(FBout=FBlndIrrig, flds_scalar_name=flds_scalar_name, & + call FB_init(FBout=FBlndIrrig, & + flds_scalar_name=is_local%wrap%flds_scalar_name, & FBgeom=is_local%wrap%FBImp(complnd,complnd), & fieldNameList=(/trim(irrig_normalized_field), trim(irrig_volr0_field)/), rc=rc) if (chkerr(rc,__line__,u_file_u)) return - call shr_nuopc_methods_FB_init(FBout=FBrofIrrig, flds_scalar_name=flds_scalar_name, & + call FB_init(FBout=FBrofIrrig, & + flds_scalar_name=is_local%wrap%flds_scalar_name, & FBgeom=is_local%wrap%FBImp(comprof,comprof), & fieldNameList=(/trim(irrig_normalized_field), trim(irrig_volr0_field)/), rc=rc) if (chkerr(rc,__line__,u_file_u)) return @@ -420,11 +423,11 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) ! cells: while conservative, this would be unphysical (it would mean that irrigation ! actually adds water to those cells). - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImp(comprof,comprof), & + call FB_getFldPtr(is_local%wrap%FBImp(comprof,comprof), & trim(volr_field), volr_r_import, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(FBrofVolr, trim(volr_field), volr_r, rc=rc) + call FB_getFldPtr(FBrofVolr, trim(volr_field), volr_r, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do r = 1, size(volr_r) @@ -436,12 +439,12 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) end do ! Map volr_r to volr_l (rof->lnd) using conservative mapping without any fractional weighting - call shr_nuopc_methods_FB_FieldRegrid(FBrofVolr, trim(volr_field), FBlndVolr, trim(volr_field), & + call FB_FieldRegrid(FBrofVolr, trim(volr_field), FBlndVolr, trim(volr_field), & is_local%wrap%RH(comprof, complnd, mapconsf), rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Get volr_l - call shr_nuopc_methods_FB_getFldPtr(FBlndVolr, trim(volr_field), volr_l, rc=rc) + call FB_getFldPtr(FBlndVolr, trim(volr_field), volr_l, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! ------------------------------------------------------------------------ @@ -460,15 +463,15 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) ! flux on the rof grid. ! First extract accumulated irrigation flux from land - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImpAccum(complnd,complnd), & + call FB_getFldPtr(is_local%wrap%FBImpAccum(complnd,complnd), & trim(irrig_flux_field), irrig_flux_l, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Fill in values for irrig_normalized_l and irrig_volr0_l in temporary FBlndIrrig field bundle - call shr_nuopc_methods_FB_getFldPtr(FBlndIrrig, trim(irrig_normalized_field), irrig_normalized_l, rc=rc) + call FB_getFldPtr(FBlndIrrig, trim(irrig_normalized_field), irrig_normalized_l, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(FBlndIrrig, trim(irrig_volr0_field), irrig_volr0_l, rc=rc) + call FB_getFldPtr(FBlndIrrig, trim(irrig_volr0_field), irrig_volr0_l, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do l = 1, size(volr_l) @@ -493,14 +496,14 @@ subroutine med_phases_prep_rof_irrig(gcomp, rc) is_local%wrap%RH(complnd, comprof, mapconsf), & string='mapping normalized irrig from lnd to to rof', rc=rc) - call shr_nuopc_methods_FB_getFldPtr(FBrofIrrig, trim(irrig_normalized_field), irrig_normalized_r, rc=rc) + call FB_getFldPtr(FBrofIrrig, trim(irrig_normalized_field), irrig_normalized_r, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return - call shr_nuopc_methods_FB_getFldPtr(FBrofIrrig, trim(irrig_volr0_field), irrig_volr0_r, rc=rc) + call FB_getFldPtr(FBrofIrrig, trim(irrig_volr0_field), irrig_volr0_r, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return ! Convert to a total irrigation flux on the ROF grid, and put this in the pre-merge FBImpAccum(complnd,comprof) - call shr_nuopc_methods_FB_getFldPtr(is_local%wrap%FBImpAccum(complnd,comprof), & + call FB_getFldPtr(is_local%wrap%FBImpAccum(complnd,comprof), & trim(irrig_flux_field), irrig_flux_r, rc=rc) if (chkerr(rc,__LINE__,u_FILE_u)) return diff --git a/cime/src/drivers/nuopc/mediator/med_phases_prep_wav_mod.F90 b/cime/src/drivers/nuopc/mediator/med_phases_prep_wav_mod.F90 index a94a264db78f..aa7735bff998 100644 --- a/cime/src/drivers/nuopc/mediator/med_phases_prep_wav_mod.F90 +++ b/cime/src/drivers/nuopc/mediator/med_phases_prep_wav_mod.F90 @@ -22,13 +22,13 @@ subroutine med_phases_prep_wav(gcomp, rc) 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_constants_mod , only : CS + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr + use shr_nuopc_methods_mod , only : FB_diagnose => shr_nuopc_methods_FB_diagnose + use shr_nuopc_methods_mod , only : FB_getNumFlds => shr_nuopc_methods_FB_getNumFlds 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 @@ -57,7 +57,7 @@ subroutine med_phases_prep_wav(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- ! --- Count the number of fields outside of scalar data, if zero, then return @@ -66,8 +66,8 @@ subroutine med_phases_prep_wav(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 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 + call FB_getNumFlds(is_local%wrap%FBExp(compwav), trim(subname)//"FBexp(compwav)", ncnt, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ncnt > 0) then @@ -86,7 +86,7 @@ subroutine med_phases_prep_wav(gcomp, rc) 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif enddo @@ -99,16 +99,16 @@ subroutine med_phases_prep_wav(gcomp, rc) 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 + if (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), & + call 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if !--------------------------------------- diff --git a/cime/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 b/cime/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 index b113c1e7f3bf..bcb4837d4067 100644 --- a/cime/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 +++ b/cime/src/drivers/nuopc/mediator/med_phases_restart_mod.F90 @@ -4,6 +4,10 @@ module med_phases_restart_mod ! Write/Read mediator restart files !----------------------------------------------------------------------------- + use med_constants_mod , only : R8 + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr + implicit none private @@ -29,16 +33,12 @@ subroutine med_phases_restart_write(gcomp, rc) use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_ClockGet, ESMF_ClockGetNextTime use ESMF , only : ESMF_TimeGet, ESMF_ClockGetAlarm, ESMF_ClockPrint, ESMF_TimeIntervalGet use ESMF , only : ESMF_AlarmIsRinging, ESMF_AlarmRingerOff, ESMF_FieldBundleIsCreated - 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 : med_constants_noleap - use med_constants_mod , only : med_constants_gregorian - use med_constants_mod , only : R8 use NUOPC , only : NUOPC_CompAttributeGet use esmFlds , only : ncomps, compname, compocn - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr + use med_constants_mod , only : med_constants_noleap + use med_constants_mod , only : med_constants_gregorian + use med_constants_mod , only : SecPerDay => med_constants_SecPerDay use med_internalstate_mod , only : InternalState - 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 use med_io_mod , only : med_io_sec2hms @@ -101,22 +101,22 @@ subroutine med_phases_restart_write(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, 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=iam, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if(isPresent) then call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else cpl_inst_tag = "" endif @@ -126,33 +126,33 @@ subroutine med_phases_restart_write(gcomp, rc) !--------------------------------------- call ESMF_GridCompGet(gcomp, clock=clock, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return !--------------------------------------- ! --- Restart Alarm !--------------------------------------- call ESMF_ClockGetAlarm(clock, alarmname='alarm_restart', alarm=alarm, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (ESMF_AlarmIsRinging(alarm, rc=rc)) then - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return alarmIsOn = .true. call ESMF_AlarmRingerOff( alarm, rc=rc ) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else AlarmIsOn = .false. endif if (alarmIsOn) then call ESMF_ClockGet(clock, currtime=currtime, reftime=reftime, starttime=starttime, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGetNextTime(clock, nextTime=nexttime, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(clock, calkindflag=calkindflag, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if (calkindflag == ESMF_CALKIND_GREGORIAN) then calendar = med_constants_gregorian @@ -165,21 +165,21 @@ subroutine med_phases_restart_write(gcomp, rc) endif call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=dbrc) endif call ESMF_TimeGet(nexttime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(nexttimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": nexttime = "//trim(nexttimestr), ESMF_LOGMSG_INFO, rc=dbrc) endif call ESMF_ClockPrint(clock, options="currTime", preString="-------->"//trim(subname)//" mediating for: ", rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return timediff = nexttime - reftime call ESMF_TimeIntervalGet(timediff, d=day, s=sec, rc=rc) @@ -189,7 +189,8 @@ subroutine med_phases_restart_write(gcomp, rc) call ymd2date(yr,mon,day,start_ymd) start_tod = sec time_units = 'days since ' & - // trim(med_io_date2yyyymmdd(start_ymd)) // ' ' // med_io_sec2hms(start_tod) + // trim(med_io_date2yyyymmdd(start_ymd)) // ' ' // med_io_sec2hms(start_tod, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(nexttime, yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) call ymd2date(yr,mon,day,next_ymd) @@ -215,11 +216,9 @@ subroutine med_phases_restart_write(gcomp, rc) if (iam == 0) then restart_pfile = "rpointer.med"//cpl_inst_tag call ESMF_LogWrite(trim(subname)//" write rpointer file = "//trim(restart_pfile), ESMF_LOGMSG_INFO, rc=dbrc) - unitn = shr_file_getUnit() - open(unitn, file=restart_pfile, form='FORMATTED') + open(newunit=unitn, file=restart_pfile, form='FORMATTED') write(unitn,'(a)') trim(restart_file) close(unitn) - call shr_file_freeUnit( unitn ) endif call ESMF_LogWrite(trim(subname)//": write "//trim(restart_file), ESMF_LOGMSG_INFO, rc=dbrc) @@ -242,11 +241,13 @@ subroutine med_phases_restart_write(gcomp, rc) if (tbnds(1) >= tbnds(2)) then call med_io_write(restart_file, iam=iam, & time_units=time_units, time_cal=calendar, time_val=dayssince, & - whead=whead, wdata=wdata) + whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return else call med_io_write(restart_file, iam=iam, & time_units=time_units, time_cal=calendar, time_val=dayssince, & - whead=whead, wdata=wdata, tbnds=tbnds) + whead=whead, wdata=wdata, tbnds=tbnds, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Write out next ymd/tod in place of curr ymd/tod because @@ -254,16 +255,22 @@ subroutine med_phases_restart_write(gcomp, rc) ! the current timestep and that is where we want to start ! the next run. - call med_io_write(restart_file, iam, start_ymd, 'start_ymd', whead=whead, wdata=wdata) - call med_io_write(restart_file, iam, start_tod, 'start_tod', whead=whead, wdata=wdata) - call med_io_write(restart_file, iam, ref_ymd , 'ref_ymd' , whead=whead, wdata=wdata) - call med_io_write(restart_file, iam, ref_tod , 'ref_tod' , whead=whead, wdata=wdata) - call med_io_write(restart_file, iam, next_ymd , 'curr_ymd' , whead=whead, wdata=wdata) - call med_io_write(restart_file, iam, next_tod , 'curr_tod' , whead=whead, wdata=wdata) + call med_io_write(restart_file, iam, start_ymd, 'start_ymd', whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_write(restart_file, iam, start_tod, 'start_tod', whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_write(restart_file, iam, ref_ymd , 'ref_ymd' , whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_write(restart_file, iam, ref_tod , 'ref_tod' , whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_write(restart_file, iam, next_ymd , 'curr_ymd' , whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call med_io_write(restart_file, iam, next_tod , 'curr_tod' , whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return call med_io_write(restart_file, iam, is_local%wrap%FBExpAccumCnt, dname='ExpAccumCnt', & - whead=whead, wdata=wdata) - !if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + whead=whead, wdata=wdata, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps if (is_local%wrap%comp_present(n)) then @@ -276,7 +283,7 @@ subroutine med_phases_restart_write(gcomp, rc) !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) call med_io_write(restart_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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Write fraction field bundles @@ -285,7 +292,7 @@ subroutine med_phases_restart_write(gcomp, rc) !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) call med_io_write(restart_file, iam, is_local%wrap%FBfrac(n), & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'Frac', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Write export accumulators @@ -295,7 +302,7 @@ subroutine med_phases_restart_write(gcomp, rc) !call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO, rc=dbrc) call med_io_write(restart_file, iam, is_local%wrap%FBExpAccum(n), & nx=nx, ny=ny, nt=1, whead=whead, wdata=wdata, pre=trim(compname(n))//'ExpAccum', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif enddo @@ -306,13 +313,14 @@ subroutine med_phases_restart_write(gcomp, rc) 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if enddo ! Close file - call med_io_close(restart_file, iam) + call med_io_close(restart_file, iam, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif !--------------------------------------- @@ -327,6 +335,7 @@ subroutine med_phases_restart_write(gcomp, rc) end subroutine med_phases_restart_write !=============================================================================== + subroutine med_phases_restart_read(gcomp, rc) ! Read mediator restart @@ -336,14 +345,12 @@ subroutine med_phases_restart_read(gcomp, rc) use ESMF , only : ESMF_LOGMSG_ERROR, ESMF_VMBroadCast use ESMF , only : ESMF_GridCompGet, ESMF_VMGet, ESMF_ClockGet, ESMF_ClockPrint use ESMF , only : ESMF_FieldBundleIsCreated, ESMF_TimeGet - use med_constants_mod , only : dbug_flag => med_constants_dbug_flag use NUOPC , only : NUOPC_CompAttributeGet use esmFlds , only : ncomps, compname - use shr_nuopc_methods_mod , only : shr_nuopc_methods_ChkErr use med_internalstate_mod , only : InternalState - use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit use med_io_mod , only : med_io_read use perf_mod , only : t_startf, t_stopf + ! Input/output variables type(ESMF_GridComp) :: gcomp integer, intent(out) :: rc @@ -362,9 +369,9 @@ subroutine med_phases_restart_read(gcomp, rc) character(ESMF_MAXSTR) :: restart_file ! Local path to restart filename character(ESMF_MAXSTR) :: restart_pfile ! Local path to restart pointer filename character(ESMF_MAXSTR) :: cpl_inst_tag ! instance tag - character(len=*) , parameter :: sp_str = 'str_undefined' - integer :: dbrc - logical :: isPresent + integer :: dbrc + logical :: isPresent + character(len=*), parameter :: sp_str = 'str_undefined' character(len=*), parameter :: subname='(med_phases_restart_read)' !--------------------------------------- call t_startf('MED:'//subname) @@ -377,21 +384,21 @@ subroutine med_phases_restart_read(gcomp, rc) nullify(is_local%wrap) call ESMF_GridCompGetInternalState(gcomp, is_local, 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=iam, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='case_name', value=case_name, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', isPresent=isPresent, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return if(isPresent) then call NUOPC_CompAttributeGet(gcomp, name='inst_suffix', value=cpl_inst_tag, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return else cpl_inst_tag = "" endif @@ -401,20 +408,20 @@ subroutine med_phases_restart_read(gcomp, rc) !--------------------------------------- call ESMF_GridCompGet(gcomp, clock=clock) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_ClockGet(clock, currtime=currtime, rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return call ESMF_TimeGet(currtime,yy=yr, mm=mon, dd=day, s=sec, rc=dbrc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return write(currtimestr,'(i4.4,a,i2.2,a,i2.2,a,i5.5)') yr,'-',mon,'-',day,'-',sec if (dbug_flag > 1) then call ESMF_LogWrite(trim(subname)//": currtime = "//trim(currtimestr), ESMF_LOGMSG_INFO, rc=dbrc) endif if (iam==0) 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 + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif !--------------------------------------- ! --- Restart File @@ -424,22 +431,20 @@ subroutine med_phases_restart_read(gcomp, rc) restart_pfile = "rpointer.med"//cpl_inst_tag if (iam == 0) then - 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) + open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) if (ierr < 0) then call ESMF_LogWrite(trim(subname)//' rpointer file open returns error', ESMF_LOGMSG_INFO, rc=dbrc) rc=ESMF_Failure return end if - read(unitn,'(a)', iostat=ierr) restart_file + read (unitn,'(a)', iostat=ierr) restart_file if (ierr < 0) then call ESMF_LogWrite(trim(subname)//' rpointer file read returns error', ESMF_LOGMSG_INFO, rc=dbrc) rc=ESMF_Failure return end if close(unitn) - call shr_file_freeUnit( unitn ) call ESMF_LogWrite(trim(subname)//' restart file from rpointer = '//trim(restart_file), & ESMF_LOGMSG_INFO, rc=dbrc) endif @@ -447,7 +452,8 @@ subroutine med_phases_restart_read(gcomp, rc) call ESMF_LogWrite(trim(subname)//": read "//trim(restart_file), ESMF_LOGMSG_INFO, rc=dbrc) - call med_io_read(restart_file, vm, iam, is_local%wrap%FBExpAccumCnt, dname='ExpAccumCnt') + call med_io_read(restart_file, vm, iam, is_local%wrap%FBExpAccumCnt, dname='ExpAccumCnt', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return do n = 1,ncomps if (is_local%wrap%comp_present(n)) then @@ -455,21 +461,21 @@ subroutine med_phases_restart_read(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBimp(n,n),rc=rc)) then call med_io_read(restart_file, vm, iam, is_local%wrap%FBimp(n,n), & pre=trim(compname(n))//'Imp', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Read import fractions if (ESMF_FieldBundleIsCreated(is_local%wrap%FBfrac(n),rc=rc)) then call med_io_read(restart_file, vm, iam, is_local%wrap%FBfrac(n), & pre=trim(compname(n))//'Frac', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif ! Read export field bundle accumulator if (ESMF_FieldBundleIsCreated(is_local%wrap%FBExpAccum(n),rc=rc)) then call med_io_read(restart_file, vm, iam, is_local%wrap%FBExpAccum(n), & pre=trim(compname(n))//'ExpAccum', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return endif endif enddo @@ -478,7 +484,7 @@ subroutine med_phases_restart_read(gcomp, rc) if (ESMF_FieldBundleIsCreated(is_local%wrap%FBMed_ocnalb_o,rc=rc)) then call med_io_read(restart_file, vm, iam, is_local%wrap%FBMed_ocnalb_o, & pre='MedOcnAlb_o', rc=rc) - if (shr_nuopc_methods_ChkErr(rc,__LINE__,u_FILE_u)) return + if (ChkErr(rc,__LINE__,u_FILE_u)) return end if !--------------------------------------- diff --git a/cime/src/drivers/nuopc/mediator/shr_nuopc_methods_mod.F90 b/cime/src/drivers/nuopc/mediator/shr_nuopc_methods_mod.F90 new file mode 100644 index 000000000000..ad1ad0f27752 --- /dev/null +++ b/cime/src/drivers/nuopc/mediator/shr_nuopc_methods_mod.F90 @@ -0,0 +1,3545 @@ +module shr_nuopc_methods_mod + + !----------------------------------------------------------------------------- + ! Generic operation methods used by the Mediator Component. + !----------------------------------------------------------------------------- + + use ESMF , only : operator(<), operator(/=), operator(+), operator(-), operator(*) , operator(>=) + use ESMF , only : operator(<=), operator(>), operator(==) + use ESMF , only : ESMF_GeomType_Flag, ESMF_FieldStatus_Flag, ESMF_PoleMethod_Flag + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_SUCCESS, ESMF_FAILURE + use ESMF , only : ESMF_LOGERR_PASSTHRU, ESMF_LogFoundError, ESMF_LOGMSG_ERROR + use ESMF , only : ESMF_MAXSTR, ESMF_LOGMSG_WARNING, ESMF_POLEMETHOD_ALLAVG + use med_constants_mod , only : R8, CS, CL + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use med_constants_mod , only : czero => med_constants_czero + use med_constants_mod , only : spval_init => med_constants_spval_init + use shr_nuopc_utils_mod, only : ChkErr => shr_nuopc_utils_ChkErr + + implicit none + private + + interface shr_nuopc_methods_FB_accum ; module procedure & + shr_nuopc_methods_FB_accumFB2FB + end interface + + interface shr_nuopc_methods_FB_copy ; module procedure & + shr_nuopc_methods_FB_copyFB2FB + end interface + + interface shr_nuopc_methods_FieldPtr_compare ; module procedure & + shr_nuopc_methods_FieldPtr_compare1, & + shr_nuopc_methods_FieldPtr_compare2 + end interface + + interface shr_nuopc_methods_UpdateTimestamp; module procedure & + shr_nuopc_methods_State_UpdateTimestamp, & + shr_nuopc_methods_Field_UpdateTimestamp + end interface + + ! used/reused in module + + logical :: isPresent + character(len=1024) :: msgString + type(ESMF_GeomType_Flag) :: geomtype + type(ESMF_FieldStatus_Flag) :: status + character(*) , parameter :: u_FILE_u = & + __FILE__ + + public shr_nuopc_methods_FB_copy + 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 + public shr_nuopc_methods_FB_FldChk + public shr_nuopc_methods_FB_GetFldPtr + public shr_nuopc_methods_FB_getNameN + public shr_nuopc_methods_FB_getFieldN + 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 + public shr_nuopc_methods_State_GeomWrite + public shr_nuopc_methods_State_GetFldPtr + public shr_nuopc_methods_State_SetScalar + public shr_nuopc_methods_State_GetScalar + public shr_nuopc_methods_State_GetNumFields + public shr_nuopc_methods_State_getFieldN + public shr_nuopc_methods_State_FldDebug + public shr_nuopc_methods_Field_GeomPrint + public shr_nuopc_methods_Clock_TimePrint + public shr_nuopc_methods_UpdateTimestamp + public shr_nuopc_methods_Distgrid_Match + public shr_nuopc_methods_FieldPtr_compare + public shr_nuopc_methods_States_GetSharedFlds + + private shr_nuopc_methods_Grid_Write + private shr_nuopc_methods_Grid_Print + private shr_nuopc_methods_Mesh_Print + private shr_nuopc_methods_Mesh_Write + private shr_nuopc_methods_Field_GetFldPtr + private shr_nuopc_methods_Field_GeomWrite + private shr_nuopc_methods_Field_UpdateTimestamp + private shr_nuopc_methods_FB_GeomPrint + private shr_nuopc_methods_FB_GeomWrite + private shr_nuopc_methods_FB_RWFields + private shr_nuopc_methods_FB_getFieldByName + private shr_nuopc_methods_FB_SetFldPtr + private shr_nuopc_methods_FB_copyFB2FB + private shr_nuopc_methods_FB_accumFB2FB + private shr_nuopc_methods_State_UpdateTimestamp + private shr_nuopc_methods_State_getNameN + private shr_nuopc_methods_State_getFieldByName + private shr_nuopc_methods_State_SetFldPtr + private shr_nuopc_methods_Array_diagnose + +!----------------------------------------------------------------------------- +contains +!----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_RWFields(mode,fname,FB,flag,rc) + + ! ---------------------------------------------- + ! Read or Write Field Bundles + ! ---------------------------------------------- + use ESMF, only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldBundleWrite + use ESMF, only : ESMF_FieldRead, ESMF_IOFMT_NETCDF, ESMF_FILESTATUS_REPLACE + + character(len=*) :: mode + character(len=*) :: fname + type(ESMF_FieldBundle) :: FB + logical,optional :: flag + integer,optional :: rc + + ! local variables + type(ESMF_Field) :: field + character(len=ESMF_MAXSTR) :: name + integer :: fieldcount, n + logical :: fexists + 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) + endif + + if (mode == 'write') then + if (dbug_flag > 5) then + 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) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_diagnose(FB, 'write '//trim(fname), rc) + + elseif (mode == 'read') then + inquire(file=fname,exist=fexists) + if (fexists) then + if (dbug_flag > 5) then + 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 + ! ignore that field and read the rest, so instead read each field one at a time through ESMF_FieldRead + ! call ESMF_FieldBundleRead (FB, fname, & + ! singleFile=.true., iofmt=ESMF_IOFMT_NETCDF, rc=rc) + ! if (chkerr(rc,__LINE__,u_FILE_u)) return + !----------------------------------------------------------------------------------------------------- + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1,fieldCount + call shr_nuopc_methods_FB_getFieldByName(FB, name, field, rc) + if (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)) + enddo + + call shr_nuopc_methods_FB_diagnose(FB, 'read '//trim(fname), rc) + if (present(flag)) flag = .true. + endif + + else + 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) + endif + + end subroutine shr_nuopc_methods_FB_RWFields + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_init_pointer(StateIn, FBout, flds_scalar_name, name, rc) + + ! ---------------------------------------------- + ! 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 + + ! 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 (chkerr(rc,__LINE__,u_FILE_u)) return + + ! Get fields from StateIn + call ESMF_StateGet(StateIn, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldNameList(fieldCount)) + call ESMF_StateGet(StateIn, itemNameList=lfieldNameList, rc=rc) + if (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 (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfield, mesh=lmesh, meshloc=meshloc, rc=rc) + if (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 (chkerr(rc,__LINE__,u_FILE_u)) return + + ! determine rank of field + call ESMF_FieldGet(lfield, rank=lrank, rc=rc) + if (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 (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 (chkerr(rc,__LINE__,u_FILE_u)) return + + ! get 2d pointer for field + call ESMF_FieldGet(lfield, farrayptr=dataptr2d, rc=rc) + if (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 (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 (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 (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 (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 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 + + ! input/output variables + 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 + integer :: fieldCount,fieldCountgeom + logical :: found + character(ESMF_MAXSTR) :: lname + type(ESMF_Field) :: field,lfield + type(ESMF_Mesh) :: lmesh + type(ESMF_StaggerLoc) :: staggerloc + type(ESMF_MeshLoc) :: meshloc + integer :: ungriddedCount + integer, 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) + endif + rc = ESMF_SUCCESS + + lname = 'undefined' + if (present(name)) then + lname = trim(name) + endif + lname = 'FB '//trim(lname) + + !--------------------------------- + ! check argument consistency and + ! verify that geom argument has a field + !--------------------------------- + + 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 = 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 = 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 = ESMF_FAILURE + return + endif + + if (present(FBgeom)) then + call ESMF_FieldBundleGet(FBgeom, fieldCount=fieldCountGeom, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (present(STgeom)) then + call ESMF_StateGet(STgeom, itemCount=fieldCountGeom, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//": ERROR FBgeom or STgeom must be passed", ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + endif + + !--------------------------------- + ! determine the names of fields that will be in FBout + !--------------------------------- + + if (present(fieldNameList)) then + fieldcount = size(fieldNameList) + allocate(lfieldNameList(fieldcount)) + lfieldNameList = fieldNameList + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from argument", ESMF_LOGMSG_INFO, rc=rc) + end if + elseif (present(FBflds)) then + call ESMF_FieldBundleGet(FBflds, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldNameList(fieldCount)) + call ESMF_FieldBundleGet(FBflds, fieldNameList=lfieldNameList, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from FBflds", ESMF_LOGMSG_INFO, rc=rc) + end if + elseif (present(STflds)) then + call ESMF_StateGet(STflds, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldNameList(fieldCount)) + call ESMF_StateGet(STflds, itemNameList=lfieldNameList, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from STflds", ESMF_LOGMSG_INFO, rc=rc) + end if + elseif (present(FBgeom)) then + call ESMF_FieldBundleGet(FBgeom, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldNameList(fieldCount)) + call ESMF_FieldBundleGet(FBgeom, fieldNameList=lfieldNameList, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from FBgeom", ESMF_LOGMSG_INFO, rc=rc) + end if + elseif (present(STgeom)) then + call ESMF_StateGet(STgeom, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldNameList(fieldCount)) + call ESMF_StateGet(STgeom, itemNameList=lfieldNameList, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" fieldNameList from STflds", ESMF_LOGMSG_INFO, rc=rc) + end if + else + call ESMF_LogWrite(trim(subname)//": ERROR fieldNameList, FBflds, STflds, FBgeom, or STgeom must be passed", & + ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + endif + + !--------------------------------- + ! 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 + + !--------------------------------- + ! 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 mesh + if (present(FBgeom)) then + call shr_nuopc_methods_FB_getFieldN(FBgeom, 1, lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + 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 (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + 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 = ESMF_FAILURE + return + endif + + ! Make sure the field is not empty - if it is return with an error + call ESMF_FieldGet(lfield, status=status, rc=rc) + if (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 = ESMF_FAILURE + return + endif + + ! Assume field is on mesh + call ESMF_FieldGet(lfield, mesh=lmesh, meshloc=meshloc, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//":"//trim(lname)//" use mesh", ESMF_LOGMSG_INFO) + end if + + endif ! fieldcount > 0 + + !--------------------------------- + ! create FBout + !--------------------------------- + + FBout = ESMF_FieldBundleCreate(name=trim(lname), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (fieldcountgeom > 0) then + + ! Now loop over all the fields in the field name list + do n = 1, fieldCount + + ! Note that input fields come from ONE of FBFlds, STflds, or fieldNamelist input argument + if (present(FBFlds) .or. present(STflds)) then + + ! 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 (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (present(STflds)) then + call shr_nuopc_methods_State_getFieldN(STflds, n, lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end if + + ! 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 (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 (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 (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 (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 (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 (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 (chkerr(rc,__LINE__,u_FILE_u)) return + + enddo ! fieldCount + endif ! fieldcountgeom + + deallocate(lfieldNameList) + + call shr_nuopc_methods_FB_reset(FBout, value=spval_init, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_FB_init + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_getNameN(FB, fieldnum, fieldname, rc) + + ! ---------------------------------------------- + ! 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 + integer , intent(out) :: rc + + ! local variables + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_getNameN)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + fieldname = ' ' + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (fieldnum > fieldCount) then + call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + fieldname = lfieldnamelist(fieldnum) + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_FB_getNameN + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_getFieldN(FB, fieldnum, field, rc) + + ! ---------------------------------------------- + ! 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 + integer , intent(out) :: rc + + ! local variables + character(len=ESMF_MAXSTR) :: name + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_getFieldN)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call shr_nuopc_methods_FB_getNameN(FB, fieldnum, name, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldBundleGet(FB, fieldName=name, field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_FB_getFieldN + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_getFieldByName(FB, fieldname, field, rc) + + ! ---------------------------------------------- + ! 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 + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_getFieldByName)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(FB, fieldName=fieldname, field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_FB_getFieldByName + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_getNameN(State, fieldnum, fieldname, rc) + + ! ---------------------------------------------- + ! Get field number fieldnum name out of State + ! ---------------------------------------------- + + use ESMF, only : ESMF_State, ESMF_StateGet + + type(ESMF_State), intent(in) :: State + integer , intent(in) :: fieldnum + character(len=*), intent(out) :: fieldname + integer , intent(out) :: rc + + ! local variables + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + character(len=*),parameter :: subname='(shr_nuopc_methods_State_getNameN)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + fieldname = ' ' + + call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (fieldnum > fieldCount) then + call ESMF_LogWrite(trim(subname)//": ERROR fieldnum > fieldCount ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + + allocate(lfieldnamelist(fieldCount)) + call ESMF_StateGet(State, itemNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + fieldname = lfieldnamelist(fieldnum) + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_State_getNameN + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_getNumFields(State, fieldnum, rc) + + ! ---------------------------------------------- + ! Get field number fieldnum name out of State + ! ---------------------------------------------- + + use NUOPC , only : NUOPC_GetStateMemberLists + use ESMF , only : ESMF_State, ESMF_Field, ESMF_StateGet, ESMF_STATEITEM_FIELD + use ESMF , only : ESMF_StateItem_Flag + + type(ESMF_State), intent(in) :: State + integer , intent(inout) :: fieldnum + integer , intent(out) :: rc + + ! local variables + integer :: n,itemCount + type(ESMF_Field), pointer :: fieldList(:) + type(ESMF_StateItem_Flag), pointer :: itemTypeList(:) + logical, parameter :: use_NUOPC_method = .true. + character(len=*),parameter :: subname='(shr_nuopc_methods_State_getNumFields)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + if (use_NUOPC_method) then + + nullify(fieldList) + call NUOPC_GetStateMemberLists(state, fieldList=fieldList, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + fieldnum = 0 + if (associated(fieldList)) then + fieldnum = size(fieldList) + deallocate(fieldList) + endif + + else + + fieldnum = 0 + call ESMF_StateGet(State, itemCount=itemCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (itemCount > 0) then + allocate(itemTypeList(itemCount)) + call ESMF_StateGet(State, itemTypeList=itemTypeList, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1,itemCount + if (itemTypeList(n) == ESMF_STATEITEM_FIELD) fieldnum=fieldnum+1 + enddo + deallocate(itemTypeList) + endif + + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_State_getNumFields + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_getFieldN(State, fieldnum, field, rc) + + ! ---------------------------------------------- + ! Get field number fieldnum in State + ! ---------------------------------------------- + + use ESMF, only : ESMF_State, ESMF_Field, ESMF_StateGet + + type(ESMF_State), intent(in) :: State + integer , intent(in) :: fieldnum + type(ESMF_Field), intent(inout) :: field + integer , intent(out) :: rc + + ! local variables + character(len=ESMF_MAXSTR) :: name + character(len=*),parameter :: subname='(shr_nuopc_methods_State_getFieldN)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call shr_nuopc_methods_State_getNameN(State, fieldnum, name, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(State, itemName=name, field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_State_getFieldN + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_getFieldByName(State, fieldname, field, rc) + ! ---------------------------------------------- + ! Get field associated with fieldname from State + ! ---------------------------------------------- + use ESMF, only : ESMF_State, ESMF_Field, ESMF_StateGet + + type(ESMF_State), intent(in) :: State + character(len=*), intent(in) :: fieldname + type(ESMF_Field), intent(inout) :: field + integer , intent(out) :: rc + + ! local variables + character(len=*),parameter :: subname='(shr_nuopc_methods_State_getFieldByName)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call ESMF_StateGet(State, itemName=fieldname, field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_State_getFieldByName + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_clean(FB, rc) + ! ---------------------------------------------- + ! Destroy fields in FB and FB + ! ---------------------------------------------- + + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldDestroy + use ESMF, only : ESMF_FieldBundleDestroy, ESMF_Field + + type(ESMF_FieldBundle), intent(inout) :: FB + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + type(ESMF_Field) :: field + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_clean)' + ! ---------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + call ESMF_FieldBundleGet(FB, fieldName=lfieldnamelist(n), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldDestroy(field, rc=rc, noGarbage=.true.) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + + call ESMF_FieldBundleDestroy(FB, rc=rc, noGarbage=.true.) + if (chkerr(rc,__LINE__,u_FILE_u)) return + deallocate(lfieldnamelist) + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + + end subroutine shr_nuopc_methods_FB_clean + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_reset(FB, value, rc) + ! ---------------------------------------------- + ! Set all fields to value in FB + ! If value is not provided, reset to 0.0 + ! ---------------------------------------------- + + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet + + ! intput/output variables + type(ESMF_FieldBundle), intent(inout) :: FB + real(R8) , intent(in), optional :: value + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(R8) :: lvalue + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_reset)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + lvalue = czero + if (present(value)) then + lvalue = value + endif + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + call shr_nuopc_methods_FB_SetFldPtr(FB, lfieldnamelist(n), lvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_FB_reset + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_FieldRegrid(FBin,fldin,FBout,fldout,RH,rc,zeroregion) + + ! ---------------------------------------------- + ! Regrid a field in a field bundle to another field in a field bundle + ! ---------------------------------------------- + + use ESMF , only : ESMF_FieldBundle, ESMF_RouteHandle, ESMF_FieldRegrid, ESMF_Field + use ESMF , only : ESMF_TERMORDER_SRCSEQ, ESMF_FieldRegridStore, ESMF_SparseMatrixWrite + use ESMF , only : ESMF_Region_Flag, ESMF_REGION_TOTAL + use perf_mod , only : t_startf, t_stopf + + type(ESMF_FieldBundle), intent(in) :: FBin + character(len=*) , intent(in) :: fldin + type(ESMF_FieldBundle), intent(inout) :: FBout + character(len=*) , intent(in) :: fldout + 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 :: rank + logical :: checkflag = .false. + character(len=8) :: filename + type(ESMF_Region_Flag) :: localzr + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_FieldRegrid)' + ! ---------------------------------------------- +#ifdef DEBUG + checkflag = .true. +#endif + call t_startf(subname) + rc = ESMF_SUCCESS + + localzr = ESMF_REGION_TOTAL + if (present(zeroregion)) then + localzr = zeroregion + endif + + 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 + + call shr_nuopc_methods_FB_getFieldByName(FBin, trim(fldin), field1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_FB_getFieldByName(FBout, trim(fldout), field2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_FieldRegrid(field1, field2, routehandle=RH, & + termorderflag=ESMF_TERMORDER_SRCSEQ, checkflag=checkflag, & + zeroregion=localzr, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + call ESMF_LogWrite(trim(subname)//" field not found: "//& + trim(fldin)//","//trim(fldout), ESMF_LOGMSG_INFO) + endif + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + call t_stopf(subname) + + end subroutine shr_nuopc_methods_FB_FieldRegrid + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_reset(State, value, rc) + + ! ---------------------------------------------- + ! Set all fields to value in State + ! If value is not provided, reset to 0.0 + ! ---------------------------------------------- + + use ESMF, only : ESMF_State, ESMF_StateGet + + ! intput/output variables + type(ESMF_State) , intent(inout) :: State + real(R8) , intent(in), optional :: value + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(R8) :: lvalue + character(len=*),parameter :: subname='(shr_nuopc_methods_State_reset)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + lvalue = czero + if (present(value)) then + lvalue = value + endif + + call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_StateGet(State, itemNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + call shr_nuopc_methods_State_SetFldPtr(State, lfieldnamelist(n), lvalue, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_State_reset + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_average(FB, count, rc) + + ! ---------------------------------------------- + ! Set all fields to zero in FB + ! ---------------------------------------------- + + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet + + ! input/output variables + type(ESMF_FieldBundle), intent(inout) :: FB + integer , intent(in) :: count + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lrank + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + real(R8), pointer :: dataPtr1(:) + real(R8), pointer :: dataPtr2(:,:) + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_average)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + 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) + end if + !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 (chkerr(rc,__LINE__,u_FILE_u)) return + + else + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + do n = 1, fieldCount + call shr_nuopc_methods_FB_GetFldPtr(FB, lfieldnamelist(n), dataPtr1, dataPtr2, lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + do i=lbound(dataptr1,1),ubound(dataptr1,1) + dataptr1(i) = dataptr1(i) / real(count, R8) + enddo + elseif (lrank == 2) then + do j=lbound(dataptr2,2),ubound(dataptr2,2) + do i=lbound(dataptr2,1),ubound(dataptr2,1) + dataptr2(i,j) = dataptr2(i,j) / real(count, R8) + enddo + enddo + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + endif + enddo + deallocate(lfieldnamelist) + + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_FB_average + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_diagnose(FB, string, rc) + ! ---------------------------------------------- + ! Diagnose status of FB + ! ---------------------------------------------- + + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet + + type(ESMF_FieldBundle) , intent(inout) :: FB + character(len=*) , intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lrank + character(ESMF_MAXSTR), pointer :: lfieldnamelist(:) + character(len=CL) :: lstring + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_diagnose)' + ! ---------------------------------------------- + + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + rc = ESMF_SUCCESS + + lstring = '' + if (present(string)) then + lstring = trim(string) // ' ' + endif + + ! Determine number of fields in field bundle and allocate memory for lfieldnamelist + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + ! Get the fields in the field bundle + call ESMF_FieldBundleGet(FB, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! For each field in the bundle, get its memory location and print out the field + do n = 1, fieldCount + call shr_nuopc_methods_FB_GetFldPtr(FB, lfieldnamelist(n), & + fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n))//' ', & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), " no data" + endif + + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n))//' ', & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + " 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) + enddo + + ! Deallocate memory + deallocate(lfieldnamelist) + + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + + end subroutine shr_nuopc_methods_FB_diagnose + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Array_diagnose(array, string, rc) + + ! ---------------------------------------------- + ! Diagnose status of Array + ! ---------------------------------------------- + + use ESMF, only : ESMF_Array, ESMF_ArrayGet + + ! input/output variables + type(ESMF_Array), intent(inout) :: array + character(len=*), intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + character(len=CS) :: lstring + real(R8), pointer :: dataPtr3d(:,:,:) + character(len=*),parameter :: subname='(shr_nuopc_methods_Array_diagnose)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + ! this is not working yet, not sure about dataPtr dim/type + return + + lstring = '' + if (present(string)) then + lstring = trim(string) + endif + + call ESMF_ArrayGet(Array, farrayPtr=dataPtr3d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write(msgString,'(A,3g14.7)') trim(subname)//' '//trim(lstring), & + minval(dataPtr3d), maxval(dataPtr3d), sum(dataPtr3d) + + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + end if + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_Array_diagnose + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_diagnose(State, string, rc) + ! ---------------------------------------------- + ! Diagnose status of State + ! ---------------------------------------------- + + use ESMF, only : ESMF_State, ESMF_StateGet + + type(ESMF_State), intent(in) :: State + character(len=*), intent(in), optional :: string + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lrank + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + character(len=CS) :: lstring + real(R8), pointer :: dataPtr1d(:) + real(R8), pointer :: dataPtr2d(:,:) + character(len=*),parameter :: subname='(shr_nuopc_methods_State_diagnose)' + ! ---------------------------------------------- + + if (dbug_flag > 5) then + call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + endif + + lstring = '' + if (present(string)) then + lstring = trim(string) + endif + + call ESMF_StateGet(State, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + + call ESMF_StateGet(State, itemNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + + call shr_nuopc_methods_State_GetFldPtr(State, lfieldnamelist(n), & + fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + + elseif (lrank == 1) then + if (size(dataPtr1d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr1d), maxval(dataPtr1d), sum(dataPtr1d), size(dataPtr1d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + " no data" + endif + + elseif (lrank == 2) then + if (size(dataPtr2d) > 0) then + write(msgString,'(A,3g14.7,i8)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + minval(dataPtr2d), maxval(dataPtr2d), sum(dataPtr2d), size(dataPtr2d) + else + write(msgString,'(A,a)') trim(subname)//' '//trim(lstring)//': '//trim(lfieldnamelist(n)), & + " 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) + + enddo + + deallocate(lfieldnamelist) + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_State_diagnose + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_Field_diagnose(FB, fieldname, string, rc) + + ! ---------------------------------------------- + ! Diagnose status of State + ! ---------------------------------------------- + + use ESMF, only : ESMF_FieldBundle + + ! input/output variables + type(ESMF_FieldBundle), intent(inout) :: FB + 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 shr_nuopc_methods_FB_GetFldPtr(FB, fieldname, dataPtr1d, dataPtr2d, lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + 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 + 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_FB_Field_diagnose + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Field_diagnose(field, fieldname, string, rc) + + ! ---------------------------------------------- + ! Diagnose Field + ! ---------------------------------------------- + + 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 (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 (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 (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 + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_copyFB2FB)' + ! ---------------------------------------------- + + 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 (chkerr(rc,__LINE__,u_FILE_u)) return + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_FB_copyFB2FB + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_accumFB2FB(FBout, FBin, copy, rc) + + ! ---------------------------------------------- + ! Accumulate common field names from FBin to FBout + ! If copy is passed in and true, the this is a copy + ! ---------------------------------------------- + + use ESMF , only : ESMF_FieldBundle + use ESMF , only : ESMF_FieldBundleGet + + type(ESMF_FieldBundle), intent(inout) :: FBout + type(ESMF_FieldBundle), intent(in) :: FBin + logical, optional , intent(in) :: copy + integer , intent(out) :: rc + + ! local variables + integer :: i,j,n + integer :: fieldCount, lranki, lranko + character(ESMF_MAXSTR) ,pointer :: lfieldnamelist(:) + logical :: exists + logical :: lcopy + real(R8), pointer :: dataPtri1(:) , dataPtro1(:) + real(R8), pointer :: dataPtri2(:,:), dataPtro2(:,:) + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_accumFB2FB)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + lcopy = .false. ! accumulate by default + if (present(copy)) then + lcopy = copy + endif + + call ESMF_FieldBundleGet(FBout, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(lfieldnamelist(fieldCount)) + call ESMF_FieldBundleGet(FBout, fieldNameList=lfieldnamelist, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1, fieldCount + call ESMF_FieldBundleGet(FBin, fieldName=lfieldnamelist(n), isPresent=exists, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (exists) then + call shr_nuopc_methods_FB_GetFldPtr(FBin, lfieldnamelist(n), dataPtri1, dataPtri2, lranki, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_FB_GetFldPtr(FBout, lfieldnamelist(n), dataPtro1, dataPtro2, lranko, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + 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) + rc = ESMF_FAILURE + return + endif + + if (lcopy) then + do i=lbound(dataPtri1,1),ubound(dataPtri1,1) + dataPtro1(i) = dataPtri1(i) + enddo + else + do i=lbound(dataPtri1,1),ubound(dataPtri1,1) + dataPtro1(i) = dataPtro1(i) + dataPtri1(i) + enddo + endif + + 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) + rc = ESMF_FAILURE + return + endif + + if (lcopy) then + do j=lbound(dataPtri2,2),ubound(dataPtri2,2) + do i=lbound(dataPtri2,1),ubound(dataPtri2,1) + dataPtro2(i,j) = dataPtri2(i,j) + enddo + enddo + else + do j=lbound(dataPtri2,2),ubound(dataPtri2,2) + do i=lbound(dataPtri2,1),ubound(dataPtri2,1) + dataPtro2(i,j) = dataPtro2(i,j) + dataPtri2(i,j) + enddo + enddo + endif + + else + + write(msgString,'(a,2i8)') trim(subname)//": ranki, ranko = ",lranki,lranko + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + call ESMF_LogWrite(trim(subname)//": ERROR ranki ranko not supported "//trim(lfieldnamelist(n)), & + ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return + + endif + + endif + enddo + + deallocate(lfieldnamelist) + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_FB_accumFB2FB + + !----------------------------------------------------------------------------- + + logical function shr_nuopc_methods_FB_FldChk(FB, fldname, rc) + + ! ---------------------------------------------- + ! Determine if field with fldname is in input field bundle + ! ---------------------------------------------- + + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet + use ESMF, only : ESMF_FieldBundleIsCreated + + ! input/output variables + type(ESMF_FieldBundle), intent(in) :: FB + character(len=*) , intent(in) :: fldname + integer , intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_FldChk)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + ! If field bundle is not created then set return to .false. + if (.not. ESMF_FieldBundleIsCreated(FB)) then + shr_nuopc_methods_FB_FldChk = .false. + return + end if + + ! If field bundle is created determine if fldname is present in field bundle + shr_nuopc_methods_FB_FldChk = .false. + + call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) then + call ESMF_LogWrite(trim(subname)//" Error checking field: "//trim(fldname), & + ESMF_LOGMSG_ERROR) + return + endif + if (isPresent) then + shr_nuopc_methods_FB_FldChk = .true. + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + 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 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(:,:) + integer , intent(out) , optional :: rank + logical , intent(in) , optional :: abort + integer , intent(out) , optional :: rc + + ! local variables + type(ESMF_Mesh) :: lmesh + integer :: lrank, nnodes, nelements + logical :: labort + character(len=*), parameter :: subname='(shr_nuopc_methods_Field_GetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + 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 = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + labort = .true. + if (present(abort)) then + labort = abort + endif + lrank = -99 + + call ESMF_FieldGet(field, status=status, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (status /= ESMF_FIELDSTATUS_COMPLETE) then + lrank = 0 + if (labort) then + call ESMF_LogWrite(trim(subname)//": ERROR data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + else + call ESMF_LogWrite(trim(subname)//": WARNING data not allocated ", ESMF_LOGMSG_INFO, rc=rc) + endif + else + + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(field, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(field, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_MeshGet(lmesh, numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nnodes == 0 .and. nelements == 0) lrank = 0 + + else + call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & + ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + endif ! geomtype + + if (lrank == 0) then + call ESMF_LogWrite(trim(subname)//": no local nodes or elements ", & + 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 = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr1, rc=rc) + if (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 = ESMF_FAILURE + return + endif + call ESMF_FieldGet(field, farrayPtr=fldptr2, rc=rc) + if (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 = ESMF_FAILURE + return + endif + + endif ! status + + if (present(rank)) then + rank = lrank + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_Field_GetFldPtr + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, rank, field, rc) + + 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(:) + real(R8), pointer , intent(inout), optional :: fldptr2(:,:) + integer , intent(out), optional :: rank + integer , intent(out), optional :: rc + type(ESMF_Field) , intent(out), optional :: field + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrank + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_GetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + 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 = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + 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 = ESMF_FAILURE + return + endif + + call ESMF_FieldBundleGet(FB, fieldName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Field_GetFldPtr(lfield, & + fldptr1=fldptr1, fldptr2=fldptr2, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (present(rank)) then + rank = lrank + endif + if (present(field)) then + field = lfield + endif + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_FB_GetFldPtr + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_SetFldPtr(FB, fldname, val, rc) + + use ESMF, only : ESMF_FieldBundle, ESMF_Field + + type(ESMF_FieldBundle), intent(in) :: FB + character(len=*) , intent(in) :: fldname + real(R8) , intent(in) :: val + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrank + real(R8), pointer :: fldptr1(:) + real(R8), pointer :: fldptr2(:,:) + character(len=*), parameter :: subname='(shr_nuopc_methods_FB_SetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call shr_nuopc_methods_FB_GetFldPtr(FB, fldname, fldptr1, fldptr2, lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + fldptr1 = val + elseif (lrank == 2) then + fldptr2 = val + else + call ESMF_LogWrite(trim(subname)//": ERROR in rank "//trim(fldname), & + 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) + endif + + end subroutine shr_nuopc_methods_FB_SetFldPtr + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_GetFldPtr(ST, fldname, fldptr1, fldptr2, rank, rc) + ! ---------------------------------------------- + ! Get pointer to a state field + ! ---------------------------------------------- + + use ESMF, only : ESMF_State, ESMF_Field, ESMF_StateGet + + type(ESMF_State), intent(in) :: ST + character(len=*), intent(in) :: fldname + real(R8), pointer, intent(inout), optional :: fldptr1(:) + real(R8), pointer, intent(inout), optional :: fldptr2(:,:) + integer , intent(out), optional :: rank + integer , intent(out), optional :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrank + character(len=*), parameter :: subname='(shr_nuopc_methods_State_GetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + 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 = ESMF_FAILURE + return + endif + + rc = ESMF_SUCCESS + + call ESMF_StateGet(ST, itemName=trim(fldname), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Field_GetFldPtr(lfield, & + fldptr1=fldptr1, fldptr2=fldptr2, rank=lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (present(rank)) then + rank = lrank + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_State_GetFldPtr + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_SetFldPtr(ST, fldname, val, rc) + + use ESMF, only : ESMF_State, ESMF_Field + + type(ESMF_State) , intent(in) :: ST + character(len=*) , intent(in) :: fldname + real(R8), intent(in) :: val + integer , intent(out) :: rc + + ! local variables + type(ESMF_Field) :: lfield + integer :: lrank + real(R8), pointer :: fldptr1(:) + real(R8), pointer :: fldptr2(:,:) + character(len=*), parameter :: subname='(shr_nuopc_methods_State_SetFldPtr)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call shr_nuopc_methods_State_GetFldPtr(ST, fldname, fldptr1, fldptr2, lrank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + fldptr1 = val + elseif (lrank == 2) then + fldptr2 = val + else + call ESMF_LogWrite(trim(subname)//": ERROR in rank "//trim(fldname), & + 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) + endif + + end subroutine shr_nuopc_methods_State_SetFldPtr + + !----------------------------------------------------------------------------- + + logical function shr_nuopc_methods_FieldPtr_Compare1(fldptr1, fldptr2, cstring, rc) + + real(R8), pointer, intent(in) :: fldptr1(:) + real(R8), pointer, intent(in) :: fldptr2(:) + character(len=*) , intent(in) :: cstring + integer , intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(shr_nuopc_methods_FieldPtr_Compare1)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + shr_nuopc_methods_FieldPtr_Compare1 = .false. + if (lbound(fldptr2,1) /= lbound(fldptr1,1) .or. & + ubound(fldptr2,1) /= ubound(fldptr1,1)) then + call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(msgString,*) trim(subname)//': fldptr1 ',lbound(fldptr1),ubound(fldptr1) + 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) + else + shr_nuopc_methods_FieldPtr_Compare1 = .true. + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end function shr_nuopc_methods_FieldPtr_Compare1 + + !----------------------------------------------------------------------------- + + logical function shr_nuopc_methods_FieldPtr_Compare2(fldptr1, fldptr2, cstring, rc) + + real(R8), pointer, intent(in) :: fldptr1(:,:) + real(R8), pointer, intent(in) :: fldptr2(:,:) + character(len=*) , intent(in) :: cstring + integer , intent(out) :: rc + + ! local variables + character(len=*), parameter :: subname='(shr_nuopc_methods_FieldPtr_Compare2)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + shr_nuopc_methods_FieldPtr_Compare2 = .false. + if (lbound(fldptr2,2) /= lbound(fldptr1,2) .or. & + lbound(fldptr2,1) /= lbound(fldptr1,1) .or. & + ubound(fldptr2,2) /= ubound(fldptr1,2) .or. & + ubound(fldptr2,1) /= ubound(fldptr1,1)) then + call ESMF_LogWrite(trim(subname)//": ERROR in data size "//trim(cstring), ESMF_LOGMSG_ERROR, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write(msgString,*) trim(subname)//': fldptr2 ',lbound(fldptr2),ubound(fldptr2) + 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) + else + shr_nuopc_methods_FieldPtr_Compare2 = .true. + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end function shr_nuopc_methods_FieldPtr_Compare2 + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_GeomPrint(state, string, rc) + + use ESMF, only : ESMF_State, ESMF_Field, ESMF_StateGet + + type(ESMF_State), intent(in) :: state + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + type(ESMF_Field) :: lfield + integer :: fieldcount + character(len=*),parameter :: subname='(shr_nuopc_methods_State_GeomPrint)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (fieldCount > 0) then + call shr_nuopc_methods_State_GetFieldN(state, 1, lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_Field_GeomPrint(lfield, string, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + 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) + endif + + end subroutine shr_nuopc_methods_State_GeomPrint + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_GeomPrint(FB, string, rc) + + use ESMF, only : ESMF_FieldBundle, ESMF_Field, ESMF_FieldBundleGet + + type(ESMF_FieldBundle), intent(in) :: FB + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + type(ESMF_Field) :: lfield + integer :: fieldcount + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_GeomPrint)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (fieldCount > 0) then + + call shr_nuopc_methods_Field_GeomPrint(lfield, string, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + 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) + endif + + end subroutine shr_nuopc_methods_FB_GeomPrint + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Field_GeomPrint(field, string, rc) + + 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 + + ! local variables + type(ESMF_Grid) :: lgrid + type(ESMF_Mesh) :: lmesh + integer :: lrank + real(R8), pointer :: dataPtr1(:) + real(R8), pointer :: dataPtr2(:,:) + character(len=*),parameter :: subname='(shr_nuopc_methods_Field_GeomPrint)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call ESMF_FieldGet(field, status=status, rc=rc) + if (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 = ESMF_FAILURE + return + endif + + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field, grid=lgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_Grid_Print(lgrid, string, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(field, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_Mesh_Print(lmesh, string, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + + call shr_nuopc_methods_Field_GetFldPtr(field, & + fldptr1=dataPtr1, fldptr2=dataPtr2, rank=lrank, abort=.false., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (lrank == 0) then + ! no local data + elseif (lrank == 1) then + write (msgString,*) trim(subname)//":"//trim(string)//": dataptr bounds dim=1 ",lbound(dataptr1,1),ubound(dataptr1,1) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (lrank == 2) then + write (msgString,*) trim(subname)//":"//trim(string)//": dataptr bounds dim=1 ",lbound(dataptr2,1),ubound(dataptr2,1) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write (msgString,*) trim(subname)//":"//trim(string)//": dataptr bounds dim=2 ",lbound(dataptr2,2),ubound(dataptr2,2) + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (lrank == 0) then + ! means data allocation does not exist yet + continue + else + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", & + 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) + endif + + end subroutine shr_nuopc_methods_Field_GeomPrint + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Mesh_Print(mesh, string, rc) + + use ESMF, only: ESMF_Mesh, ESMF_DistGrid, ESMF_MeshGet, ESMF_DistGridGet + use ESMF, only: ESMF_DELayoutGet, ESMF_DELayout + use ESMF, only: ESMF_MeshStatus_Flag, ESMF_MeshStatus_Complete + + type(ESMF_Mesh) , intent(in) :: mesh + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + type(ESMF_Distgrid) :: distgrid + type(ESMF_DELayout) :: delayout + integer :: pdim, sdim, nnodes, nelements + integer :: localDeCount + integer :: DeCount + integer :: dimCount, tileCount + integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) + type(ESMF_MeshStatus_Flag) :: meshStatus + logical :: elemDGPresent, nodeDGPresent + character(len=*),parameter :: subname='(shr_nuopc_methods_Mesh_Print)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call ESMF_MeshGet(mesh, elementDistGridIsPresent=elemDGPresent, & + nodalDistgridIsPresent=nodeDGPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_MeshGet(mesh, status=meshStatus, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! first get the distgrid, which should be available + if (elemDGPresent) then + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": distGrid=element" + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distgrid, deLayout=deLayout, dimCount=dimCount, & + tileCount=tileCount, deCount=deCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": dimCount=", dimCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": tileCount=", tileCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": deCount=", deCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DELayoutGet(deLayout, localDeCount=localDeCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": localDeCount=", localDeCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount + allocate(minIndexPTile(dimCount, tileCount), & + maxIndexPTile(dimCount, tileCount)) + + ! get minIndex and maxIndex arrays + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": minIndexPTile=", minIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": maxIndexPTile=", maxIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + deallocate(minIndexPTile, maxIndexPTile) + + endif + + if (nodeDGPresent) then + call ESMF_MeshGet(mesh, nodalDistgrid=distgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": distGrid=nodal" + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distgrid, deLayout=deLayout, dimCount=dimCount, & + tileCount=tileCount, deCount=deCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": dimCount=", dimCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": tileCount=", tileCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": deCount=", deCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DELayoutGet(deLayout, localDeCount=localDeCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": localDeCount=", localDeCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount + allocate(minIndexPTile(dimCount, tileCount), & + maxIndexPTile(dimCount, tileCount)) + + ! get minIndex and maxIndex arrays + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": minIndexPTile=", minIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": maxIndexPTile=", maxIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + deallocate(minIndexPTile, maxIndexPTile) + + endif + + if (.not. elemDGPresent .and. .not. nodeDGPresent) then + call ESMF_LogWrite(trim(subname)//": cannot print distgrid from mesh", & + ESMF_LOGMSG_WARNING, rc=rc) + return + endif + + ! if mesh is complete, also get additional parameters + if (meshStatus==ESMF_MESHSTATUS_COMPLETE) then + ! access localDeCount to show this is a real Grid + call ESMF_MeshGet(mesh, parametricDim=pdim, spatialDim=sdim, & + numOwnedNodes=nnodes, numOwnedElements=nelements, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": parametricDim=", pdim + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + write (msgString,*) trim(subname)//":"//trim(string)//": spatialDim=", sdim + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + write (msgString,*) trim(subname)//":"//trim(string)//": numOwnedNodes=", nnodes + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + write (msgString,*) trim(subname)//":"//trim(string)//": numOwnedElements=", nelements + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_Mesh_Print + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Grid_Print(grid, string, rc) + + 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 + + type(ESMF_Distgrid) :: distgrid + integer :: localDeCount + integer :: DeCount + integer :: dimCount, tileCount + integer :: staggerlocCount, arbdimCount, rank + type(ESMF_StaggerLoc) :: staggerloc + character(len=32) :: staggerstr + integer, allocatable :: minIndexPTile(:,:), maxIndexPTile(:,:) + real(R8), pointer :: fldptr1(:) + real(R8), pointer :: fldptr2(:,:) + integer :: n1,n2,n3 + character(len=*),parameter :: subname='(shr_nuopc_methods_Grid_Print)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + ! access localDeCount to show this is a real Grid + call ESMF_GridGet(grid, localDeCount=localDeCount, distgrid=distgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": localDeCount=", localDeCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! get dimCount and tileCount + call ESMF_DistGridGet(distgrid, dimCount=dimCount, tileCount=tileCount, deCount=deCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": dimCount=", dimCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": tileCount=", tileCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": deCount=", deCount + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! allocate minIndexPTile and maxIndexPTile accord. to dimCount and tileCount + allocate(minIndexPTile(dimCount, tileCount), & + maxIndexPTile(dimCount, tileCount)) + + ! get minIndex and maxIndex arrays + call ESMF_DistGridGet(distgrid, minIndexPTile=minIndexPTile, & + maxIndexPTile=maxIndexPTile, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": minIndexPTile=", minIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": maxIndexPTile=", maxIndexPTile + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + deallocate(minIndexPTile, maxIndexPTile) + + ! get staggerlocCount, arbDimCount +! call ESMF_GridGet(grid, staggerlocCount=staggerlocCount, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return + +! write (msgString,*) trim(subname)//":"//trim(string)//": staggerlocCount=", staggerlocCount +! call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return + +! call ESMF_GridGet(grid, arbDimCount=arbDimCount, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return + +! write (msgString,*) trim(subname)//":"//trim(string)//": arbDimCount=", arbDimCount +! call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) +! if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! get rank + call ESMF_GridGet(grid, rank=rank, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + write (msgString,*) trim(subname)//":"//trim(string)//": rank=", rank + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n1 = 1,2 + if (n1 == 1) then + staggerloc = ESMF_STAGGERLOC_CENTER + staggerstr = 'ESMF_STAGGERLOC_CENTER' + elseif (n1 == 2) then + staggerloc = ESMF_STAGGERLOC_CORNER + staggerstr = 'ESMF_STAGGERLOC_CORNER' + else + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//":staggerloc failure", ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + call ESMF_GridGetCoord(grid, staggerloc=staggerloc, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write (msgString,*) trim(subname)//":"//trim(staggerstr)//" present=",isPresent + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + do n3 = 0,localDECount-1 + do n2 = 1,dimCount + if (rank == 1) then + call ESMF_GridGetCoord(grid,coordDim=n2,localDE=n3,staggerloc=staggerloc,farrayPtr=fldptr1,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write (msgString,'(a,2i4,2f16.8)') trim(subname)//":"//trim(staggerstr)//" coord=",n2,n3,minval(fldptr1),maxval(fldptr1) + endif + if (rank == 2) then + call ESMF_GridGetCoord(grid,coordDim=n2,localDE=n3,staggerloc=staggerloc,farrayPtr=fldptr2,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + write (msgString,'(a,2i4,2f16.8)') trim(subname)//":"//trim(staggerstr)//" coord=",n2,n3,minval(fldptr2),maxval(fldptr2) + endif + call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + enddo + endif + enddo + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_Grid_Print + +!----------------------------------------------------------------------------- + subroutine shr_nuopc_methods_Clock_TimePrint(clock,string,rc) + + use ESMF , only : ESMF_Clock, ESMF_Time, ESMF_TimeInterval + use ESMF , only : ESMF_ClockGet, ESMF_TimeGet, ESMF_TimeIntervalGet + + ! input/output variables + type(ESMF_Clock) , intent(in) :: clock + character(len=*) , intent(in),optional :: string + integer , intent(out) :: rc + + ! local variables + type(ESMF_Time) :: time + type(ESMF_TimeInterval) :: timeStep + character(len=CS) :: timestr + character(len=CL) :: lstring + 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) + endif + + if (present(string)) then + lstring = trim(subname)//":"//trim(string) + else + lstring = trim(subname) + endif + + call ESMF_ClockGet(clock,currtime=time,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(time,timestring=timestr,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(lstring)//": currtime = "//trim(timestr), ESMF_LOGMSG_INFO) + + call ESMF_ClockGet(clock,starttime=time,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(time,timestring=timestr,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(lstring)//": startime = "//trim(timestr), ESMF_LOGMSG_INFO) + + call ESMF_ClockGet(clock,stoptime=time,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeGet(time,timestring=timestr,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_LogWrite(trim(lstring)//": stoptime = "//trim(timestr), ESMF_LOGMSG_INFO) + + call ESMF_ClockGet(clock,timestep=timestep,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeIntervalGet(timestep,timestring=timestr,rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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) + endif + + end subroutine shr_nuopc_methods_Clock_TimePrint + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Mesh_Write(mesh, string, rc) + + use ESMF, only : ESMF_Mesh, ESMF_MeshGet, ESMF_Array, ESMF_ArrayWrite, ESMF_DistGrid + + type(ESMF_Mesh) ,intent(in) :: mesh + character(len=*),intent(in) :: string + integer ,intent(out) :: rc + + ! local + integer :: n,l,i,lsize,ndims + character(len=CS) :: name + type(ESMF_DISTGRID) :: distgrid + type(ESMF_Array) :: array + real(R8), pointer :: rawdata(:) + real(R8), pointer :: coord(:) + 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) + endif + +#if (1 == 0) + !--- elements --- + + call ESMF_MeshGet(mesh, spatialDim=ndims, numownedElements=lsize, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(rawdata(ndims*lsize)) + allocate(coord(lsize)) + + call ESMF_MeshGet(mesh, elementDistgrid=distgrid, ownedElemCoords=rawdata, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1,ndims + name = "unknown" + if (n == 1) name = "lon_element" + if (n == 2) name = "lat_element" + do l = 1,lsize + i = 2*(l-1) + n + coord(l) = rawdata(i) + array = ESMF_ArrayCreate(distgrid, farrayPtr=coord, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + enddo + + deallocate(rawdata,coord) + + !--- nodes --- + + call ESMF_MeshGet(mesh, spatialDim=ndims, numownedNodes=lsize, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(rawdata(ndims*lsize)) + allocate(coord(lsize)) + + call ESMF_MeshGet(mesh, nodalDistgrid=distgrid, ownedNodeCoords=rawdata, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do n = 1,ndims + name = "unknown" + if (n == 1) name = "lon_nodes" + if (n == 2) name = "lat_nodes" + do l = 1,lsize + i = 2*(l-1) + n + coord(l) = rawdata(i) + array = ESMF_ArrayCreate(distgrid, farrayPtr=coord, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + enddo + + deallocate(rawdata,coord) +#else + 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) + endif + + end subroutine shr_nuopc_methods_Mesh_Write + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_GeomWrite(state, string, rc) + use ESMF, only : ESMF_State, ESMF_Field, ESMF_StateGet + type(ESMF_State), intent(in) :: state + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + type(ESMF_Field) :: lfield + integer :: fieldcount + character(len=*),parameter :: subname='(shr_nuopc_methods_State_GeomWrite)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (fieldCount > 0) then + call shr_nuopc_methods_State_getFieldN(state, 1, lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_Field_GeomWrite(lfield, string, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + 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) + endif + + end subroutine shr_nuopc_methods_State_GeomWrite + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_GeomWrite(FB, string, rc) + use ESMF, only : ESMF_Field, ESMF_FieldBundle, ESMF_FieldBundleGet + + type(ESMF_FieldBundle), intent(in) :: FB + character(len=*), intent(in) :: string + integer , intent(out) :: rc + + type(ESMF_Field) :: lfield + integer :: fieldcount + character(len=*),parameter :: subname='(shr_nuopc_methods_FB_GeomWrite)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call ESMF_FieldBundleGet(FB, fieldCount=fieldCount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (fieldCount > 0) then + call shr_nuopc_methods_FB_getFieldN(FB, 1, lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_Field_GeomWrite(lfield, string, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + else + 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) + endif + + 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 + character(len=*),parameter :: subname='(shr_nuopc_methods_Field_GeomWrite)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + rc = ESMF_SUCCESS + + call ESMF_FieldGet(field, status=status, rc=rc) + if (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 ") + rc = ESMF_FAILURE + return + endif + + call ESMF_FieldGet(field, geomtype=geomtype, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (geomtype == ESMF_GEOMTYPE_GRID) then + call ESMF_FieldGet(field, grid=lgrid, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_Grid_Write(lgrid, string, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + elseif (geomtype == ESMF_GEOMTYPE_MESH) then + call ESMF_FieldGet(field, mesh=lmesh, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_methods_Mesh_Write(lmesh, string, rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_Field_GeomWrite + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_Grid_Write(grid, string, rc) + + use ESMF , only : ESMF_Grid, ESMF_Array, ESMF_GridGetCoord, ESMF_ArraySet + use ESMF , only : ESMF_ArrayWrite, ESMF_GridGetItem, ESMF_GridGetCoord + use ESMF , only : ESMF_GRIDITEM_AREA, ESMF_GRIDITEM_MASK + use ESMF , only : ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER + + ! input/output variables + type(ESMF_Grid) ,intent(in) :: grid + character(len=*),intent(in) :: string + integer ,intent(out) :: rc + + ! local + type(ESMF_Array) :: array + character(len=CS) :: name + 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) + endif + + ! -- centers -- + + call ESMF_GridGetCoord(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + name = "lon_center" + call ESMF_GridGetCoord(grid, coordDim=1, staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArraySet(array, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + name = "lat_center" + call ESMF_GridGetCoord(grid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArraySet(array, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + + ! -- corners -- + + call ESMF_GridGetCoord(grid, staggerLoc=ESMF_STAGGERLOC_CORNER, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + name = "lon_corner" + call ESMF_GridGetCoord(grid, coordDim=1, staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) + if (.not. ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then + call ESMF_ArraySet(array, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + + name = "lat_corner" + call ESMF_GridGetCoord(grid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) + if (.not. ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) then + call ESMF_ArraySet(array, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + endif + + ! -- mask -- + + name = "mask" + call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_MASK, staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, itemflag=ESMF_GRIDITEM_MASK, array=array, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArraySet(array, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//"_"//trim(name), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + + ! -- area -- + + name = "area" + call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_AREA, staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (isPresent) then + call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, itemflag=ESMF_GRIDITEM_AREA, array=array, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArraySet(array, name=name, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_methods_Array_diagnose(array, string=trim(string)//trim(name), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ArrayWrite(array, trim(string)//"_"//trim(name)//".nc", overwrite=.true., rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + endif + + if (dbug_flag > 10) then + call ESMF_LogWrite(trim(subname)//": done", ESMF_LOGMSG_INFO) + endif + + end subroutine shr_nuopc_methods_Grid_Write + + !----------------------------------------------------------------------------- + + logical function shr_nuopc_methods_Distgrid_Match(distGrid1, distGrid2, rc) + use ESMF, only : ESMF_DistGrid, ESMF_DistGridGet + ! Arguments + type(ESMF_DistGrid), intent(in) :: distGrid1 + type(ESMF_DistGrid), intent(in) :: distGrid2 + integer, intent(out), optional :: rc + + ! Local Variables + integer :: dimCount1, dimCount2 + integer :: tileCount1, tileCount2 + integer, allocatable :: minIndexPTile1(:,:), minIndexPTile2(:,:) + integer, allocatable :: maxIndexPTile1(:,:), maxIndexPTile2(:,:) + integer, allocatable :: elementCountPTile1(:), elementCountPTile2(:) + character(len=*), parameter :: subname='(shr_nuopc_methods_Distgrid_Match)' + ! ---------------------------------------------- + + if (dbug_flag > 10) then + call ESMF_LogWrite(subname//": called", ESMF_LOGMSG_INFO) + endif + + if(present(rc)) rc = ESMF_SUCCESS + shr_nuopc_methods_Distgrid_Match = .true. + + call ESMF_DistGridGet(distGrid1, & + dimCount=dimCount1, tileCount=tileCount1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distGrid2, & + dimCount=dimCount2, tileCount=tileCount2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if ( dimCount1 /= dimCount2) then + shr_nuopc_methods_Distgrid_Match = .false. + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": Grid dimCount MISMATCH ", & + ESMF_LOGMSG_INFO) + endif + endif + + if ( tileCount1 /= tileCount2) then + shr_nuopc_methods_Distgrid_Match = .false. + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": Grid tileCount MISMATCH ", & + ESMF_LOGMSG_INFO) + endif + endif + + allocate(elementCountPTile1(tileCount1)) + allocate(elementCountPTile2(tileCount2)) + allocate(minIndexPTile1(dimCount1,tileCount1)) + allocate(minIndexPTile2(dimCount2,tileCount2)) + allocate(maxIndexPTile1(dimCount1,tileCount1)) + allocate(maxIndexPTile2(dimCount2,tileCount2)) + + call ESMF_DistGridGet(distGrid1, & + elementCountPTile=elementCountPTile1, & + minIndexPTile=minIndexPTile1, & + maxIndexPTile=maxIndexPTile1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_DistGridGet(distGrid2, & + elementCountPTile=elementCountPTile2, & + minIndexPTile=minIndexPTile2, & + maxIndexPTile=maxIndexPTile2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if ( ANY((elementCountPTile1 - elementCountPTile2) .NE. 0) ) then + shr_nuopc_methods_Distgrid_Match = .false. + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": Grid elementCountPTile MISMATCH ", & + ESMF_LOGMSG_INFO) + endif + endif + + if ( ANY((minIndexPTile1 - minIndexPTile2) .NE. 0) ) then + shr_nuopc_methods_Distgrid_Match = .false. + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": Grid minIndexPTile MISMATCH ", & + ESMF_LOGMSG_INFO) + endif + endif + + if ( ANY((maxIndexPTile1 - maxIndexPTile2) .NE. 0) ) then + shr_nuopc_methods_Distgrid_Match = .false. + if (dbug_flag > 1) then + call ESMF_LogWrite(trim(subname)//": Grid maxIndexPTile MISMATCH ", & + ESMF_LOGMSG_INFO) + endif + endif + + deallocate(elementCountPTile1) + deallocate(elementCountPTile2) + deallocate(minIndexPTile1) + deallocate(minIndexPTile2) + deallocate(maxIndexPTile1) + deallocate(maxIndexPTile2) + + ! TODO: Optionally Check Coordinates + + if (dbug_flag > 10) then + 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, 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 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 + + ! input/output variables + type(ESMF_State), intent(in) :: state + integer, intent(in) :: scalar_id + real(R8), intent(out) :: scalar_value + character(len=*), intent(in) :: flds_scalar_name + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask, ierr, len, icount + type(ESMF_VM) :: vm + type(ESMF_Field) :: field + real(R8), pointer :: farrayptr(:,:) + real(r8) :: tmp(1) + character(len=*), parameter :: subname='(shr_nuopc_methods_State_GetScalar)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + ! check item exist or not? + call ESMF_StateGet(State, itemSearch=trim(flds_scalar_name), itemCount=icount, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (icount > 0) then + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) + if (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 = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return + endif + tmp(:) = farrayptr(scalar_id,:) + endif + call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + scalar_value = tmp(1) + else + call ESMF_LogWrite(trim(subname)//": no ESMF_Field found named: "//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + end if + + end subroutine shr_nuopc_methods_State_GetScalar + +!================================================================================ + + 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 ESMF , only : ESMF_Field, ESMF_State, ESMF_StateGet, ESMF_FieldGet + use ESMF , only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet + + ! 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 + integer, intent(in) :: flds_scalar_num + integer, intent(inout) :: rc + + ! local variables + integer :: mytask + type(ESMF_Field) :: field + type(ESMF_VM) :: vm + real(R8), pointer :: farrayptr(:,:) + character(len=*), parameter :: subname='(shr_nuopc_methods_State_SetScalar)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) + if (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) + rc = ESMF_FAILURE + return + endif + farrayptr(scalar_id,1) = scalar_value + endif + + 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 + + ! local variables + integer :: i + type(ESMF_Field),pointer :: fieldList(:) + character(len=*), parameter :: subname='(shr_nuopc_methods_State_UpdateTimestamp)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call NUOPC_GetStateMemberLists(state, fieldList=fieldList, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + do i=1, size(fieldList) + call shr_nuopc_methods_Field_UpdateTimestamp(fieldList(i), time, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + enddo + + 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 + character(len=*), parameter :: subname='(shr_nuopc_methods_Field_UpdateTimestamp)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_TimeGet(time, yy=yy, mm=mm, dd=dd, h=h, m=m, s=s, ms=ms, us=us, & + ns=ns, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_AttributeSet(field, & + name="TimeStamp", valueList=(/yy,mm,dd,h,m,s,ms,us,ns/), & + convention="NUOPC", purpose="Instance", & + attnestflag=ESMF_ATTNEST_ON, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + end subroutine shr_nuopc_methods_Field_UpdateTimestamp + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_State_FldDebug(state, flds_scalar_name, prefix, ymd, tod, logunit, rc) + + use ESMF, only : ESMF_State, ESMF_StateGet, ESMF_Field, ESMF_FieldGet + + ! input/output variables + type(ESMF_State) :: state + character(len=*) , intent(in) :: flds_scalar_name + character(len=*) , intent(in) :: prefix + integer , intent(in) :: ymd + integer , intent(in) :: tod + integer , intent(in) :: logunit + integer , intent(out) :: rc + + ! local variables + 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(:) + character(len=ESMF_MAXSTR) , allocatable :: fieldNameList(:) + !----------------------------------------------------- + + ! Determine the list of fields and the dimension count for each field + call ESMF_StateGet(state, itemCount=fieldCount, rc=rc) + if (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 (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 (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfields(nfld), dimCount=dimCounts(nfld), rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + end do + + ! Determine local size of field + do nfld=1, fieldCount + if (dimCounts(nfld) == 1) then + call ESMF_FieldGet(lfields(nfld), farrayPtr=dataPtr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + lsize = size(dataPtr1d) + exit + end if + end do + + ! Write out debug output + do n = 1,lsize + do nfld=1, fieldCount + if (dimCounts(nfld) == 1) then + call ESMF_FieldGet(lfields(nfld), farrayPtr=dataPtr1d, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + 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) + end if + else if (dimCounts(nfld) == 2) then + call ESMF_FieldGet(lfields(nfld), ungriddedUBound=ungriddedUBound, gridtoFieldMap=gridToFieldMap, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_FieldGet(lfields(nfld), farrayPtr=dataPtr2d, rc=rc) + if (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)) //' = ' + 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) + deallocate(dimCounts) + + end subroutine shr_nuopc_methods_State_FldDebug + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_FB_getNumFlds(FB, string, nflds, rc) + + ! ---------------------------------------------- + ! Determine if fieldbundle is created and if so, the number of non-scalar + ! fields in the field bundle + ! ---------------------------------------------- + + use ESMF, only : ESMF_FieldBundle, ESMF_FieldBundleGet, ESMF_FieldBundleIsCreated + + ! input/output variables + type(ESMF_FieldBundle) , intent(in) :: FB + character(len=*) , intent(in) :: string + integer , intent(out) :: nflds + integer , intent(inout) :: rc + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (.not. ESMF_FieldBundleIsCreated(FB)) then + 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 + ! field bundles - so this is why we check if the fieldCount is 0 and not 1 here + + call ESMF_FieldBundleGet(FB, fieldCount=nflds, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + if (nflds == 0) then + call ESMF_LogWrite(trim(string)//": only has scalar data, returning", ESMF_LOGMSG_INFO) + end if + end if + + end subroutine shr_nuopc_methods_FB_getNumFlds + + !----------------------------------------------------------------------------- + + subroutine shr_nuopc_methods_States_GetSharedFlds(State1, State2, flds_scalar_name, fldnames_shared, rc) + + ! ---------------------------------------------- + ! Get shared Fld names between State1 and State2 and + ! allocate the return array fldnames_shared + ! ---------------------------------------------- + + use ESMF, only : ESMF_State, ESMF_StateGet, ESMF_MAXSTR + + ! input/output variables + type(ESMF_State) , intent(in) :: State1 + type(ESMF_State) , intent(in) :: State2 + character(len=*) , intent(in) :: flds_scalar_name + character(len=ESMF_MAXSTR) , pointer :: fldnames_shared(:) + integer , intent(inout) :: rc + + ! local variables + integer :: ncnt1, ncnt2 + integer :: n1, n2, nshr + character(len=ESMF_MAXSTR), allocatable :: fldnames1(:) + character(len=ESMF_MAXSTR), allocatable :: fldnames2(:) + character(len=*), parameter :: subname='(shr_nuopc_methods_States_GetSharedFlds)' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + if (associated(fldnames_shared)) then + call ESMF_LogWrite(trim(subname)//": ERROR fldnames_shared must not be associated ", ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + RETURN + end if + + call ESMF_StateGet(State1, itemCount=ncnt1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(fldnames1(ncnt1)) + call ESMF_StateGet(State1, itemNameList=fldnames1, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + call ESMF_StateGet(State2, itemCount=ncnt2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + allocate(fldnames2(ncnt2)) + call ESMF_StateGet(State2, itemNameList=fldnames2, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return + + nshr = 0 + do n1 = 1,ncnt1 + do n2 = 1,ncnt2 + if (trim(fldnames1(n1)) == trim(fldnames2(n2)) .and. trim(fldnames1(n1)) /= flds_scalar_name) then + nshr = nshr + 1 + end if + end do + end do + allocate(fldnames_shared(nshr)) + + nshr = 0 + do n1 = 1,ncnt1 + do n2 = 1,ncnt2 + if (trim(fldnames1(n1)) == trim(fldnames2(n2)) .and. trim(fldnames1(n1)) /= flds_scalar_name) then + nshr = nshr + 1 + fldnames_shared(nshr) = trim(fldnames1(n1)) + exit + end if + end do + end do + + end subroutine shr_nuopc_methods_States_GetSharedFlds + +end module shr_nuopc_methods_mod + diff --git a/cime/src/drivers/nuopc/mediator/shr_nuopc_time_mod.F90 b/cime/src/drivers/nuopc/mediator/shr_nuopc_time_mod.F90 new file mode 100644 index 000000000000..dd807ec0474c --- /dev/null +++ b/cime/src/drivers/nuopc/mediator/shr_nuopc_time_mod.F90 @@ -0,0 +1,1089 @@ +module shr_nuopc_time_mod + + use ESMF , only : ESMF_GridComp, ESMF_GridCompGet, ESMF_GridCompSet + use ESMF , only : ESMF_Clock, ESMF_ClockCreate, ESMF_ClockGet, ESMF_ClockSet + use ESMF , only : ESMF_ClockAdvance + use ESMF , only : ESMF_Alarm, ESMF_AlarmCreate, ESMF_AlarmGet + use ESMF , only : ESMF_Calendar, ESMF_CalKind_Flag, ESMF_CalendarCreate + use ESMF , only : ESMF_CALKIND_NOLEAP, ESMF_CALKIND_GREGORIAN + use ESMF , only : ESMF_Time, ESMF_TimeGet, ESMF_TimeSet + use ESMF , only : ESMF_TimeInterval, ESMF_TimeIntervalSet, ESMF_TimeIntervalGet + use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_FAILURE + use ESMF , only : ESMF_VM, ESMF_VMGet, ESMF_VMBroadcast + use ESMF , only : ESMF_LOGMSG_INFO, ESMF_FAILURE + use ESMF , only : operator(<), operator(/=), operator(+) + use ESMF , only : operator(-), operator(*) , operator(>=) + use ESMF , only : operator(<=), operator(>), operator(==) + use NUOPC , only : NUOPC_CompAttributeGet + use med_constants_mod , only : dbug_flag => med_constants_dbug_flag + use shr_nuopc_utils_mod , only : chkerr => shr_nuopc_utils_ChkErr + + implicit none + private ! default private + + public :: shr_nuopc_time_alarmInit ! initialize an alarm + public :: shr_nuopc_time_clockInit ! initialize driver clock + public :: shr_nuopc_time_set_component_stop_alarm + + private :: shr_nuopc_time_timeInit + private :: shr_nuopc_time_date2ymd + + ! Clock and alarm options + character(len=*), private, parameter :: & + optNONE = "none" , & + optNever = "never" , & + optNSteps = "nsteps" , & + optNStep = "nstep" , & + optNSeconds = "nseconds" , & + optNSecond = "nsecond" , & + optNMinutes = "nminutes" , & + optNMinute = "nminute" , & + optNHours = "nhours" , & + optNHour = "nhour" , & + optNDays = "ndays" , & + optNDay = "nday" , & + optNMonths = "nmonths" , & + optNMonth = "nmonth" , & + optNYears = "nyears" , & + optNYear = "nyear" , & + optMonthly = "monthly" , & + optYearly = "yearly" , & + optDate = "date" , & + optIfdays0 = "ifdays0" , & + optGLCCouplingPeriod = "glc_coupling_period" + + ! Module data + integer, parameter :: SecPerDay = 86400 ! Seconds per day + character(len=*), parameter :: u_FILE_u = & + __FILE__ + +!=============================================================================== +contains +!=============================================================================== + + subroutine shr_nuopc_time_clockInit(ensemble_driver, esmdriver, logunit, rc) + + use med_constants_mod , only : CL, CS + use shr_cal_mod , only : shr_cal_noleap, shr_cal_gregorian, shr_cal_calendarname + + ! input/output variables + type(ESMF_GridComp) :: ensemble_driver, esmdriver + integer, intent(in) :: logunit + integer, intent(out) :: rc + + ! local variables + type(ESMF_Clock) :: clock + type(ESMF_VM) :: vm + type(ESMF_Time) :: StartTime ! Start time + type(ESMF_Time) :: RefTime ! Reference time + type(ESMF_Time) :: CurrTime ! Current time + type(ESMF_Time) :: StopTime ! Stop time + type(ESMF_Time) :: StopTime1 ! Stop time + type(ESMF_Time) :: StopTime2 ! Stop time + type(ESMF_Time) :: Clocktime ! Loop time + type(ESMF_TimeInterval) :: TimeStep ! Clock time-step + type(ESMF_Calendar) :: calendar ! esmf calendar + type(ESMF_CalKind_Flag) :: caltype ! esmf calendar type + type(ESMF_Alarm) :: alarm_stop ! alarm + type(ESMF_Alarm) :: alarm_datestop ! alarm + integer :: ref_ymd ! Reference date (YYYYMMDD) + integer :: ref_tod ! Reference time of day (seconds) + integer :: start_ymd ! Start date (YYYYMMDD) + integer :: start_tod ! Start time of day (seconds) + integer :: curr_ymd ! Current ymd (YYYYMMDD) + integer :: curr_tod ! Current tod (seconds) + integer :: stop_n ! Number until stop + integer :: stop_ymd ! Stop date (YYYYMMDD) + integer :: stop_tod ! Stop time-of-day + character(CS) :: stop_option ! Stop option units + integer :: atm_cpl_dt ! Atmosphere coupling interval + integer :: lnd_cpl_dt ! Land coupling interval + integer :: ice_cpl_dt ! Sea-Ice coupling interval + integer :: ocn_cpl_dt ! Ocean coupling interval + integer :: glc_cpl_dt ! Glc coupling interval + integer :: rof_cpl_dt ! Runoff coupling interval + integer :: wav_cpl_dt ! Wav coupling interval + integer :: esp_cpl_dt ! Esp coupling interval + character(CS) :: glc_avg_period ! Glc avering coupling period + logical :: read_restart + character(len=CL) :: restart_file + character(len=CL) :: restart_pfile + character(len=CL) :: cvalue + integer :: dtime_drv ! time-step to use + integer :: yr, mon, day ! Year, month, day as integers + integer :: localPet ! local pet in esm domain + logical :: mastertask ! true if mastertask in esm domain + integer :: unitn ! unit number + integer :: ierr ! Return code + character(CL) :: tmpstr ! temporary + character(CS) :: calendar_name ! Calendar name + character(CS) :: inst_suffix + integer :: tmp(6) ! Array for Broadcast + logical :: isPresent + character(len=*), parameter :: subname = '(shr_nuopc_time_clockInit): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + if (dbug_flag > 5) then + call ESMF_LogWrite(trim(subname)//": called", ESMF_LOGMSG_INFO) + endif + + call ESMF_GridCompGet(esmdriver, vm=vm, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! We may want to get the ensemble_driver vm here instead so that + ! files are read on global task 0 only instead of each esm member task 0 + call ESMF_VMGet(vm, localPet=localPet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + mastertask = localPet == 0 + !--------------------------------------------------------------------------- + ! Create the driver calendar + !--------------------------------------------------------------------------- + + call NUOPC_CompAttributeGet(esmdriver, name="calendar", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + calendar_name = shr_cal_calendarName(cvalue) + + if ( trim(calendar_name) == trim(shr_cal_noleap)) then + caltype = ESMF_CALKIND_NOLEAP + else if ( trim(calendar_name) == trim(shr_cal_gregorian)) then + caltype = ESMF_CALKIND_GREGORIAN + else + call ESMF_LogWrite(trim(subname)//': unrecognized ESMF calendar specified: '//& + trim(calendar_name), ESMF_LOGMSG_INFO, rc=rc) + rc = ESMF_FAILURE + return + end if + + call ESMF_LogWrite(trim(subname)//': driver calendar is : '// trim(calendar_name), & + ESMF_LOGMSG_INFO, rc=rc) + + calendar = ESMF_CalendarCreate( name='CMEPS_'//trim(calendar_name), & + calkindflag=caltype, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------------------------------------------- + ! Determine clock start time, reference time and current time + !--------------------------------------------------------------------------- + + curr_ymd = 0 + curr_tod = 0 + + call NUOPC_CompAttributeGet(esmdriver, name="start_ymd", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) start_ymd + call NUOPC_CompAttributeGet(esmdriver, name="start_tod", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) start_tod + + call NUOPC_CompAttributeGet(esmdriver, name="ref_ymd", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ref_ymd + call NUOPC_CompAttributeGet(esmdriver, name="ref_tod", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ref_tod + + call NUOPC_CompAttributeGet(esmdriver, name='read_restart', value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) read_restart + + if (read_restart) then + + call NUOPC_CompAttributeGet(esmdriver, name='restart_file', value=restart_file, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !--- read rpointer if restart_file is set to str_undefined --- + if (trim(restart_file) == 'str_undefined') then + + ! Error check on restart_pfile + call NUOPC_CompAttributeGet(esmdriver, name="restart_pfile", value=restart_pfile, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(esmdriver, name="inst_suffix", isPresent=isPresent, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if(isPresent) then + call NUOPC_CompAttributeGet(esmdriver, name="inst_suffix", value=inst_suffix, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + else + inst_suffix = "" + endif + if ( len_trim(restart_pfile) == 0 ) then + call ESMF_LogWrite(trim(subname)//' ERROR restart_pfile must be defined', & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) + rc = ESMF_FAILURE + return + end if + restart_pfile = trim(restart_pfile)//inst_suffix + if (mastertask) then + call ESMF_LogWrite(trim(subname)//" read rpointer file = "//trim(restart_pfile), & + ESMF_LOGMSG_INFO) + open(newunit=unitn, file=restart_pfile, form='FORMATTED', status='old',iostat=ierr) + if (ierr < 0) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file open returns error', & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) + return + end if + read(unitn,'(a)', iostat=ierr) restart_file + if (ierr < 0) then + rc = ESMF_FAILURE + call ESMF_LogWrite(trim(subname)//' ERROR rpointer file read returns error', & + ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__) + return + end if + close(unitn) + call ESMF_LogWrite(trim(subname)//" read driver restart from file = "//trim(restart_file), & + ESMF_LOGMSG_INFO) + endif + endif + if (mastertask) then + call shr_nuopc_time_read_restart_calendar_settings(restart_file, & + start_ymd, start_tod, ref_ymd, ref_tod, curr_ymd, curr_tod, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + tmp(1) = start_ymd + tmp(2) = start_tod + tmp(3) = ref_ymd + tmp(4) = ref_tod + tmp(5) = curr_ymd + tmp(6) = curr_tod + call ESMF_VMBroadcast(vm, tmp, 6, 0, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + start_ymd = tmp(1) + start_tod = tmp(2) + ref_ymd = tmp(3) + ref_tod = tmp(4) + curr_ymd = tmp(5) + curr_tod = tmp(6) + end if + + 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 + + ! Determine start time + call shr_nuopc_time_date2ymd(start_ymd, yr, mon, day) + call ESMF_TimeSet( StartTime, yy=yr, mm=mon, dd=day, s=start_tod, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if(mastertask .or. dbug_flag > 2) then + write(tmpstr,'(i10)') start_ymd + call ESMF_LogWrite(trim(subname)//': driver start_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO) + write(logunit,*) trim(subname)//': driver start_ymd: '// trim(tmpstr) + write(tmpstr,'(i10)') start_tod + call ESMF_LogWrite(trim(subname)//': driver start_tod: '// trim(tmpstr), ESMF_LOGMSG_INFO) + write(logunit,*) trim(subname)//': driver start_tod: '// trim(tmpstr) + endif + + ! Determine reference time + call shr_nuopc_time_date2ymd(ref_ymd, yr, mon, day) + call ESMF_TimeSet( RefTime, yy=yr, mm=mon, dd=day, s=ref_tod, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if(mastertask .or. dbug_flag > 2) then + write(tmpstr,'(i10)') ref_ymd + call ESMF_LogWrite(trim(subname)//': driver ref_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO) + write(logunit,*) trim(subname)//': driver ref_ymd: '// trim(tmpstr) + write(tmpstr,'(i10)') ref_tod + call ESMF_LogWrite(trim(subname)//': driver ref_tod: '// trim(tmpstr), ESMF_LOGMSG_INFO) + write(logunit,*) trim(subname)//': driver ref_tod: '// trim(tmpstr) + endif + ! Determine current time + call shr_nuopc_time_date2ymd(curr_ymd, yr, mon, day) + call ESMF_TimeSet( CurrTime, yy=yr, mm=mon, dd=day, s=curr_tod, calendar=calendar, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if(mastertask .or. dbug_flag > 2) then + write(tmpstr,'(i10)') curr_ymd + call ESMF_LogWrite(trim(subname)//': driver curr_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO) + write(logunit,*) trim(subname)//': driver curr_ymd: '// trim(tmpstr) + write(tmpstr,'(i10)') curr_tod + call ESMF_LogWrite(trim(subname)//': driver curr_tod: '// trim(tmpstr), ESMF_LOGMSG_INFO) + write(logunit,*) trim(subname)//': driver curr_tod: '// trim(tmpstr) + endif + !--------------------------------------------------------------------------- + ! Determine driver clock timestep + !--------------------------------------------------------------------------- + + call NUOPC_CompAttributeGet(esmdriver, name="atm_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) atm_cpl_dt + + call NUOPC_CompAttributeGet(esmdriver, name="lnd_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) lnd_cpl_dt + + call NUOPC_CompAttributeGet(esmdriver, name="ice_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ice_cpl_dt + + call NUOPC_CompAttributeGet(esmdriver, name="ocn_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) ocn_cpl_dt + + call NUOPC_CompAttributeGet(esmdriver, name="glc_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) glc_cpl_dt + + call NUOPC_CompAttributeGet(esmdriver, name="rof_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) rof_cpl_dt + + call NUOPC_CompAttributeGet(esmdriver, name="wav_cpl_dt", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) wav_cpl_dt + + call NUOPC_CompAttributeGet(esmdriver, name="glc_avg_period", value=glc_avg_period, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) glc_avg_period + + ! TODO: for now - this is not in the namelist_definition_drv.xml file + ! call NUOPC_CompAttributeGet(esmdriver, name="esp_cpl_dt", value=cvalue, rc=rc) + ! if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! read(cvalue,*) esp_cpl_dt + esp_cpl_dt = 9999 + + dtime_drv = 9999 + dtime_drv = min(dtime_drv, atm_cpl_dt) + dtime_drv = min(dtime_drv, lnd_cpl_dt) + dtime_drv = min(dtime_drv, ocn_cpl_dt) + dtime_drv = min(dtime_drv, ice_cpl_dt) + dtime_drv = min(dtime_drv, glc_cpl_dt) + dtime_drv = min(dtime_drv, rof_cpl_dt) + dtime_drv = min(dtime_drv, wav_cpl_dt) + dtime_drv = min(dtime_drv, esp_cpl_dt) + if(mastertask .or. dbug_flag > 2) then + write(tmpstr,'(i10)') dtime_drv + call ESMF_LogWrite(trim(subname)//': driver time interval is : '// trim(tmpstr), ESMF_LOGMSG_INFO, rc=rc) + write(logunit,*) trim(subname)//': driver time interval is : '// trim(tmpstr) + endif + call ESMF_TimeIntervalSet( TimeStep, s=dtime_drv, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !--------------------------------------------------------------------------- + ! Create the driver clock with an artificial stop time + !--------------------------------------------------------------------------- + + ! Create the clock + clock = ESMF_ClockCreate(TimeStep, StartTime, refTime=RefTime, name='ESMF Driver Clock', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Advance the clock to the current time (in case of a restart) + call ESMF_ClockGet(clock, currTime=clocktime, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + do while( clocktime < CurrTime) + call ESMF_ClockAdvance( clock, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_ClockGet( clock, currTime=clocktime, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end do + + ! Set the driver gridded component clock to the created clock + call ESMF_GridCompSet(esmdriver, clock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + !------------------------------- + ! Set driver clock stop time + !------------------------------- + + call NUOPC_CompAttributeGet(esmdriver, name="stop_option", value=stop_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call NUOPC_CompAttributeGet(esmdriver, name="stop_n", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) stop_n + call NUOPC_CompAttributeGet(esmdriver, name="stop_ymd", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) stop_ymd + call NUOPC_CompAttributeGet(esmdriver, name="stop_tod", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) stop_tod + if ( stop_ymd < 0) then + stop_ymd = 99990101 + stop_tod = 0 + endif + if(mastertask .or. dbug_flag > 2) then + write(tmpstr,'(i10)') stop_ymd + call ESMF_LogWrite(trim(subname)//': driver stop_ymd: '// trim(tmpstr), ESMF_LOGMSG_INFO) + write(logunit,*) trim(subname)//': driver stop_ymd: '// trim(tmpstr) + write(tmpstr,'(i10)') stop_tod + call ESMF_LogWrite(trim(subname)//': driver stop_tod: '// trim(tmpstr), ESMF_LOGMSG_INFO) + write(logunit,*) trim(subname)//': driver stop_tod: '// trim(tmpstr) + endif + call shr_nuopc_time_alarmInit(clock, & + alarm = alarm_stop, & + option = stop_option, & + opt_n = stop_n, & + opt_ymd = stop_ymd, & + opt_tod = stop_tod, & + RefTime = CurrTime, & + alarmname = 'alarm_stop', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call shr_nuopc_time_alarmInit(clock, & + alarm = alarm_datestop, & + option = optDate, & + opt_ymd = stop_ymd, & + opt_tod = stop_tod, & + RefTime = StartTime, & + alarmname = 'alarm_datestop', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_AlarmGet(alarm_stop, RingTime=StopTime1, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_AlarmGet(alarm_datestop, RingTime=StopTime2, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + if (StopTime2 < StopTime1) then + StopTime = StopTime2 + else + StopTime = StopTime1 + endif + + call ESMF_ClockSet(clock, StopTime=StopTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + ! Create the ensemble driver clock + TimeStep = StopTime-ClockTime + clock = ESMF_ClockCreate(TimeStep, ClockTime, StopTime=StopTime, & + refTime=RefTime, name='ESMF ensemble Driver Clock', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_GridCompSet(ensemble_driver, clock=clock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + + + end subroutine shr_nuopc_time_clockInit + + subroutine shr_nuopc_time_set_component_stop_alarm(gcomp, rc) + use ESMF, only : ESMF_GridComp, ESMF_Alarm, ESMF_Clock, ESMF_ClockGet + use ESMF, only : ESMF_AlarmSet + use NUOPC, only : NUOPC_CompAttributeGet + use NUOPC_Model, only : NUOPC_ModelGet + type(ESMF_gridcomp) :: gcomp + + character(len=256) :: stop_option ! Stop option units + integer :: stop_n ! Number until stop interval + integer :: stop_ymd ! Stop date (YYYYMMDD) + type(ESMF_ALARM) :: stop_alarm + character(len=256) :: cvalue + type(ESMF_Clock) :: mclock + type(ESMF_Time) :: mCurrTime + integer :: rc + !---------------- + ! Stop alarm + !---------------- + call NUOPC_CompAttributeGet(gcomp, name="stop_option", value=stop_option, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_ModelGet(gcomp, modelClock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_ClockGet(mclock, CurrTime=mCurrTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call NUOPC_CompAttributeGet(gcomp, name="stop_n", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) stop_n + + call NUOPC_CompAttributeGet(gcomp, name="stop_ymd", value=cvalue, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + read(cvalue,*) stop_ymd + call shr_nuopc_time_alarmInit(mclock, stop_alarm, stop_option, & + opt_n = stop_n, & + opt_ymd = stop_ymd, & + RefTime = mcurrTime, & + alarmname = 'alarm_stop', rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_AlarmSet(stop_alarm, clock=mclock, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end subroutine shr_nuopc_time_set_component_stop_alarm + +!=============================================================================== + + subroutine shr_nuopc_time_alarmInit( clock, alarm, option, & + opt_n, opt_ymd, opt_tod, RefTime, alarmname, rc) + + ! !DESCRIPTION: Setup an alarm in a clock + ! 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. + + ! input/output variables + type(ESMF_Clock) , intent(inout) :: clock ! clock + type(ESMF_Alarm) , intent(inout) :: alarm ! alarm + character(len=*) , intent(in) :: option ! alarm option + integer , optional , intent(in) :: opt_n ! alarm freq + integer , optional , intent(in) :: opt_ymd ! alarm ymd + integer , 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 variables + type(ESMF_Calendar) :: cal ! calendar + integer :: lymd ! local ymd + integer :: ltod ! local tod + integer :: cyy,cmm,cdd,csec ! 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 + integer :: sec + character(len=*), parameter :: subname = '(shr_nuopc_time_alarmInit): ' + !------------------------------------------------------------------------------- + + rc = ESMF_SUCCESS + + lalarmname = 'alarm_unknown' + if (present(alarmname)) lalarmname = trim(alarmname) + ltod = 0 + if (present(opt_tod)) ltod = opt_tod + lymd = -1 + if (present(opt_ymd)) lymd = opt_ymd + + call ESMF_ClockGet(clock, CurrTime=CurrTime, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(CurrTime, yy=cyy, mm=cmm, dd=cdd, s=csec, rc=rc ) + if (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 + + ! Determine calendar + call ESMF_ClockGet(clock, calendar=cal) + + ! Determine inputs for call to create alarm + selectcase (trim(option)) + + case (optNONE) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optNever) + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=9999, mm=12, dd=1, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optDate) + if (.not. present(opt_ymd)) then + call ESMF_LogWrite(trim(subname)//trim(option)//' requires opt_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (lymd < 0 .or. ltod < 0) then + call ESMF_LogWrite(subname//trim(option)//'opt_ymd, opt_tod invalid', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=9999, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call shr_nuopc_time_timeInit(NextAlarm, lymd, cal, tod=ltod, desc="optDate") + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .false. + + case (optIfdays0) + if (.not. present(opt_ymd)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=opt_n, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case (optNSteps) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNStep) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_ClockGet(clock, TimeStep=AlarmInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSeconds) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNSecond) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinutes) + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMinute) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=60, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHours) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNHour) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, s=3600, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDays) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNDay) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, d=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonths) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNMonth) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optMonthly) + call ESMF_TimeIntervalSet(AlarmInterval, mm=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=cmm, dd=1, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case (optNYears) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optNYear) + if (.not.present(opt_n)) then + call ESMF_LogWrite(subname//trim(option)//' requires opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + if (opt_n <= 0) then + call ESMF_LogWrite(subname//trim(option)//' invalid opt_n', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + AlarmInterval = AlarmInterval * opt_n + update_nextalarm = .true. + + case (optYearly) + call ESMF_TimeIntervalSet(AlarmInterval, yy=1, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call ESMF_TimeSet( NextAlarm, yy=cyy, mm=1, dd=1, s=0, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + update_nextalarm = .true. + + case default + call ESMF_LogWrite(subname//'unknown option '//trim(option), ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + + 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 + + alarm = ESMF_AlarmCreate( name=lalarmname, clock=clock, ringTime=NextAlarm, & + ringInterval=AlarmInterval, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine shr_nuopc_time_alarmInit + + !=============================================================================== + + subroutine shr_nuopc_time_timeInit( Time, ymd, cal, tod, desc, logunit ) + + ! 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) :: Time ! ESMF time + integer , intent(in) :: ymd ! year, month, day YYYYMMDD + type(ESMF_Calendar) , intent(in) :: cal ! ESMF calendar + integer , intent(in), optional :: tod ! time of day in seconds + character(len=*) , intent(in), optional :: desc ! description of time to set + integer , intent(in), optional :: logunit + + ! local variables + integer :: yr, mon, day ! Year, month, day as integers + integer :: ltod ! local tod + character(len=256) :: ldesc ! local desc + integer :: rc ! return code + character(len=*), parameter :: subname = '(shr_nuopc_time_m_ETimeInit) ' + !------------------------------------------------------------------------------- + + ltod = 0 + if (present(tod)) ltod = tod + ldesc = '' + if (present(desc)) ldesc = desc + + if ( (ymd < 0) .or. (ltod < 0) .or. (ltod > SecPerDay) )then + if (present(logunit)) then + write(logunit,*) subname//': ERROR yymmdd is a negative number or '// & + 'time-of-day out of bounds', ymd, ltod + end if + call ESMF_LogWrite( subname//'ERROR: Bad input' , ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + + call shr_nuopc_time_date2ymd (ymd,yr,mon,day) + + call ESMF_TimeSet( Time, yy=yr, mm=mon, dd=day, s=ltod, calendar=cal, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + end subroutine shr_nuopc_time_timeInit + + !=============================================================================== + + subroutine shr_nuopc_time_date2ymd (date, year, month, day) + + ! input/output variables + integer, intent(in) :: date ! coded-date (yyyymmdd) + integer, intent(out) :: year,month,day ! calendar year,month,day + + ! local variables + integer :: tdate ! temporary date + character(*),parameter :: subName = "(shr_nuopc_time_date2ymd)" + !------------------------------------------------------------------------------- + + tdate = abs(date) + year = int(tdate/10000) + if (date < 0) then + year = -year + end if + month = int( mod(tdate,10000)/ 100) + day = mod(tdate, 100) + + end subroutine shr_nuopc_time_date2ymd + + !=============================================================================== + + subroutine shr_nuopc_time_read_restart_calendar_settings(restart_file, & + start_ymd, start_tod, ref_ymd, ref_tod, curr_ymd, curr_tod, rc) + + use netcdf , only : nf90_open, nf90_nowrite, nf90_noerr + use netcdf , only : nf90_inq_varid, nf90_get_var, nf90_close + use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_INFO + use med_constants_mod , only : CL + + ! input/output variables + character(len=*), intent(in) :: restart_file + integer, intent(out) :: ref_ymd ! Reference date (YYYYMMDD) + integer, intent(out) :: ref_tod ! Reference time of day (seconds) + integer, intent(out) :: start_ymd ! Start date (YYYYMMDD) + integer, intent(out) :: start_tod ! Start time of day (seconds) + integer, intent(out) :: curr_ymd ! Current ymd (YYYYMMDD) + integer, intent(out) :: curr_tod ! Current tod (seconds) + integer, intent(out) :: rc + + ! local variables + integer :: status, ncid, varid ! netcdf stuff + character(CL) :: tmpstr ! temporary + character(len=*), parameter :: subname = "(shr_nuopc_time_read_restart_calendar_settings)" + !---------------------------------------------------------------- + + ! use netcdf here since it's serial + status = nf90_open(restart_file, NF90_NOWRITE, ncid) + if (status /= nf90_NoErr) then + print *,__FILE__,__LINE__,trim(restart_file) + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_open', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + endif + status = nf90_inq_varid(ncid, 'start_ymd', varid) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid start_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_get_var(ncid, varid, start_ymd) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var start_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_inq_varid(ncid, 'start_tod', varid) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid start_tod', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_get_var(ncid, varid, start_tod) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var start_tod', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_inq_varid(ncid, 'ref_ymd', varid) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid ref_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_get_var(ncid, varid, ref_ymd) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var ref_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_inq_varid(ncid, 'ref_tod', varid) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid ref_tod', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_get_var(ncid, varid, ref_tod) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var ref_tod', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_inq_varid(ncid, 'curr_ymd', varid) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid curr_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_get_var(ncid, varid, curr_ymd) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var curr_ymd', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_inq_varid(ncid, 'curr_tod', varid) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_inq_varid curr_tod', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_get_var(ncid, varid, curr_tod) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_get_var curr_tod', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + status = nf90_close(ncid) + if (status /= nf90_NoErr) then + call ESMF_LogWrite(trim(subname)//' ERROR: nf90_close', ESMF_LOGMSG_INFO) + rc = ESMF_FAILURE + return + end if + + write(tmpstr,*) trim(subname)//" read start_ymd = ",start_ymd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read start_tod = ",start_tod + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read ref_ymd = ",ref_ymd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read ref_tod = ",ref_tod + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read curr_ymd = ",curr_ymd + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + write(tmpstr,*) trim(subname)//" read curr_tod = ",curr_tod + call ESMF_LogWrite(trim(tmpstr), ESMF_LOGMSG_INFO) + + end subroutine shr_nuopc_time_read_restart_calendar_settings + +end module shr_nuopc_time_mod diff --git a/cime/src/drivers/nuopc/mediator/shr_nuopc_utils_mod.F90 b/cime/src/drivers/nuopc/mediator/shr_nuopc_utils_mod.F90 new file mode 100644 index 000000000000..866df7bf836a --- /dev/null +++ b/cime/src/drivers/nuopc/mediator/shr_nuopc_utils_mod.F90 @@ -0,0 +1,87 @@ +module shr_nuopc_utils_mod + + implicit none + private + + public :: shr_nuopc_memcheck + public :: shr_nuopc_utils_ChkErr + public :: shr_nuopc_log_clock_advance + + 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 + logical, intent(in) :: mastertask + integer :: ierr + integer, external :: GPTLprint_memusage + if((mastertask .and. memdebug_level > level) .or. memdebug_level > level+1) then + ierr = GPTLprint_memusage(string) + endif + end subroutine shr_nuopc_memcheck + +!=============================================================================== + + 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 + + character(len=*), intent(in) :: file + logical, optional, intent(in) :: mpierr + + character(MPI_MAX_ERROR_STRING) :: lstring + integer :: dbrc, lrc, len, ierr + + shr_nuopc_utils_ChkErr = .false. + lrc = rc + if (present(mpierr) .and. mpierr) then + if (rc == MPI_SUCCESS) return + call MPI_ERROR_STRING(rc, lstring, len, ierr) + call ESMF_LogWrite("ERROR: "//trim(lstring), ESMF_LOGMSG_INFO, line=line, file=file, rc=dbrc) + lrc = ESMF_FAILURE + endif + + if (ESMF_LogFoundError(rcToCheck=lrc, msg=ESMF_LOGERR_PASSTHRU, line=line, file=file)) then + shr_nuopc_utils_ChkErr = .true. + endif + + 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 + + type(ESMF_Clock) :: clock + character(len=*), intent(in) :: component + integer, intent(in) :: logunit + + character(len=CL) :: cvalue, prestring + integer :: rc + + write(prestring, *) "------>Advancing ",trim(component)," from: " + call ESMF_ClockPrint(clock, options="currTime", unit=cvalue, & + preString=trim(prestring), rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) + + call ESMF_ClockPrint(clock, options="stopTime", unit=cvalue, & + preString="--------------------------------> to: ", rc=rc) + if (shr_nuopc_utils_ChkErr(rc,__LINE__,u_FILE_u)) return + write(logunit, *) trim(cvalue) + + end subroutine shr_nuopc_log_clock_advance + +end module shr_nuopc_utils_mod diff --git a/cime/src/share/nuopc/glc_elevclass_mod.F90 b/cime/src/share/nuopc/glc_elevclass_mod.F90 new file mode 100644 index 000000000000..7e996dd684bd --- /dev/null +++ b/cime/src/share/nuopc/glc_elevclass_mod.F90 @@ -0,0 +1,431 @@ +module glc_elevclass_mod + + !--------------------------------------------------------------------- + ! + ! Purpose: + ! + ! This module contains data and routines for operating on GLC elevation classes. + !--------------------------------------------------------------------- + +#include "shr_assert.h" + use shr_kind_mod , only : r8=>shr_kind_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/cime/src/share/nuopc/seq_drydep_mod.F90 b/cime/src/share/nuopc/seq_drydep_mod.F90 new file mode 100644 index 000000000000..93bd212a2a66 --- /dev/null +++ b/cime/src/share/nuopc/seq_drydep_mod.F90 @@ -0,0 +1,903 @@ +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 + 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, 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 + + 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 + + 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, drydep_nflds) + + !======================================================================== + ! 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 + + character(len=*), intent(in) :: NLFilename ! Namelist filename + 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 + type(ESMF_VM) :: vm + 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 + ! 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) + + 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 + drydep_nflds=drydep_nflds+1 + endif + enddo + + end if + end if + + tmp = drydep_nflds + call ESMF_VMBroadcast(vm, tmp, 1, 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 + + !--- Make sure method is valid and determine if land is passing drydep fields --- + 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 ( 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 ', 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 + + 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/cime/src/share/nuopc/shr_carma_mod.F90 b/cime/src/share/nuopc/shr_carma_mod.F90 new file mode 100644 index 000000000000..c00f35beedb1 --- /dev/null +++ b/cime/src/share/nuopc/shr_carma_mod.F90 @@ -0,0 +1,82 @@ +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 + 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 + private + + public :: shr_carma_readnl ! reads carma_inparm namelist + +!------------------------------------------------------------------------- +contains +!------------------------------------------------------------------------- + + 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 + + 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/cime/src/share/nuopc/shr_expr_parser_mod.F90 b/cime/src/share/nuopc/shr_expr_parser_mod.F90 new file mode 100644 index 000000000000..f37a4ac3c0be --- /dev/null +++ b/cime/src/share/nuopc/shr_expr_parser_mod.F90 @@ -0,0 +1,185 @@ +!============================================================================= +! expression parser utility -- +! for parsing simple linear mathematical expressions of the form +! X = a*Y + b*Z + ... +! +!============================================================================= +module shr_expr_parser_mod + use shr_kind_mod,only : r8 => shr_kind_r8 + use shr_kind_mod,only : cx => shr_kind_cx + + implicit none + private + + public :: shr_exp_parse ! parses simple strings which contain expressions + public :: shr_exp_item_t ! user defined type which contains an expression component + public :: shr_exp_list_destroy ! destroy the linked list returned by shr_exp_parse + + ! contains componets of expression + type shr_exp_item_t + character(len=64) :: name + character(len=64),pointer :: vars(:) => null() + real(r8) ,pointer :: coeffs(:) => null() + integer :: n_terms = 0 + type(shr_exp_item_t), pointer :: next_item => null() + end type shr_exp_item_t + +contains + + ! ----------------------------------------------------------------- + ! parses expressions provided in array of strings + ! ----------------------------------------------------------------- + function shr_exp_parse( exp_array, nitems ) result(exp_items_list) + + character(len=*), intent(in) :: exp_array(:) ! contains a expressions + integer, optional, intent(out) :: nitems ! number of expressions parsed + type(shr_exp_item_t), pointer :: exp_items_list ! linked list of items returned + + integer :: i,j, jj, nmax, nterms, n_exp_items + character(len=cx) :: tmp_str + type(shr_exp_item_t), pointer :: exp_item, list_item + + nullify( exp_items_list ) + nullify( exp_item ) + nullify( list_item ) + + n_exp_items = 0 + nmax = size( exp_array ) + + do i = 1,nmax + if (len_trim(exp_array(i))>0) then + + j = scan( exp_array(i), '=' ) + + if ( j>0 ) then + + n_exp_items = n_exp_items + 1 + + allocate( exp_item ) + exp_item%n_terms = 0 + exp_item%name = trim(adjustl(exp_array(i)(:j-1))) + + tmp_str = trim(adjustl(exp_array(i)(j+1:))) + + nterms = 1 + jj = scan( tmp_str, '+' ) + do while(jj>0) + nterms = nterms + 1 + tmp_str = tmp_str(jj+1:) + jj = scan( tmp_str, '+' ) + enddo + + allocate( exp_item%vars(nterms) ) + allocate( exp_item%coeffs(nterms) ) + + tmp_str = trim(adjustl(exp_array(i)(j+1:))) + + j = scan( tmp_str, '+' ) + + if (j>0) then + call set_coefvar( tmp_str(:j-1), exp_item ) + tmp_str = tmp_str(j-1:) + else + call set_coefvar( tmp_str, exp_item ) + endif + + else + + tmp_str = trim(adjustl(exp_array(i))) ! assumed to begin with '+' + + endif + + ! at this point tmp_str begins with '+' + j = scan( tmp_str, '+' ) + + if (j>0) then + + ! remove the leading + ... + tmp_str = tmp_str(j+1:) + j = scan( tmp_str, '+' ) + + do while(j>0) + + call set_coefvar( tmp_str(:j-1), exp_item ) + + tmp_str = tmp_str(j+1:) + j = scan( tmp_str, '+' ) + + enddo + + call set_coefvar( tmp_str, exp_item ) + + endif + + + if (associated(exp_item)) then + if (associated(exp_items_list)) then + list_item => exp_items_list + do while(associated(list_item%next_item)) + list_item => list_item%next_item + enddo + list_item%next_item => exp_item + else + exp_items_list => exp_item + endif + endif + + endif + enddo + + if ( present(nitems) ) then + nitems = n_exp_items + endif + + end function shr_exp_parse + + ! ----------------------------------------------------------------- + ! deallocates memory occupied by linked list + ! ----------------------------------------------------------------- + subroutine shr_exp_list_destroy( list ) + type(shr_exp_item_t), pointer, intent(inout) :: list + + type(shr_exp_item_t), pointer :: item, next + + item => list + do while(associated(item)) + next => item%next_item + if (associated(item%vars)) then + deallocate(item%vars) + nullify(item%vars) + deallocate(item%coeffs) + nullify(item%coeffs) + endif + deallocate(item) + nullify(item) + item => next + enddo + + end subroutine shr_exp_list_destroy + + !========================== + ! Private Methods + + ! ----------------------------------------------------------------- + ! ----------------------------------------------------------------- + subroutine set_coefvar( term, item ) + character(len=*), intent(in) :: term + type(shr_exp_item_t) , intent(inout) :: item + + integer :: k, n + + item%n_terms = item%n_terms + 1 + n = item%n_terms + + k = scan( term, '*' ) + if (k>0) then + item%vars(n) = trim(adjustl(term(k+1:))) + read( term(:k-1), *) item%coeffs(n) + else + item%vars(n) = trim(adjustl(term)) + item%coeffs(n) = 1.0_r8 + endif + + end subroutine set_coefvar + +end module shr_expr_parser_mod diff --git a/cime/src/share/nuopc/shr_fire_emis_mod.F90 b/cime/src/share/nuopc/shr_fire_emis_mod.F90 new file mode 100644 index 000000000000..a86a0d393cd3 --- /dev/null +++ b/cime/src/share/nuopc/shr_fire_emis_mod.F90 @@ -0,0 +1,300 @@ +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 + 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=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 +!------------------------------------------------------------------------- + + 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 + integer, intent(out) :: emis_nflds + + ! 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 + + 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 ) + + end subroutine shr_fire_emis_readnl + +!------------------------------------------------------------------------- +! 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(:) + + ! local variables + integer :: n_entries + integer :: i, j, k + type(shr_exp_item_t), pointer :: items_list, item + !------------------------------------------------------ + + 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 + + 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 + + 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 + + end subroutine shr_fire_emis_init + + !------------------------------------------------------------------------- + + 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/cime/src/share/nuopc/shr_megan_mod.F90 b/cime/src/share/nuopc/shr_megan_mod.F90 new file mode 100644 index 000000000000..545d6cc74337 --- /dev/null +++ b/cime/src/share/nuopc/shr_megan_mod.F90 @@ -0,0 +1,324 @@ +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 + use shr_log_mod, only : loglev => shr_log_Level + use shr_log_mod, only : logunit => shr_log_Unit + + implicit none + 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=CL), public :: shr_megan_factors_file = '' + + ! 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 +!-------------------------------------------------------- + + 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 + integer, intent(out) :: megan_nflds + + ! 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) + 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_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' ) + 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) then + ! 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 + 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 ) + + end subroutine shr_megan_readnl + +!------------------------------------------------------------------------- +! 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(:) + + ! local variables + integer :: n_entries + integer :: i, j, k + type(shr_exp_item_t), pointer :: items_list, item + !-------------------------------------------------------------- + + 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 + + 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 + + item => item%next_item + i = i+1 + + enddo + if (associated(items_list)) call shr_exp_list_destroy(items_list) + + megan_initialized = .true. + + end subroutine shr_megan_init + + !------------------------------------------------------------------------- + + 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/cime/src/share/nuopc/shr_ndep_mod.F90 b/cime/src/share/nuopc/shr_ndep_mod.F90 new file mode 100644 index 000000000000..c266d1489f99 --- /dev/null +++ b/cime/src/share/nuopc/shr_ndep_mod.F90 @@ -0,0 +1,110 @@ +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 + !======================================================================== + + use ESMF , only : ESMF_VMGetCurrent, ESMF_VM, ESMF_VMBroadcast, ESMF_VMGet + use ESMF , only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU + use shr_sys_mod, only : shr_sys_abort + use shr_log_mod , only : s_logunit => shr_log_Unit + use shr_kind_mod, only : r8 => shr_kind_r8 + use shr_file_mod , only : shr_file_getUnit, shr_file_freeUnit + use shr_nl_mod , only : shr_nl_find_group_name + + 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_nflds) + + !======================================================================== + ! reads ndep_inparm namelist and sets up driver list of fields for + ! atmosphere -> land and atmosphere -> ocn communications. + !======================================================================== + + ! input/output variables + character(len=*), intent(in) :: NLFilename ! Namelist filename + 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 + 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 + + !----------------------------------------------------------------------------- + ! 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 (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_VMGet(vm, localpet=localpet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) 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' ) + write(s_logunit,F00) 'Read in ndep_inparm namelist from: ', trim(NLFilename) + 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) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ndep_nflds=tmp(1) + + end subroutine shr_ndep_readnl + +end module shr_ndep_mod