diff --git a/med_test_comps/xatm/cime_config/buildlib b/med_test_comps/xatm/cime_config/buildlib new file mode 120000 index 000000000..ba1b3b80a --- /dev/null +++ b/med_test_comps/xatm/cime_config/buildlib @@ -0,0 +1 @@ +../../xshare/cime_config/buildlib \ No newline at end of file diff --git a/med_test_comps/xatm/cime_config/buildnml b/med_test_comps/xatm/cime_config/buildnml new file mode 100755 index 000000000..e7efcd46b --- /dev/null +++ b/med_test_comps/xatm/cime_config/buildnml @@ -0,0 +1,32 @@ +#!/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/med_test_comps/xatm/cime_config/config_component.xml b/med_test_comps/xatm/cime_config/config_component.xml new file mode 100644 index 000000000..76c8be8c7 --- /dev/null +++ b/med_test_comps/xatm/cime_config/config_component.xml @@ -0,0 +1,25 @@ + + + + + + + Dead atm component + + + + char + xatm + xatm + case_comp + env_case.xml + Name of atmosphere component + + + + ========================================= + XATM naming conventions in compset name + ========================================= + + + diff --git a/med_test_comps/xatm/src/atm_comp_nuopc.F90 b/med_test_comps/xatm/src/atm_comp_nuopc.F90 new file mode 100644 index 000000000..64cd5b768 --- /dev/null +++ b/med_test_comps/xatm/src/atm_comp_nuopc.F90 @@ -0,0 +1,529 @@ +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/med_test_comps/xglc/cime_config/buildlib b/med_test_comps/xglc/cime_config/buildlib new file mode 120000 index 000000000..ba1b3b80a --- /dev/null +++ b/med_test_comps/xglc/cime_config/buildlib @@ -0,0 +1 @@ +../../xshare/cime_config/buildlib \ No newline at end of file diff --git a/med_test_comps/xglc/cime_config/buildnml b/med_test_comps/xglc/cime_config/buildnml new file mode 100755 index 000000000..a90f7a189 --- /dev/null +++ b/med_test_comps/xglc/cime_config/buildnml @@ -0,0 +1,32 @@ +#!/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/med_test_comps/xglc/cime_config/config_component.xml b/med_test_comps/xglc/cime_config/config_component.xml new file mode 100644 index 000000000..f1765811b --- /dev/null +++ b/med_test_comps/xglc/cime_config/config_component.xml @@ -0,0 +1,26 @@ + + + + + + + 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/med_test_comps/xglc/src/glc_comp_nuopc.F90 b/med_test_comps/xglc/src/glc_comp_nuopc.F90 new file mode 100644 index 000000000..4b498f8d9 --- /dev/null +++ b/med_test_comps/xglc/src/glc_comp_nuopc.F90 @@ -0,0 +1,457 @@ +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/med_test_comps/xice/cime_config/buildlib b/med_test_comps/xice/cime_config/buildlib new file mode 120000 index 000000000..ba1b3b80a --- /dev/null +++ b/med_test_comps/xice/cime_config/buildlib @@ -0,0 +1 @@ +../../xshare/cime_config/buildlib \ No newline at end of file diff --git a/med_test_comps/xice/cime_config/buildnml b/med_test_comps/xice/cime_config/buildnml new file mode 100755 index 000000000..7d141edd6 --- /dev/null +++ b/med_test_comps/xice/cime_config/buildnml @@ -0,0 +1,32 @@ +#!/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/med_test_comps/xice/cime_config/config_component.xml b/med_test_comps/xice/cime_config/config_component.xml new file mode 100644 index 000000000..a3263a0ee --- /dev/null +++ b/med_test_comps/xice/cime_config/config_component.xml @@ -0,0 +1,26 @@ + + + + + + + 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/med_test_comps/xice/src/ice_comp_nuopc.F90 b/med_test_comps/xice/src/ice_comp_nuopc.F90 new file mode 100644 index 000000000..9185b8e53 --- /dev/null +++ b/med_test_comps/xice/src/ice_comp_nuopc.F90 @@ -0,0 +1,552 @@ +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/med_test_comps/xlnd/cime_config/buildlib b/med_test_comps/xlnd/cime_config/buildlib new file mode 120000 index 000000000..ba1b3b80a --- /dev/null +++ b/med_test_comps/xlnd/cime_config/buildlib @@ -0,0 +1 @@ +../../xshare/cime_config/buildlib \ No newline at end of file diff --git a/med_test_comps/xlnd/cime_config/buildnml b/med_test_comps/xlnd/cime_config/buildnml new file mode 100755 index 000000000..72e822771 --- /dev/null +++ b/med_test_comps/xlnd/cime_config/buildnml @@ -0,0 +1,32 @@ +#!/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/med_test_comps/xlnd/cime_config/config_component.xml b/med_test_comps/xlnd/cime_config/config_component.xml new file mode 100644 index 000000000..8179d0310 --- /dev/null +++ b/med_test_comps/xlnd/cime_config/config_component.xml @@ -0,0 +1,26 @@ + + + + + + + Dead land component + + + + + char + xlnd + xlnd + case_comp + env_case.xml + Name of land component + + + + ========================================= + XLND naming conventions in compset name + ========================================= + + + diff --git a/med_test_comps/xlnd/src/lnd_comp_nuopc.F90 b/med_test_comps/xlnd/src/lnd_comp_nuopc.F90 new file mode 100644 index 000000000..a43215939 --- /dev/null +++ b/med_test_comps/xlnd/src/lnd_comp_nuopc.F90 @@ -0,0 +1,564 @@ +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/med_test_comps/xocn/cime_config/buildlib b/med_test_comps/xocn/cime_config/buildlib new file mode 120000 index 000000000..ba1b3b80a --- /dev/null +++ b/med_test_comps/xocn/cime_config/buildlib @@ -0,0 +1 @@ +../../xshare/cime_config/buildlib \ No newline at end of file diff --git a/med_test_comps/xocn/cime_config/buildnml b/med_test_comps/xocn/cime_config/buildnml new file mode 100755 index 000000000..7158056b4 --- /dev/null +++ b/med_test_comps/xocn/cime_config/buildnml @@ -0,0 +1,32 @@ +#!/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/med_test_comps/xocn/cime_config/config_component.xml b/med_test_comps/xocn/cime_config/config_component.xml new file mode 100644 index 000000000..f68d1ff47 --- /dev/null +++ b/med_test_comps/xocn/cime_config/config_component.xml @@ -0,0 +1,27 @@ + + + + + + + Dead ocean component + + + + char + xocn + xocn + case_comp + env_case.xml + Name of ocean component + + + + + + ========================================= + XOCN naming conventions in compset name + ========================================= + + + diff --git a/med_test_comps/xocn/src/ocn_comp_nuopc.F90 b/med_test_comps/xocn/src/ocn_comp_nuopc.F90 new file mode 100644 index 000000000..87f8ca251 --- /dev/null +++ b/med_test_comps/xocn/src/ocn_comp_nuopc.F90 @@ -0,0 +1,475 @@ +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/med_test_comps/xrof/cime_config/buildlib b/med_test_comps/xrof/cime_config/buildlib new file mode 120000 index 000000000..ba1b3b80a --- /dev/null +++ b/med_test_comps/xrof/cime_config/buildlib @@ -0,0 +1 @@ +../../xshare/cime_config/buildlib \ No newline at end of file diff --git a/med_test_comps/xrof/cime_config/buildnml b/med_test_comps/xrof/cime_config/buildnml new file mode 100755 index 000000000..bf23e8913 --- /dev/null +++ b/med_test_comps/xrof/cime_config/buildnml @@ -0,0 +1,32 @@ +#!/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/med_test_comps/xrof/cime_config/config_component.xml b/med_test_comps/xrof/cime_config/config_component.xml new file mode 100644 index 000000000..e1663cbbb --- /dev/null +++ b/med_test_comps/xrof/cime_config/config_component.xml @@ -0,0 +1,39 @@ + + + + + + + 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/med_test_comps/xrof/src/rof_comp_nuopc.F90 b/med_test_comps/xrof/src/rof_comp_nuopc.F90 new file mode 100644 index 000000000..1b5b9dd49 --- /dev/null +++ b/med_test_comps/xrof/src/rof_comp_nuopc.F90 @@ -0,0 +1,473 @@ +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/med_test_comps/xshare/cime_config/buildlib b/med_test_comps/xshare/cime_config/buildlib new file mode 100755 index 000000000..f7f597d77 --- /dev/null +++ b/med_test_comps/xshare/cime_config/buildlib @@ -0,0 +1,39 @@ +#!/usr/bin/env python3 + +""" +build cime component model library. This buildlib script is used by all cime internal +components. +""" + +import sys, os + +_CIMEROOT = os.environ.get("CIMEROOT") +if _CIMEROOT == None: + raise ValueError("ERROR: CIMEROOT not defined in buildlib.internal_components.") +sys.path.append(os.path.join(_CIMEROOT, "CIME", "Tools")) + +from standard_script_setup import * +from CIME.buildlib import build_cime_component_lib, parse_input +from CIME.case import Case + + +def buildlib(bldroot, libroot, case, compname=None): + if compname is None: + thisdir = os.path.dirname(os.path.abspath(__file__)) + path, dir1 = os.path.split(thisdir) + _, dir2 = os.path.split(path) + if dir1 == "cime_config": + compname = dir2 + else: + compname = dir1.split(".")[1] + build_cime_component_lib(case, compname, libroot, bldroot) + + +def _main_func(args): + caseroot, libroot, bldroot = parse_input(args) + with Case(caseroot) as case: + buildlib(bldroot, libroot, case) + + +if __name__ == "__main__": + _main_func(sys.argv) diff --git a/med_test_comps/xshare/dead_methods_mod.F90 b/med_test_comps/xshare/dead_methods_mod.F90 new file mode 100644 index 000000000..a9ad38e24 --- /dev/null +++ b/med_test_comps/xshare/dead_methods_mod.F90 @@ -0,0 +1,853 @@ +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/med_test_comps/xshare/dead_nuopc_mod.F90 b/med_test_comps/xshare/dead_nuopc_mod.F90 new file mode 100644 index 000000000..ee3ca6b68 --- /dev/null +++ b/med_test_comps/xshare/dead_nuopc_mod.F90 @@ -0,0 +1,346 @@ +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/med_test_comps/xwav/cime_config/buildlib b/med_test_comps/xwav/cime_config/buildlib new file mode 120000 index 000000000..ba1b3b80a --- /dev/null +++ b/med_test_comps/xwav/cime_config/buildlib @@ -0,0 +1 @@ +../../xshare/cime_config/buildlib \ No newline at end of file diff --git a/med_test_comps/xwav/cime_config/buildnml b/med_test_comps/xwav/cime_config/buildnml new file mode 100755 index 000000000..1ea9dc3a5 --- /dev/null +++ b/med_test_comps/xwav/cime_config/buildnml @@ -0,0 +1,32 @@ +#!/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/med_test_comps/xwav/cime_config/config_component.xml b/med_test_comps/xwav/cime_config/config_component.xml new file mode 100644 index 000000000..e82944fd3 --- /dev/null +++ b/med_test_comps/xwav/cime_config/config_component.xml @@ -0,0 +1,26 @@ + + + + + + + Dead wave component + + + + + char + xwav + xwav + case_comp + env_case.xml + Name of wave component + + + + ========================================= + XWAV naming conventions in compset name + ========================================= + + + diff --git a/med_test_comps/xwav/src/wav_comp_nuopc.F90 b/med_test_comps/xwav/src/wav_comp_nuopc.F90 new file mode 100644 index 000000000..aa4d982e5 --- /dev/null +++ b/med_test_comps/xwav/src/wav_comp_nuopc.F90 @@ -0,0 +1,465 @@ +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