diff --git a/CMakeLists.txt b/CMakeLists.txt index 010e45fdf8..593f4ca29f 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -51,6 +51,11 @@ if(ENABLE_PARALLELRESTART) list(APPEND _ufsatm_defs_private ENABLE_PARALLELRESTART) endif() +# Inline +if(CDEPS_INLINE) + add_definitions(-DCDEPS_INLINE) +endif() + if(ENABLE_RRFS_WAR) list(APPEND _ufsatm_defs_private ENABLE_RRFS_WAR) endif() @@ -160,6 +165,13 @@ if (FV3) list(APPEND moving_nest_srcs "") endif() + # Inline + if(CDEPS_INLINE) + list(APPEND cdeps_inline_srcs cpl/module_cdeps_inline.F90) + else() + list(APPEND cdeps_inline_srcs "") + endif() + # FV3 drivers and dependencies add_library(${DYCORE_TARGET} ufsatm_cap.F90 @@ -172,10 +184,15 @@ if (FV3) ${fv3_io_srcs} ${io_srcs} ${moving_nest_srcs} + ${cdeps_inline_srcs} ${POST_SRC} ) add_dependencies(${DYCORE_TARGET} fv3 fv3ccpp stochastic_physics) + if(CDEPS_INLINE) + add_dependencies(${DYCORE_TARGET} cdeps::cdeps) + endif() + list(APPEND _ufsatm_defs_private GFS_PHYS INTERNAL_FILE_NML use_WRTCOMP) @@ -268,6 +285,9 @@ if (FV3) if(INLINE_POST) target_link_libraries(${DYCORE_TARGET} PUBLIC upp::upp) endif() + if(CDEPS_INLINE) + target_link_libraries(${DYCORE_TARGET} PUBLIC cdeps::cdeps) + endif() endif() if (MPAS) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 74de8c9704..eface64dac 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -686,6 +686,13 @@ module GFS_typedefs !-- prognostic updraft area fraction coupling in convection real (kind=kind_phys), pointer :: dqdt_qmicro(:,:) => null() !< instantanious microphysics tendency to be passed from MP to convection + !-- lake surface temperature from cdeps inline + real (kind=kind_phys), pointer :: mask_dat (:) => null() !< land-sea mask from cdeps inline + real (kind=kind_phys), pointer :: tsfco_dat (:) => null() !< sfc temperature from cdeps inline + real (kind=kind_phys), pointer :: tice_dat (:) => null() !< sfc temperature over ice from cdeps inline + real (kind=kind_phys), pointer :: hice_dat (:) => null() !< sfc ice thickness from cdeps inline + real (kind=kind_phys), pointer :: fice_dat (:) => null() !< sfc ice fraction from cdeps inline + contains procedure :: create => coupling_create !< allocate array data end type GFS_coupling_type @@ -803,6 +810,9 @@ module GFS_typedefs logical :: cpl_imp_dbg !< default no write import data to file post merge logical :: use_med_flux !< default .false. - i.e. don't use atmosphere-ocean fluxes imported from mediator +!--- cdeps inline parameters + logical :: use_cdeps_inline !< default .false. - i.e. don't use data provided by CDEPS inline + !--- integrated dynamics through earth's atmosphere logical :: lsidea @@ -3389,6 +3399,19 @@ subroutine coupling_create (Coupling, Model) Coupling%qci_conv = clear_val endif + if (Model%use_cdeps_inline) then + allocate (Coupling%tsfco_dat(IM)) + Coupling%tsfco_dat = clear_val + allocate (Coupling%mask_dat(IM)) + Coupling%mask_dat = clear_val + allocate (Coupling%tice_dat(IM)) + Coupling%tice_dat = clear_val + allocate (Coupling%hice_dat(IM)) + Coupling%hice_dat = clear_val + allocate (Coupling%fice_dat(IM)) + Coupling%fice_dat = clear_val + end if + end subroutine coupling_create @@ -3491,6 +3514,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, & logical :: cpl_imp_dbg = .false. !< default no write import data to file post merge logical :: use_med_flux = .false. !< default no atmosphere-ocean fluxes from mediator + !--- cdeps inline parameters + logical :: use_cdeps_inline = .false. !< default no data from cdeps inline + !--- integrated dynamics through earth's atmosphere logical :: lsidea = .false. @@ -4173,6 +4199,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, & #else lsidea, use_med_flux, & #endif + !--- cdeps inline parameters + use_cdeps_inline, & !--- radiation parameters fhswr, fhlwr, levr, nfxr, iaerclm, iflip, isol, ico2, ialb, & isot, iems, iaer, icliq_sw, iovr, ictm, isubc_sw, & @@ -4607,6 +4635,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, & Model%cpl_imp_dbg = cpl_imp_dbg Model%use_med_flux = use_med_flux +!--- cdeps inline parameters + Model%use_cdeps_inline = use_cdeps_inline + !--- RRFS-SD Model%rrfs_sd = rrfs_sd Model%cpl_fire = cpl_fire @@ -6842,6 +6873,7 @@ subroutine control_print(Model) print *, ' cpl_imp_mrg : ', Model%cpl_imp_mrg print *, ' cpl_imp_dbg : ', Model%cpl_imp_dbg print *, ' use_med_flux : ', Model%use_med_flux + print *, ' use_cdeps_inline : ', Model%use_cdeps_inline if(Model%imfdeepcnv == Model%imfdeepcnv_gf .or.Model%imfdeepcnv == Model%imfdeepcnv_c3) then print*,'ichoice_s : ', Model%ichoice_s print*,'ichoicem : ', Model%ichoicem diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 1e4e404cab..f09fa74484 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -3420,6 +3420,46 @@ type = real kind = kind_phys active = (flag_for_rrtmgp_radiation_scheme) +[tsfco_dat] + standard_name = sea_surface_temperature_from_data + long_name = sfc temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + active = (do_cdeps_inline) +[mask_dat] + standard_name = land_sea_mask_from_data + long_name = landmask + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + active = (do_cdeps_inline) +[tice_dat] + standard_name = surface_skin_temperature_over_ice_from_data + long_name = surface skin temperature over ice + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + active = (do_cdeps_inline) +[hice_dat] + standard_name = sea_ice_thickness_from_data + long_name = sea-ice thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + active = (do_cdeps_inline) +[fice_dat] + standard_name = sea_ice_area_fraction_of_sea_area_fraction_from_data + long_name = sea-ice concentration [0,1] + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + active = (do_cdeps_inline) ######################################################################## [ccpp-table-properties] @@ -3823,6 +3863,12 @@ units = flag dimensions = () type = logical +[use_cdeps_inline] + standard_name = do_cdeps_inline + long_name = flag for using data provided by CDEPS inline (default false) + units = flag + dimensions = () + type = logical [fhcyc] standard_name = frequency_for_surface_cycling_calls long_name = frequency for surface cycling calls diff --git a/ccpp/physics b/ccpp/physics index 7395db572d..55886ae3c2 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 7395db572d57af1118b9b524e8f8cda4e1cced4c +Subproject commit 55886ae3c2c8c95d4e14a72a7115cfe88678178f diff --git a/cpl/module_cdeps_inline.F90 b/cpl/module_cdeps_inline.F90 new file mode 100644 index 0000000000..83b4dfa040 --- /dev/null +++ b/cpl/module_cdeps_inline.F90 @@ -0,0 +1,254 @@ +module module_cdeps_inline +! +!*** this module contains the subroutines for cdeps inline capability +! +! revision history +! 22 Aug 2023: U. Turuncoglu Initial development +! + use ESMF + use dshr_mod , only: dshr_pio_init + use dshr_strdata_mod, only: shr_strdata_type + use dshr_strdata_mod, only: shr_strdata_init_from_inline + use dshr_strdata_mod, only: shr_strdata_advance + use dshr_stream_mod , only: shr_stream_init_from_esmfconfig + + use GFS_typedefs , only: kp => kind_phys + use CCPP_data , only: GFS_control + use atmos_model_mod , only: setup_inlinedata + + implicit none + + private + public cdeps_stream_init + public cdeps_stream_run + + type(ESMF_Grid) :: grid + type(ESMF_Mesh) :: mesh + type(ESMF_Field) :: fgrid + + type config + integer :: year_first + integer :: year_last + integer :: year_align + integer :: offset + real(kind=8) :: dtlimit + character(len=ESMF_MAXSTR) :: mesh_filename + character(len=ESMF_MAXSTR), allocatable :: data_filename(:) + character(len=ESMF_MAXSTR), allocatable :: fld_list(:) + character(len=ESMF_MAXSTR), allocatable :: fld_list_model(:) + character(len=ESMF_MAXSTR) :: mapalgo + character(len=ESMF_MAXSTR) :: taxmode + character(len=ESMF_MAXSTR) :: tintalgo + character(len=ESMF_MAXSTR) :: name + end type config + + type(config) :: stream ! stream configuration + type(shr_strdata_type) :: sdat_config + type(shr_strdata_type), allocatable :: sdat(:) ! input data stream + real(kind=8), dimension(:,:), allocatable :: farray + + integer :: dbug = 0 + integer :: logunit = 6 + real(kind=8), parameter :: missing_value = 9.99d20 +! + contains + + !----------------------------------------------------------------------------- + !----------------------------------------------------------------------------- + + subroutine cdeps_stream_init(comp, clock, rc) + ! input/output variables + type(ESMF_GridComp), intent(in) :: comp + type(ESMF_Clock) , intent(in) :: clock + integer , intent(out) :: rc + + ! local variables + type(ESMF_ArraySpec) :: arraySpec + integer :: localPet + integer :: l, id, nstreams + integer :: isc, iec, jsc, jec + character(len=ESMF_MAXSTR) :: streamfilename, stream_name + character(len=ESMF_MAXSTR), allocatable :: file_list(:), var_list(:,:) + + ! query compontn to retrieve required information + call ESMF_GridCompGet(comp, grid=grid, localPet=localPet, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! create mesh from grid + mesh = ESMF_MeshCreate(grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! init pio + call dshr_pio_init(comp, sdat_config, logunit, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! read stream configuration file + streamfilename = 'stream.config' + call shr_stream_init_from_esmfconfig(streamfilename, sdat_config%stream, logunit, & + sdat_config%pio_subsystem, sdat_config%io_type, sdat_config%io_format, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! get number of streams + nstreams = size(sdat_config%stream) + + ! allocate stream data type + if (.not. allocated(sdat)) allocate(sdat(nstreams)) + + ! loop over streams and init + do id = 1, nstreams + ! set pio related variables + sdat(id)%pio_subsystem => sdat_config%pio_subsystem + sdat(id)%io_type = sdat_config%io_type + sdat(id)%io_format = sdat_config%io_format + + ! allocate temporary arrays + allocate(file_list(sdat_config%stream(id)%nfiles)) + allocate(var_list(sdat_config%stream(id)%nvars,2)) + + ! fill variables + do l = 1, sdat_config%stream(id)%nfiles + file_list(l) = trim(sdat_config%stream(id)%file(l)%name) + end do + do l = 1, sdat_config%stream(id)%nvars + var_list(l,1) = trim(sdat_config%stream(id)%varlist(l)%nameinfile) + var_list(l,2) = trim(sdat_config%stream(id)%varlist(l)%nameinmodel) + end do + + ! init stream + write(stream_name,fmt='(a,i2.2)') 'stream_', id + call shr_strdata_init_from_inline(sdat(id), & + my_task=localPet, logunit=logunit, & + compname = 'cmeps', model_clock=clock, model_mesh=mesh, & + stream_meshfile=trim(sdat_config%stream(id)%meshfile), & + stream_filenames=file_list, & + stream_yearFirst=sdat_config%stream(id)%yearFirst, & + stream_yearLast=sdat_config%stream(id)%yearLast, & + stream_yearAlign=sdat_config%stream(id)%yearAlign, & + stream_fldlistFile=var_list(:,1), & + stream_fldListModel=var_list(:,2), & + stream_lev_dimname=trim(sdat_config%stream(id)%lev_dimname), & + stream_mapalgo=trim(sdat_config%stream(id)%mapalgo), & + stream_offset=sdat_config%stream(id)%offset, & + stream_taxmode=trim(sdat_config%stream(id)%taxmode), & + stream_dtlimit=sdat_config%stream(id)%dtlimit, & + stream_tintalgo=trim(sdat_config%stream(id)%tInterpAlgo), & + stream_name=trim(stream_name), & + stream_src_mask=sdat_config%stream(id)%src_mask_val, & + stream_dst_mask=sdat_config%stream(id)%dst_mask_val, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! clean memory + deallocate(file_list) + deallocate(var_list) + end do + + ! create temporary field on grid + isc = GFS_control%isc + iec = GFS_control%isc+GFS_control%nx-1 + jsc = GFS_control%jsc + jec = GFS_control%jsc+GFS_control%ny-1 + allocate(farray(isc:iec,jsc:jec)) + fgrid = ESMF_FieldCreate(grid=grid, farray=farray, indexflag=ESMF_INDEX_DELOCAL, name='noname', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + end subroutine cdeps_stream_init + + !----------------------------------------------------------------------------- + + subroutine cdeps_stream_run(clock, rc) + ! input/output variables + type(ESMF_Clock), intent(in) :: clock + integer, intent(out) :: rc + + ! local variables + integer :: item, id, nstreams, nflds + integer :: curr_ymd, sec + integer :: year, month, day, hour, minute, second + character(len=ESMF_MAXSTR) :: filename, istr + type(ESMF_Time) :: currTime + type(ESMF_Field) :: fmesh + type(ESMF_RouteHandle), save :: rh + real(kind=8), dimension(:,:), pointer :: dataptr2d + + ! query clock + call ESMF_ClockGet(clock, currTime=currTime, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! get current time + call ESMF_TimeGet(currTime, yy=year, mm=month, dd=day, h=hour, m=minute, s=second, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + curr_ymd = abs(year)*10000+month*100+day + sec = hour*3600+minute*60+second + + ! get number of streams + nstreams = size(sdat) + + ! loop over streams and get data + do id = 1, nstreams + ! advance cdeps inline + write(istr,fmt='(a,i2.2)') 'stream_', id + call shr_strdata_advance(sdat(id), ymd=curr_ymd, tod=sec, logunit=logunit, istr=trim(istr), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! get number of fields in FB + nflds = size(sdat(id)%pstrm(1)%fldlist_model) + + ! loop over fields + do item = 1, nflds + ! get field on mesh + call ESMF_FieldBundleGet(sdat(id)%pstrm(1)%fldbun_model, fieldName=trim(sdat(id)%pstrm(1)%fldlist_model(item)), field=fmesh, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! create RH and destination field to transfer data from mesh to grid + if (.not. ESMF_RouteHandleIsCreated(rh, rc=rc)) then + ! create RH + call ESMF_FieldRedistStore(fmesh, fgrid, rh, ignoreUnmatchedIndices=.true., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if + + ! initialize destination field + call ESMF_FieldFill(fgrid, dataFillScheme="const", const1=missing_value, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! transfer data from mesh to grid + call ESMF_FieldRedist(fmesh, fgrid, rh, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! get field + call ESMF_FieldGet(fgrid, farrayPtr=dataptr2d, localDE=0, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + ! fill internal data structures + call setup_inlinedata(trim(sdat(id)%pstrm(1)%fldlist_model(item)), dataptr2d, logunit) + + ! diagnostic output + if (dbug > 0) then + ! write statistics + write(logunit,'(A,3g14.7,i8)') '(cdeps inline): '//trim(sdat(id)%pstrm(1)%fldlist_model(item))//' ', & + minval(dataptr2d), maxval(dataptr2d), sum(dataptr2d), size(dataptr2d) + end if + + if (dbug > 5) then + ! file name + write(filename, fmt='(a,i4,a1,i2.2,a1,i2.2,a1,i5.5)') trim(sdat(id)%pstrm(1)%fldlist_model(item))//'_', & + year, '-', month, '-', day, '-', sec + + ! write field + if (dbug > 10) then + ! write field on mesh to VTK + call ESMF_FieldWriteVTK(fmesh, trim(filename), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else + ! write field on grid to netCDF + call ESMF_FieldWrite(fgrid, fileName=trim(filename)//'.nc', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if + end if + end do + end do + + end subroutine cdeps_stream_run + +end module module_cdeps_inline diff --git a/fv3/atmos_model.F90 b/fv3/atmos_model.F90 index 24750db9df..9d268be902 100644 --- a/fv3/atmos_model.F90 +++ b/fv3/atmos_model.F90 @@ -134,6 +134,7 @@ module atmos_model_mod public atmos_model_get_nth_domain_info public addLsmask2grid public setup_exportdata +public setup_inlinedata public set_fhzero_loop, InitTimeFromIAUOffset public get_atmos_tracer_types !----------------------------------------------------------------------- @@ -3326,7 +3327,83 @@ subroutine assign_importdata(jdat, rc) rc=0 ! end subroutine assign_importdata +! + subroutine setup_inlinedata(fieldName, datar82d, logunit) + + use ESMF, only: ESMF_KIND_R8 + + !--- arguments + character(len=*), intent(in) :: fieldName + real(kind=ESMF_KIND_R8), dimension(:,:), target, intent(in) :: datar82d + integer, intent(in) :: logunit + + !--- local variables + integer :: i, j, ix, nb, im + integer :: isc, iec, jsc, jec + +! set up local dimension + isc = GFS_control%isc + iec = GFS_control%isc+GFS_control%nx-1 + jsc = GFS_control%jsc + jec = GFS_control%jsc+GFS_control%ny-1 + +! fill variables + select case(trim(fieldName)) + case ('Si_ifrac') +!$omp parallel do default(shared) private(i,j,nb,ix,im) + do j = jsc, jec + do i = isc, iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + im = GFS_control%chunk_begin(nb)+ix-1 + GFS_Coupling%fice_dat(im) = datar82d(i-isc+1,j-jsc+1) + end do + end do + case ('Si_thick') +!$omp parallel do default(shared) private(i,j,nb,ix,im) + do j = jsc, jec + do i = isc, iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + im = GFS_control%chunk_begin(nb)+ix-1 + GFS_Coupling%hice_dat(im) = datar82d(i-isc+1,j-jsc+1) + end do + end do + case ('So_omask') +!$omp parallel do default(shared) private(i,j,nb,ix,im) + do j = jsc, jec + do i = isc, iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + im = GFS_control%chunk_begin(nb)+ix-1 + GFS_Coupling%mask_dat(im) = datar82d(i-isc+1,j-jsc+1) + end do + end do + case ('So_t') +!$omp parallel do default(shared) private(i,j,nb,ix,im) + do j = jsc, jec + do i = isc, iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + im = GFS_control%chunk_begin(nb)+ix-1 + GFS_Coupling%tsfco_dat(im) = datar82d(i-isc+1,j-jsc+1) + end do + end do + case ('Si_t') +!$omp parallel do default(shared) private(i,j,nb,ix,im) + do j = jsc, jec + do i = isc, iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + im = GFS_control%chunk_begin(nb)+ix-1 + GFS_Coupling%tice_dat(im) = datar82d(i-isc+1,j-jsc+1) + end do + end do + case default + write(logunit,*) trim(fieldName)//' can not be used by cdeps inline! Skipping field ...' + end select + end subroutine setup_inlinedata ! subroutine setup_exportdata(rc) diff --git a/fv3/module_fcst_grid_comp.F90 b/fv3/module_fcst_grid_comp.F90 index 5762543c6a..ee8a15bd83 100644 --- a/fv3/module_fcst_grid_comp.F90 +++ b/fv3/module_fcst_grid_comp.F90 @@ -79,6 +79,10 @@ module module_fcst_grid_comp use atmos_model_mod, only: setup_exportdata use CCPP_data, only: GFS_control +#ifdef CDEPS_INLINE + use module_cdeps_inline, only: cdeps_stream_init + use module_cdeps_inline, only: cdeps_stream_run +#endif ! !----------------------------------------------------------------------- ! @@ -1293,6 +1297,14 @@ subroutine fcst_realize(fcst_comp, importState, exportState, clock, rc) exportState=exportState, phase=4, userrc=urc, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return if (ESMF_LogFoundError(rcToCheck=urc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__, rcToReturn=rc)) return + +#ifdef CDEPS_INLINE + ! --- call cdeps inline initialization ------------------- + if (GFS_control%use_cdeps_inline) then + call cdeps_stream_init(fcstGridComp(cpl_grid_id), clock, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if +#endif ! ! !----------------------------------------------------------------------- @@ -1351,6 +1363,16 @@ subroutine fcst_run_phase_1(fcst_comp, importState, exportState,clock,rc) endif ! !----------------------------------------------------------------------- +! *** call cdeps inline + +#ifdef CDEPS_INLINE + if (GFS_control%use_cdeps_inline) then + call cdeps_stream_run(clock, rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + end if +#endif +! +!----------------------------------------------------------------------- ! *** call fcst integration subroutines call update_atmos_model_dynamics (Atmos)