Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Enable cpl_scalars #794

Merged
merged 18 commits into from
Apr 3, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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 [email protected]
!> @author modified for FV3atm by [email protected] @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
DusanJovic-NOAA marked this conversation as resolved.
Show resolved Hide resolved

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 [email protected], [email protected]
!> @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 [email protected], [email protected]
!> @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 [email protected], [email protected]
!> @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
Loading