diff --git a/atmos_model.F90 b/atmos_model.F90 index bd2c1c887..512c263ad 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -275,7 +275,7 @@ subroutine update_atmos_radiation_physics (Atmos) !--- if coupled, assign coupled fields if (.not. GFS_control%cplchm) then - call assign_importdata(rc) + call assign_importdata(jdat(:),rc) endif ! Calculate total non-physics tendencies by substracting old GFS Stateout @@ -1621,13 +1621,14 @@ subroutine dealloc_atmos_data_type (Atmos) Atmos%lat ) end subroutine dealloc_atmos_data_type - subroutine assign_importdata(rc) + subroutine assign_importdata(jdat, rc) use module_cplfields, only: importFields, nImportFields, queryImportFields, & importFieldsValid use ESMF ! implicit none + integer, intent(in) :: jdat(8) integer, intent(out) :: rc !--- local variables @@ -1639,9 +1640,15 @@ subroutine assign_importdata(rc) real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d real(kind=ESMF_KIND_R8), dimension(:,:,:), pointer:: datar83d real(kind=GFS_kind_phys), dimension(:,:), pointer :: datar8 + logical, dimension(:,:), pointer :: mergeflg real(kind=GFS_kind_phys) :: tem, ofrac logical found, isFieldCreated, lcpl_fice + real(ESMF_KIND_R8), parameter :: missing_value = 9.99e20_ESMF_KIND_R8 + type(ESMF_Grid) :: grid + type(ESMF_Field) :: dbgField + character(19) :: currtimestring real (kind=GFS_kind_phys), parameter :: z0ice=1.1 ! (in cm) + ! real(kind=GFS_kind_phys), parameter :: himax = 8.0 !< maximum ice thickness allowed ! real(kind=GFS_kind_phys), parameter :: himin = 0.1 !< minimum ice thickness required @@ -1660,6 +1667,7 @@ subroutine assign_importdata(rc) lcpl_fice = .false. allocate(datar8(isc:iec,jsc:jec)) + allocate(mergeflg(isc:iec,jsc:jec)) ! if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in cplImp,dim=',isc,iec,jsc,jec ! if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in cplImp,GFS_data, size', size(GFS_data) @@ -1676,6 +1684,7 @@ subroutine assign_importdata(rc) if (isFieldCreated) then ! put the data from local cubed sphere grid to column grid for phys datar8 = -99999.0 + mergeflg = .false. call ESMF_FieldGet(importFields(n), dimCount=dimCount ,typekind=datatype, & name=impfield_name, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -1685,6 +1694,9 @@ subroutine assign_importdata(rc) call ESMF_FieldGet(importFields(n),farrayPtr=datar82d,localDE=0, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return datar8 = datar82d + if (GFS_control%cpl_imp_mrg) then + mergeflg(:,:) = datar82d(:,:).eq.missing_value + endif if (mpp_pe() == mpp_root_pe() .and. debug) print *,'in cplIMP,atmos gets ',trim(impfield_name),' datar8=', & datar8(isc,jsc), maxval(datar8), minval(datar8) found = .true. @@ -1779,9 +1791,17 @@ subroutine assign_importdata(rc) do i=isc,iec nb = Atm_block%blkno(i,j) ix = Atm_block%ixp(i,j) - if (GFS_data(nb)%Sfcprop%oceanfrac(ix) > zero .and. datar8(i,j) > 150.0) then -! GFS_data(nb)%Coupling%tseain_cpl(ix) = datar8(i,j) - GFS_data(nb)%Sfcprop%tsfco(ix) = datar8(i,j) + if (GFS_Data(nb)%Sfcprop%oceanfrac(ix) > zero .and. datar8(i,j) > 150.0) then + if(mergeflg(i,j)) then +! GFS_Data(nb)%Coupling%tseain_cpl(ix) = & +! GFS_Data(nb)%Sfcprop%tsfc(ix) + GFS_Data(nb)%Sfcprop%tsfco(ix) = & + GFS_Data(nb)%Sfcprop%tsfc(ix) + datar8(i,j) = GFS_Data(nb)%Sfcprop%tsfc(ix) + else +! GFS_Data(nb)%Coupling%tseain_cpl(ix) = datar8(i,j) + GFS_Data(nb)%Sfcprop%tsfco(ix) = datar8(i,j) + endif endif enddo enddo @@ -2436,10 +2456,29 @@ subroutine assign_importdata(rc) endif endif + ! write post merge import data to NetCDF file. + if (GFS_control%cpl_imp_dbg) then + call ESMF_FieldGet(importFields(n), grid=grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + dbgField = ESMF_FieldCreate(grid=grid, farrayPtr=datar8, name=impfield_name, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + write (currtimestring, "(I4.4,'-',I2.2,'-',I2.2,'T',I2.2,':',I2.2,':',I2.2)") & + jdat(1), jdat(2), jdat(3), jdat(5), jdat(6), jdat(7) + call ESMF_FieldWrite(dbgField, fileName='fv3_merge_'//trim(impfield_name)//'_'// & + trim(currtimestring)//'.nc', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + call ESMF_FieldDestroy(dbgField, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + endif ! if (found) then endif ! if (isFieldCreated) then enddo ! + deallocate(mergeflg) deallocate(datar8) ! update sea ice related fields: diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index d9c89bd71..f44dabb7b 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -628,9 +628,12 @@ module GFS_typedefs !--- coupling parameters logical :: cplflx !< default no cplflx collection + logical :: cplice !< default yes cplice collection (used together with cplflx) logical :: cplwav !< default no cplwav collection logical :: cplwav2atm !< default no wav->atm coupling logical :: cplchm !< default no cplchm collection + logical :: cpl_imp_mrg !< default no merge import with internal forcings + logical :: cpl_imp_dbg !< default no write import data to file post merge !--- integrated dynamics through earth's atmosphere logical :: lsidea @@ -1093,6 +1096,9 @@ module GFS_typedefs real(kind=kind_phys) :: dspfac !< tke dissipative heating factor real(kind=kind_phys) :: bl_upfr !< updraft fraction in boundary layer mass flux scheme real(kind=kind_phys) :: bl_dnfr !< downdraft fraction in boundary layer mass flux scheme + real(kind=kind_phys) :: rlmx !< maximum allowed mixing length in boundary layer mass flux scheme + real(kind=kind_phys) :: elmx !< maximum allowed dissipation mixing length in boundary layer mass flux scheme + integer :: sfc_rlm !< choice of near surface mixing length in boundary layer mass flux scheme !--- parameters for canopy heat storage (CHS) parameterization real(kind=kind_phys) :: h0facu !< CHS factor for sensible heat flux in unstable surface layer @@ -3103,9 +3109,12 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- coupling parameters logical :: cplflx = .false. !< default no cplflx collection + logical :: cplice = .true. !< default yes cplice collection (used together with cplflx) logical :: cplwav = .false. !< default no cplwav collection logical :: cplwav2atm = .false. !< default no cplwav2atm coupling logical :: cplchm = .false. !< default no cplchm collection + logical :: cpl_imp_mrg = .false. !< default no merge import with internal forcings + logical :: cpl_imp_dbg = .false. !< default no write import data to file post merge !--- integrated dynamics through earth's atmosphere logical :: lsidea = .false. @@ -3496,6 +3505,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: dspfac = 1.0 !< tke dissipative heating factor real(kind=kind_phys) :: bl_upfr = 0.13 !< updraft fraction in boundary layer mass flux scheme real(kind=kind_phys) :: bl_dnfr = 0.1 !< downdraft fraction in boundary layer mass flux scheme + real(kind=kind_phys) :: rlmx = 300. !< maximum allowed mixing length in boundary layer mass flux scheme + real(kind=kind_phys) :: elmx = 300. !< maximum allowed dissipation mixing length in boundary layer mass flux scheme + integer :: sfc_rlm = 0 !< choice of near surface mixing length in boundary layer mass flux scheme !--- parameters for canopy heat storage (CHS) parameterization real(kind=kind_phys) :: h0facu = 0.25 @@ -3565,7 +3577,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & naux3d, aux2d_time_avg, aux3d_time_avg, fhcyc, & thermodyn_id, sfcpress_id, & !--- coupling parameters - cplflx, cplwav, cplwav2atm, cplchm, lsidea, & + cplflx, cplice, cplwav, cplwav2atm, cplchm, & + cpl_imp_mrg, cpl_imp_dbg, & + lsidea, & !--- radiation parameters fhswr, fhlwr, levr, nfxr, iaerclm, iflip, isol, ico2, ialb, & isot, iems, iaer, icliq_sw, iovr, ictm, isubc_sw, & @@ -3650,7 +3664,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & thsfc_loc, & ! vertical diffusion xkzm_m, xkzm_h, xkzm_s, xkzminv, moninq_fac, dspfac, & - bl_upfr, bl_dnfr, & + bl_upfr, bl_dnfr, rlmx, elmx, sfc_rlm, & !--- canopy heat storage parameterization h0facu, h0facs, & !--- cellular automata @@ -3840,9 +3854,12 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- coupling parameters Model%cplflx = cplflx + Model%cplice = cplice Model%cplwav = cplwav Model%cplwav2atm = cplwav2atm Model%cplchm = cplchm + Model%cpl_imp_mrg = cpl_imp_mrg + Model%cpl_imp_dbg = cpl_imp_dbg !--- integrated dynamics through earth's atmosphere Model%lsidea = lsidea @@ -4360,6 +4377,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%dspfac = dspfac Model%bl_upfr = bl_upfr Model%bl_dnfr = bl_dnfr + Model%rlmx = rlmx + Model%elmx = elmx + Model%sfc_rlm = sfc_rlm !--- canopy heat storage parametrization Model%h0facu = h0facu @@ -5423,9 +5443,12 @@ subroutine control_print(Model) print *, ' ' print *, 'coupling parameters' print *, ' cplflx : ', Model%cplflx + print *, ' cplice : ', Model%cplice print *, ' cplwav : ', Model%cplwav print *, ' cplwav2atm : ', Model%cplwav2atm print *, ' cplchm : ', Model%cplchm + print *, ' cpl_imp_mrg : ', Model%cpl_imp_mrg + print *, ' cpl_imp_dbg : ', Model%cpl_imp_dbg print *, ' ' print *, 'integrated dynamics through earth atmosphere' print *, ' lsidea : ', Model%lsidea @@ -5712,6 +5735,9 @@ subroutine control_print(Model) print *, ' dspfac : ', Model%dspfac print *, ' bl_upfr : ', Model%bl_upfr print *, ' bl_dnfr : ', Model%bl_dnfr + print *, ' rlmx : ', Model%rlmx + print *, ' elmx : ', Model%elmx + print *, ' sfc_rlm : ', Model%sfc_rlm print *, ' ' print *, 'parameters for canopy heat storage parametrization' print *, ' h0facu : ', Model%h0facu diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 36c729fe8..81592b886 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -2588,6 +2588,12 @@ units = flag dimensions = () type = logical +[cplice] + standard_name = flag_for_sea_ice_coupling + long_name = flag controlling cplice collection (default on) + units = flag + dimensions = () + type = logical [cplwav] standard_name = flag_for_ocean_wave_coupling long_name = flag controlling cplwav collection (default off) @@ -2606,6 +2612,18 @@ units = flag dimensions = () type = logical +[cpl_imp_mrg] + standard_name = flag_for_merging_imported_data + long_name = flag controlling cpl_imp_mrg for imported data (default off) + units = flag + dimensions = () + type = logical +[cpl_imp_dbg] + standard_name = flag_for_debugging_merged_imported_data + long_name = flag controlling cpl_imp_dbg for imported data (default off) + units = flag + dimensions = () + type = logical [lsidea] standard_name = flag_for_integrated_dynamics_through_earths_atmosphere long_name = flag for idealized physics @@ -4371,6 +4389,26 @@ dimensions = () type = real kind = kind_phys +[rlmx] + standard_name = maximum_allowed_mixing_length_in_boundary_layer_mass_flux_scheme + long_name = maximum allowed mixing length in boundary layer mass flux scheme + units = m + dimensions = () + type = real + kind = kind_phys +[elmx] + standard_name = maximum_allowed_dissipation_mixing_length_in_boundary_layer_mass_flux_scheme + long_name = maximum allowed dissipation mixing length in boundary layer mass flux scheme + units = m + dimensions = () + type = real + kind = kind_phys +[sfc_rlm] + standard_name = choice_of_near_surface_mixing_length_in_boundary_layer_mass_flux_scheme + long_name = choice of near surface mixing length in boundary layer mass flux scheme + units = none + dimensions = () + type = integer [h0facu] standard_name = multiplicative_tuning_parameter_for_reduced_surface_heat_fluxes_due_to_canopy_heat_storage long_name = canopy heat storage factor for sensible heat flux in unstable surface layer diff --git a/ccpp/physics b/ccpp/physics index 5f0f192b6..4960c9a08 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 5f0f192b65cf8f1619f6644b66e8312c401e75f5 +Subproject commit 4960c9a0873d4e5045b13caaba01d4d9a78ceef1 diff --git a/ccpp/suites/suite_FV3_HAFS_v0_gfdlmp_tedmf.xml b/ccpp/suites/suite_FV3_HAFS_v0_gfdlmp_tedmf.xml new file mode 100644 index 000000000..12eb779d0 --- /dev/null +++ b/ccpp/suites/suite_FV3_HAFS_v0_gfdlmp_tedmf.xml @@ -0,0 +1,95 @@ + + + + + + + fv_sat_adj + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + GFS_radiation_surface + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_FV3_HAFS_v0_gfdlmp_tedmf_nonsst.xml b/ccpp/suites/suite_FV3_HAFS_v0_gfdlmp_tedmf_nonsst.xml new file mode 100644 index 000000000..068da3e1b --- /dev/null +++ b/ccpp/suites/suite_FV3_HAFS_v0_gfdlmp_tedmf_nonsst.xml @@ -0,0 +1,93 @@ + + + + + + + fv_sat_adj + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + GFS_radiation_surface + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_ocean + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + diff --git a/ccpp/suites/suite_HAFS_v0_hwrf.xml b/ccpp/suites/suite_FV3_HAFS_v0_hwrf.xml similarity index 98% rename from ccpp/suites/suite_HAFS_v0_hwrf.xml rename to ccpp/suites/suite_FV3_HAFS_v0_hwrf.xml index 6d5b4565b..80f3a8f1c 100644 --- a/ccpp/suites/suite_HAFS_v0_hwrf.xml +++ b/ccpp/suites/suite_FV3_HAFS_v0_hwrf.xml @@ -1,6 +1,6 @@ - + diff --git a/ccpp/suites/suite_HAFS_v0_hwrf_thompson.xml b/ccpp/suites/suite_FV3_HAFS_v0_hwrf_thompson.xml similarity index 98% rename from ccpp/suites/suite_HAFS_v0_hwrf_thompson.xml rename to ccpp/suites/suite_FV3_HAFS_v0_hwrf_thompson.xml index 28bfa5fca..6240bb687 100644 --- a/ccpp/suites/suite_HAFS_v0_hwrf_thompson.xml +++ b/ccpp/suites/suite_FV3_HAFS_v0_hwrf_thompson.xml @@ -1,6 +1,6 @@ - + diff --git a/cpl/module_cap_cpl.F90 b/cpl/module_cap_cpl.F90 index f74ae1a9c..47f48ce4d 100644 --- a/cpl/module_cap_cpl.F90 +++ b/cpl/module_cap_cpl.F90 @@ -139,7 +139,7 @@ end subroutine realizeConnectedInternCplField subroutine realizeConnectedCplFields(state, grid, & numLevels, numSoilLayers, numTracers, & - fields_info, state_tag, fieldList, rc) + fields_info, state_tag, fieldList, fill_value, rc) use field_manager_mod, only: MODEL_ATMOS use tracer_manager_mod, only: get_number_tracers, get_tracer_names @@ -152,18 +152,28 @@ subroutine realizeConnectedCplFields(state, grid, & type(FieldInfo), dimension(:), intent(in) :: fields_info character(len=*), intent(in) :: state_tag !< Import or export. type(ESMF_Field), dimension(:), intent(out) :: fieldList + real(ESMF_KIND_R8), optional , intent(in) :: fill_value integer, intent(out) :: rc ! local variables + integer :: item, pos, tracerCount logical :: isConnected type(ESMF_Field) :: field + real(ESMF_KIND_R8) :: l_fill_value + real(ESMF_KIND_R8), parameter :: d_fill_value = 0._ESMF_KIND_R8 type(ESMF_StateIntent_Flag) :: stateintent character(len=32), allocatable, dimension(:) :: tracerNames, tracerUnits ! begin rc = ESMF_SUCCESS + if (present(fill_value)) then + l_fill_value = fill_value + else + l_fill_value = d_fill_value + end if + ! attach list of tracer names to exported tracer field as metadata call ESMF_StateGet(state, stateintent=stateintent, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -221,8 +231,8 @@ subroutine realizeConnectedCplFields(state, grid, & call NUOPC_Realize(state, field=field, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! -- zero out field - call ESMF_FieldFill(field, dataFillScheme="const", const1=0._ESMF_KIND_R8, rc=rc) + ! -- initialize field value + call ESMF_FieldFill(field, dataFillScheme="const", const1=l_fill_value, rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! -- save field diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 1477f3bbc..eca8cf686 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -819,7 +819,7 @@ subroutine InitializeRealize(gcomp, rc) ! -- realize connected fields in exportState call realizeConnectedCplFields(exportState, fcstGrid, & numLevels, numSoilLayers, numTracers, & - exportFieldsInfo, 'FV3 Export', exportFields, rc) + exportFieldsInfo, 'FV3 Export', exportFields, 0.0_ESMF_KIND_R8, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! -- initialize export fields if applicable @@ -829,7 +829,7 @@ subroutine InitializeRealize(gcomp, rc) ! -- realize connected fields in importState call realizeConnectedCplFields(importState, fcstGrid, & numLevels, numSoilLayers, numTracers, & - importFieldsInfo, 'FV3 Import', importFields, rc) + importFieldsInfo, 'FV3 Import', importFields, 9.99e20_ESMF_KIND_R8, rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return end if diff --git a/io/module_write_netcdf.F90 b/io/module_write_netcdf.F90 index d15d646a6..30959e625 100644 --- a/io/module_write_netcdf.F90 +++ b/io/module_write_netcdf.F90 @@ -398,7 +398,7 @@ subroutine write_netcdf(fieldbundle, wrtfb, filename, mpi_comm, mype, im, jm, ic end if end subroutine write_netcdf - +! !---------------------------------------------------------------------------------------- subroutine get_global_attr(fldbundle, ncid, rc) type(ESMF_FieldBundle), intent(in) :: fldbundle diff --git a/module_fcst_grid_comp.F90 b/module_fcst_grid_comp.F90 index a02744058..9ff27b1a6 100644 --- a/module_fcst_grid_comp.F90 +++ b/module_fcst_grid_comp.F90 @@ -204,6 +204,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) logical :: freq_restart, fexist integer, allocatable, dimension(:) :: isl, iel, jsl, jel integer, allocatable, dimension(:,:,:) :: deBlockList + integer :: tlb(2), tub(2) type(ESMF_Decomp_Flag) :: decompflagPTile(2,6) @@ -466,8 +467,7 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) fcstGrid = ESMF_GridCreateNoPeriDim(regDecomp=(/atm_int_state%Atm%layout(1),atm_int_state%Atm%layout(2)/), & minIndex=(/1,1/), & maxIndex=(/atm_int_state%Atm%mlon,atm_int_state%Atm%mlat/), & - gridEdgeLWidth=(/0,0/), & - gridEdgeUWidth=(/0,0/), & + gridAlign=(/-1,-1/), & decompflag=(/ESMF_DECOMP_SYMMEDGEMAX,ESMF_DECOMP_SYMMEDGEMAX/), & name="fcst_grid", & indexflag=ESMF_INDEX_DELOCAL, & @@ -488,16 +488,18 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) enddo ! add and define "corner" coordinate values - !call ESMF_GridAddCoord(fcstGrid, staggerLoc=ESMF_STAGGERLOC_CORNER, staggerAlign=(/1,1/), rc=rc); ESMF_ERR_ABORT(rc) - !call ESMF_GridGetCoord(fcstGrid, coordDim=1, staggerLoc=ESMF_STAGGERLOC_CORNER, farrayPtr=glonPtr, rc=rc); ESMF_ERR_ABORT(rc) - !call ESMF_GridGetCoord(fcstGrid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CORNER, farrayPtr=glatPtr, rc=rc); ESMF_ERR_ABORT(rc) - - !do j = jsc, jec - !do i = isc, iec - ! glonPtr(i,j) = atm_int_state%Atm%gridstruct%agrid_64(i,j,1) - ! glatPtr(i,j) = atm_int_state%Atm%gridstruct%agrid_64(i,j,2) - !enddo - !enddo + call ESMF_GridAddCoord(fcstGrid, staggerLoc=ESMF_STAGGERLOC_CORNER, & + rc=rc); ESMF_ERR_ABORT(rc) + call ESMF_GridGetCoord(fcstGrid, coordDim=1, staggerLoc=ESMF_STAGGERLOC_CORNER, & + totalLBound=tlb, totalUBound=tub, & + farrayPtr=glonPtr, rc=rc); ESMF_ERR_ABORT(rc) + glonPtr(tlb(1):tub(1),tlb(2):tub(2)) = & + atm_int_state%Atm%lon_bnd(tlb(1):tub(1),tlb(2):tub(2)) * dtor + call ESMF_GridGetCoord(fcstGrid, coordDim=2, staggerLoc=ESMF_STAGGERLOC_CORNER, & + totalLBound=tlb, totalUBound=tub, & + farrayPtr=glatPtr, rc=rc); ESMF_ERR_ABORT(rc) + glatPtr(tlb(1):tub(1),tlb(2):tub(2)) = & + atm_int_state%Atm%lat_bnd(tlb(1):tub(1),tlb(2):tub(2)) * dtor else ! not regional @@ -580,6 +582,13 @@ subroutine fcst_initialize(fcst_comp, importState, exportState, clock, rc) ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return ! endif ! +! Write grid to netcdf file + if( cplprint_flag ) then + call wrt_fcst_grid(fcstGrid, "diagnostic_FV3_fcstGrid.nc", & + regridArea=.TRUE., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + endif + ! Add gridfile Attribute to the exportState call ESMF_AttributeAdd(exportState, convention="NetCDF", purpose="FV3", & attrList=(/"gridfile"/), rc=rc) @@ -990,6 +999,192 @@ subroutine wrt_atmres_timestamp(atm_int_state,timestamp) endif end subroutine wrt_atmres_timestamp ! +!####################################################################### +!-- write forecast grid to NetCDF file for diagnostics +! + subroutine wrt_fcst_grid(grid, fileName, relaxedflag, regridArea, rc) + type(ESMF_Grid), intent(in) :: grid + character(len=*), intent(in), optional :: fileName + logical, intent(in), optional :: relaxedflag + logical, intent(in), optional :: regridArea + integer, intent(out) :: rc +! +!----------------------------------------------------------------------- +!*** local variables +! + logical :: ioCapable + logical :: doItFlag + character(len=64) :: lfileName + character(len=64) :: gridName + type(ESMF_Array) :: array + type(ESMF_ArrayBundle) :: arraybundle + logical :: isPresent + integer :: stat + logical :: hasCorners + logical :: lRegridArea + type(ESMF_Field) :: areaField + type(ESMF_FieldStatus_Flag) :: areaFieldStatus + + ioCapable = (ESMF_IO_PIO_PRESENT .and. & + (ESMF_IO_NETCDF_PRESENT .or. ESMF_IO_PNETCDF_PRESENT)) + doItFlag = .true. + if (present(relaxedFlag)) then + doItFlag = .not.relaxedflag .or. (relaxedflag.and.ioCapable) + endif + + if (doItFlag) then + ! Process optional arguments + if (present(fileName)) then + lfileName = trim(fileName) + else + call ESMF_GridGet(grid, name=gridName, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + lfileName = trim(gridName)//".nc" + endif + if (present(regridArea)) then + lRegridArea = regridArea + else + lRegridArea = .FALSE. + endif + + ! Create bundle for storing output + arraybundle = ESMF_ArrayBundleCreate(rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + + ! -- Centers -- + call ESMF_GridGetCoord(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, & + isPresent=isPresent, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + if (isPresent) then + call ESMF_GridGetCoord(grid, coordDim=1, & + staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + call ESMF_ArraySet(array, name="lon_center", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + call ESMF_ArrayBundleAdd(arraybundle,(/array/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(grid, coordDim=2, & + staggerLoc=ESMF_STAGGERLOC_CENTER, array=array, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + call ESMF_ArraySet(array, name="lat_center", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + call ESMF_ArrayBundleAdd(arraybundle,(/array/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + endif + + ! -- Corners -- + call ESMF_GridGetCoord(grid, staggerLoc=ESMF_STAGGERLOC_CORNER, & + isPresent=hasCorners, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + if (hasCorners) then + call ESMF_GridGetCoord(grid, coordDim=1, & + staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) + if (.not. ESMF_LogFoundError(rc, line=__LINE__, file=__FILE__)) then + call ESMF_ArraySet(array, name="lon_corner", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + call ESMF_ArrayBundleAdd(arraybundle,(/array/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + endif + call ESMF_GridGetCoord(grid, coordDim=2, & + staggerLoc=ESMF_STAGGERLOC_CORNER, array=array, rc=rc) + if (.not. ESMF_LogFoundError(rc, line=__LINE__, file=__FILE__)) then + call ESMF_ArraySet(array, name="lat_corner", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + call ESMF_ArrayBundleAdd(arraybundle,(/array/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + endif + if (lRegridArea) then + areaField = ESMF_FieldCreate(grid=grid, & + typekind=ESMF_TYPEKIND_R8, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + call ESMF_FieldRegridGetArea(areaField, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + call ESMF_FieldGet(areaField, array=array, rc=rc) + if (.not. ESMF_LogFoundError(rc, line=__LINE__, file=__FILE__)) then + call ESMF_ArraySet(array, name="regrid_area", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + call ESMF_ArrayBundleAdd(arraybundle,(/array/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + endif + endif + endif + + ! -- Mask -- + call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_MASK, & + staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + if (isPresent) then + call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, & + itemflag=ESMF_GRIDITEM_MASK, array=array, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + call ESMF_ArraySet(array, name="mask", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + call ESMF_ArrayBundleAdd(arraybundle,(/array/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + endif + + ! -- Area -- + call ESMF_GridGetItem(grid, itemflag=ESMF_GRIDITEM_AREA, & + staggerLoc=ESMF_STAGGERLOC_CENTER, isPresent=isPresent, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + if (isPresent) then + call ESMF_GridGetItem(grid, staggerLoc=ESMF_STAGGERLOC_CENTER, & + itemflag=ESMF_GRIDITEM_AREA, array=array, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + call ESMF_ArraySet(array, name="area", rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + call ESMF_ArrayBundleAdd(arraybundle,(/array/), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + endif + + ! Write array bundle to grid file + call ESMF_ArrayBundleWrite(arraybundle, fileName=trim(lfileName), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + + ! Clean-up + if (lRegridArea) then + call ESMF_FieldGet(areaField, status=areaFieldStatus, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + if (areaFieldStatus.eq.ESMF_FIELDSTATUS_COMPLETE) then + call ESMF_FieldDestroy(areaField, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + endif + endif + call ESMF_ArrayBundleDestroy(arraybundle,rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return + endif + end subroutine wrt_fcst_grid +! !---------------------------------------------------------------------------- !---------------------------------------------------------------------------- !