diff --git a/.gitignore b/.gitignore index 976ac250596..978286a820e 100644 --- a/.gitignore +++ b/.gitignore @@ -23,10 +23,7 @@ scripts/Tools/JENKINS* # Ignore anything that are produced under scripts "cases" directory /scripts/cases/ -#Ignore Externals -components -libraries -share +# Ignore some other files test_coverage/** *.bak diff --git a/CIME/data/config/cesm/config_files.xml b/CIME/data/config/cesm/config_files.xml index ea9dd6f0857..07f087549b5 100644 --- a/CIME/data/config/cesm/config_files.xml +++ b/CIME/data/config/cesm/config_files.xml @@ -134,7 +134,7 @@ $SRCROOT/components/cdeps/datm $CIMEROOT/CIME/non_py/src/components/stub_comps_$COMP_INTERFACE/satm - $CIMEROOT/CIME/non_py/src/components/xcpl_comps_$COMP_INTERFACE/xatm + $SRCROOT/components/cmeps/med_test_comps/xatm $SRCROOT/components/cam/ $SRCROOT/components/fv3/ @@ -169,7 +169,7 @@ $SRCROOT/components/blom/ $SRCROOT/components/cdeps/docn $CIMEROOT/CIME/non_py/src/components/stub_comps_$COMP_INTERFACE/socn - $CIMEROOT/CIME/non_py/src/components/xcpl_comps_$COMP_INTERFACE/xocn + $SRCROOT/components/cmeps/med_test_comps/xocn case_comps env_case.xml @@ -184,7 +184,7 @@ $SRCROOT/components/ww3/ $SRCROOT/components/cdeps/dwav $CIMEROOT/CIME/non_py/src/components/stub_comps_$COMP_INTERFACE/swav - $CIMEROOT/CIME/non_py/src/components/xcpl_comps_$COMP_INTERFACE/xwav + $SRCROOT/components/cmeps/med_test_comps/xwav case_comps env_case.xml @@ -199,7 +199,7 @@ $SRCROOT/components/cism/ $SRCROOT/components/cdeps/dglc $CIMEROOT/CIME/non_py/src/components/stub_comps_$COMP_INTERFACE/sglc - $CIMEROOT/CIME/non_py/src/components/xcpl_comps_$COMP_INTERFACE/xglc + $SRCROOT/components/cmeps/med_test_comps/xglc case_comps env_case.xml @@ -216,7 +216,7 @@ $SRCROOT/components/mpas-seaice/ $SRCROOT/components/cdeps/dice $CIMEROOT/CIME/non_py/src/components/stub_comps_$COMP_INTERFACE/sice - $CIMEROOT/CIME/non_py/src/components/xcpl_comps_$COMP_INTERFACE/xice + $SRCROOT/components/cmeps/med_test_comps/xice case_comps env_case.xml @@ -233,7 +233,7 @@ $SRCROOT/components/mizuRoute/ $SRCROOT/components/cdeps/drof $CIMEROOT/CIME/non_py/src/components/stub_comps_$COMP_INTERFACE/srof - $CIMEROOT/CIME/non_py/src/components/xcpl_comps_$COMP_INTERFACE/xrof + $SRCROOT/components/cmeps/med_test_comps/xrof case_comps env_case.xml @@ -249,7 +249,7 @@ $SRCROOT/components/slim/ $SRCROOT/components/cdeps/dlnd $CIMEROOT/CIME/non_py/src/components/stub_comps_$COMP_INTERFACE/slnd - $CIMEROOT/CIME/non_py/src/components/xcpl_comps_$COMP_INTERFACE/xlnd + $SRCROOT/components/cmeps/med_test_comps/xlnd case_comps env_case.xml @@ -262,7 +262,7 @@ unset $CIMEROOT/CIME/non_py/src/components/stub_comps_$COMP_INTERFACE/siac - $CIMEROOT/CIME/non_py/src/components/xcpl_comps_$COMP_INTERFACE/xiac + $SRCROOT/components/cmeps/med_test_comps/xiac case_comps env_case.xml diff --git a/CIME/data/config/ufs/config_files.xml b/CIME/data/config/ufs/config_files.xml index 1f7137821fa..5f717ad6144 100644 --- a/CIME/data/config/ufs/config_files.xml +++ b/CIME/data/config/ufs/config_files.xml @@ -109,7 +109,7 @@ $SRCROOT/src/model/CDEPS/datm $CIMEROOT/CIME/non_py/src/components/stub_comps_$COMP_INTERFACE/satm - $CIMEROOT/CIME/non_py/src/components/xcpl_comps_$COMP_INTERFACE/xatm + $SRCROOT/components/cmeps/med_test_comps/xatm $SRCROOT/components/cam/ $SRCROOT/src/model/FV3 @@ -141,7 +141,7 @@ $SRCROOT/src/model/HYCOM/ $SRCROOT/src/model/CDEPS/docn $CIMEROOT/CIME/non_py/src/components/stub_comps_$COMP_INTERFACE/socn - $CIMEROOT/CIME/non_py/src/components/xcpl_comps_$COMP_INTERFACE/xocn + $SRCROOT/components/cmeps/med_test_comps/xocn case_comps env_case.xml @@ -156,7 +156,7 @@ $SRCROOT/components/ww3/ $SRCROOT/src/model/CDEPS/dwav $CIMEROOT/CIME/non_py/src/components/stub_comps_$COMP_INTERFACE/swav - $CIMEROOT/CIME/non_py/src/components/xcpl_comps_$COMP_INTERFACE/xwav + $SRCROOT/components/cmeps/med_test_comps/xwav case_comps env_case.xml @@ -171,7 +171,7 @@ $SRCROOT/components/cism/ $SRCROOT/src/model/CDEPS/dglc $CIMEROOT/CIME/non_py/src/components/stub_comps_$COMP_INTERFACE/sglc - $CIMEROOT/CIME/non_py/src/components/xcpl_comps_$COMP_INTERFACE/xglc + $SRCROOT/components/cmeps/med_test_comps/xglc case_comps env_case.xml @@ -186,7 +186,7 @@ $SRCROOT/src/model/CICE/ $SRCROOT/src/model/CDEPS/dice $CIMEROOT/CIME/non_py/src/components/stub_comps_$COMP_INTERFACE/sice - $CIMEROOT/CIME/non_py/src/components/xcpl_comps_$COMP_INTERFACE/xice + $SRCROOT/components/cmeps/med_test_comps/xice case_comps env_case.xml @@ -202,7 +202,7 @@ $SRCROOT/components/mosart/ $SRCROOT/src/model/CDEPS/drof $CIMEROOT/CIME/non_py/src/components/stub_comps_$COMP_INTERFACE/srof - $CIMEROOT/CIME/non_py/src/components/xcpl_comps_$COMP_INTERFACE/xrof + $SRCROOT/components/cmeps/med_test_comps/xrof case_comps env_case.xml @@ -217,7 +217,7 @@ $SRCROOT/components/clm/ $SRCROOT/src/model/CDEPS/dlnd $CIMEROOT/CIME/non_py/src/components/stub_comps_$COMP_INTERFACE/slnd - $CIMEROOT/CIME/non_py/src/components/xcpl_comps_$COMP_INTERFACE/xlnd + $SRCROOT/components/cmeps/med_test_comps/xlnd case_comps env_case.xml @@ -230,7 +230,7 @@ unset $CIMEROOT/CIME/non_py/src/components/stub_comps_$COMP_INTERFACE/siac - $CIMEROOT/CIME/non_py/src/components/xcpl_comps_$COMP_INTERFACE/xiac + $SRCROOT/components/cmeps/med_test_comps/xiac case_comps env_case.xml diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xatm/cime_config/buildlib b/CIME/non_py/src/components/xcpl_comps_nuopc/xatm/cime_config/buildlib deleted file mode 120000 index 7766f77f5bc..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xatm/cime_config/buildlib +++ /dev/null @@ -1 +0,0 @@ -../../../../../../build_scripts/buildlib.internal_components \ No newline at end of file diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xatm/cime_config/buildlib_cmake b/CIME/non_py/src/components/xcpl_comps_nuopc/xatm/cime_config/buildlib_cmake deleted file mode 120000 index 7766f77f5bc..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xatm/cime_config/buildlib_cmake +++ /dev/null @@ -1 +0,0 @@ -../../../../../../build_scripts/buildlib.internal_components \ No newline at end of file diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xatm/cime_config/buildnml b/CIME/non_py/src/components/xcpl_comps_nuopc/xatm/cime_config/buildnml deleted file mode 100755 index e7efcd46b01..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xatm/cime_config/buildnml +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/env python3 - -""" -build data model library -""" - -import sys, os - -_CIMEROOT = os.path.join( - os.path.dirname(os.path.abspath(__file__)), "..", "..", "..", "..", ".." -) -sys.path.append(os.path.join(_CIMEROOT, "CIME", "Tools")) - -from standard_script_setup import * -from CIME.buildnml import build_xcpl_nml, parse_input -from CIME.case import Case - - -def buildnml(case, caseroot, compname): - if compname != "xatm": - raise AttributeError - build_xcpl_nml(case, caseroot, compname) - - -def _main_func(): - caseroot = parse_input(sys.argv) - with Case(caseroot) as case: - buildnml(case, caseroot, "xatm") - - -if __name__ == "__main__": - _main_func() diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xatm/cime_config/config_component.xml b/CIME/non_py/src/components/xcpl_comps_nuopc/xatm/cime_config/config_component.xml deleted file mode 100644 index 76c8be8c7f9..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xatm/cime_config/config_component.xml +++ /dev/null @@ -1,25 +0,0 @@ - - - - - - - Dead atm component - - - - char - xatm - xatm - case_comp - env_case.xml - Name of atmosphere component - - - - ========================================= - XATM naming conventions in compset name - ========================================= - - - diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xatm/src/atm_comp_nuopc.F90 b/CIME/non_py/src/components/xcpl_comps_nuopc/xatm/src/atm_comp_nuopc.F90 deleted file mode 100644 index 64cd5b768da..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xatm/src/atm_comp_nuopc.F90 +++ /dev/null @@ -1,529 +0,0 @@ -module atm_comp_nuopc - - !---------------------------------------------------------------------------- - ! This is the NUOPC cap for XATM - !---------------------------------------------------------------------------- - - use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - 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, SetVM - 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_log_mod , only : shr_log_getlogunit, shr_log_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_read_inparms, ModelInitPhase, ModelSetRunClock - use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - - implicit none - private ! except - - public :: SetServices - public :: SetVM - !-------------------------------------------------------------------------- - ! 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) - type (fld_list_type) :: fldsFrAtm(fldsMax) - integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost - - type(ESMF_Mesh) :: mesh - 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=5) :: inst_suffix ! char string associated with instance (ie. "_0001" or "") - integer :: logunit ! logging unit number - logical :: mastertask - integer :: dbug = 0 - character(*),parameter :: modName = "(xatm_comp_nuopc)" - character(*),parameter :: u_FILE_u = & - __FILE__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine SetServices(gcomp, rc) - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' - - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! the NUOPC gcomp component will register the generic methods - call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (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 (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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & - userRoutine=InitializeRealize, rc=rc) - 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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine SetServices - - !=============================================================================== - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - - ! 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(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) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - mastertask = (my_task==0) - - ! determine instance information - 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 set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Initialize xatm - call dead_read_inparms('atm', inst_suffix, logunit, nxg, nyg) - - ! 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)) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_topo' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_z' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_u' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_v' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_tbot' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_ptem' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_shum' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_pbot' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_dens' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Sa_pslv' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_rainc' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_rainl' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_snowc' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_snowl' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_lwdn' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swndr' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swvdr' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swndf' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swvdf' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_swnet' ) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_bcph' , ungridded_lbound=1, ungridded_ubound=3) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_ocph' , ungridded_lbound=1, ungridded_ubound=3) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) - call fld_list_add(fldsFrAtm_num, fldsFrAtm, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) - - call fld_list_add(fldsToAtm_num, fldsToAtm, trim(flds_scalar_name)) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sx_anidr' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sx_avsdf' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sx_anidf' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sx_avsdr' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sl_lfrac' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Si_ifrac' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'So_ofrac' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sx_tref' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sx_qref' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sx_t' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'So_t' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sl_fv' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sl_ram1' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sl_snowh' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Si_snowh' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'So_ssq' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'So_re' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Sx_u10' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Faxx_taux' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Faxx_tauy' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Faxx_lat' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Faxx_sen' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Faxx_lwup' ) - call fld_list_add(fldsToAtm_num, fldsToAtm, 'Faxx_evap' ) - - do n = 1,fldsFrAtm_num - if(mastertask) write(logunit,*)'Advertising From Xatm ',trim(fldsFrAtm(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrAtm(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - - do n = 1,fldsToAtm_num - if(mastertask) write(logunit,*)'Advertising To Xatm',trim(fldsToAtm(n)%stdname) - call NUOPC_Advertise(importState, standardName=fldsToAtm(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - enddo - end if - - ! Reset shr logging to original values - call shr_log_setLogUnit (shrlogunit) - - 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 - integer, intent(out) :: rc - - ! local variables - type(ESMF_Time) :: nextTime - real(r8) :: nextsw_cday - integer :: n - integer :: shrlogunit ! original log unit - character(ESMF_MAXSTR) :: cvalue ! config data - character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize: xatm) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Reset shr logging to my log file - call shr_log_getLogUnit (shrlogunit) - call shr_log_setLogUnit (logUnit) - - ! generate the mesh - call NUOPC_CompAttributeGet(gcomp, name='mesh_atm', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - mesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - ! realize the actively coupled fields, now that a mesh is established - ! NUOPC_Realize "realizes" a previously advertised field in the importState and exportState - ! by replacing the advertised fields with the newly created fields of the same name. - call fld_list_realize( & - state=exportState, & - fldList=fldsFrAtm, & - numflds=fldsFrAtm_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':xatmExport',& - mesh=mesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call fld_list_realize( & - state=importState, & - fldList=fldsToAtm, & - numflds=fldsToAtm_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':xatmImport',& - mesh=mesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Pack export state - call state_setexport(exportState, rc=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 State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, flds_scalar_name, flds_scalar_num, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Set time of next radiation computation - 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 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 - - ! diagnostics - if (dbug > 1) then - call State_diagnose(exportState,subname//':ES',rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - - call shr_log_setLogUnit (shrlogunit) - - end subroutine InitializeRealize - - !=============================================================================== - subroutine ModelAdvance(gcomp, rc) - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_State) :: exportState - real(r8) :: nextsw_cday - integer :: shrlogunit ! original log unit - character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - if (dbug > 1) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - end if - call memcheck(subname, 3, mastertask) - - call shr_log_getLogUnit (shrlogunit) - call shr_log_setLogUnit (logunit) - - !-------------------------------- - ! Pack export state - !-------------------------------- - - call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call state_setexport(exportState, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - 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 - - !-------------------------------- - ! diagnostics - !-------------------------------- - - if (dbug > 1) then - call state_diagnose(exportState,subname//':ES',rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - call log_clock_advance(clock, 'XATM', logunit, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - endif - - call shr_log_setLogUnit (shrlogunit) - - end subroutine ModelAdvance - - !=============================================================================== - subroutine state_setexport(exportState, rc) - - ! input/output variables - type(ESMF_State) , intent(inout) :: exportState - integer, intent(out) :: rc - - ! local variables - integer :: n, nf, nind - real(r8), pointer :: lat(:) - real(r8), pointer :: lon(:) - integer :: spatialDim - integer :: numOwnedElements - real(R8), pointer :: ownedElemCoords(:) - !-------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ownedElemCoords(spatialDim*numOwnedElements)) - call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - allocate(lon(numownedElements)) - allocate(lat(numownedElements)) - do n = 1,numownedElements - lon(n) = ownedElemCoords(2*n-1) - lat(n) = ownedElemCoords(2*n) - end do - - ! Start from index 2 in order to Skip the scalar field here - do nf = 2,fldsFrAtm_num - if (fldsFrAtm(nf)%ungridded_ubound == 0) then - call field_setexport(exportState, trim(fldsFrAtm(nf)%stdname), lon, lat, nf=nf, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - do nind = 1,fldsFrAtm(nf)%ungridded_ubound - call field_setexport(exportState, trim(fldsFrAtm(nf)%stdname), lon, lat, nf=nf+nind-1, & - ungridded_index=nind, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - end if - end do - - deallocate(lon) - deallocate(lat) - - end subroutine state_setexport - - !=============================================================================== - subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) - - use shr_const_mod , only : pi=>shr_const_pi - - ! intput/otuput variables - type(ESMF_State) , intent(inout) :: exportState - character(len=*) , intent(in) :: fldname - real(r8) , intent(in) :: lon(:) - real(r8) , intent(in) :: lat(:) - integer , intent(in) :: nf - integer, optional , intent(in) :: ungridded_index - integer , intent(out) :: rc - - ! local variables - integer :: i, ncomp - type(ESMF_Field) :: lfield - real(r8), pointer :: data1d(:) - real(r8), pointer :: data2d(:,:) - !-------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ncomp = 1 - if (present(ungridded_index)) then - call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (gridToFieldMap == 1) then - do i = 1,size(data2d, dim=1) - data2d(i,ungridded_index) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) - end do - else if (gridToFieldMap == 2) then - do i = 1,size(data2d, dim=2) - data2d(ungridded_index,i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) - end do - end if - else - call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do i = 1,size(data1d) - data1d(i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) - end do - end if - - end subroutine field_setexport - - !=============================================================================== - subroutine ModelFinalize(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - if (mastertask) then - write(logunit,*) - write(logunit,*) 'xatm: end of main integration loop' - write(logunit,*) - end if - end subroutine ModelFinalize - -end module atm_comp_nuopc diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xglc/cime_config/buildlib b/CIME/non_py/src/components/xcpl_comps_nuopc/xglc/cime_config/buildlib deleted file mode 120000 index 7766f77f5bc..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xglc/cime_config/buildlib +++ /dev/null @@ -1 +0,0 @@ -../../../../../../build_scripts/buildlib.internal_components \ No newline at end of file diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xglc/cime_config/buildlib_cmake b/CIME/non_py/src/components/xcpl_comps_nuopc/xglc/cime_config/buildlib_cmake deleted file mode 120000 index 7766f77f5bc..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xglc/cime_config/buildlib_cmake +++ /dev/null @@ -1 +0,0 @@ -../../../../../../build_scripts/buildlib.internal_components \ No newline at end of file diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xglc/cime_config/buildnml b/CIME/non_py/src/components/xcpl_comps_nuopc/xglc/cime_config/buildnml deleted file mode 100755 index a90f7a189ef..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xglc/cime_config/buildnml +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/env python3 - -""" -build data model library -""" - -import sys, os - -_CIMEROOT = os.path.join( - os.path.dirname(os.path.abspath(__file__)), "..", "..", "..", "..", ".." -) -sys.path.append(os.path.join(_CIMEROOT, "CIME", "Tools")) - -from standard_script_setup import * -from CIME.buildnml import build_xcpl_nml, parse_input -from CIME.case import Case - - -def buildnml(case, caseroot, compname): - if compname != "xglc": - raise AttributeError - build_xcpl_nml(case, caseroot, compname) - - -def _main_func(): - caseroot = parse_input(sys.argv) - with Case(caseroot) as case: - buildnml(case, caseroot, "xglc") - - -if __name__ == "__main__": - _main_func() diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xglc/cime_config/config_component.xml b/CIME/non_py/src/components/xcpl_comps_nuopc/xglc/cime_config/config_component.xml deleted file mode 100644 index f1765811b70..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xglc/cime_config/config_component.xml +++ /dev/null @@ -1,26 +0,0 @@ - - - - - - - Dead land-ice component - - - - char - xglc - xglc - case_comp - env_case.xml - Name of land-ice component - - - - - ========================================= - XGLC naming conventions in compset name - ========================================= - - - diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xglc/src/glc_comp_nuopc.F90 b/CIME/non_py/src/components/xcpl_comps_nuopc/xglc/src/glc_comp_nuopc.F90 deleted file mode 100644 index 4b498f8d9c6..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xglc/src/glc_comp_nuopc.F90 +++ /dev/null @@ -1,457 +0,0 @@ -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, NUOPC_AddNestedState - 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, SetVM - 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_log_mod , only : shr_log_getlogunit, shr_log_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_read_inparms, ModelInitPhase, ModelSetRunClock - use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - - implicit none - private ! except - - public :: SetServices - public :: SetVM - !-------------------------------------------------------------------------- - ! 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) - type (fld_list_type) :: fldsFrGlc(fldsMax) - integer, parameter :: gridTofieldMap = 2 ! ungridded dimension is innermost - - type(ESMF_Mesh) :: mesh - 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 = 0 - character(*),parameter :: modName = "(xglc_comp_nuopc)" - character(*),parameter :: u_FILE_u = & - __FILE__ - - ! TODO: this must be generalized - but for now is just hard-wired - integer, parameter :: max_icesheets = 1 - integer :: num_icesheets = 1 - type(ESMF_State) :: NStateImp(max_icesheets) - type(ESMF_State) :: NStateExp(max_icesheets) - -!=============================================================================== -contains -!=============================================================================== - - subroutine SetServices(gcomp, rc) - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' - - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! the NUOPC gcomp component will register the generic methods - call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (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 (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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & - userRoutine=InitializeRealize, rc=rc) - 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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine SetServices - - !=============================================================================== - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - - ! 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(CS) :: stdname - integer :: n, ns, nf - integer :: lsize ! local array size - integer :: shrlogunit ! original log unit - character(CL) :: cvalue - character(len=CL) :: logmsg - character(len=CS) :: cnum - logical :: isPresent, isSet - character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - mastertask = (my_task == master_task) - - ! determine instance information - 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 set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Initialize xglc - call dead_read_inparms('glc', inst_suffix, logunit, nxg, nyg) - - ! 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 - - ! Create nested state for each active ice sheet - do ns = 1,num_icesheets - write(cnum,'(i0)') ns - call NUOPC_AddNestedState(importState, CplSet="GLC"//trim(cnum), nestedState=NStateImp(ns), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - call NUOPC_AddNestedState(exportState, CplSet="GLC"//trim(cnum), nestedState=NStateExp(ns), rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - end do - - if (nxg /= 0 .and. nyg /= 0) then - - call fld_list_add(fldsFrGlc_num, fldsFrGlc, trim(flds_scalar_name)) - call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Sg_icemask' ) - call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Sg_icemask_coupled_fluxes' ) - call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Sg_ice_covered' ) - call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Sg_topo' ) - call fld_list_add(fldsFrGlc_num, fldsFrGlc, 'Flgg_hflx' ) - - call fld_list_add(fldsToGlc_num, fldsToGlc, trim(flds_scalar_name)) - call fld_list_add(fldsToGlc_num, fldsToGlc, 'Sl_tsrf') - call fld_list_add(fldsToGlc_num, fldsToGlc, 'Flgl_qice') - - ! Now advertise import and export fields fields - do ns = 1,num_icesheets - if (mastertask) write(logunit,*)'Advertising To Xglc ',trim(fldsToGlc(ns)%stdname) - do nf = 1,fldsToGlc_num - call NUOPC_Advertise(NStateImp(ns), standardName=fldsToGlc(nf)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - end do - if (mastertask) write(logunit,*)'Advertising From Xglc ',trim(fldsFrGlc(ns)%stdname) - do nf = 1,fldsFrGlc_num - call NUOPC_Advertise(NStateExp(ns), standardName=fldsFrGlc(nf)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (chkErr(rc,__LINE__,u_FILE_u)) return - end do - enddo - - end if - - 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 - integer, intent(out) :: rc - - ! local variables - integer :: n, ns - character(ESMF_MAXSTR) :: cvalue ! config data - character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! generate the mesh - call NUOPC_CompAttributeGet(gcomp, name='mesh_glc', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - mesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! realize the actively coupled fields, now that a mesh is established - ! NUOPC_Realize "realizes" a previously advertised field in the importState and exportState - ! by replacing the advertised fields with the newly created fields of the same name. - do ns = 1,num_icesheets - call fld_list_realize( & - state=NStateExp(ns), & - fldList=fldsFrGlc, & - numflds=fldsFrGlc_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':dglcExport',& - mesh=mesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call fld_list_realize( & - state=NStateImp(ns), & - fldList=fldsToGlc, & - numflds=fldsToGlc_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':dglcImport',& - mesh=mesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - - ! Pack export state and set the coupling scalars - call state_setexport(rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - do ns = 1,num_icesheets - call state_setscalar(dble(nxg),flds_scalar_index_nx, NStateExp(ns), flds_scalar_name, flds_scalar_num, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call state_setscalar(dble(nyg),flds_scalar_index_ny, NStateExp(ns), flds_scalar_name, flds_scalar_num, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - - end subroutine InitializeRealize - - !=============================================================================== - - subroutine ModelAdvance(gcomp, rc) - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - call memcheck(subname, 3, mastertask) - - call state_setexport(rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine ModelAdvance - - !=============================================================================== - subroutine state_setexport(rc) - - ! input/output variables - integer, intent(out) :: rc - - ! local variables - integer :: n, nf, nind, ns - real(r8), pointer :: lat(:) - real(r8), pointer :: lon(:) - integer :: spatialDim - integer :: numOwnedElements - real(R8), pointer :: ownedElemCoords(:) - character(len=*),parameter :: subname=trim(modName)//':(state_setexport) ' - !-------------------------------------------------- - rc = ESMF_SUCCESS - - call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ownedElemCoords(spatialDim*numOwnedElements)) - call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - allocate(lon(numownedElements)) - allocate(lat(numownedElements)) - do n = 1,numownedElements - lon(n) = ownedElemCoords(2*n-1) - lat(n) = ownedElemCoords(2*n) - end do - - ! Start from index 2 in order to skip the scalar field - do ns = 1,num_icesheets - do nf = 2,fldsFrGlc_num - if (fldsFrGlc(nf)%ungridded_ubound == 0) then - call field_setexport(NStateExp(ns), trim(fldsFrGlc(nf)%stdname), lon, lat, nf=nf, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - do nind = 1,fldsFrGlc(nf)%ungridded_ubound - call field_setexport(NStateExp(ns), trim(fldsFrGlc(nf)%stdname), lon, lat, nf=nf+nind-1, & - ungridded_index=nind, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - end if - end do - if (dbug > 1) then - call State_diagnose(NStateExp(ns), trim(subname)//':ES',rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - end do - - deallocate(lon) - deallocate(lat) - - end subroutine state_setexport - - !=============================================================================== - - subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) - - use shr_const_mod , only : pi=>shr_const_pi - - ! intput/otuput variables - type(ESMF_State) , intent(inout) :: exportState - character(len=*) , intent(in) :: fldname - real(r8) , intent(in) :: lon(:) - real(r8) , intent(in) :: lat(:) - integer , intent(in) :: nf - integer, optional , intent(in) :: ungridded_index - integer , intent(out) :: rc - - ! local variables - integer :: i, ncomp - type(ESMF_Field) :: lfield - real(r8), pointer :: data1d(:) - real(r8), pointer :: data2d(:,:) - !-------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ncomp = 5 - if (present(ungridded_index)) then - call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (gridToFieldMap == 1) then - do i = 1,size(data2d, dim=1) - data2d(i,ungridded_index) = (nf*100) & - * cos (pi*lat(i)/180.0_R8) * cos (pi*lat(i)/180.0_R8) & - * sin (pi*lon(i)/180.0_R8) * sin (pi*lon(i)/180.0_R8) & - + (ncomp*10.0_R8) - enddo - else if (gridToFieldMap == 2) then - do i = 1,size(data2d, dim=2) - data2d(ungridded_index,i) = (nf*100) & - * cos (pi*lat(i)/180.0_R8) * cos (pi*lat(i)/180.0_R8) & - * sin (pi*lon(i)/180.0_R8) * sin (pi*lon(i)/180.0_R8) & - + (ncomp*10.0_R8) - end do - end if - else - call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (fldname == 'Sg_icemask' .or. fldname == 'Sg_icemask_coupled_fluxes' .or. fldname == 'Sg_ice_covered') then - data1d(:) = 1._r8 - else - do i = 1,size(data1d) - data1d(i) = (nf*100) & - * cos (pi*lat(i)/180.0_R8) * cos (pi*lat(i)/180.0_R8) & - * sin (pi*lon(i)/180.0_R8) * sin (pi*lon(i)/180.0_R8) & - + (ncomp*10.0_R8) - end do - end if - end if - - end subroutine field_setexport - - !=============================================================================== - subroutine ModelFinalize(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - if (mastertask) then - write(logunit,*) - write(logunit,*) 'xglc: end of main integration loop' - write(logunit,*) - end if - end subroutine ModelFinalize - -end module glc_comp_nuopc diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xice/cime_config/buildlib b/CIME/non_py/src/components/xcpl_comps_nuopc/xice/cime_config/buildlib deleted file mode 120000 index 7766f77f5bc..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xice/cime_config/buildlib +++ /dev/null @@ -1 +0,0 @@ -../../../../../../build_scripts/buildlib.internal_components \ No newline at end of file diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xice/cime_config/buildlib_cmake b/CIME/non_py/src/components/xcpl_comps_nuopc/xice/cime_config/buildlib_cmake deleted file mode 120000 index 7766f77f5bc..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xice/cime_config/buildlib_cmake +++ /dev/null @@ -1 +0,0 @@ -../../../../../../build_scripts/buildlib.internal_components \ No newline at end of file diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xice/cime_config/buildnml b/CIME/non_py/src/components/xcpl_comps_nuopc/xice/cime_config/buildnml deleted file mode 100755 index 7d141edd619..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xice/cime_config/buildnml +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/env python3 - -""" -build data model library -""" - -import sys, os - -_CIMEROOT = os.path.join( - os.path.dirname(os.path.abspath(__file__)), "..", "..", "..", "..", ".." -) -sys.path.append(os.path.join(_CIMEROOT, "CIME", "Tools")) - -from standard_script_setup import * -from CIME.buildnml import build_xcpl_nml, parse_input -from CIME.case import Case - - -def buildnml(case, caseroot, compname): - if compname != "xice": - raise AttributeError - build_xcpl_nml(case, caseroot, compname) - - -def _main_func(): - caseroot = parse_input(sys.argv) - with Case(caseroot) as case: - buildnml(case, caseroot, "xice") - - -if __name__ == "__main__": - _main_func() diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xice/cime_config/config_component.xml b/CIME/non_py/src/components/xcpl_comps_nuopc/xice/cime_config/config_component.xml deleted file mode 100644 index a3263a0eed6..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xice/cime_config/config_component.xml +++ /dev/null @@ -1,26 +0,0 @@ - - - - - - - Dead ice component - - - - char - xice - xice - case_comp - env_case.xml - Name of sea-ice component - - - - - ========================================= - XICE naming conventions in compset name - ========================================= - - - diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xice/src/ice_comp_nuopc.F90 b/CIME/non_py/src/components/xcpl_comps_nuopc/xice/src/ice_comp_nuopc.F90 deleted file mode 100644 index 9185b8e532f..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xice/src/ice_comp_nuopc.F90 +++ /dev/null @@ -1,552 +0,0 @@ -module ice_comp_nuopc - - !---------------------------------------------------------------------------- - ! This is the NUOPC cap for XICE - !---------------------------------------------------------------------------- - - use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - 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, SetVM - 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_log_mod , only : shr_log_getlogunit, shr_log_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_read_inparms, ModelInitPhase, ModelSetRunClock - use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - - implicit none - private ! except - - public :: SetServices - public :: SetVM - !-------------------------------------------------------------------------- - ! 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 :: 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 - - type(ESMF_Mesh) :: mesh - 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 = 0 - character(*),parameter :: modName = "(xice_comp_nuopc)" - character(*),parameter :: u_FILE_u = & - __FILE__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine SetServices(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' - - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! the NUOPC gcomp component will register the generic methods - call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (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 (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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & - userRoutine=InitializeRealize, rc=rc) - 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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine SetServices - - !=============================================================================== - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - - ! 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 :: shrlogunit ! original log unit - character(len=CL) :: logmsg - logical :: isPresent, isSet - character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - mastertask = my_task == master_task - - !---------------------------------------------------------------------------- - ! determine instance information - !---------------------------------------------------------------------------- - - 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 set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - !---------------------------------------------------------------------------- - ! Initialize xice - !---------------------------------------------------------------------------- - - call dead_read_inparms('ice', inst_suffix, logunit, nxg, nyg) - - !-------------------------------- - ! 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)) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_imask' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_ifrac' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_t' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_tref' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_qref' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_snowh' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_u10' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_avsdr' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_anidr' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_avsdf' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Si_anidf' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Faii_taux' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Faii_tauy' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Faii_lat' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Faii_sen' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Faii_lwup' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Faii_evap' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Faii_swnet' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_melth' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_swpen' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_meltw' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_salt' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_taux' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_tauy' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_bcpho' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_bcphi' ) - call fld_list_add(fldsFrIce_num, fldsFrIce, 'Fioi_flxdst' ) - - call fld_list_add(fldsToIce_num, fldsToIce, trim(flds_scalar_name)) - call fld_list_add(fldsToIce_num, fldsToIce, 'So_dhdx' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'So_dhdy' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'So_t' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'So_s' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'So_u' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'So_v' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Fioo_q' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Sa_z' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Sa_u' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Sa_v' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Sa_ptem' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Sa_shum' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Sa_dens' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Sa_tbot' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_swvdr' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_swndr' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_swvdf' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_swndf' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_lwdn' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_rain' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_snow' ) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_bcph' , ungridded_lbound=1, ungridded_ubound=3) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_ocph' , ungridded_lbound=1, ungridded_ubound=3) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstwet', ungridded_lbound=1, ungridded_ubound=4) - call fld_list_add(fldsToIce_num, fldsToIce, 'Faxa_dstdry', ungridded_lbound=1, ungridded_ubound=4) - - do n = 1,fldsFrIce_num - if(mastertask) write(logunit,*)'Advertising From Xice ',trim(fldsFrIce(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrIce(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - enddo - - do n = 1,fldsToIce_num - if(mastertask) write(logunit,*)'Advertising To Xice ',trim(fldsToIce(n)%stdname) - call NUOPC_Advertise(importState, standardName=fldsToIce(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - end if - - - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_log_setLogUnit (shrlogunit) - - end subroutine InitializeAdvertise - - !=============================================================================== - subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - - ! local variables - integer :: shrlogunit ! original log unit - integer :: n - character(ESMF_MAXSTR) :: cvalue ! config data - character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_log_getLogUnit (shrlogunit) - call shr_log_setLogUnit (logUnit) - - !-------------------------------- - ! generate the mesh - !-------------------------------- - - call NUOPC_CompAttributeGet(gcomp, name='mesh_ice', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - mesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !-------------------------------- - ! realize the actively coupled fields, now that a mesh is established - ! NUOPC_Realize "realizes" a previously advertised field in the importState and exportState - ! by replacing the advertised fields with the newly created fields of the same name. - !-------------------------------- - - call fld_list_realize( & - state=ExportState, & - fldlist=fldsFrIce, & - numflds=fldsFrIce_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':diceExport',& - mesh=mesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call fld_list_realize( & - state=importState, & - fldList=fldsToIce, & - numflds=fldsToIce_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':diceImport',& - mesh=mesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - !-------------------------------- - ! Pack export state - !-------------------------------- - - call State_SetExport(exportState, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - 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 State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & - flds_scalar_name, flds_scalar_num, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - !-------------------------------- - ! diagnostics - !-------------------------------- - - if (dbug > 1) then - call State_diagnose(exportState,subname//':ES',rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - - call shr_log_setLogUnit (shrlogunit) - - end subroutine InitializeRealize - - !=============================================================================== - subroutine ModelAdvance(gcomp, rc) - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_State) :: exportState - integer :: shrlogunit ! original log unit - character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - call memcheck(subname, 3, mastertask) - - call shr_log_getLogUnit (shrlogunit) - call shr_log_setLogUnit (logunit) - - !-------------------------------- - ! Pack export state - !-------------------------------- - - call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=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 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, 'XICE', logunit, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - endif - - call shr_log_setLogUnit (shrlogunit) - - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - - end subroutine ModelAdvance - - !=============================================================================== - subroutine state_setexport(exportState, rc) - - ! input/output variables - type(ESMF_State) , intent(inout) :: exportState - integer, intent(out) :: rc - - ! local variables - integer :: n, nf, nind - real(r8), pointer :: lat(:) - real(r8), pointer :: lon(:) - integer :: spatialDim - integer :: numOwnedElements - real(R8), pointer :: ownedElemCoords(:) - !-------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ownedElemCoords(spatialDim*numOwnedElements)) - call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - allocate(lon(numownedElements)) - allocate(lat(numownedElements)) - do n = 1,numownedElements - lon(n) = ownedElemCoords(2*n-1) - lat(n) = ownedElemCoords(2*n) - end do - - ! Start from index 2 in order to skip the scalar field - do nf = 2,fldsFrIce_num - if (fldsFrIce(nf)%ungridded_ubound == 0) then - call field_setexport(exportState, trim(fldsFrIce(nf)%stdname), lon, lat, nf=nf, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - do nind = 1,fldsFrIce(nf)%ungridded_ubound - call field_setexport(exportState, trim(fldsFrIce(nf)%stdname), lon, lat, nf=nf+nind-1, & - ungridded_index=nind, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - end if - end do - - deallocate(lon) - deallocate(lat) - - end subroutine state_setexport - - !=============================================================================== - subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) - - use shr_const_mod , only : pi=>shr_const_pi - - ! intput/otuput variables - type(ESMF_State) , intent(inout) :: exportState - character(len=*) , intent(in) :: fldname - real(r8) , intent(in) :: lon(:) - real(r8) , intent(in) :: lat(:) - integer , intent(in) :: nf - integer, optional , intent(in) :: ungridded_index - integer , intent(out) :: rc - - ! local variables - integer :: i, ncomp - type(ESMF_Field) :: lfield - real(r8), pointer :: data1d(:) - real(r8), pointer :: data2d(:,:) - !-------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ncomp = 3 - if (present(ungridded_index)) then - call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (gridToFieldMap == 1) then - do i = 1,size(data2d, dim=1) - data2d(i,ungridded_index) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) - end do - else if (gridToFieldMap == 2) then - do i = 1,size(data2d, dim=2) - data2d(ungridded_index,i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) - end do - end if - else - call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do i = 1,size(data1d) - data1d(i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) - end do - ! Reset some fields - if (fldname == 'Si_ifrac') then - do i = 1,size(data1d) - data1d(i) = min(1.0_R8,max(0.0_R8,data1d(i))) - end do - else if (fldname == 'Si_imask') then - do i = 1,size(data1d) - data1d(i) = float(nint(min(1.0_R8,max(0.0_R8,data1d(i))))) - end do - end if - end if - - end subroutine field_setexport - - !=============================================================================== - subroutine ModelFinalize(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - if (mastertask) then - write(logunit,*) - write(logunit,*) 'xice: end of main integration loop' - write(logunit,*) - end if - end subroutine ModelFinalize - -end module ice_comp_nuopc diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xlnd/cime_config/buildlib b/CIME/non_py/src/components/xcpl_comps_nuopc/xlnd/cime_config/buildlib deleted file mode 120000 index 7766f77f5bc..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xlnd/cime_config/buildlib +++ /dev/null @@ -1 +0,0 @@ -../../../../../../build_scripts/buildlib.internal_components \ No newline at end of file diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xlnd/cime_config/buildlib_cmake b/CIME/non_py/src/components/xcpl_comps_nuopc/xlnd/cime_config/buildlib_cmake deleted file mode 120000 index 7766f77f5bc..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xlnd/cime_config/buildlib_cmake +++ /dev/null @@ -1 +0,0 @@ -../../../../../../build_scripts/buildlib.internal_components \ No newline at end of file diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xlnd/cime_config/buildnml b/CIME/non_py/src/components/xcpl_comps_nuopc/xlnd/cime_config/buildnml deleted file mode 100755 index 72e822771b4..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xlnd/cime_config/buildnml +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/env python3 - -""" -build data model library -""" - -import sys, os - -_CIMEROOT = os.path.join( - os.path.dirname(os.path.abspath(__file__)), "..", "..", "..", "..", ".." -) -sys.path.append(os.path.join(_CIMEROOT, "CIME", "Tools")) - -from standard_script_setup import * -from CIME.buildnml import build_xcpl_nml, parse_input -from CIME.case import Case - - -def buildnml(case, caseroot, compname): - if compname != "xlnd": - raise AttributeError - build_xcpl_nml(case, caseroot, compname) - - -def _main_func(): - caseroot = parse_input(sys.argv) - with Case(caseroot) as case: - buildnml(case, caseroot, "xlnd") - - -if __name__ == "__main__": - _main_func() diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xlnd/cime_config/config_component.xml b/CIME/non_py/src/components/xcpl_comps_nuopc/xlnd/cime_config/config_component.xml deleted file mode 100644 index 8179d03108b..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xlnd/cime_config/config_component.xml +++ /dev/null @@ -1,26 +0,0 @@ - - - - - - - Dead land component - - - - - char - xlnd - xlnd - case_comp - env_case.xml - Name of land component - - - - ========================================= - XLND naming conventions in compset name - ========================================= - - - diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xlnd/src/lnd_comp_nuopc.F90 b/CIME/non_py/src/components/xcpl_comps_nuopc/xlnd/src/lnd_comp_nuopc.F90 deleted file mode 100644 index a43215939ad..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xlnd/src/lnd_comp_nuopc.F90 +++ /dev/null @@ -1,564 +0,0 @@ -module lnd_comp_nuopc - - !---------------------------------------------------------------------------- - ! This is the NUOPC cap for XLND - !---------------------------------------------------------------------------- - - use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - 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, SetVM - 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_log_mod , only : shr_log_getlogunit, shr_log_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_read_inparms, ModelInitPhase, ModelSetRunClock - use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - - implicit none - private ! except - - public :: SetServices - public :: SetVM - !-------------------------------------------------------------------------- - ! 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._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 - integer :: glc_nec - - type(ESMF_Mesh) :: mesh - 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__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine SetServices(gcomp, rc) - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' - - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! the NUOPC gcomp component will register the generic methods - call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (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 (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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & - userRoutine=InitializeRealize, rc=rc) - 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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine SetServices - - !=============================================================================== - - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - - ! 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(CS) :: stdname - integer :: n - integer :: lsize ! local array size - integer :: shrlogunit ! original log unit - character(CL) :: cvalue - character(CL) :: logmsg - logical :: isPresent, isSet - character(len=*),parameter :: subname=trim(modName)//':(InitializeAdvertise) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - mastertask = (my_task == master_task) - - !---------------------------------------------------------------------------- - ! determine instance information - !---------------------------------------------------------------------------- - - 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 set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - !---------------------------------------------------------------------------- - ! Initialize xlnd - !---------------------------------------------------------------------------- - - call dead_read_inparms('lnd', inst_suffix, logunit, nxg, nyg) - - !-------------------------------- - ! 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 NUOPC_CompAttributeGet(gcomp, name='glc_nec', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) glc_nec - call ESMF_LogWrite('glc_nec = '// trim(cvalue), ESMF_LOGMSG_INFO) - - call fld_list_add(fldsFrLnd_num, fldsFrlnd, trim(flds_scalar_name)) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_lfrin' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_t' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_tref' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_qref' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_avsdr' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_anidr' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_avsdf' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_anidf' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_snowh' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_u10' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_fv' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_ram1' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofsur' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofgwl' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofsub' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_rofi' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flrl_irrig' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_taux' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_tauy' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lat' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_sen' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_lwup' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_evap' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_swnet' ) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Fall_flxdst' , ungridded_lbound=1, ungridded_ubound=4) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Flgl_qice_elev', ungridded_lbound=1, ungridded_ubound=glc_nec+1) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_tsrf_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) - call fld_list_add(fldsFrLnd_num, fldsFrlnd, 'Sl_topo_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) - - call fld_list_add(fldsToLnd_num, fldsToLnd, trim(flds_scalar_name)) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Sa_z' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Sa_topo' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Sa_u' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Sa_v' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Sa_ptem' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Sa_pbot' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Sa_tbot' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Sa_shum' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Flrr_volr' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Flrr_volrmch' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_lwdn' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_rainc' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_rainl' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_snowc' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_snowl' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_swndr' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_swvdr' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_swndf' ) - call fld_list_add(fldsToLnd_num, fldsToLnd, 'Faxa_swvdf' ) - call fld_list_add(fldsTolnd_num, fldsTolnd, 'Faxa_bcph' , ungridded_lbound=1, ungridded_ubound=3) - call fld_list_add(fldsTolnd_num, fldsTolnd, 'Faxa_ocph' , ungridded_lbound=1, ungridded_ubound=3) - call fld_list_add(fldsTolnd_num, fldsTolnd, 'Faxa_dstwet' , ungridded_lbound=1, ungridded_ubound=4) - call fld_list_add(fldsTolnd_num, fldsTolnd, 'Faxa_dstdry' , ungridded_lbound=1, ungridded_ubound=4) - call fld_list_add(fldsToLnd_num, fldsTolnd, 'Sg_topo_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) - call fld_list_add(fldsToLnd_num, fldsTolnd, 'Sg_ice_covered_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) - call fld_list_add(fldsToLnd_num, fldsTolnd, 'Flgg_hflx_elev' , ungridded_lbound=1, ungridded_ubound=glc_nec+1) - call fld_list_add(fldsToLnd_num, fldsTolnd, 'Sg_icemask') - call fld_list_add(fldsToLnd_num, fldsTolnd, 'Sg_icemask_coupled_fluxes') - - do n = 1,fldsFrLnd_num - if (mastertask) write(logunit,*)'Advertising From Xlnd ',trim(fldsFrLnd(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrLnd(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - enddo - - do n = 1,fldsToLnd_num - if(mastertask) write(logunit,*)'Advertising To Xlnd',trim(fldsToLnd(n)%stdname) - call NUOPC_Advertise(importState, standardName=fldsToLnd(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - enddo - - end if - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_log_setLogUnit (shrlogunit) - - 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 - integer, intent(out) :: rc - - ! local variables - integer :: shrlogunit ! original log unit - integer :: n - character(ESMF_MAXSTR) :: cvalue ! config data - character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - if (dbug > 5) call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - - !---------------------------------------------------------------------------- - ! Reset shr logging to my log file - !---------------------------------------------------------------------------- - - call shr_log_getLogUnit (shrlogunit) - call shr_log_setLogUnit (logUnit) - - !-------------------------------- - ! generate the mesh - !-------------------------------- - - call NUOPC_CompAttributeGet(gcomp, name='mesh_lnd', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - mesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - !-------------------------------- - ! realize the actively coupled fields, now that a mesh is established - ! NUOPC_Realize "realizes" a previously advertised field in the importState and exportState - ! by replacing the advertised fields with the newly created fields of the same name. - !-------------------------------- - - call fld_list_realize( & - state=ExportState, & - fldlist=fldsFrLnd, & - numflds=fldsFrLnd_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':dlndExport',& - mesh=mesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call fld_list_realize( & - state=importState, & - fldList=fldsToLnd, & - numflds=fldsToLnd_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':dlndImport',& - mesh=mesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - !-------------------------------- - ! Pack export state - !-------------------------------- - - call state_setexport(exportState, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - 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 State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, & - flds_scalar_name, flds_scalar_num, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - !-------------------------------- - ! diagnostics - !-------------------------------- - - if (dbug > 1) then - call state_diagnose(exportState,subname//':ES',rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - - call shr_log_setLogUnit (shrlogunit) - - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - - end subroutine InitializeRealize - - !=============================================================================== - subroutine ModelAdvance(gcomp, rc) - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_State) :: exportState - integer :: shrlogunit ! original log unit - character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - call memcheck(subname, 3, mastertask) - - call shr_log_getLogUnit (shrlogunit) - call shr_log_setLogUnit (logunit) - - !-------------------------------- - ! Pack export state - !-------------------------------- - - call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=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 state_diagnose(exportState,subname//':ES',rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - call log_clock_advance(clock, 'LND', logunit, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - endif - - call shr_log_setLogUnit (shrlogunit) - - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - - end subroutine ModelAdvance - - !=============================================================================== - - subroutine state_setexport(exportState, rc) - - ! input/output variables - type(ESMF_State) , intent(inout) :: exportState - integer, intent(out) :: rc - - ! local variables - integer :: n, nf, nind - real(r8), pointer :: lat(:) - real(r8), pointer :: lon(:) - integer :: spatialDim - integer :: numOwnedElements - real(R8), pointer :: ownedElemCoords(:) - !-------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ownedElemCoords(spatialDim*numOwnedElements)) - call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - allocate(lon(numownedElements)) - allocate(lat(numownedElements)) - do n = 1,numownedElements - lon(n) = ownedElemCoords(2*n-1) - lat(n) = ownedElemCoords(2*n) - end do - - ! Start from index 2 in order to Skip the scalar field here - do nf = 2,fldsFrLnd_num - if (fldsFrLnd(nf)%ungridded_ubound == 0) then - call field_setexport(exportState, trim(fldsFrLnd(nf)%stdname), lon, lat, nf=nf, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - do nind = 1,fldsFrLnd(nf)%ungridded_ubound - call field_setexport(exportState, trim(fldsFrLnd(nf)%stdname), lon, lat, nf=nf+nind-1, & - ungridded_index=nind, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - end if - end do - - deallocate(lon) - deallocate(lat) - - end subroutine state_setexport - - !=============================================================================== - - subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) - - use shr_const_mod , only : pi=>shr_const_pi - - ! intput/otuput variables - type(ESMF_State) , intent(inout) :: exportState - character(len=*) , intent(in) :: fldname - real(r8) , intent(in) :: lon(:) - real(r8) , intent(in) :: lat(:) - integer , intent(in) :: nf - integer, optional , intent(in) :: ungridded_index - integer , intent(out) :: rc - - ! local variables - integer :: i, ncomp - type(ESMF_Field) :: lfield - real(r8), pointer :: data1d(:) - real(r8), pointer :: data2d(:,:) - !-------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ncomp = 2 - if (present(ungridded_index)) then - call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (gridToFieldMap == 1) then - do i = 1,size(data2d, dim=1) - data2d(i,ungridded_index) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) - end do - else if (gridToFieldMap == 2) then - do i = 1,size(data2d, dim=2) - data2d(ungridded_index,i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) - end do - end if - else - call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (fldname == 'Sl_lfrin') then - data1d(:) = 1._r8 - else - do i = 1,size(data1d) - data1d(i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) - end do - end if - end if - - end subroutine field_setexport - - !=============================================================================== - subroutine ModelFinalize(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - if (mastertask) then - write(logunit,*) - write(logunit,*) 'xlnd: end of main integration loop' - write(logunit,*) - end if - end subroutine ModelFinalize - -end module lnd_comp_nuopc diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xocn/cime_config/buildlib b/CIME/non_py/src/components/xcpl_comps_nuopc/xocn/cime_config/buildlib deleted file mode 120000 index 7766f77f5bc..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xocn/cime_config/buildlib +++ /dev/null @@ -1 +0,0 @@ -../../../../../../build_scripts/buildlib.internal_components \ No newline at end of file diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xocn/cime_config/buildlib_cmake b/CIME/non_py/src/components/xcpl_comps_nuopc/xocn/cime_config/buildlib_cmake deleted file mode 120000 index 7766f77f5bc..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xocn/cime_config/buildlib_cmake +++ /dev/null @@ -1 +0,0 @@ -../../../../../../build_scripts/buildlib.internal_components \ No newline at end of file diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xocn/cime_config/buildnml b/CIME/non_py/src/components/xcpl_comps_nuopc/xocn/cime_config/buildnml deleted file mode 100755 index 7158056b462..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xocn/cime_config/buildnml +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/env python3 - -""" -build data model library -""" - -import sys, os - -_CIMEROOT = os.path.join( - os.path.dirname(os.path.abspath(__file__)), "..", "..", "..", "..", ".." -) -sys.path.append(os.path.join(_CIMEROOT, "CIME", "Tools")) - -from standard_script_setup import * -from CIME.buildnml import build_xcpl_nml, parse_input -from CIME.case import Case - - -def buildnml(case, caseroot, compname): - if compname != "xocn": - raise AttributeError - build_xcpl_nml(case, caseroot, compname) - - -def _main_func(): - caseroot = parse_input(sys.argv) - with Case(caseroot) as case: - buildnml(case, caseroot, "xocn") - - -if __name__ == "__main__": - _main_func() diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xocn/cime_config/config_component.xml b/CIME/non_py/src/components/xcpl_comps_nuopc/xocn/cime_config/config_component.xml deleted file mode 100644 index f68d1ff4701..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xocn/cime_config/config_component.xml +++ /dev/null @@ -1,27 +0,0 @@ - - - - - - - Dead ocean component - - - - char - xocn - xocn - case_comp - env_case.xml - Name of ocean component - - - - - - ========================================= - XOCN naming conventions in compset name - ========================================= - - - diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xocn/src/ocn_comp_nuopc.F90 b/CIME/non_py/src/components/xcpl_comps_nuopc/xocn/src/ocn_comp_nuopc.F90 deleted file mode 100644 index 87f8ca25102..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xocn/src/ocn_comp_nuopc.F90 +++ /dev/null @@ -1,475 +0,0 @@ -module ocn_comp_nuopc - - !---------------------------------------------------------------------------- - ! This is the NUOPC cap for XOCN - !---------------------------------------------------------------------------- - - use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - 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, SetVM - 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_log_mod , only : shr_log_getlogunit, shr_log_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_read_inparms, ModelInitPhase, ModelSetRunClock - use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - - implicit none - private ! except - - public :: SetServices - public :: SetVM - !-------------------------------------------------------------------------- - ! 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._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 - - type(ESMF_Mesh) :: mesh - 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 = 0 - character(*),parameter :: modName = "(xocn_comp_nuopc)" - character(*),parameter :: u_FILE_u = & - __FILE__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine SetServices(gcomp, rc) - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' - - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! the NUOPC gcomp component will register the generic methods - call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (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 (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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & - userRoutine=InitializeRealize, rc=rc) - 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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine SetServices - - !=============================================================================== - - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - - ! 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 - 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) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - mastertask = (my_task == master_task) - - ! determine instance information - 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 set_component_logging(gcomp, my_task==master_task, logunit, shrlogunit, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Initialize xocn - call dead_read_inparms('ocn', inst_suffix, logunit, nxg, nyg) - - ! 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)) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_omask" ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_t" ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_s" ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_u" ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_v" ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdx" ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_dhdy" ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "So_bldepth" ) - call fld_list_add(fldsFrOcn_num, fldsFrOcn, "Fioo_q" ) - - call fld_list_add(fldsToOcn_num, fldsToOcn, trim(flds_scalar_name)) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_rain" ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_snow" ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_lwdn" ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndr" ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdr" ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swndf" ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Faxa_swvdf" ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_taux" ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_tauy" ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_sen" ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lat" ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_lwup" ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_evap" ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Fioi_salt" ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofl" ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Foxx_rofi" ) - call fld_list_add(fldsToOcn_num, fldsToOcn, "Sa_pslv" ) - - do n = 1,fldsFrOcn_num - if(mastertask) write(logunit,*)'Advertising From Xocn ',trim(fldsFrOcn(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrOcn(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - enddo - - do n = 1,fldsToOcn_num - if(mastertask) write(logunit,*)'Advertising To Xocn',trim(fldsToOcn(n)%stdname) - call NUOPC_Advertise(importState, standardName=fldsToOcn(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - enddo - end if - - ! Reset shr logging to original values - call shr_log_setLogUnit (shrlogunit) - - 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 - integer, intent(out) :: rc - - ! local variables - integer :: shrlogunit ! original log unit - character(ESMF_MAXSTR) :: cvalue ! config data - character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize: xocn) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Reset shr logging to my log file - call shr_log_getLogUnit (shrlogunit) - call shr_log_setLogUnit (logunit) - - ! generate the mesh - call NUOPC_CompAttributeGet(gcomp, name='mesh_ocn', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - mesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! realize the actively coupled fields, now that a mesh is established - ! NUOPC_Realize "realizes" a previously advertised field in the importState and exportState - ! by replacing the advertised fields with the newly created fields of the same name. - call fld_list_realize( & - state=ExportState, & - fldlist=fldsFrOcn, & - numflds=fldsFrOcn_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':docnExport',& - mesh=mesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call fld_list_realize( & - state=importState, & - fldList=fldsToOcn, & - numflds=fldsToOcn_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':docnImport',& - mesh=mesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Pack export state - call state_setexport(exportState, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - 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 State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, flds_scalar_name, flds_scalar_num, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! diagnostics - if (dbug > 1) then - call state_diagnose(exportState,subname//':ES',rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - - call shr_log_setLogUnit (shrlogunit) - - end subroutine InitializeRealize - - !=============================================================================== - subroutine ModelAdvance(gcomp, rc) - - ! intput/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_State) :: exportState - integer :: shrlogunit ! original log unit - character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call memcheck(subname, 3, mastertask) - - call shr_log_getLogUnit (shrlogunit) - call shr_log_setLogUnit (logunit) - - ! Pack export state - call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=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 state_diagnose(exportState,subname//':ES',rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - - call shr_log_setLogUnit (shrlogunit) - - end subroutine ModelAdvance - - !=============================================================================== - subroutine state_setexport(exportState, rc) - - ! input/output variables - type(ESMF_State) , intent(inout) :: exportState - integer, intent(out) :: rc - - ! local variables - integer :: n, nf, nind - real(r8), pointer :: lat(:) - real(r8), pointer :: lon(:) - integer :: spatialDim - integer :: numOwnedElements - real(R8), pointer :: ownedElemCoords(:) - !-------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ownedElemCoords(spatialDim*numOwnedElements)) - call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - allocate(lon(numownedElements)) - allocate(lat(numownedElements)) - do n = 1,numownedElements - lon(n) = ownedElemCoords(2*n-1) - lat(n) = ownedElemCoords(2*n) - end do - - ! Start from index 2 in order to Skip the scalar field here - do nf = 2,fldsFrOcn_num - if (fldsFrOcn(nf)%ungridded_ubound == 0) then - call field_setexport(exportState, trim(fldsFrOcn(nf)%stdname), lon, lat, nf=nf, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - do nind = 1,fldsFrOcn(nf)%ungridded_ubound - call field_setexport(exportState, trim(fldsFrOcn(nf)%stdname), lon, lat, nf=nf, & - ungridded_index=nind, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - end if - end do - - deallocate(lon) - deallocate(lat) - - end subroutine state_setexport - - !=============================================================================== - - subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) - - use shr_const_mod , only : pi=>shr_const_pi - - ! intput/otuput variables - type(ESMF_State) , intent(inout) :: exportState - character(len=*) , intent(in) :: fldname - real(r8) , intent(in) :: lon(:) - real(r8) , intent(in) :: lat(:) - integer , intent(in) :: nf - integer, optional , intent(in) :: ungridded_index - integer , intent(out) :: rc - - ! local variables - integer :: i, ncomp - type(ESMF_Field) :: lfield - real(r8), pointer :: data1d(:) - real(r8), pointer :: data2d(:,:) - !-------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ncomp = 4 - if (present(ungridded_index)) then - call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (gridToFieldMap == 1) then - do i = 1,size(data2d, dim=1) - data2d(i,ungridded_index) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) - end do - else if (gridToFieldMap == 2) then - do i = 1,size(data2d, dim=2) - data2d(ungridded_index,i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) - end do - end if - else - call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do i = 1,size(data1d) - data1d(i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) - end do - end if - - if (fldname == 'So_omask') then - do i = 1,size(data1d) - !data1d(i) = float(nint(min(1.0_R8,max(0.0_R8,data1d(i))))) - data1d(i) = 0._r8 - end do - end if - - end subroutine field_setexport - - !=============================================================================== - subroutine ModelFinalize(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - if (mastertask) then - write(logunit,*) - write(logunit,*) 'xocn: end of main integration loop' - write(logunit,*) - end if - end subroutine ModelFinalize - -end module ocn_comp_nuopc diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xrof/cime_config/buildlib b/CIME/non_py/src/components/xcpl_comps_nuopc/xrof/cime_config/buildlib deleted file mode 120000 index 7766f77f5bc..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xrof/cime_config/buildlib +++ /dev/null @@ -1 +0,0 @@ -../../../../../../build_scripts/buildlib.internal_components \ No newline at end of file diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xrof/cime_config/buildlib_cmake b/CIME/non_py/src/components/xcpl_comps_nuopc/xrof/cime_config/buildlib_cmake deleted file mode 120000 index 7766f77f5bc..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xrof/cime_config/buildlib_cmake +++ /dev/null @@ -1 +0,0 @@ -../../../../../../build_scripts/buildlib.internal_components \ No newline at end of file diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xrof/cime_config/buildnml b/CIME/non_py/src/components/xcpl_comps_nuopc/xrof/cime_config/buildnml deleted file mode 100755 index bf23e8913e5..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xrof/cime_config/buildnml +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/env python3 - -""" -build data model library -""" - -import sys, os - -_CIMEROOT = os.path.join( - os.path.dirname(os.path.abspath(__file__)), "..", "..", "..", "..", ".." -) -sys.path.append(os.path.join(_CIMEROOT, "CIME", "Tools")) - -from standard_script_setup import * -from CIME.buildnml import build_xcpl_nml, parse_input -from CIME.case import Case - - -def buildnml(case, caseroot, compname): - if compname != "xrof": - raise AttributeError - build_xcpl_nml(case, caseroot, compname) - - -def _main_func(): - caseroot = parse_input(sys.argv) - with Case(caseroot) as case: - buildnml(case, caseroot, "xrof") - - -if __name__ == "__main__": - _main_func() diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xrof/cime_config/config_component.xml b/CIME/non_py/src/components/xcpl_comps_nuopc/xrof/cime_config/config_component.xml deleted file mode 100644 index e1663cbbb7b..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xrof/cime_config/config_component.xml +++ /dev/null @@ -1,39 +0,0 @@ - - - - - - - Dead river component - - - - char - xrof - xrof - case_comp - env_case.xml - Name of river component - - - - char - ACTIVE,NULL - NULL - - ACTIVE - ACTIVE - - build_component_xrof - env_build.xml - mode for xrof flood feature, NULL means xrof flood is turned off - - - - - ========================================= - XROF naming conventions in compset name - ========================================= - - - diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xrof/src/rof_comp_nuopc.F90 b/CIME/non_py/src/components/xcpl_comps_nuopc/xrof/src/rof_comp_nuopc.F90 deleted file mode 100644 index 1b5b9dd4901..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xrof/src/rof_comp_nuopc.F90 +++ /dev/null @@ -1,473 +0,0 @@ -module rof_comp_nuopc - - !---------------------------------------------------------------------------- - ! This is the NUOPC cap for XROF - !---------------------------------------------------------------------------- - - use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - 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, SetVM - 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_log_mod , only : shr_log_getlogunit, shr_log_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_read_inparms, ModelInitPhase, ModelSetRunClock - use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - - implicit none - private ! except - - public :: SetServices - public :: SetVM - !-------------------------------------------------------------------------- - ! 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 :: 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 - - type(ESMF_Mesh) :: mesh - 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 = 0 - character(*),parameter :: modName = "(xrof_comp_nuopc)" - character(*),parameter :: u_FILE_u = & - __FILE__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine SetServices(gcomp, rc) - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' - - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! the NUOPC gcomp component will register the generic methods - call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (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 (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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & - userRoutine=InitializeRealize, rc=rc) - 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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine SetServices - - !=============================================================================== - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - - ! 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(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) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - mastertask = (my_task == master_task) - - ! determine instance information - 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 set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! Initialize xrof - call dead_read_inparms('rof', inst_suffix, logunit, nxg, nyg) - - !-------------------------------- - ! 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)) - call fld_list_add(fldsFrRof_num, fldsFrRof, 'Forr_rofl') - call fld_list_add(fldsFrRof_num, fldsFrRof, 'Forr_rofi') - call fld_list_add(fldsFrRof_num, fldsFrRof, 'Flrr_flood') - call fld_list_add(fldsFrRof_num, fldsFrRof, 'Flrr_volr') - call fld_list_add(fldsFrRof_num, fldsFrRof, 'Flrr_volrmch') - - call fld_list_add(fldsToRof_num, fldsToRof, trim(flds_scalar_name)) - call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofsur') - call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofgwl') - call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofsub') - call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofdto') - call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_rofi') - call fld_list_add(fldsToRof_num, fldsToRof, 'Flrl_irrig') - - do n = 1,fldsFrRof_num - if(mastertask) write(logunit,*)'Advertising From Xrof ',trim(fldsFrRof(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrRof(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - enddo - - do n = 1,fldsToRof_num - if(mastertask) write(logunit,*)'Advertising To Xrof',trim(fldsToRof(n)%stdname) - call NUOPC_Advertise(importState, standardName=fldsToRof(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - enddo - end if - - if (dbug > 5) call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - - !---------------------------------------------------------------------------- - ! Reset shr logging to original values - !---------------------------------------------------------------------------- - - call shr_log_setLogUnit (shrlogunit) - - 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 - integer, intent(out) :: rc - - ! local variables - integer :: shrlogunit ! original log unit - character(ESMF_MAXSTR) :: cvalue ! config data - character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Reset shr logging to my log file - call shr_log_getLogUnit (shrlogunit) - call shr_log_setLogUnit (logUnit) - - - ! generate the mesh - call NUOPC_CompAttributeGet(gcomp, name='mesh_rof', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - mesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! realize the actively coupled fields, now that a mesh is established - ! NUOPC_Realize "realizes" a previously advertised field in the importState and exportState - ! by replacing the advertised fields with the newly created fields of the same name. - call fld_list_realize( & - state=ExportState, & - fldlist=fldsFrRof, & - numflds=fldsFrRof_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':drofExport',& - mesh=mesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call fld_list_realize( & - state=importState, & - fldList=fldsToRof, & - numflds=fldsToRof_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':drofImport',& - mesh=mesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - !-------------------------------- - ! Pack export state - !-------------------------------- - - call state_setexport(exportState, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - 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 State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, flds_scalar_name, flds_scalar_num, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - !-------------------------------- - ! diagnostics - !-------------------------------- - - if (dbug > 1) then - call State_diagnose(exportState,subname//':ES',rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - - call shr_log_setLogUnit (shrlogunit) - - end subroutine InitializeRealize - - !=============================================================================== - subroutine ModelAdvance(gcomp, rc) - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_State) :: exportState - integer :: shrlogunit ! original log unit - character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - if (dbug > 5) then - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - end if - call memcheck(subname, 3, mastertask) - - call shr_log_getLogUnit (shrlogunit) - call shr_log_setLogUnit (logunit) - - ! Pack export state - call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=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 State_diagnose(exportState,subname//':ES',rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (mastertask) then - call log_clock_advance(clock, 'XROF', logunit, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - endif - - call shr_log_setLogUnit (shrlogunit) - - if (dbug > 5) then - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - end if - - end subroutine ModelAdvance - - !=============================================================================== - subroutine state_setexport(exportState, rc) - - ! input/output variables - type(ESMF_State) , intent(inout) :: exportState - integer, intent(out) :: rc - - ! local variables - integer :: n, nf, nind - real(r8), pointer :: lat(:) - real(r8), pointer :: lon(:) - integer :: spatialDim - integer :: numOwnedElements - real(R8), pointer :: ownedElemCoords(:) - !-------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ownedElemCoords(spatialDim*numOwnedElements)) - call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - allocate(lon(numownedElements)) - allocate(lat(numownedElements)) - do n = 1,numownedElements - lon(n) = ownedElemCoords(2*n-1) - lat(n) = ownedElemCoords(2*n) - end do - - ! Start from index 2 in order to skip the scalar field - do nf = 2,fldsFrRof_num - if (fldsFrRof(nf)%ungridded_ubound == 0) then - call field_setexport(exportState, trim(fldsFrRof(nf)%stdname), lon, lat, nf=nf, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - do nind = 1,fldsFrRof(nf)%ungridded_ubound - call field_setexport(exportState, trim(fldsFrRof(nf)%stdname), lon, lat, nf=nf+nind-1, & - ungridded_index=nind, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - end if - end do - - deallocate(lon) - deallocate(lat) - - end subroutine state_setexport - - !=============================================================================== - subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) - - use shr_const_mod , only : pi=>shr_const_pi - - ! intput/otuput variables - type(ESMF_State) , intent(inout) :: exportState - character(len=*) , intent(in) :: fldname - real(r8) , intent(in) :: lon(:) - real(r8) , intent(in) :: lat(:) - integer , intent(in) :: nf - integer, optional , intent(in) :: ungridded_index - integer , intent(out) :: rc - - ! local variables - integer :: i, ncomp - type(ESMF_Field) :: lfield - real(r8), pointer :: data1d(:) - real(r8), pointer :: data2d(:,:) - !-------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ncomp = 6 - if (present(ungridded_index)) then - call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (gridToFieldMap == 1) then - do i = 1,size(data2d, dim=1) - data2d(i,ungridded_index) = (nf+1) * 1.0_r8 - end do - else if (gridToFieldMap == 2) then - do i = 1,size(data2d, dim=2) - data2d(ungridded_index,i) = (nf+1) * 1.0_r8 - end do - end if - else - call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do i = 1,size(data1d) - data1d(i) = (nf+1) * 1.0_r8 - end do - end if - - end subroutine field_setexport - - !=============================================================================== - subroutine ModelFinalize(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - if (mastertask) then - write(logunit,*) - write(logunit,*) 'xrof: end of main integration loop' - write(logunit,*) - end if - end subroutine ModelFinalize - -end module rof_comp_nuopc diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xshare/dead_methods_mod.F90 b/CIME/non_py/src/components/xcpl_comps_nuopc/xshare/dead_methods_mod.F90 deleted file mode 100644 index a9ad38e2419..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xshare/dead_methods_mod.F90 +++ /dev/null @@ -1,853 +0,0 @@ -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_log_mod , only : shr_log_setlogunit, shr_log_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) - use ESMF, only : ESMF_GridCompGet, ESMF_LogWrite - use NUOPC, only: NUOPC_CompAttributeAdd, NUOPC_CompAttributeSet - ! 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, name - character(len=CL) :: logfile - character(len=*), parameter :: subname ='('//__FILE__//': set_component_logging)' - !----------------------------------------------------------------------- - - 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_log_setLogUnit (logunit) - - call ESMF_GridCompGet(gcomp, name=name, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(trim(subname)//": setting logunit for component: "//trim(name), ESMF_LOGMSG_INFO) - - call NUOPC_CompAttributeAdd(gcomp, attrList=(/'logunit'/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompAttributeSet(gcomp, name='logunit',value=logunit, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - - 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/non_py/src/components/xcpl_comps_nuopc/xshare/dead_nuopc_mod.F90 b/CIME/non_py/src/components/xcpl_comps_nuopc/xshare/dead_nuopc_mod.F90 deleted file mode 100644 index ee3ca6b682e..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xshare/dead_nuopc_mod.F90 +++ /dev/null @@ -1,346 +0,0 @@ -module dead_nuopc_mod - - use ESMF , only : ESMF_Gridcomp, ESMF_State, ESMF_StateGet - use ESMF , only : ESMF_Clock, ESMF_Time, ESMF_TimeInterval, ESMF_Alarm - use ESMF , only : ESMF_GridCompGet, ESMF_ClockGet, ESMF_ClockSet, ESMF_ClockAdvance, ESMF_AlarmSet - use ESMF , only : ESMF_SUCCESS, ESMF_LogWrite, ESMF_LOGMSG_INFO, ESMF_METHOD_INITIALIZE - use ESMF , only : ESMF_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 - - public :: dead_read_inparms - public :: ModelInitPhase - public :: ModelSetRunClock - public :: fld_list_add - public :: fld_list_realize - - ! !PUBLIC DATA MEMBERS: - type fld_list_type - character(len=128) :: stdname - integer :: ungridded_lbound = 0 - integer :: ungridded_ubound = 0 - end type fld_list_type - public :: fld_list_type - - integer, parameter, public :: fldsMax = 100 - integer :: dbug_flag = 0 - character(*), parameter :: u_FILE_u = & - __FILE__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine dead_read_inparms(model, inst_suffix, logunit, nxg, nyg) - - ! input/output variables - character(len=*) , intent(in) :: model - character(len=*) , intent(in) :: inst_suffix ! char string associated with instance - integer , intent(in) :: logunit ! logging unit number - integer , intent(out) :: nxg ! global dim i-direction - integer , intent(out) :: nyg ! global dim j-direction - - ! local variables - type(ESMF_VM) :: vm - character(CL) :: fileName ! generic file name - integer :: nunit ! unit number - integer :: unitn ! Unit for namelist file - integer :: tmp(2) ! array for broadcast - integer :: localPet ! mpi id of current task in current context - integer :: rc ! return code - character(*), parameter :: F00 = "('(dead_read_inparms) ',8a)" - character(*), parameter :: F01 = "('(dead_read_inparms) ',a,a,4i8)" - character(*), parameter :: F03 = "('(dead_read_inparms) ',a,a,i8,a)" - character(*), parameter :: subName = "(dead_read_inpamrs) " - !------------------------------------------------------------------------------- - - ! read the input parms (used to configure model) - call ESMF_VMGetCurrent(vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call ESMF_VMGet(vm, localPet=localPet, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - nxg = -9999 - nyg = -9999 - - if (localPet==0) then - open(newunit=unitn, file='x'//model//'_in'//trim(inst_suffix), status='old' ) - read(unitn,*) nxg - read(unitn,*) nyg - close (unitn) - endif - - tmp(1) = nxg - tmp(2) = nyg - call ESMF_VMBroadcast(vm, tmp, 3, 0, rc=rc) - nxg = tmp(1) - nyg = tmp(2) - - if (localPet==0) then - write(logunit,*)' Read in X'//model//' input from file= x'//model//'_in' - write(logunit,F00) model - write(logunit,F00) model,' Model : ',model - write(logunit,F01) model,' NGX : ',nxg - write(logunit,F01) model,' NGY : ',nyg - write(logunit,F00) model,' inst_suffix : ',trim(inst_suffix) - write(logunit,F00) model - end if - - end subroutine dead_read_inparms - - !=============================================================================== - subroutine fld_list_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound) - - ! input/output variables - integer , intent(inout) :: num - type(fld_list_type) , intent(inout) :: fldlist(:) - character(len=*) , intent(in) :: stdname - integer, optional , intent(in) :: ungridded_lbound - integer, optional , intent(in) :: ungridded_ubound - - ! local variables - character(len=*), parameter :: subname='(dead_nuopc_mod:fld_list_add)' - !------------------------------------------------------------------------------- - - ! Set up a list of field information - num = num + 1 - if (num > fldsMax) then - call ESMF_LogWrite(trim(subname)//": ERROR num > fldsMax "//trim(stdname), & - ESMF_LOGMSG_ERROR, line=__LINE__, file=__FILE__) - return - endif - fldlist(num)%stdname = trim(stdname) - - if (present(ungridded_lbound) .and. present(ungridded_ubound)) then - fldlist(num)%ungridded_lbound = ungridded_lbound - fldlist(num)%ungridded_ubound = ungridded_ubound - end if - - end subroutine fld_list_add - - !=============================================================================== - subroutine fld_list_realize(state, fldList, numflds, flds_scalar_name, flds_scalar_num, mesh, tag, rc) - - use NUOPC , only : NUOPC_IsConnected, NUOPC_Realize - use ESMF , only : ESMF_MeshLoc_Element, ESMF_FieldCreate, ESMF_TYPEKIND_R8 - use ESMF , only : ESMF_MAXSTR, ESMF_Field, ESMF_State, ESMF_Mesh, ESMF_StateRemove - use ESMF , only : ESMF_LogFoundError, ESMF_LOGMSG_INFO, ESMF_SUCCESS - use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LOGERR_PASSTHRU - - type(ESMF_State) , intent(inout) :: state - type(fld_list_type) , intent(in) :: fldList(:) - integer , intent(in) :: numflds - character(len=*) , intent(in) :: flds_scalar_name - integer , intent(in) :: flds_scalar_num - character(len=*) , intent(in) :: tag - type(ESMF_Mesh) , intent(in) :: mesh - integer , intent(inout) :: rc - - ! local variables - integer :: n - type(ESMF_Field) :: field - character(len=80) :: stdname - integer :: gridtoFieldMap=2 - character(len=*),parameter :: subname='(dead_nuopc_mod:fld_list_realize)' - ! ---------------------------------------------- - - rc = ESMF_SUCCESS - - do n = 1, numflds - stdname = fldList(n)%stdname - if (NUOPC_IsConnected(state, fieldName=stdname)) then - if (stdname == trim(flds_scalar_name)) then - call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected on root pe", & - ESMF_LOGMSG_INFO) - ! Create the scalar field - call SetScalarField(field, flds_scalar_name, flds_scalar_num, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - else - call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & - ESMF_LOGMSG_INFO) - ! Create the field - if (fldlist(n)%ungridded_lbound > 0 .and. fldlist(n)%ungridded_ubound > 0) then - field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, & - ungriddedLbound=(/fldlist(n)%ungridded_lbound/), & - ungriddedUbound=(/fldlist(n)%ungridded_ubound/), & - gridToFieldMap=(/gridToFieldMap/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - field = ESMF_FieldCreate(mesh, ESMF_TYPEKIND_R8, name=stdname, meshloc=ESMF_MESHLOC_ELEMENT, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - end if - endif - - ! NOW call NUOPC_Realize - call NUOPC_Realize(state, field=field, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - else - if (stdname /= trim(flds_scalar_name)) then - call ESMF_LogWrite(subname // trim(tag) // " Field = "// trim(stdname) // " is not connected.", & - ESMF_LOGMSG_INFO) - call ESMF_StateRemove(state, (/stdname/), rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=u_FILE_u)) return - end if - end if - end do - - 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='(dead_nuopc_mod: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 fld_list_realize - - !=============================================================================== - subroutine ModelInitPhase(gcomp, importState, exportState, clock, rc) - - use NUOPC, only : NUOPC_CompFilterPhaseMap - - type(ESMF_GridComp) :: gcomp - type(ESMF_State) :: importState, exportState - type(ESMF_Clock) :: clock - integer, intent(out) :: rc - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Switch to IPDv01 by filtering all other phaseMap entries - call NUOPC_CompFilterPhaseMap(gcomp, ESMF_METHOD_INITIALIZE, acceptStringList=(/"IPDv01p"/), rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine ModelInitPhase - - !=============================================================================== - subroutine ModelSetRunClock(gcomp, rc) - - use ESMF , only : ESMF_ClockGetAlarmList, ESMF_ALARMLIST_ALL - use NUOPC_Model , only : NUOPC_ModelGet - use NUOPC , only : NUOPC_CompAttributeGet - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: mclock, dclock - type(ESMF_Time) :: mcurrtime, dcurrtime - type(ESMF_Time) :: mstoptime - type(ESMF_TimeInterval) :: mtimestep, dtimestep - character(len=256) :: cvalue - character(len=256) :: restart_option ! Restart option units - integer :: restart_n ! Number until restart interval - integer :: restart_ymd ! Restart date (YYYYMMDD) - type(ESMF_ALARM) :: restart_alarm - character(len=128) :: name - integer :: alarmcount - character(len=*),parameter :: subname='dead_nuopc_mod:(ModelSetRunClock) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! query the Component for its clocks - call NUOPC_ModelGet(gcomp, driverClock=dclock, modelClock=mclock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_ClockGet(dclock, currTime=dcurrtime, timeStep=dtimestep, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - !-------------------------------- - ! force model clock currtime and timestep to match driver and set stoptime - !-------------------------------- - - mstoptime = mcurrtime + dtimestep - call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - !-------------------------------- - ! set restart alarm - !-------------------------------- - - call ESMF_ClockGetAlarmList(mclock, alarmlistflag=ESMF_ALARMLIST_ALL, alarmCount=alarmCount, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - if (alarmCount == 0) then - - call ESMF_GridCompGet(gcomp, name=name, rc=rc) - 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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompAttributeGet(gcomp, name="restart_n", value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) restart_n - - call NUOPC_CompAttributeGet(gcomp, name="restart_ymd", value=cvalue, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - read(cvalue,*) restart_ymd - - call alarmInit(mclock, restart_alarm, restart_option, & - opt_n = restart_n, & - opt_ymd = restart_ymd, & - RefTime = mcurrTime, & - alarmname = 'alarm_restart', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_AlarmSet(restart_alarm, clock=mclock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end if - - !-------------------------------- - ! Advance model clock to trigger alarms then reset model clock back to currtime - !-------------------------------- - - call ESMF_ClockAdvance(mclock,rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_ClockSet(mclock, currTime=dcurrtime, timeStep=dtimestep, stopTime=mstoptime, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine ModelSetRunClock - -end module dead_nuopc_mod diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xwav/cime_config/buildlib b/CIME/non_py/src/components/xcpl_comps_nuopc/xwav/cime_config/buildlib deleted file mode 120000 index 7766f77f5bc..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xwav/cime_config/buildlib +++ /dev/null @@ -1 +0,0 @@ -../../../../../../build_scripts/buildlib.internal_components \ No newline at end of file diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xwav/cime_config/buildlib_cmake b/CIME/non_py/src/components/xcpl_comps_nuopc/xwav/cime_config/buildlib_cmake deleted file mode 120000 index 7766f77f5bc..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xwav/cime_config/buildlib_cmake +++ /dev/null @@ -1 +0,0 @@ -../../../../../../build_scripts/buildlib.internal_components \ No newline at end of file diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xwav/cime_config/buildnml b/CIME/non_py/src/components/xcpl_comps_nuopc/xwav/cime_config/buildnml deleted file mode 100755 index 1ea9dc3a5d8..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xwav/cime_config/buildnml +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/env python3 - -""" -build data model library -""" - -import sys, os - -_CIMEROOT = os.path.join( - os.path.dirname(os.path.abspath(__file__)), "..", "..", "..", "..", ".." -) -sys.path.append(os.path.join(_CIMEROOT, "CIME", "Tools")) - -from standard_script_setup import * -from CIME.buildnml import build_xcpl_nml, parse_input -from CIME.case import Case - - -def buildnml(case, caseroot, compname): - if compname != "xwav": - raise AttributeError - build_xcpl_nml(case, caseroot, compname) - - -def _main_func(): - caseroot = parse_input(sys.argv) - with Case(caseroot) as case: - buildnml(case, caseroot, "xwav") - - -if __name__ == "__main__": - _main_func() diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xwav/cime_config/config_component.xml b/CIME/non_py/src/components/xcpl_comps_nuopc/xwav/cime_config/config_component.xml deleted file mode 100644 index e82944fd3d8..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xwav/cime_config/config_component.xml +++ /dev/null @@ -1,26 +0,0 @@ - - - - - - - Dead wave component - - - - - char - xwav - xwav - case_comp - env_case.xml - Name of wave component - - - - ========================================= - XWAV naming conventions in compset name - ========================================= - - - diff --git a/CIME/non_py/src/components/xcpl_comps_nuopc/xwav/src/wav_comp_nuopc.F90 b/CIME/non_py/src/components/xcpl_comps_nuopc/xwav/src/wav_comp_nuopc.F90 deleted file mode 100644 index aa4d982e530..00000000000 --- a/CIME/non_py/src/components/xcpl_comps_nuopc/xwav/src/wav_comp_nuopc.F90 +++ /dev/null @@ -1,465 +0,0 @@ -module wav_comp_nuopc - - !---------------------------------------------------------------------------- - ! This is the NUOPC cap for XWAV - !---------------------------------------------------------------------------- - - use ESMF - use NUOPC , only : NUOPC_CompDerive, NUOPC_CompSetEntryPoint, NUOPC_CompSpecialize - use NUOPC , only : NUOPC_CompAttributeGet, NUOPC_Advertise - 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, SetVM - 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_log_mod , only : shr_log_getlogunit, shr_log_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_read_inparms, ModelInitPhase, ModelSetRunClock - use dead_nuopc_mod , only : fld_list_add, fld_list_realize, fldsMax, fld_list_type - - implicit none - private ! except - - public :: SetServices - public :: SetVM - !-------------------------------------------------------------------------- - ! 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 :: 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 - - type(ESMF_Mesh) :: mesh - 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__ - -!=============================================================================== -contains -!=============================================================================== - - subroutine SetServices(gcomp, rc) - - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - character(len=*),parameter :: subname=trim(modName)//':(SetServices) ' - - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! the NUOPC gcomp component will register the generic methods - call NUOPC_CompDerive(gcomp, model_routine_SS, rc=rc) - if (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 (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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSetEntryPoint(gcomp, ESMF_METHOD_INITIALIZE, phaseLabelList=(/"IPDv01p3"/), & - userRoutine=InitializeRealize, rc=rc) - 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 (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_MethodRemove(gcomp, label=model_label_SetRunClock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_SetRunClock, specRoutine=ModelSetRunClock, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call NUOPC_CompSpecialize(gcomp, specLabel=model_label_Finalize, specRoutine=ModelFinalize, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - end subroutine SetServices - - !=============================================================================== - subroutine InitializeAdvertise(gcomp, importState, exportState, clock, rc) - - ! 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(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) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_GridCompGet(gcomp, vm=vm, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call ESMF_VMGet(vm, localpet=my_task, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - mastertask = (my_task == 0) - - ! determine instance information - 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 set_component_logging(gcomp, mastertask, logunit, shrlogunit, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Initialize xwav - call dead_read_inparms('wav', inst_suffix, logunit, nxg, nyg) - - ! 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)) - call fld_list_add(fldsFrWav_num, fldsFrWav, 'Sw_lamult' ) - call fld_list_add(fldsFrWav_num, fldsFrWav, 'Sw_ustokes' ) - call fld_list_add(fldsFrWav_num, fldsFrWav, 'Sw_vstokes' ) - call fld_list_add(fldsFrWav_num, fldsFrWav, 'Sw_hstokes' ) - - call fld_list_add(fldsToWav_num, fldsToWav, trim(flds_scalar_name)) - call fld_list_add(fldsToWav_num, fldsToWav, 'Sa_u' ) - call fld_list_add(fldsToWav_num, fldsToWav, 'Sa_v' ) - call fld_list_add(fldsToWav_num, fldsToWav, 'Sa_tbot' ) - call fld_list_add(fldsToWav_num, fldsToWav, 'Si_ifrac' ) - call fld_list_add(fldsToWav_num, fldsToWav, 'So_t' ) - call fld_list_add(fldsToWav_num, fldsToWav, 'So_u' ) - call fld_list_add(fldsToWav_num, fldsToWav, 'So_v' ) - call fld_list_add(fldsToWav_num, fldsToWav, 'So_bldepth' ) - - do n = 1,fldsFrWav_num - if (mastertask) write(logunit,*)'Advertising From Xwav ',trim(fldsFrWav(n)%stdname) - call NUOPC_Advertise(exportState, standardName=fldsFrWav(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - enddo - - do n = 1,fldsToWav_num - if(mastertask) write(logunit,*)'Advertising To Xwav ',trim(fldsToWav(n)%stdname) - call NUOPC_Advertise(importState, standardName=fldsToWav(n)%stdname, & - TransferOfferGeomObject='will provide', rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - enddo - end if - - call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Reset shr logging to original values - call shr_log_setLogUnit (shrlogunit) - - 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 - integer, intent(out) :: rc - - ! local variables - integer :: shrlogunit ! original log unit - character(ESMF_MAXSTR) :: cvalue ! config data - character(len=*),parameter :: subname=trim(modName)//':(InitializeRealize) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - ! Reset shr logging to my log file - call shr_log_getLogUnit (shrlogunit) - call shr_log_setLogUnit (logunit) - - ! generate the mesh - call NUOPC_CompAttributeGet(gcomp, name='mesh_wav', value=cvalue, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - mesh = ESMF_MeshCreate(filename=trim(cvalue), fileformat=ESMF_FILEFORMAT_ESMFMESH, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - ! realize the actively coupled fields, now that a mesh is established - ! NUOPC_Realize "realizes" a previously advertised field in the importState and exportState - ! by replacing the advertised fields with the newly created fields of the same name. - call fld_list_realize( & - state=ExportState, & - fldlist=fldsFrWav, & - numflds=fldsFrWav_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':dwavExport',& - mesh=mesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - call fld_list_realize( & - state=importState, & - fldList=fldsToWav, & - numflds=fldsToWav_num, & - flds_scalar_name=flds_scalar_name, & - flds_scalar_num=flds_scalar_num, & - tag=subname//':dwavImport',& - mesh=mesh, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! Pack export state - call State_SetExport(exportState, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - 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 State_SetScalar(dble(nyg),flds_scalar_index_ny, exportState, flds_scalar_name, flds_scalar_num, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ! diagnostics - if (dbug > 1) then - call State_diagnose(exportState,subname//':ES',rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - - call shr_log_setLogUnit (shrlogunit) - - end subroutine InitializeRealize - - !=============================================================================== - subroutine ModelAdvance(gcomp, rc) - - ! input/output variables - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - - ! local variables - type(ESMF_Clock) :: clock - type(ESMF_State) :: exportState - integer :: shrlogunit ! original log unit - character(len=*),parameter :: subname=trim(modName)//':(ModelAdvance) ' - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - call memcheck(subname, 3, mastertask) - - call shr_log_getLogUnit (shrlogunit) - call shr_log_setLogUnit (logunit) - - ! Pack export state - call NUOPC_ModelGet(gcomp, modelClock=clock, exportState=exportState, rc=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 State_diagnose(exportState,subname//':ES',rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if ( mastertask) then - call log_clock_advance(clock, 'XWAV', logunit, rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - endif - endif - - call shr_log_setLogUnit (shrlogunit) - - end subroutine ModelAdvance - - !=============================================================================== - subroutine state_setexport(exportState, rc) - - ! input/output variables - type(ESMF_State) , intent(inout) :: exportState - integer , intent(out) :: rc - - ! local variables - integer :: nfstart, ubound - integer :: n, nf, nind - real(r8), pointer :: lat(:) - real(r8), pointer :: lon(:) - integer :: spatialDim - integer :: numOwnedElements - real(R8), pointer :: ownedElemCoords(:) - !-------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_MeshGet(mesh, spatialDim=spatialDim, numOwnedElements=numOwnedElements, rc=rc) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - allocate(ownedElemCoords(spatialDim*numOwnedElements)) - call ESMF_MeshGet(mesh, ownedElemCoords=ownedElemCoords) - if (ChkErr(rc,__LINE__,u_FILE_u)) return - - allocate(lon(numownedElements)) - allocate(lat(numownedElements)) - do n = 1,numownedElements - lon(n) = ownedElemCoords(2*n-1) - lat(n) = ownedElemCoords(2*n) - end do - - nfstart = 0 ! for fields that have ubound > 0 - do nf = 2,fldsFrWav_num ! Start from index 2 in order to skip the scalar field - ubound = fldsFrWav(nf)%ungridded_ubound - if (ubound == 0) then - call field_setexport(exportState, trim(fldsFrWav(nf)%stdname), lon, lat, nf=nf, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - else - nfstart = nfstart + nf + ubound - 1 - do nind = 1,ubound - call field_setexport(exportState, trim(fldsFrWav(nf)%stdname), lon, lat, nf=nfstart+nind-1, & - ungridded_index=nind, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - end do - end if - end do - - deallocate(lon) - deallocate(lat) - - end subroutine state_setexport - - !=============================================================================== - - subroutine field_setexport(exportState, fldname, lon, lat, nf, ungridded_index, rc) - - use shr_const_mod , only : pi=>shr_const_pi - - ! intput/otuput variables - type(ESMF_State) , intent(inout) :: exportState - character(len=*) , intent(in) :: fldname - real(r8) , intent(in) :: lon(:) - real(r8) , intent(in) :: lat(:) - integer , intent(in) :: nf - integer, optional , intent(in) :: ungridded_index - integer , intent(out) :: rc - - ! local variables - integer :: i, ncomp - type(ESMF_Field) :: lfield - real(r8), pointer :: data1d(:) - real(r8), pointer :: data2d(:,:) - !-------------------------------------------------- - - rc = ESMF_SUCCESS - - call ESMF_StateGet(exportState, itemName=trim(fldname), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - - ncomp = 7 - if (present(ungridded_index)) then - call ESMF_FieldGet(lfield, farrayPtr=data2d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - if (gridToFieldMap == 1) then - do i = 1,size(data2d, dim=1) - data2d(i,ungridded_index) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) - end do - else if (gridToFieldMap == 2) then - do i = 1,size(data2d, dim=2) - data2d(ungridded_index,i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) - end do - end if - else - call ESMF_FieldGet(lfield, farrayPtr=data1d, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return - do i = 1,size(data1d) - data1d(i) = (nf*100) * cos(pi*lat(i)/180.0_R8) * & - sin((pi*lon(i)/180.0_R8) - (ncomp-1)*(pi/3.0_R8) ) + (ncomp*10.0_R8) - end do - end if - - end subroutine field_setexport - - !=============================================================================== - subroutine ModelFinalize(gcomp, rc) - type(ESMF_GridComp) :: gcomp - integer, intent(out) :: rc - !------------------------------------------------------------------------------- - - rc = ESMF_SUCCESS - - if (mastertask) then - write(logunit,*) - write(logunit,*) 'xwav: end of main integration loop' - write(logunit,*) - end if - end subroutine ModelFinalize - -end module wav_comp_nuopc