From b09b03a3b83bd62ec81eda9e0487dbf49ee87617 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Thu, 7 Mar 2024 14:01:58 -0500 Subject: [PATCH 1/2] add export of cpl_scalars * export 2dsize of tile and number of tiles for use by CMEPS mediatory history files --- CMakeLists.txt | 7 +- drivers/nuopc/lnd_comp_cplscalars.F90 | 193 +++++++++++++++++++++++ drivers/nuopc/lnd_comp_import_export.F90 | 112 +++++++++---- drivers/nuopc/lnd_comp_nuopc.F90 | 67 +++++++- 4 files changed, 334 insertions(+), 45 deletions(-) create mode 100644 drivers/nuopc/lnd_comp_cplscalars.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index df20602..9af118e 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -14,9 +14,10 @@ list(APPEND _noahmp_cap_files drivers/nuopc/lnd_comp_kind.F90 drivers/nuopc/lnd_comp_domain.F90 drivers/nuopc/lnd_comp_import_export.F90 drivers/nuopc/lnd_comp_nuopc.F90 - drivers/nuopc/lnd_comp_driver.F90) + drivers/nuopc/lnd_comp_driver.F90 + drivers/nuopc/lnd_comp_cplscalars.F90) -# CCPP interface +# CCPP interface list(APPEND _noahmp_ccpp_files drivers/ccpp/noahmpdrv.F90 drivers/ccpp/sfc_diff.f drivers/ccpp/machine.F @@ -67,7 +68,7 @@ add_definitions(-DCCPP) #------------------------------------------------------------------------------ # NOAHMP add_library(noahmp STATIC ${_noahmp_cap_files} ${_noahmp_ccpp_files} ${_noahmp_files}) -set_target_properties(noahmp PROPERTIES +set_target_properties(noahmp PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR}/include ) target_include_directories(noahmp PUBLIC $ diff --git a/drivers/nuopc/lnd_comp_cplscalars.F90 b/drivers/nuopc/lnd_comp_cplscalars.F90 new file mode 100644 index 0000000..2f5450c --- /dev/null +++ b/drivers/nuopc/lnd_comp_cplscalars.F90 @@ -0,0 +1,193 @@ +!> @file +!> @brief Manage cpl_scalars +!> @author mvertens@ucar.edu +!> @author modified for NOAHMP by Denise.Worthen@noaa.gov @date 03-03-2024 +!> +!> Manage scalars in import and export states. Called at realization to set the +!> required scalar data into a state. The scalar_value will be set into a field +!> with name flds_scalar_name. The scalar_id identifies which dimension in the +!> scalar field is given by the scalar_value. The number of scalars is used to +!> ensure that the scalar_id is within the bounds of the scalar field + +module lnd_comp_cplscalars + + use NUOPC + use ESMF, only : ESMF_Field, ESMF_Distgrid, ESMF_Grid, ESMF_State + use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadCast + use ESMF, only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_FAILURE, ESMF_SUCCESS + use ESMF, only : ESMF_LOGMSG_INFO, ESMF_LOGWRITE, ESMF_TYPEKIND_R8, ESMF_KIND_R8 + use ESMF, only : ESMF_GridCreate, ESMF_FieldCreate, ESMF_StateGet, ESMF_DistGridCreate + use ESMF, only : ESMF_FieldGet + + implicit none + + private + public SetScalarField + public State_SetScalar + public State_GetScalar + + integer, public :: flds_scalar_num, flds_scalar_index_nx + integer, public :: flds_scalar_index_ny, flds_scalar_index_ntile + character(len=80), public :: flds_scalar_name + +contains + + !================================================================================ + !> Create a scalar field + !> + !> @param[inout] field an ESMF_Field + !> @param[in] flds_scalar_name the name of the scalar + !> @param[in] flds_scalar_num the number of scalars + !> @param[inout] rc a return code + subroutine SetScalarField(field, flds_scalar_name, flds_scalar_num, rc) + + 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='(lnd_comp_cplscalars: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=__FILE__)) return + + grid = ESMF_GridCreate(distgrid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) 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) ! num of scalar values + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end subroutine SetScalarField + + !================================================================================ + !> Set scalar data into a state + !> + !> @param[inout] State an ESMF_State + !> @param[in] scalar_value the value of the scalar + !> @param[in] scalar_id the identity of the scalar + !> @param[in] flds_scalar_name the name of the scalar + !> @param[in] flds_scalar_num the number of scalars + !> @param[inout] rc a return code + subroutine State_SetScalar(scalar_value, scalar_id, State, flds_scalar_name, flds_scalar_num, rc) + + ! input/output arguments + real(ESMF_KIND_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(ESMF_KIND_R8), pointer :: farrayptr(:,:) + + character(len=*), parameter :: subname = ' (lnd_comp_cplscalars:state_setscalar) ' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=lfield, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (mytask == 0) then + call ESMF_FieldGet(lfield, farrayPtr = farrayptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) 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 + + !=============================================================================== + !> Get scalar data from a state + !> + !> @details Obtain the field flds_scalar_name from a State and broadcast and + !> it to all PEs + !> + !> @param[in] State an ESMF_State + !> @param[in] scalar_value the value of the scalar + !> @param[in] scalar_id the identity of the scalar + !> @param[in] flds_scalar_name the name of the scalar + !> @param[in] flds_scalar_num the number of scalars + !> @param[out] rc a return code + 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(ESMF_KIND_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, icount + type(ESMF_VM) :: vm + type(ESMF_Field) :: field + real(ESMF_KIND_R8), pointer :: farrayptr(:,:) + real(ESMF_KIND_R8) :: tmp(1) + + character(len=*), parameter :: subname = ' (lnd_comp_cplscalars:state_getscalar) ' + ! ---------------------------------------------- + + rc = ESMF_SUCCESS + + call ESMF_VMGetCurrent(vm, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_VMGet(vm, localPet=mytask, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! check item exist or not? + call ESMF_StateGet(State, itemSearch=trim(flds_scalar_name), itemCount=icount, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (icount > 0) then + call ESMF_StateGet(State, itemName=trim(flds_scalar_name), field=field, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (mytask == 0) then + call ESMF_FieldGet(field, farrayPtr = farrayptr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) 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=__FILE__) + rc = ESMF_FAILURE + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + tmp(:) = farrayptr(scalar_id,:) + endif + call ESMF_VMBroadCast(vm, tmp, 1, 0, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + scalar_value = tmp(1) + else + scalar_value = 0.0_ESMF_KIND_R8 + call ESMF_LogWrite(trim(subname)//": no ESMF_Field found named: "//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + end if + + end subroutine State_GetScalar +end module lnd_comp_cplscalars diff --git a/drivers/nuopc/lnd_comp_import_export.F90 b/drivers/nuopc/lnd_comp_import_export.F90 index 411034a..074d071 100644 --- a/drivers/nuopc/lnd_comp_import_export.F90 +++ b/drivers/nuopc/lnd_comp_import_export.F90 @@ -82,6 +82,7 @@ subroutine advertise_fields(gcomp, rc) call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_cmm') call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_chh') call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'Sl_zvfun') + call fldlist_add(fldsFrLnd_num, fldsFrlnd, 'cpl_scalars') ! Now advertise above export fields do n = 1,fldsFrLnd_num @@ -166,21 +167,35 @@ subroutine fldlist_add(num, fldlist, stdname, ungridded_lbound, ungridded_ubound end subroutine fldlist_add !=============================================================================== - subroutine realize_fields(importState, exportState, Emesh, rc) + subroutine realize_fields(importState, exportState, noahmp, rc) + + use lnd_comp_cplscalars, only : flds_scalar_name, flds_scalar_num, & + flds_scalar_index_nx, flds_scalar_index_ny, flds_scalar_index_ntile + use lnd_comp_cplscalars, only : State_SetScalar + + !logical :: global ! flag for global vs. regional domain + !integer :: ntiles ! number of tiles in case of having CS grid + !integer :: ni ! global size in i direction + !integer :: nj ! global size in j direction ! input/output variables type(ESMF_State) , intent(inout) :: importState type(ESMF_State) , intent(inout) :: exportState - type(ESMF_Mesh) , intent(in) :: Emesh + type(noahmp_type), intent(in) :: noahmp integer , intent(out) :: rc ! local variables + type(ESMF_Mesh) :: Emesh + real(R8) :: scalardim(3) + character(len=*), parameter :: subname=trim(modName)//':(realize_fields)' !--------------------------------------------------------------------------- rc = ESMF_SUCCESS call ESMF_LogWrite(subname//' called', ESMF_LOGMSG_INFO) + Emesh = noahmp%domain%mesh + call fldlist_realize( & state=ExportState, & fldList=fldsFrLnd, & @@ -197,6 +212,23 @@ subroutine realize_fields(importState, exportState, Emesh, rc) mesh=Emesh, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + ! cpl_scalars for export state + scalardim = 0.0 + scalardim(1) = real(noahmp%domain%ni,8) + scalardim(2) = real(noahmp%domain%nj,8) + scalardim(3) = 1.0 + if (noahmp%domain%global)scalardim(3) = 6.0 + + if (flds_scalar_num > 0) then + ! Set the scalar data into the exportstate + call State_SetScalar(scalardim(1), flds_scalar_index_nx, exportState, flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call State_SetScalar(scalardim(2), flds_scalar_index_ny, exportState, flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + call State_SetScalar(scalardim(3), flds_scalar_index_ntile, exportState, flds_scalar_name, flds_scalar_num, rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + call ESMF_LogWrite(subname//' done', ESMF_LOGMSG_INFO) end subroutine realize_fields @@ -210,6 +242,9 @@ subroutine fldlist_realize(state, fldList, numflds, mesh, tag, rc) use ESMF , only : ESMF_LogFoundError, ESMF_LOGMSG_INFO, ESMF_SUCCESS use ESMF , only : ESMF_LogWrite, ESMF_LOGMSG_ERROR, ESMF_LOGERR_PASSTHRU + use lnd_comp_cplscalars, only: flds_scalar_name, flds_scalar_num + use lnd_comp_cplscalars, only: SetScalarField + ! input/output variables type(ESMF_State) , intent(inout) :: state type(fld_list_type) , intent(inout) :: fldList(:) @@ -222,7 +257,7 @@ subroutine fldlist_realize(state, fldList, numflds, mesh, tag, rc) integer :: n type(ESMF_Field) :: field character(len=80) :: stdname - character(len=*),parameter :: subname=trim(modName)//':fldlist_realize)' + character(len=*), parameter :: subname=trim(modName)//':fldlist_realize)' ! ---------------------------------------------- rc = ESMF_SUCCESS @@ -238,12 +273,18 @@ subroutine fldlist_realize(state, fldList, numflds, mesh, tag, rc) ungriddedUbound=(/fldlist(n)%ungridded_ubound/), & gridToFieldMap=(/2/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return + elseif (trim(stdname) == trim(flds_scalar_name)) then + ! 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=__FILE__)) return + call NUOPC_Realize(state, field=field, 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 (ChkErr(rc,__LINE__,u_FILE_u)) return end if call ESMF_LogWrite(trim(subname)//trim(tag)//" Field = "//trim(stdname)//" is connected using mesh", & - ESMF_LOGMSG_INFO) + ESMF_LOGMSG_INFO) ! NOW call NUOPC_Realize call NUOPC_Realize(state, field=field, rc=rc) @@ -253,7 +294,7 @@ subroutine fldlist_realize(state, fldList, numflds, mesh, tag, rc) fldList(n)%connected = .true. else call ESMF_LogWrite(subname // trim(tag) // " Field = "// trim(stdname) // " is not connected.", & - ESMF_LOGMSG_INFO) + ESMF_LOGMSG_INFO) call ESMF_StateRemove(state, (/stdname/), rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if @@ -268,7 +309,7 @@ subroutine import_fields(gcomp, noahmp, rc) ! input/output variables type(ESMF_GridComp), intent(in) :: gcomp - type(noahmp_type), intent(inout) :: noahmp + type(noahmp_type), intent(inout) :: noahmp integer, intent(out) :: rc ! local variables @@ -368,7 +409,7 @@ subroutine export_fields(gcomp, noahmp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! ----------------------- - ! output to atm + ! output to atm ! ----------------------- call state_setexport_1d(exportState, 'Sl_sfrac', noahmp%model%sncovr1, rc=rc) @@ -527,13 +568,14 @@ subroutine state_getfldptr(state, fldname, fldptr1d, fldptr2d, rc) end subroutine state_getfldptr !=============================================================================== - subroutine state_diagnose(state, string, rc) + subroutine state_diagnose(state, flds_scalar_name, string, rc) ! ---------------------------------------------- ! Diagnose status of State ! ---------------------------------------------- type(ESMF_State), intent(in) :: state + character(len=*), intent(in) :: flds_scalar_name character(len=*), intent(in) :: string integer , intent(out) :: rc @@ -556,35 +598,37 @@ subroutine state_diagnose(state, string, rc) if (chkerr(rc,__LINE__,u_FILE_u)) return do n = 1, fieldCount + if (trim(lfieldnamelist(n)) /= trim(flds_scalar_name)) then - call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc) - if (chkerr(rc,__LINE__,u_FILE_u)) return + call ESMF_StateGet(state, itemName=lfieldnamelist(n), field=lfield, rc=rc) + if (chkerr(rc,__LINE__,u_FILE_u)) return - call field_getfldptr(lfield, rc=rc, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank) - if (chkerr(rc,__LINE__,u_FILE_u)) return + call field_getfldptr(lfield, rc=rc, fldptr1=dataPtr1d, fldptr2=dataPtr2d, rank=lrank) + 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) + 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 - 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" + call ESMF_LogWrite(trim(subname)//": ERROR rank not supported ", ESMF_LOGMSG_ERROR) + rc = ESMF_FAILURE + return 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) + call ESMF_LogWrite(trim(msgString), ESMF_LOGMSG_INFO) + end if enddo deallocate(lfieldnamelist) @@ -653,7 +697,7 @@ subroutine field_getfldptr(field, rc, fldptr1, fldptr2, rank, abort) 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 + else call ESMF_LogWrite(trim(subname)//": ERROR geomtype not supported ", & ESMF_LOGMSG_INFO, rc=rc) rc = ESMF_FAILURE @@ -748,7 +792,7 @@ logical function check_for_connected(fldList, numflds, fname) check_for_connected = .false. do n = 1, numflds if (trim(fname) == trim(fldList(n)%stdname)) then - check_for_connected = fldList(n)%connected + check_for_connected = fldList(n)%connected exit end if end do diff --git a/drivers/nuopc/lnd_comp_nuopc.F90 b/drivers/nuopc/lnd_comp_nuopc.F90 index b191d20..c561e52 100644 --- a/drivers/nuopc/lnd_comp_nuopc.F90 +++ b/drivers/nuopc/lnd_comp_nuopc.F90 @@ -20,7 +20,7 @@ module lnd_comp_nuopc use ESMF , only : ESMF_MeshCreate, ESMF_Grid, ESMF_GeomType_Flag use ESMF , only : ESMF_VMGet, ESMF_VMGetCurrent use NUOPC , only : NUOPC_CompDerive, NUOPC_CompAttributeGet - use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_CompSetEntryPoint + use NUOPC , only : NUOPC_CompFilterPhaseMap, NUOPC_CompSetEntryPoint use NUOPC , only : NUOPC_CompSpecialize use NUOPC_Model , only : NUOPC_ModelGet use NUOPC_Model , only : model_routine_SS => SetServices @@ -169,6 +169,9 @@ end subroutine InitializeAdvertise !=============================================================================== subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) + use lnd_comp_cplscalars, only: flds_scalar_name, flds_scalar_num, & + flds_scalar_index_nx, flds_scalar_index_ny, flds_scalar_index_ntile + ! Realize the list of fields that will be exchanged ! input/output variables type(ESMF_GridComp) :: gcomp @@ -241,7 +244,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) call ESMF_LogWrite(trim(subname)//': restart_dir = '//trim(noahmp%nmlist%restart_dir), ESMF_LOGMSG_INFO) ! --------------------- - ! Query ESMF attribute, layout + ! Query ESMF attribute, layout ! --------------------- call NUOPC_CompAttributeGet(gcomp, name='layout', value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) @@ -272,7 +275,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) noahmp%nmlist%restart_run = .true. end if else - noahmp%nmlist%restart_run = .false. + noahmp%nmlist%restart_run = .false. end if write(msg, fmt='(A,L)') trim(subname)//': restart_run = ', noahmp%nmlist%restart_run call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) @@ -358,8 +361,54 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) write(msg, fmt='(A,L)') trim(subname)//': calc_snet = ', noahmp%nmlist%calc_snet call ESMF_LogWrite(trim(msg), ESMF_LOGMSG_INFO) + ! set cpl_scalars from config. Default to null values + flds_scalar_name = '' + flds_scalar_num = 0 + flds_scalar_index_nx = 0 + flds_scalar_index_ny = 0 + flds_scalar_index_ntile = 0 + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldName", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + flds_scalar_name = trim(cvalue) + call ESMF_LogWrite(trim(subname)//' flds_scalar_name = '//trim(flds_scalar_name), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldCount", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue, *) flds_scalar_num + write(msg,*) flds_scalar_num + call ESMF_LogWrite(trim(subname)//' flds_scalar_num = '//trim(msg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNX", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_nx + write(msg,*) flds_scalar_index_nx + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_nx = '//trim(msg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNY", value=cvalue, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + read(cvalue,*) flds_scalar_index_ny + write(msg,*) flds_scalar_index_ny + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ny = '//trim(msg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + call NUOPC_CompAttributeGet(gcomp, name="ScalarFieldIdxGridNTile", 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_ntile + write(msg,*) flds_scalar_index_ntile + call ESMF_LogWrite(trim(subname)//' : flds_scalar_index_ntile = '//trim(msg), ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + endif + ! --------------------- - ! Create mosaic grid and convert it to mesh + ! Create mosaic grid and convert it to mesh ! --------------------- call lnd_set_decomp_and_domain_from_mosaic(gcomp, noahmp, rc) @@ -382,7 +431,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! Realize the actively coupled fields ! --------------------- - call realize_fields(importState, exportState, noahmp%domain%mesh, rc) + call realize_fields(importState, exportState, noahmp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return ! --------------------- @@ -399,7 +448,7 @@ subroutine InitializeRealize(gcomp, importState, exportState, clock, rc) ! --------------------- if (dbug > 0) then - call state_diagnose(exportState, subname//': ExportState ',rc=rc) + call state_diagnose(exportState, flds_scalar_name, subname//': ExportState ',rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -410,6 +459,8 @@ end subroutine InitializeRealize !=============================================================================== subroutine ModelAdvance(gcomp, rc) + use lnd_comp_cplscalars, only: flds_scalar_name + !------------------------ ! Run NoahMP !------------------------ @@ -448,7 +499,7 @@ subroutine ModelAdvance(gcomp, rc) !---------------------- if (dbug > 1) then - call state_diagnose(importState, subname//': ImportState ',rc=rc) + call state_diagnose(importState, flds_scalar_name, subname//': ImportState ',rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif @@ -472,7 +523,7 @@ subroutine ModelAdvance(gcomp, rc) !---------------------- if (dbug > 1) then - call state_diagnose(exportState, subname//': ExportState ',rc=rc) + call state_diagnose(exportState, flds_scalar_name, subname//': ExportState ',rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return endif From e240f35b2a8d114dd35868b23fea67352f766f65 Mon Sep 17 00:00:00 2001 From: Denise Worthen Date: Wed, 20 Mar 2024 09:16:14 -0400 Subject: [PATCH 2/2] remove unused NUOPC use statement --- drivers/nuopc/lnd_comp_cplscalars.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/drivers/nuopc/lnd_comp_cplscalars.F90 b/drivers/nuopc/lnd_comp_cplscalars.F90 index 2f5450c..42144a9 100644 --- a/drivers/nuopc/lnd_comp_cplscalars.F90 +++ b/drivers/nuopc/lnd_comp_cplscalars.F90 @@ -11,7 +11,6 @@ module lnd_comp_cplscalars - use NUOPC use ESMF, only : ESMF_Field, ESMF_Distgrid, ESMF_Grid, ESMF_State use ESMF, only : ESMF_VM, ESMF_VMGetCurrent, ESMF_VMGet, ESMF_VMBroadCast use ESMF, only : ESMF_LogFoundError, ESMF_LOGERR_PASSTHRU, ESMF_FAILURE, ESMF_SUCCESS