!----------------------------------------------------------------------- ! Earth System Modeling Framework ! Copyright 2002-2017, University Corporation for Atmospheric Research, ! Massachusetts Institute of Technology, Geophysical Fluid Dynamics ! Laboratory, University of Michigan, National Centers for Environmental ! Prediction, Los Alamos National Laboratory, Argonne National Laboratory, ! NASA Goddard Space Flight Center. ! Licensed under the University of Illinois-NCSA License. #define FILENAME "mod_esmf_cpl.F90" ! !----------------------------------------------------------------------- ! CPL gridded component code !----------------------------------------------------------------------- ! module mod_esmf_cpl ! !----------------------------------------------------------------------- ! Used module declarations !----------------------------------------------------------------------- ! use ESMF use NUOPC use NUOPC_Connector, only : & NUOPC_SetServices => SetServices, & NUOPC_Label_ComputeRH => label_ComputeRouteHandle, & NUOPC_Label_ExecuteRH => label_ExecuteRouteHandle, & NUOPC_Label_ReleaseRH => label_ReleaseRouteHandle, & NUOPC_ConnectorGet, NUOPC_ConnectorSet use mod_types ! implicit none private ! !----------------------------------------------------------------------- ! Public subroutines !----------------------------------------------------------------------- ! public :: CPL_SetServices ! contains ! subroutine CPL_SetServices(ccomp, rc) implicit none ! !----------------------------------------------------------------------- ! Imported variable declarations !----------------------------------------------------------------------- ! type(ESMF_CplComp) :: ccomp integer, intent(out) :: rc ! rc = ESMF_SUCCESS ! call NUOPC_CompDerive(ccomp, NUOPC_SetServices, rc = rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return call NUOPC_CompSpecialize(ccomp, specLabel=NUOPC_Label_ComputeRH, & specRoutine=CPL_ComputeRH, rc = rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return call NUOPC_CompSpecialize(ccomp, specLabel=NUOPC_Label_ExecuteRH, & specRoutine=CPL_ExecuteRH, rc = rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return call NUOPC_CompSpecialize(ccomp, specLabel=NUOPC_Label_ReleaseRH, & specRoutine=CPL_ReleaseRH, rc = rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return end subroutine CPL_SetServices ! !----------------------------------------------------------------------- ! Initialize the coupler !----------------------------------------------------------------------- ! subroutine CPL_ComputeRH(ccomp, rc) implicit none type(ESMF_CplComp) :: ccomp integer, intent(out) :: rc ! integer :: localrc type(ESMF_State) :: state type(ESMF_FieldBundle) :: dstFields, srcFields type(ESMF_FieldBundle) :: interDstFields type(ESMF_Field), allocatable :: fields(:) integer :: fieldCount, i type(ESMF_Grid) :: Grid type(ESMF_TypeKind_Flag) :: typekind type(ESMF_Field) :: field type(ESMF_RouteHandle) :: rh1, rh2 type(ESMF_RouteHandle) :: rh integer :: iterI character(ESMF_MAXSTR) :: fname integer :: extrapNumSrcPnts = 6 real(ESMF_KIND_R4) :: extrapDistExponent = 4.0 rc = ESMF_SUCCESS PRINT *, "calling CPL_ComputeRH..." call NUOPC_ConnectorGet(ccomp, srcFields=srcFields, & dstFields=dstFields, state=state, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return call ESMF_FieldBundleGet(dstFields, fieldCount=fieldCount, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return allocate(fields(fieldCount)) call ESMF_FieldBundleGet(dstFields, fieldList=fields, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return interDstFields = ESMF_FieldBundleCreate(name="interDstFields", & rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return do i=1, fieldCount call ESMF_FieldGet(fields(i), grid=grid, typekind=typekind, & name=fname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out enddo do i=1, fieldCount call ESMF_FieldGet(fields(i), grid=grid, typekind=typekind, & name=fname, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out field = ESMF_FieldCreate(grid, typekind, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return call ESMF_FieldBundleAdd(interDstFields, (/field/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return enddo ! add interDstFields to the state member call ESMF_StateAdd(state, (/interDstFields/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return ! compute the first RouteHandle for srcFields->interDstFields (Regrid) ! TODO::interpolation method is NEAREST POINT now (1st order) if (interp_option .eq. 'nearest') then call ESMF_FieldBundleRegridStore(srcFields, interDstFields, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & regridMethod=ESMF_REGRIDMETHOD_NEAREST_STOD, & extrapMethod=ESMF_EXTRAPMETHOD_NEAREST_IDAVG, & extrapNumSrcPnts=6, & extrapDistExponent=extrapDistExponent, & routehandle=rh1, rc=rc) elseif (interp_option .eq. 'bilinear') then call ESMF_FieldBundleRegridStore(srcFields, interDstFields, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & regridMethod=ESMF_REGRIDMETHOD_BILINEAR, & extrapMethod=ESMF_EXTRAPMETHOD_NEAREST_IDAVG, & extrapNumSrcPnts=6, & extrapDistExponent=extrapDistExponent, & routehandle=rh1, rc=rc) elseif (interp_option .eq. 'patch') then call ESMF_FieldBundleRegridStore(srcFields, interDstFields, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & regridMethod=ESMF_REGRIDMETHOD_PATCH, & routehandle=rh1, rc=rc) elseif (interp_option .eq. 'conserve') then call ESMF_FieldBundleRegridStore(srcFields, interDstFields, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & regridMethod=ESMF_REGRIDMETHOD_CONSERVE, & routehandle=rh1, rc=rc) elseif (interp_option .eq. 'conserve2nd') then call ESMF_FieldBundleRegridStore(srcFields, interDstFields, & unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & regridMethod=ESMF_REGRIDMETHOD_CONSERVE_2ND, & routehandle=rh1, rc=rc) endif call ESMF_RouteHandleSet(rh1, name="src2interDstRH", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return ! compute the second RouteHandle for interDstFields->dstFields (Redist) call ESMF_FieldBundleRedistStore(interDstFields, dstFields, & routehandle=rh2, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return call ESMF_RouteHandleSet(rh2, name="interDst2dstRH", rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return ! add rh1, rh2 to the state member call ESMF_StateAdd(state, (/rh1, rh2/), rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=FILENAME)) return end subroutine ! !----------------------------------------------------------------------- ! Run the coupler !----------------------------------------------------------------------- ! subroutine CPL_ExecuteRH(ccomp, rc) implicit none type(ESMF_CplComp) :: ccomp integer, intent(out) :: rc integer :: localrc type(ESMF_FieldBundle) :: interDstFields type(ESMF_RouteHandle) :: rh1, rh2 type(ESMF_State) :: state type(ESMF_FieldBundle) :: dstFields, srcFields real(ESMF_KIND_R8) :: timeStart, timeEnd character(160) :: msgString ! rc = ESMF_SUCCESS ! PRINT *, "CPL_ExecuteRH running..." call ESMF_VMWtime(timeStart) write (msgString,*) "START TIME: ", timeStart call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) call NUOPC_ConnectorGet(ccomp, srcFields=srcFields, & dstFields=dstFields, state=state, rc=rc) call ESMF_StateGet(state, "interDstFields", interDstFields, rc=rc) call ESMF_StateGet(state, "src2interDstRH", rh1, rc=rc) call ESMF_StateGet(state, "interDst2dstRH", rh2, rc=rc) call ESMF_FieldBundleRegrid(srcFields, interDstFields, & routehandle=rh1, rc=rc) call ESMF_FieldBundleRegrid(interDstFields, dstFields, & routehandle=rh2, rc=rc) call ESMF_VMWtime(timeEnd) write (msgString,*) "END TIME: ", timeEnd call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) esm_wall_time = esm_wall_time + timeEnd - timeStart write (msgString,*) "ESM TIME: ", esm_wall_time call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) write (msgString,*) "ATM TIME: ", atm_wall_time call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) write (msgString,*) "OCN TIME: ", ocn_wall_time call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) end subroutine ! !----------------------------------------------------------------------- ! Finalize the coupler !----------------------------------------------------------------------- ! subroutine CPL_ReleaseRH(ccomp, rc) implicit none type(ESMF_CplComp) :: ccomp integer, intent(out) :: rc integer :: localrc type(ESMF_State) :: state type(ESMF_FieldBundle) :: interDstFields type(ESMF_RouteHandle) :: rh1, rh2 ! rc = ESMF_SUCCESS call NUOPC_ConnectorGet(ccomp, state=state, rc=rc) call ESMF_StateGet(state, "interDstFields", interDstFields, rc=rc) call ESMF_StateGet(state, "src2interDstRH", rh1, rc=rc) call ESMF_StateGet(state, "interDst2dstRH", rh2, rc=rc) call ESMF_FieldBundleRegridRelease(rh1, rc=rc) call ESMF_FieldBundleRegridRelease(rh2, rc=rc) end subroutine end module mod_esmf_cpl