Skip to content

Commit

Permalink
Enable cpl_scalars (NOAA-EMC#794)
Browse files Browse the repository at this point in the history
* add cpl_scalars for atm

* add field cpl_scalars to export state of fv3atm when coupled.
cpl_scalars contain the dimensions of the fv3atm domain and are
used by cmeps to write mediator history files as a single 2d
grid for regional and 6 2d grids for CSG.

* remove unused NUOPC use statement
  • Loading branch information
DeniseWorthen authored Apr 3, 2024
1 parent 1b75fe2 commit 1cac9d3
Show file tree
Hide file tree
Showing 7 changed files with 336 additions and 46 deletions.
1 change: 1 addition & 0 deletions CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -105,6 +105,7 @@ add_library(fv3atm
cpl/module_block_data.F90
cpl/module_cplfields.F90
cpl/module_cap_cpl.F90
cpl/module_cplscalars.F90
io/fv3atm_common_io.F90
io/fv3atm_clm_lake_io.F90
io/fv3atm_rrfs_sd_io.F90
Expand Down
54 changes: 29 additions & 25 deletions atmos_model.F90
Original file line number Diff line number Diff line change
Expand Up @@ -3142,7 +3142,8 @@ subroutine setup_exportdata(rc)

use ESMF

use module_cplfields, only: exportFields, chemistryFieldNames
use module_cplfields, only: exportFields, chemistryFieldNames
use module_cplscalars, only: flds_scalar_name

!--- arguments
integer, optional, intent(out) :: rc
Expand Down Expand Up @@ -3192,33 +3193,36 @@ subroutine setup_exportdata(rc)
if (isFound) then
call ESMF_FieldGet(exportFields(n), name=fieldname, rank=rank, typekind=datatype, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
if (datatype == ESMF_TYPEKIND_R8) then
select case (rank)
case (2)
call ESMF_FieldGet(exportFields(n),farrayPtr=datar82d,localDE=0, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
case (3)
call ESMF_FieldGet(exportFields(n),farrayPtr=datar83d,localDE=0, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
case default
!--- skip field
isFound = .false.
end select
else if (datatype == ESMF_TYPEKIND_R4) then
select case (rank)
case (2)
call ESMF_FieldGet(exportFields(n),farrayPtr=datar42d,localDE=0, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
case default
!--- skip field
isFound = .false.
end select
else
!--- skip field
if (trim(fieldname) == trim(flds_scalar_name)) then
isFound = .false.
else
if (datatype == ESMF_TYPEKIND_R8) then
select case (rank)
case (2)
call ESMF_FieldGet(exportFields(n),farrayPtr=datar82d,localDE=0, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
case (3)
call ESMF_FieldGet(exportFields(n),farrayPtr=datar83d,localDE=0, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
case default
!--- skip field
isFound = .false.
end select
else if (datatype == ESMF_TYPEKIND_R4) then
select case (rank)
case (2)
call ESMF_FieldGet(exportFields(n),farrayPtr=datar42d,localDE=0, rc=localrc)
if (ESMF_LogFoundError(rcToCheck=localrc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return
case default
!--- skip field
isFound = .false.
end select
else
!--- skip field
isFound = .false.
end if
end if
end if

!--- skip field if only required for chemistry
if (isFound .and. GFS_control%cplchm) isFound = .not.any(trim(fieldname) == chemistryFieldNames)

Expand Down
1 change: 0 additions & 1 deletion cpl/module_cap_cpl.F90
Original file line number Diff line number Diff line change
Expand Up @@ -11,7 +11,6 @@ module module_cap_cpl

private
public diagnose_cplFields
!
contains

!-----------------------------------------------------------------------------
Expand Down
42 changes: 25 additions & 17 deletions cpl/module_cplfields.F90
Original file line number Diff line number Diff line change
Expand Up @@ -26,7 +26,7 @@ module module_cplfields
! l : model levels (3D)
! s : surface (2D)
! t : tracers (4D)
integer, public, parameter :: NexportFields = 119
integer, public, parameter :: NexportFields = 120
type(ESMF_Field), target, public :: exportFields(NexportFields)

type(FieldInfo), dimension(NexportFields), public, parameter :: exportFieldsInfo = [ &
Expand Down Expand Up @@ -153,7 +153,8 @@ module module_cplfields
FieldInfo("snwdph ", "s"), &
FieldInfo("f10m ", "s"), &
FieldInfo("zorl ", "s"), &
FieldInfo("t2m ", "s") ]
FieldInfo("t2m ", "s"), &
FieldInfo("cpl_scalars ", "s")]

! Import Fields ----------------------------------------
integer, public, parameter :: NimportFields = 64
Expand Down Expand Up @@ -192,7 +193,7 @@ module module_cplfields
! For receiving fluxes from external land component
FieldInfo("land_fraction ", "s"), &
FieldInfo("inst_snow_area_fraction_lnd ", "s"), &
FieldInfo("inst_spec_humid_lnd ", "s"), &
FieldInfo("inst_spec_humid_lnd ", "s"), &
FieldInfo("inst_laten_heat_flx_lnd ", "s"), &
FieldInfo("inst_sensi_heat_flx_lnd ", "s"), &
FieldInfo("inst_potential_laten_heat_flx_lnd ", "s"), &
Expand Down Expand Up @@ -441,6 +442,7 @@ subroutine realizeConnectedCplFields(state, grid, &

use field_manager_mod, only: MODEL_ATMOS
use tracer_manager_mod, only: get_number_tracers, get_tracer_names
use module_cplscalars, only: flds_scalar_name, flds_scalar_num, SetScalarField

type(ESMF_State), intent(inout) :: state
type(ESMF_Grid), intent(in) :: grid
Expand Down Expand Up @@ -488,22 +490,27 @@ subroutine realizeConnectedCplFields(state, grid, &
isConnected = NUOPC_IsConnected(state, fieldName=trim(fields_info(item)%name), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
if (isConnected) then
call ESMF_StateGet(state, field=field, itemName=trim(fields_info(item)%name), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
call ESMF_FieldEmptySet(field, grid=grid, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
select case (fields_info(item)%type)
if (trim(fields_info(item)%name) == 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
else
call ESMF_StateGet(state, field=field, itemName=trim(fields_info(item)%name), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
call ESMF_FieldEmptySet(field, grid=grid, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
select case (fields_info(item)%type)
case ('l','layer')
call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, &
ungriddedLBound=(/1/), ungriddedUBound=(/numLevels/), rc=rc)
ungriddedLBound=(/1/), ungriddedUBound=(/numLevels/), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
case ('i','interface')
call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, &
ungriddedLBound=(/1/), ungriddedUBound=(/numLevels+1/), rc=rc)
ungriddedLBound=(/1/), ungriddedUBound=(/numLevels+1/), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
case ('t','tracer')
call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, &
ungriddedLBound=(/1, 1/), ungriddedUBound=(/numLevels, numTracers/), rc=rc)
ungriddedLBound=(/1, 1/), ungriddedUBound=(/numLevels, numTracers/), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
if (allocated(tracerNames)) then
call addFieldMetadata(field, 'tracerNames', tracerNames, rc=rc)
Expand All @@ -518,14 +525,15 @@ subroutine realizeConnectedCplFields(state, grid, &
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
case ('g','soil')
call ESMF_FieldEmptyComplete(field, typekind=ESMF_TYPEKIND_R8, &
ungriddedLBound=(/1/), ungriddedUBound=(/numSoilLayers/), rc=rc)
ungriddedLBound=(/1/), ungriddedUBound=(/numSoilLayers/), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
case default
call ESMF_LogSetError(ESMF_RC_NOT_VALID, &
msg="exportFieldType = '"//trim(fields_info(item)%type)//"' not recognized", &
line=__LINE__, file=__FILE__, rcToReturn=rc)
msg="exportFieldType = '"//trim(fields_info(item)%type)//"' not recognized", &
line=__LINE__, file=__FILE__, rcToReturn=rc)
return
end select
end select
end if
call NUOPC_Realize(state, field=field, rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return

Expand All @@ -536,13 +544,13 @@ subroutine realizeConnectedCplFields(state, grid, &
! -- save field
fieldList(item) = field
call ESMF_LogWrite('realizeConnectedCplFields '//trim(state_tag)//' Field '//trim(fields_info(item)%name) &
// ' is connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc)
// ' is connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc)
else
! remove a not connected Field from State
call ESMF_StateRemove(state, (/trim(fields_info(item)%name)/), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return
call ESMF_LogWrite('realizeConnectedCplFields '//trim(state_tag)//' Field '//trim(fields_info(item)%name) &
// ' is not connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc)
// ' is not connected ', ESMF_LOGMSG_INFO, line=__LINE__, file=__FILE__, rc=rc)
end if
end do

Expand Down
203 changes: 203 additions & 0 deletions cpl/module_cplscalars.F90
Original file line number Diff line number Diff line change
@@ -0,0 +1,203 @@
!> @file
!> @brief Manage cpl_scalars
!> @author mvertens@ucar.edu
!> @author modified for FV3atm by Denise.Worthen@noaa.gov @date 03-03-2024

!> Manage scalars in import and export states. Called by realizeConnectedCplFields
!> 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 module_cplscalars

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

! set from config
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
!>
!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov
!> @date 03-03-2024
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='(module_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
!>
!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov
!> @date 03-02-2024
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 = ' (module_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
!>
!> @author mvertens@ucar.edu, Denise.Worthen@noaa.gov
!> @date 03-02-2024
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 = ' (module_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 module_cplscalars
Loading

0 comments on commit 1cac9d3

Please sign in to comment.