From 704174e8d4a6ce8fd7ecc9376ba3ad68557fab04 Mon Sep 17 00:00:00 2001 From: "Yihua.Wu" Date: Mon, 8 Aug 2022 14:14:29 +0000 Subject: [PATCH 01/74] Updated flake physics and modified related files --- .gitmodules | 4 +- ccpp/data/CCPP_typedefs.F90 | 6 +- ccpp/data/CCPP_typedefs.meta | 6 -- ccpp/data/GFS_typedefs.F90 | 39 +++++++ ccpp/data/GFS_typedefs.meta | 69 ++++++++++++ ccpp/physics | 2 +- io/FV3GFS_io.F90 | 198 ++++++++++++++++++++++++++++++----- 7 files changed, 283 insertions(+), 41 deletions(-) diff --git a/.gitmodules b/.gitmodules index 6bb663df1..d1c04971b 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,8 +8,8 @@ branch = main [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/NCAR/ccpp-physics - branch = main + url = https://github.com/YihuaWu-NOAA/ccpp-physics + branch = flake.v9 [submodule "upp"] path = upp url = https://github.com/NOAA-EMC/UPP diff --git a/ccpp/data/CCPP_typedefs.F90 b/ccpp/data/CCPP_typedefs.F90 index 694e27211..eaa7e34ba 100644 --- a/ccpp/data/CCPP_typedefs.F90 +++ b/ccpp/data/CCPP_typedefs.F90 @@ -189,7 +189,7 @@ module CCPP_typedefs integer, pointer :: idxday(:) => null() !< logical, pointer :: icy(:) => null() !< logical, pointer :: lake(:) => null() !< - logical, pointer :: use_flake(:) => null() !< +! logical, pointer :: use_flake(:) => null() !< logical, pointer :: ocean(:) => null() !< integer :: ipr !< integer, pointer :: islmsk(:) => null() !< @@ -665,7 +665,7 @@ subroutine gfs_interstitial_create (Interstitial, IM, Model) allocate (Interstitial%idxday (IM)) allocate (Interstitial%icy (IM)) allocate (Interstitial%lake (IM)) - allocate (Interstitial%use_flake (IM)) +! allocate (Interstitial%use_flake (IM)) allocate (Interstitial%ocean (IM)) allocate (Interstitial%islmsk (IM)) allocate (Interstitial%islmsk_cice (IM)) @@ -1459,7 +1459,7 @@ subroutine gfs_interstitial_phys_reset (Interstitial, Model) Interstitial%dry = .false. Interstitial%icy = .false. Interstitial%lake = .false. - Interstitial%use_flake = .false. +! Interstitial%use_flake = .false. Interstitial%ocean = .false. Interstitial%islmsk = 0 Interstitial%islmsk_cice = 0 diff --git a/ccpp/data/CCPP_typedefs.meta b/ccpp/data/CCPP_typedefs.meta index fcdaa0e8a..f36f0e06f 100644 --- a/ccpp/data/CCPP_typedefs.meta +++ b/ccpp/data/CCPP_typedefs.meta @@ -1252,12 +1252,6 @@ units = flag dimensions = (horizontal_loop_extent) type = logical -[use_flake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model - units = flag - dimensions = (horizontal_loop_extent) - type = logical [ocean] standard_name = flag_nonzero_ocean_surface_fraction long_name = flag indicating presence of some ocean surface area fraction diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 194bc97f4..478262ce5 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -210,6 +210,19 @@ module GFS_typedefs real (kind=kind_phys), pointer :: landfrac(:) => null() !< land fraction [0:1] real (kind=kind_phys), pointer :: lakefrac(:) => null() !< lake fraction [0:1] real (kind=kind_phys), pointer :: lakedepth(:) => null() !< lake depth [ m ] + + integer, pointer :: use_flake (:) => null()!Flag for flake + real (kind=kind_phys), pointer :: h_ML(:) => null() !Mixed Layer depth of lakes [m] + real (kind=kind_phys), pointer :: t_ML(:) => null() !Mixing layer temperature in K + real (kind=kind_phys), pointer :: t_mnw(:) => null() !Mean temperature of the water column [K] + real (kind=kind_phys), pointer :: h_talb(:) => null() !the thermally active layer depth of the bottom sediments [m] + real (kind=kind_phys), pointer :: t_talb(:) => null() !Temperature at the bottom of the sediment upper layer [K] + real (kind=kind_phys), pointer :: t_bot1(:) => null() !Temperature at the water-bottom sediment interface [K] + real (kind=kind_phys), pointer :: t_bot2(:) => null() !Temperature for bottom layer of water [K] + real (kind=kind_phys), pointer :: c_t(:) => null() !Shape factor of water temperature vertical profile + real (kind=kind_phys), pointer :: T_snow(:) => null() !temperature of snow on a lake [K] + real (kind=kind_phys), pointer :: T_ice(:) => null() !temperature of ice on a lake [K] + real (kind=kind_phys), pointer :: tsfc (:) => null() !< surface air temperature in K !< [tsea in gbphys.f] real (kind=kind_phys), pointer :: tsfco (:) => null() !< sst in K @@ -2061,6 +2074,19 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%landfrac (IM)) allocate (Sfcprop%lakefrac (IM)) allocate (Sfcprop%lakedepth(IM)) + + allocate (Sfcprop%use_flake(IM)) + allocate (Sfcprop%h_ML (IM)) + allocate (Sfcprop%t_ML (IM)) + allocate (Sfcprop%t_mnw (IM)) + allocate (Sfcprop%h_talb (IM)) + allocate (Sfcprop%t_talb (IM)) + allocate (Sfcprop%t_bot1 (IM)) + allocate (Sfcprop%t_bot2 (IM)) + allocate (Sfcprop%c_t (IM)) + allocate (Sfcprop%T_snow (IM)) + allocate (Sfcprop%T_ice (IM)) + allocate (Sfcprop%tsfc (IM)) allocate (Sfcprop%tsfco (IM)) allocate (Sfcprop%tsfcl (IM)) @@ -2094,6 +2120,19 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%landfrac = clear_val Sfcprop%lakefrac = clear_val Sfcprop%lakedepth = clear_val + + Sfcprop%use_flake = clear_val + Sfcprop%h_ML = clear_val + Sfcprop%t_ML = clear_val + Sfcprop%t_mnw = clear_val + Sfcprop%h_talb = clear_val + Sfcprop%t_talb = clear_val + Sfcprop%t_bot1 = clear_val + Sfcprop%t_bot2 = clear_val + Sfcprop%c_t = clear_val + Sfcprop%T_snow = clear_val + Sfcprop%T_ice = clear_val + Sfcprop%tsfc = clear_val Sfcprop%tsfco = clear_val Sfcprop%tsfcl = clear_val diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 6d17f675a..938df59a9 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -619,6 +619,75 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[use_flake] + standard_name = flag_for_using_flake + long_name = flag indicating lake points using flake model + units = flag + dimensions = (horizontal_loop_extent) + type = integer +[h_ML] + standard_name = mixed_layer_depth_of_lakes + long_name = depth of lake mixing layer + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[t_ML] + standard_name = lake_mixed_layer_temperature + long_name = temperature of lake mixing layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[t_mnw] + standard_name = mean_temperature_of_the_water_column + long_name = thee mean temperature of the water column + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[h_talb] + standard_name = the_thermally_active_layer_depth_of_the_bottom_sediment + long_name = the depth of the thermally active layer of the bottom sediment + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[t_talb] + standard_name = temperature_at_the_bottom_of_the_sediment_upper_layer + long_name = the temperature at the bottom of the sediment upper layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[t_bot1] + standard_name = lake_bottom_temperature + long_name = the temperature at the water-bottom sediment interface + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[t_bot2] + standard_name = temperature_for_bottom_layer_of_water + long_name = the temperature at the lake bottom layer water + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[c_t] + standard_name = shape_factor_of_water_temperature_vertical_profile + long_name = the shape factor of water temperature vertical profile + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[T_snow] + standard_name = temperature_of_snow_on_lake + long_name = temperature of snow on a lake + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [tsfc] standard_name = surface_skin_temperature long_name = surface skin temperature diff --git a/ccpp/physics b/ccpp/physics index dd4911977..cbbc106fd 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit dd49119778bbb0fea60f4aa91ad1b82923ff4d76 +Subproject commit cbbc106fdba491398b9ccfab7d658744a9f4dda1 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 97d942fb3..f633a125f 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -204,6 +204,11 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) nsfcprop2d = nsfcprop2d + 16 endif +! Flake + if(Model%lkm > 0 ) then + nsfcprop2d = nsfcprop2d + 10 + endif + allocate (temp2d(isc:iec,jsc:jec,nsfcprop2d+Model%ntot2d+Model%nctp)) allocate (temp3d(isc:iec,jsc:jec,1:lev,14+Model%ntot3d+2*ntr)) allocate (temp3dlevsp1(isc:iec,jsc:jec,1:lev+1,3)) @@ -432,8 +437,24 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) temp2d(i,j,idx_opt+13) = GFS_Data(nb)%Sfcprop%ifd(ix) temp2d(i,j,idx_opt+14) = GFS_Data(nb)%Sfcprop%dt_cool(ix) temp2d(i,j,idx_opt+15) = GFS_Data(nb)%Sfcprop%qrain(ix) + idx_opt = idx_opt + 15 endif +! Flake + if (Model%lkm > 0 ) then + temp2d(i,j,idx_opt+ 1) = GFS_Data(nb)%Sfcprop%h_ML(ix) + temp2d(i,j,idx_opt+ 2) = GFS_Data(nb)%Sfcprop%t_ML(ix) + temp2d(i,j,idx_opt+ 3) = GFS_Data(nb)%Sfcprop%t_mnw(ix) + temp2d(i,j,idx_opt+ 4) = GFS_Data(nb)%Sfcprop%h_talb(ix) + temp2d(i,j,idx_opt+ 5) = GFS_Data(nb)%Sfcprop%t_talb(ix) + temp2d(i,j,idx_opt+ 6) = GFS_Data(nb)%Sfcprop%t_bot1(ix) + temp2d(i,j,idx_opt+ 7) = GFS_Data(nb)%Sfcprop%t_bot2(ix) + temp2d(i,j,idx_opt+ 8) = GFS_Data(nb)%Sfcprop%c_t(ix) + temp2d(i,j,idx_opt+ 9) = GFS_Data(nb)%Sfcprop%T_snow(ix) + temp2d(i,j,idx_opt+ 10) = GFS_Data(nb)%Sfcprop%T_ice(ix) + endif + + do l = 1,Model%ntot2d temp2d(i,j,nsfcprop2d+l) = GFS_Data(nb)%Tbd%phy_f2d(ix,l) enddo @@ -522,6 +543,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta integer :: isc, iec, jsc, jec, npz, nx, ny integer :: id_restart integer :: nvar_o2, nvar_s2m, nvar_s2o, nvar_s3 + integer :: nvar_s2me, nvar_s2l integer :: nvar_oro_ls_ss integer :: nvar_s2r, nvar_s2mp, nvar_s3mp, isnow integer :: nvar_emi, nvar_dust12m, nvar_gbbepx @@ -673,11 +695,15 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%landfrac(ix) = -9999.0 Sfcprop(nb)%lakefrac(ix) = -9999.0 + Sfcprop(nb)%lakedepth(ix) = -9999.0 Sfcprop(nb)%landfrac(ix) = oro_var2(i,j,17) !land frac [0:1] - Sfcprop(nb)%lakefrac(ix) = oro_var2(i,j,18) !lake frac [0:1] - Sfcprop(nb)%lakedepth(ix) = oro_var2(i,j,19) !lake depth [m] !YWu + if (Model%lkm > 0 ) then + Sfcprop(nb)%lakefrac(ix) = oro_var2(i,j,18) !lake frac [0:1] + Sfcprop(nb)%lakedepth(ix) = oro_var2(i,j,19) !lake depth [m] !YWu + endif + enddo enddo @@ -690,6 +716,12 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (Model%cplwav) then nvar_s2m = nvar_s2m + 1 endif +! Flake + if (Model%lkm > 0 ) then + nvar_s2l = 10 + else + nvar_s2l = 0 + endif !--- deallocate containers and free restart container deallocate(oro_name2, oro_var2) @@ -944,9 +976,9 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (.not. allocated(sfc_name2)) then !--- allocate the various containers needed for restarts - allocate(sfc_name2(nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r)) + allocate(sfc_name2(nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r+nvar_s2l)) allocate(sfc_name3(0:nvar_s3+nvar_s3mp)) - allocate(sfc_var2(nx,ny,nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r)) + allocate(sfc_var2(nx,ny,nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r+nvar_s2l)) ! Note that this may cause problems with RUC LSM for coldstart runs from GFS data ! if the initial conditions do contain this variable, because Model%kice is 9 for ! RUC LSM, but tiice in the initial conditions will only have two vertical layers @@ -1053,6 +1085,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(nvar_s2m+16) = 'ifd' sfc_name2(nvar_s2m+17) = 'dt_cool' sfc_name2(nvar_s2m+18) = 'qrain' + nvar_s2me = nvar_s2m+18 ! ! Only needed when Noah MP LSM is used - 29 2D ! @@ -1086,6 +1119,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(nvar_s2m+45) = 'smcwtdxy' sfc_name2(nvar_s2m+46) = 'deeprechxy' sfc_name2(nvar_s2m+47) = 'rechxy' + nvar_s2me = nvar_s2m+47 else if (Model%lsm == Model%lsm_ruc .and. warm_start) then sfc_name2(nvar_s2m+19) = 'wetness' sfc_name2(nvar_s2m+20) = 'clw_surf_land' @@ -1099,12 +1133,28 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(nvar_s2m+28) = 'sfalb_lnd' sfc_name2(nvar_s2m+29) = 'sfalb_lnd_bck' sfc_name2(nvar_s2m+30) = 'sfalb_ice' + nvar_s2me = nvar_s2m+30 if (Model%rdlai) then sfc_name2(nvar_s2m+31) = 'lai' + nvar_s2me = nvar_s2m+31 endif else if (Model%lsm == Model%lsm_ruc .and. Model%rdlai) then sfc_name2(nvar_s2m+19) = 'lai' + nvar_s2me = nvar_s2m+19 endif +!Flake + if (Model%lkm > 0 ) then + sfc_name2(nvar_s2me+1) = 'h_ML' + sfc_name2(nvar_s2me+2) = 't_ML' + sfc_name2(nvar_s2me+3) = 't_mnw' + sfc_name2(nvar_s2me+4) = 'h_talb' + sfc_name2(nvar_s2me+5) = 't_talb' + sfc_name2(nvar_s2me+6) = 't_bot1' + sfc_name2(nvar_s2me+7) = 't_bot2' + sfc_name2(nvar_s2me+8) = 'c_t' + sfc_name2(nvar_s2me+9) = 'T_snow' + sfc_name2(nvar_s2me+10) = 'T_ice' + endif is_lsoil=.false. if ( .not. warm_start ) then @@ -1204,6 +1254,19 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta end if enddo endif ! noahmp +! Flake + if (Model%lkm > 0 ) then + mand = .false. + do num = nvar_s2me+1,nvar_s2me+nvar_s2l + var2_p => sfc_var2(:,:,num) + if(is_lsoil) then + call register_restart_field(Sfc_restart, sfc_name2(num),var2_p,dimensions=(/'lat','lon'/), is_optional=.not.mand) + else + call register_restart_field(Sfc_restart, sfc_name2(num),var2_p,dimensions=(/'Time ','yaxis_1','xaxis_1'/), is_optional=.not.mand) + endif + enddo + endif + nullify(var2_p) endif ! if not allocated @@ -1360,21 +1423,27 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorlw(ix) endif + if(Sfcprop(nb)%lakefrac(ix) < zero) Sfcprop(nb)%lakefrac(ix) =zero + if(Sfcprop(nb)%landfrac(ix) < zero) Sfcprop(nb)%landfrac(ix) =zero + if(Sfcprop(nb)%fice(ix) < zero) Sfcprop(nb)%fice(ix) =zero +! Sfcprop(nb)%oceanfrac(ix)=one-Sfcprop(nb)%landfrac(ix)-Sfcprop(nb)%lakefrac(ix)-Sfcprop(nb)%fice(ix) + Sfcprop(nb)%oceanfrac(ix)=one-Sfcprop(nb)%landfrac(ix)-Sfcprop(nb)%lakefrac(ix) + if(Sfcprop(nb)%oceanfrac(ix) < zero) Sfcprop(nb)%oceanfrac(ix)=zero +! write(35,75) ix, Sfcprop(nb)%fice(ix), Sfcprop(nb)%oceanfrac(ix), & +! & Sfcprop(nb)%landfrac(ix), Sfcprop(nb)%lakefrac(ix) + if (Sfcprop(nb)%stype(ix) == 14 .or. Sfcprop(nb)%stype(ix) <= 0) then Sfcprop(nb)%landfrac(ix) = zero Sfcprop(nb)%stype(ix) = 0 - if (Sfcprop(nb)%lakefrac(ix) > zero) then - Sfcprop(nb)%lakefrac(ix) = one - endif endif + if (Model%frac_grid) then - if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then + if (Sfcprop(nb)%landfrac(ix) > zero) then Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)-1.0e-6) - if (Sfcprop(nb)%slmsk(ix) == 1 .and. Sfcprop(nb)%stype(ix) == 14) & - Sfcprop(nb)%slmsk(ix) = 0 + if (Sfcprop(nb)%slmsk(ix) == 1 .and. Sfcprop(nb)%stype(ix) == 14) Sfcprop(nb)%slmsk(ix) = 0 if (Sfcprop(nb)%lakefrac(ix) > zero) then - Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell +! Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then if(Sfcprop(nb)%fice(ix) >= Model%min_lakeice) then Sfcprop(nb)%slmsk(ix) = 2 @@ -1384,7 +1453,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta endif else Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) +! Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) then Sfcprop(nb)%slmsk(ix) = 2 @@ -1398,26 +1467,26 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then Sfcprop(nb)%landfrac(ix) = one Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = zero +! Sfcprop(nb)%oceanfrac(ix) = zero else if (Sfcprop(nb)%slmsk(ix) < 0.1_r8 .or. Sfcprop(nb)%slmsk(ix) > 1.9_r8) then Sfcprop(nb)%landfrac(ix) = zero if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes Sfcprop(nb)%lakefrac(ix) = one - Sfcprop(nb)%oceanfrac(ix) = zero +! Sfcprop(nb)%oceanfrac(ix) = zero else ! ocean Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = one +! Sfcprop(nb)%oceanfrac(ix) = one endif endif endif endif else ! not a fractional grid - if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then + if (Sfcprop(nb)%landfrac(ix) > zero) then if (Sfcprop(nb)%lakefrac(ix) > zero) then - Sfcprop(nb)%oceanfrac(ix) = zero +! Sfcprop(nb)%oceanfrac(ix) = zero Sfcprop(nb)%landfrac(ix) = zero - Sfcprop(nb)%lakefrac(ix) = one +! Sfcprop(nb)%lakefrac(ix) = one Sfcprop(nb)%slmsk(ix) = zero if (Sfcprop(nb)%fice(ix) >= Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 else @@ -1425,32 +1494,32 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (Sfcprop(nb)%stype(ix) <= 0 .or. Sfcprop(nb)%stype(ix) == 14) & Sfcprop(nb)%slmsk(ix) = zero if (nint(Sfcprop(nb)%slmsk(ix)) == 0) then - Sfcprop(nb)%oceanfrac(ix) = one +! Sfcprop(nb)%oceanfrac(ix) = one Sfcprop(nb)%landfrac(ix) = zero - Sfcprop(nb)%lakefrac(ix) = zero +! Sfcprop(nb)%lakefrac(ix) = zero if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 else Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = zero +! Sfcprop(nb)%lakefrac(ix) = zero +! Sfcprop(nb)%oceanfrac(ix) = zero endif endif else if (nint(Sfcprop(nb)%slmsk(ix)) == 1 .and. Sfcprop(nb)%stype(ix) > 0 & .and. Sfcprop(nb)%stype(ix) /= 14) then Sfcprop(nb)%landfrac(ix) = one - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = zero +! Sfcprop(nb)%lakefrac(ix) = zero +! Sfcprop(nb)%oceanfrac(ix) = zero else Sfcprop(nb)%slmsk(ix) = zero Sfcprop(nb)%landfrac(ix) = zero if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes - Sfcprop(nb)%lakefrac(ix) = one +! Sfcprop(nb)%lakefrac(ix) = one Sfcprop(nb)%oceanfrac(ix) = zero if (Sfcprop(nb)%fice(ix) > Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 else ! ocean - Sfcprop(nb)%lakefrac(ix) = zero - Sfcprop(nb)%oceanfrac(ix) = one +! Sfcprop(nb)%lakefrac(ix) = zero +! Sfcprop(nb)%oceanfrac(ix) = one if (Sfcprop(nb)%fice(ix) > Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 endif endif @@ -1503,6 +1572,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%ifd(ix) = sfc_var2(i,j,nvar_s2m+16) !--- nsstm ifd Sfcprop(nb)%dt_cool(ix) = sfc_var2(i,j,nvar_s2m+17) !--- nsstm dt_cool Sfcprop(nb)%qrain(ix) = sfc_var2(i,j,nvar_s2m+18) !--- nsstm qrain + nvar_s2me = nvar_s2m+18 endif endif @@ -1520,14 +1590,17 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%sfalb_lnd(ix) = sfc_var2(i,j,nvar_s2m+28) Sfcprop(nb)%sfalb_lnd_bck(ix) = sfc_var2(i,j,nvar_s2m+29) Sfcprop(nb)%sfalb_ice(ix) = sfc_var2(i,j,nvar_s2m+30) + nvar_s2me = nvar_s2m+30 if (Model%rdlai) then Sfcprop(nb)%xlaixy(ix) = sfc_var2(i,j,nvar_s2m+31) + nvar_s2me = nvar_s2m+31 endif else if (Model%lsm == Model%lsm_ruc) then ! Initialize RUC snow cover on ice from snow cover Sfcprop(nb)%sncovr_ice(ix) = Sfcprop(nb)%sncovr(ix) if (Model%rdlai) then Sfcprop(nb)%xlaixy(ix) = sfc_var2(i,j,nvar_s2m+19) + nvar_s2me = nvar_s2m+19 end if elseif (Model%lsm == Model%lsm_noahmp) then !--- Extra Noah MP variables @@ -1560,6 +1633,20 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%smcwtdxy(ix) = sfc_var2(i,j,nvar_s2m+45) Sfcprop(nb)%deeprechxy(ix) = sfc_var2(i,j,nvar_s2m+46) Sfcprop(nb)%rechxy(ix) = sfc_var2(i,j,nvar_s2m+47) + nvar_s2me = nvar_s2m+47 + endif +!Flake + if (Model%lkm > 0 ) then + Sfcprop(nb)%h_ML(ix) = sfc_var2(i,j,nvar_s2me+1) + Sfcprop(nb)%t_ML(ix) = sfc_var2(i,j,nvar_s2me+2) + Sfcprop(nb)%t_mnw(ix) = sfc_var2(i,j,nvar_s2me+3) + Sfcprop(nb)%h_talb(ix) = sfc_var2(i,j,nvar_s2me+4) + Sfcprop(nb)%t_talb(ix) = sfc_var2(i,j,nvar_s2me+5) + Sfcprop(nb)%t_bot1(ix) = sfc_var2(i,j,nvar_s2me+6) + Sfcprop(nb)%t_bot2(ix) = sfc_var2(i,j,nvar_s2me+7) + Sfcprop(nb)%c_t(ix) = sfc_var2(i,j,nvar_s2me+8) + Sfcprop(nb)%T_snow(ix) = sfc_var2(i,j,nvar_s2me+9) + Sfcprop(nb)%T_ice(ix) = sfc_var2(i,j,nvar_s2me+10) endif if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. (.not.warm_start)) then @@ -1839,6 +1926,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta integer :: id_restart integer :: nvar2m, nvar2o, nvar3 integer :: nvar2r, nvar2mp, nvar3mp + integer :: nvar2me, nvar2l !for flake logical :: mand character(len=32) :: fn_srf = 'sfc_data.nc' real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() @@ -1879,6 +1967,14 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nvar2mp = 29 nvar3mp = 5 endif +!Flake + if (Model%lkm > 0 ) then + nvar2l = 10 + nvar2me = nvar2m + else + nvar2l = 0 + nvar2me = 0 + endif isc = Atm_block%isc iec = Atm_block%iec @@ -1978,9 +2074,9 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta if (.not. allocated(sfc_name2)) then !--- allocate the various containers needed for restarts - allocate(sfc_name2(nvar2m+nvar2o+nvar2mp+nvar2r)) + allocate(sfc_name2(nvar2m+nvar2o+nvar2mp+nvar2r+nvar2l)) allocate(sfc_name3(0:nvar3+nvar3mp)) - allocate(sfc_var2(nx,ny,nvar2m+nvar2o+nvar2mp+nvar2r)) + allocate(sfc_var2(nx,ny,nvar2m+nvar2o+nvar2mp+nvar2r+nvar2l)) if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then allocate(sfc_var3(nx,ny,Model%lsoil,nvar3)) elseif (Model%lsm == Model%lsm_ruc) then @@ -2128,6 +2224,19 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+46) = 'deeprechxy' sfc_name2(nvar2m+47) = 'rechxy' endif +!Flake + if(Model%lkm > 0 ) then + sfc_name2(nvar2me+1) = 'h_ML' + sfc_name2(nvar2me+2) = 't_ML' + sfc_name2(nvar2me+3) = 't_mnw' + sfc_name2(nvar2me+4) = 'h_talb' + sfc_name2(nvar2me+5) = 't_talb' + sfc_name2(nvar2me+6) = 't_bot1' + sfc_name2(nvar2me+7) = 't_bot2' + sfc_name2(nvar2me+8) = 'c_t' + sfc_name2(nvar2me+9) = 'T_snow' + sfc_name2(nvar2me+10) = 'T_ice' + endif end if !--- register the 2D fields @@ -2172,6 +2281,19 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta &is_optional=.not.mand) enddo endif +!Flake + nvar2me=nvar2m+nvar2o+nvar2r+nvar2mp + if(Model%lkm > 0) then + mand = .false. + do num = nvar2me+1,nvar2me+nvar2l +! do num = +! nvar2m+nvar2o+nvar2r+nvar2mp+1,nvar2m+nvar2o+nvar2r+nvar2mp+nvar2l + var2_p => sfc_var2(:,:,num) + call register_restart_field(Sfc_restart, sfc_name2(num),var2_p,dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/),& + &is_optional=.not.mand) + enddo + endif + nullify(var2_p) if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then @@ -2322,6 +2444,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+16) = Sfcprop(nb)%ifd(ix) !--- nsstm ifd sfc_var2(i,j,nvar2m+17) = Sfcprop(nb)%dt_cool(ix)!--- nsstm dt_cool sfc_var2(i,j,nvar2m+18) = Sfcprop(nb)%qrain(ix) !--- nsstm qrain + nvar2me = nvar2m + 18 endif if (Model%lsm == Model%lsm_ruc) then @@ -2338,8 +2461,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+28) = Sfcprop(nb)%sfalb_lnd(ix) sfc_var2(i,j,nvar2m+29) = Sfcprop(nb)%sfalb_lnd_bck(ix) sfc_var2(i,j,nvar2m+30) = Sfcprop(nb)%sfalb_ice(ix) + nvar2me = nvar2m + 30 if (Model%rdlai) then sfc_var2(i,j,nvar2m+31) = Sfcprop(nb)%xlaixy(ix) + nvar2me = nvar2m + 31 endif else if (Model%lsm == Model%lsm_noahmp) then !--- Extra Noah MP variables @@ -2372,6 +2497,21 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+45) = Sfcprop(nb)%smcwtdxy(ix) sfc_var2(i,j,nvar2m+46) = Sfcprop(nb)%deeprechxy(ix) sfc_var2(i,j,nvar2m+47) = Sfcprop(nb)%rechxy(ix) + nvar2me = nvar2m + 47 + endif +!Flake + if(Model%lkm > 0 ) then + sfc_var2(i,j,nvar2me+1) = Sfcprop(nb)%h_ML(ix) + sfc_var2(i,j,nvar2me+2) = Sfcprop(nb)%t_ML(ix) + sfc_var2(i,j,nvar2me+3) = Sfcprop(nb)%t_mnw(ix) + sfc_var2(i,j,nvar2me+4) = Sfcprop(nb)%h_talb(ix) + sfc_var2(i,j,nvar2me+5) = Sfcprop(nb)%t_talb(ix) + sfc_var2(i,j,nvar2me+6) = Sfcprop(nb)%t_bot1(ix) + sfc_var2(i,j,nvar2me+7) = Sfcprop(nb)%t_bot2(ix) + sfc_var2(i,j,nvar2me+8) = Sfcprop(nb)%c_t(ix) + sfc_var2(i,j,nvar2me+9) = Sfcprop(nb)%T_snow(ix) + sfc_var2(i,j,nvar2me+10) = Sfcprop(nb)%T_ice(ix) + nvar2me = nvar2m + 10 endif do k = 1,Model%kice From 8b4f476424d67a6f020257a7405495459cfd8494 Mon Sep 17 00:00:00 2001 From: Helin Wei Date: Wed, 10 Aug 2022 14:46:52 -0400 Subject: [PATCH 02/74] update ccpp-physics repo --- .gitmodules | 4 ++-- ccpp/physics | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index d1c04971b..23bf4bf35 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,8 +8,8 @@ branch = main [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/YihuaWu-NOAA/ccpp-physics - branch = flake.v9 + url = https://github.com/HelinWei-NOAA/ccpp-physics + branch = flake [submodule "upp"] path = upp url = https://github.com/NOAA-EMC/UPP diff --git a/ccpp/physics b/ccpp/physics index 1f8cf92bb..a343c92e0 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 1f8cf92bb4d562ba1aa53966fc361fcd1331c2b3 +Subproject commit a343c92e06e02b7c19f7823f8fe7db013767deb6 From 9ca4b3913ee17cdcacddda227fe92ccdaf15e23f Mon Sep 17 00:00:00 2001 From: Helin Wei Date: Wed, 10 Aug 2022 18:40:01 -0400 Subject: [PATCH 03/74] update ccpp-physics repo --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 1f8cf92bb..a343c92e0 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 1f8cf92bb4d562ba1aa53966fc361fcd1331c2b3 +Subproject commit a343c92e06e02b7c19f7823f8fe7db013767deb6 From ee532c4119a9b35896e7571ffe595745b8421ccb Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 11 Aug 2022 20:28:21 +0000 Subject: [PATCH 04/74] add clm lake --- ccpp/config/ccpp_prebuild_config.py | 2 + ccpp/data/CCPP_typedefs.F90 | 3 - ccpp/data/GFS_typedefs.F90 | 170 ++++++++++++++- ccpp/data/GFS_typedefs.meta | 311 +++++++++++++++++++++++++++- ccpp/driver/GFS_diagnostics.F90 | 281 +++++++++++++++++++++++++ ccpp/physics | 2 +- io/FV3GFS_io.F90 | 2 +- 7 files changed, 751 insertions(+), 20 deletions(-) diff --git a/ccpp/config/ccpp_prebuild_config.py b/ccpp/config/ccpp_prebuild_config.py index 2d848c1eb..2d2f33cdd 100755 --- a/ccpp/config/ccpp_prebuild_config.py +++ b/ccpp/config/ccpp_prebuild_config.py @@ -1,3 +1,4 @@ + #!/usr/bin/env python # CCPP prebuild config for GFDL Finite-Volume Cubed-Sphere Model (FV3) @@ -206,6 +207,7 @@ 'physics/physics/lsm_noah.f', 'physics/physics/noahmpdrv.F90', 'physics/physics/flake_driver.F90', + 'physics/physics/clm_lake.f90', 'physics/physics/sfc_nst_pre.f', 'physics/physics/sfc_nst.f', 'physics/physics/sfc_nst_post.f', diff --git a/ccpp/data/CCPP_typedefs.F90 b/ccpp/data/CCPP_typedefs.F90 index eaa7e34ba..4d70de07b 100644 --- a/ccpp/data/CCPP_typedefs.F90 +++ b/ccpp/data/CCPP_typedefs.F90 @@ -189,7 +189,6 @@ module CCPP_typedefs integer, pointer :: idxday(:) => null() !< logical, pointer :: icy(:) => null() !< logical, pointer :: lake(:) => null() !< -! logical, pointer :: use_flake(:) => null() !< logical, pointer :: ocean(:) => null() !< integer :: ipr !< integer, pointer :: islmsk(:) => null() !< @@ -665,7 +664,6 @@ subroutine gfs_interstitial_create (Interstitial, IM, Model) allocate (Interstitial%idxday (IM)) allocate (Interstitial%icy (IM)) allocate (Interstitial%lake (IM)) -! allocate (Interstitial%use_flake (IM)) allocate (Interstitial%ocean (IM)) allocate (Interstitial%islmsk (IM)) allocate (Interstitial%islmsk_cice (IM)) @@ -1459,7 +1457,6 @@ subroutine gfs_interstitial_phys_reset (Interstitial, Model) Interstitial%dry = .false. Interstitial%icy = .false. Interstitial%lake = .false. -! Interstitial%use_flake = .false. Interstitial%ocean = .false. Interstitial%islmsk = 0 Interstitial%islmsk_cice = 0 diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 57d72ec48..e19137c74 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -208,10 +208,14 @@ module GFS_typedefs real (kind=kind_phys), pointer :: slmsk (:) => null() !< sea/land mask array (sea:0,land:1,sea-ice:2) real (kind=kind_phys), pointer :: oceanfrac(:) => null() !< ocean fraction [0:1] real (kind=kind_phys), pointer :: landfrac(:) => null() !< land fraction [0:1] + +!--- In (lakes) real (kind=kind_phys), pointer :: lakefrac(:) => null() !< lake fraction [0:1] real (kind=kind_phys), pointer :: lakedepth(:) => null() !< lake depth [ m ] + integer, pointer :: use_lake_model(:) => null()!1=run lake, 2=run lake&nsst, 0=no lake + real (kind=kind_phys), pointer :: lake_t2m (:) => null() !< 2 meter temperature from CLM Lake model + real (kind=kind_phys), pointer :: lake_q2m (:) => null() !< 2 meter humidity from CLM Lake model - integer, pointer :: use_flake (:) => null()!Flag for flake real (kind=kind_phys), pointer :: h_ML(:) => null() !Mixed Layer depth of lakes [m] real (kind=kind_phys), pointer :: t_ML(:) => null() !Mixing layer temperature in K real (kind=kind_phys), pointer :: t_mnw(:) => null() !Mean temperature of the water column [K] @@ -967,8 +971,22 @@ module GFS_typedefs integer :: ntsflg !< flag for updating skin temperature in the GFDL surface layer scheme real(kind=kind_phys) :: sfenth !< enthalpy flux factor 0 zot via charnock ..>0 zot enhanced>15m/s -!--- flake model parameters - integer :: lkm !< flag for flake model +!--- lake model parameters + integer :: lkm !< =0 no lake, =1 lake, =2 lake&nsst + integer :: iopt_lake !< =1 flake, =2 clm lake + integer :: iopt_lake_flake = 1 + integer :: iopt_lake_clm = 2 + real(kind_phys) :: lakedepth_threshold !< lakedepth must be GREATER than this value to enable a lake model + real(kind_phys) :: lakefrac_threshold !< lakefrac must be GREATER than this value to enable a lake model + +!--- clm lake model parameters + integer :: nlevlake_clm_lake !< Number of lake levels for clm lake model + integer :: nlevsoil_clm_lake !< Number of soil levels for clm lake model + integer :: nlevsnow_clm_lake !< Number of snow levels for clm lake model + integer :: nlevsnowsoil_clm_lake !< -nlevsnow:nlevsoil dimensioned variables + integer :: nlevsnowsoil1_clm_lake !< -nlevsnow+1:nlevsoil dimensioned variables + real(kind_phys) :: clm_lake_depth_default !< minimum lake elevation in clm lake model + logical :: clm_lake_use_lakedepth !< initialize lake from lakedepth !--- tuning parameters for physical parameterizations logical :: ras !< flag for ras convection scheme @@ -1584,6 +1602,35 @@ module GFS_typedefs real (kind=kind_phys), pointer :: phy_myj_a1t(:) => null() ! real (kind=kind_phys), pointer :: phy_myj_a1q(:) => null() ! + ! CLM Lake model internal variables: + real (kind=kind_phys), pointer :: lake_albedo(:) => null() ! + real (kind=kind_phys), pointer :: lake_z3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_dz3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_watsat3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_csol3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_tkmg3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_tkdry3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_tksatu3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_h2osno2d(:) => null() ! + real (kind=kind_phys), pointer :: lake_dp2dsno(:) => null() ! + real (kind=kind_phys), pointer :: lake_snl2d(:) => null() ! + real (kind=kind_phys), pointer :: lake_snow_z3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_snow_dz3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_snow_zi3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_t_h2osoi_vol3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_t_h2osoi_liq3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_t_h2osoi_ice3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_t_grnd2d(:) => null() ! + real (kind=kind_phys), pointer :: lake_t_soisno3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_t_lake3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_savedtke12d(:)=> null() ! + real (kind=kind_phys), pointer :: lake_icefrac3d(:,:)=> null() + real (kind=kind_phys), pointer :: lake_rho0(:)=> null() + real (kind=kind_phys), pointer :: lake_ht(:)=> null() + real (kind=kind_phys), pointer :: lake_clay3d(:,:) => null() + real (kind=kind_phys), pointer :: lake_sand3d(:,:) => null() + integer, pointer :: clm_lake_initialized(:) => null() !< lakeini was called + !--- DFI Radar real (kind=kind_phys), pointer :: dfi_radar_tten(:,:,:) => null() ! real (kind=kind_phys), pointer :: cap_suppress(:,:) => null() ! @@ -2075,7 +2122,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%lakefrac (IM)) allocate (Sfcprop%lakedepth(IM)) - allocate (Sfcprop%use_flake(IM)) + allocate (Sfcprop%use_lake_model(IM)) allocate (Sfcprop%h_ML (IM)) allocate (Sfcprop%t_ML (IM)) allocate (Sfcprop%t_mnw (IM)) @@ -2121,7 +2168,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%lakefrac = clear_val Sfcprop%lakedepth = clear_val - Sfcprop%use_flake = clear_val + Sfcprop%use_lake_model = clear_val Sfcprop%h_ML = clear_val Sfcprop%t_ML = clear_val Sfcprop%t_mnw = clear_val @@ -2501,6 +2548,12 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%conv_act = zero Sfcprop%conv_act_m = zero end if + if (Model%lkm/=0 .and. Model%iopt_lake==Model%iopt_lake_clm) then + allocate(Sfcprop%lake_t2m(IM)) + allocate(Sfcprop%lake_q2m(IM)) + Sfcprop%lake_t2m = clear_val + Sfcprop%lake_q2m = clear_val + endif end subroutine sfcprop_create @@ -3121,6 +3174,17 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- Thompson,GFDL microphysical parameter logical :: lrefres = .false. !< flag for radar reflectivity in restart file + !--- CLM Lake Model parameters (MUST match clm_lake.F90) + integer, parameter :: nlevlake_clm_lake = 10 !< number of lake levels + integer, parameter :: nlevsoil_clm_lake = 10 !< number of soil levels + integer, parameter :: nlevsnow_clm_lake = 5 !< number of snow levels + integer, parameter :: nlevsnowsoil_clm_lake = nlevsnow_clm_lake+nlevsoil_clm_lake+1 !< -nlevsno:nlevsoil dimensioned variables + integer, parameter :: nlevsnowsoil1_clm_lake = nlevsnow_clm_lake+nlevsoil_clm_lake !< -nlevsno+1:nlevsoil dimensioned variables + + !--- CLM Lake configurables + real(kind_phys) :: clm_lake_depth_default = 50 !< default lake depth in clm lake model + logical :: clm_lake_use_lakedepth = .true. !< initialize depth from lakedepth + !--- land/surface model parameters integer :: lsm = 1 !< flag for land surface model to use =0 for osu lsm; =1 for noah lsm; =2 for noah mp lsm; =3 for RUC lsm integer :: lsoil = 4 !< number of soil layers @@ -3166,7 +3230,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & real(kind=kind_phys) :: sfenth = 0.0 !< enthalpy flux factor 0 zot via charnock ..>0 zot enhanced>15m/s !--- flake model parameters - integer :: lkm = 0 !< flag for flake model - default no flake + integer :: lkm = 0 !< =1 run lake, =2 run lake&nsst =0 no lake + integer :: iopt_lake = 1 !< =1 flake, =2 clm lake + real(kind_phys) :: lakedepth_threshold = 1.0 !< lakedepth must be GREATER than this value to enable a lake model + real(kind_phys) :: lakefrac_threshold = 0.0 !< lakefrac must be GREATER than this value to enable a lake model !--- tuning parameters for physical parameterizations logical :: ras = .false. !< flag for ras convection scheme @@ -3535,7 +3602,8 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ! GFDL surface layer options lcurr_sf, pert_cd, ntsflg, sfenth, & !--- lake model control - lkm, & + lkm, iopt_lake, lakedepth_threshold, lakefrac_threshold, & + clm_lake_depth_default, clm_lake_use_lakedepth, & !--- physical parameterizations ras, trans_trac, old_monin, cnvgwd, mstrat, moist_adj, & cscnv, cal_pre, do_aw, do_shoc, shocaftcnv, shoc_cld, & @@ -4163,8 +4231,20 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%ntsflg = ntsflg Model%sfenth = sfenth -!--- flake model parameters +!--- lake model parameters Model%lkm = lkm + Model%iopt_lake = iopt_lake + Model%lakedepth_threshold = lakedepth_threshold + Model%lakefrac_threshold = lakefrac_threshold + +!--- clm lake model parameters + Model%nlevlake_clm_lake = nlevlake_clm_lake + Model%nlevsoil_clm_lake = nlevsoil_clm_lake + Model%nlevsnow_clm_lake = nlevsnow_clm_lake + Model%nlevsnowsoil_clm_lake = nlevsnowsoil_clm_lake + Model%nlevsnowsoil1_clm_lake = nlevsnowsoil1_clm_lake + Model%clm_lake_depth_default = clm_lake_depth_default + Model%clm_lake_use_lakedepth = clm_lake_use_lakedepth ! Noah MP options from namelist ! @@ -5088,8 +5168,19 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & print *,' min_lakeice=',Model%min_lakeice,' min_seaice=',Model%min_seaice, & 'min_lake_height=',Model%min_lake_height - print *, 'flake model parameters' - print *, 'lkm : ', Model%lkm + print *, 'lake model parameters' + print *, ' lake master flag lkm : ', Model%lkm + if(Model%lkm>0) then + print *, ' lake model selection : ', Model%iopt_lake + if(Model%iopt_lake==Model%iopt_lake_clm) then + print *,' CLM Lake model configuration' + print *,' nlevlake_clm_lake = ',Model%nlevlake_clm_lake + print *,' nlevsoil_clm_lake = ',Model%nlevsoil_clm_lake + print *,' nlevsnow_clm_lake = ',Model%nlevsnow_clm_lake + print *,' nlevsnowsoil_clm_lake = ',Model%nlevsnowsoil_clm_lake + print *,' nlevsnowsoil1_clm_lake = ',Model%nlevsnowsoil1_clm_lake + endif + endif if (Model%nstf_name(1) > 0 ) then print *,' NSSTM is active ' @@ -6454,6 +6545,65 @@ subroutine tbd_create (Tbd, IM, Model) Tbd%phy_myj_a1q = clear_val end if + ! CLM Lake Model variables + if(Model%iopt_lake==Model%iopt_lake_clm) then + allocate(Tbd%lake_albedo(IM)) + allocate(Tbd%lake_z3d(IM,Model%nlevlake_clm_lake)) + allocate(Tbd%lake_dz3d(IM,Model%nlevlake_clm_lake)) + allocate(Tbd%lake_watsat3d(IM,Model%nlevlake_clm_lake)) + allocate(Tbd%lake_csol3d(IM,Model%nlevlake_clm_lake)) + allocate(Tbd%lake_tkmg3d(IM,Model%nlevlake_clm_lake)) + allocate(Tbd%lake_tkdry3d(IM,Model%nlevlake_clm_lake)) + allocate(Tbd%lake_tksatu3d(IM,Model%nlevlake_clm_lake)) + allocate(Tbd%lake_h2osno2d(IM)) + allocate(Tbd%lake_dp2dsno(IM)) + allocate(Tbd%lake_snl2d(IM)) + allocate(Tbd%lake_snow_z3d(IM,Model%nlevsnowsoil1_clm_lake)) + allocate(Tbd%lake_snow_dz3d(IM,Model%nlevsnowsoil1_clm_lake)) + allocate(Tbd%lake_snow_zi3d(IM,Model%nlevsnowsoil_clm_lake)) + allocate(Tbd%lake_t_h2osoi_vol3d(IM,Model%nlevsnowsoil1_clm_lake)) + allocate(Tbd%lake_t_h2osoi_liq3d(IM,Model%nlevsnowsoil1_clm_lake)) + allocate(Tbd%lake_t_h2osoi_ice3d(IM,Model%nlevsnowsoil1_clm_lake)) + allocate(Tbd%lake_t_grnd2d(IM)) + allocate(Tbd%lake_t_soisno3d(IM,Model%nlevsnowsoil1_clm_lake)) + allocate(Tbd%lake_t_lake3d(IM,Model%nlevlake_clm_lake)) + allocate(Tbd%lake_savedtke12d(IM)) + allocate(Tbd%lake_icefrac3d(IM,Model%nlevlake_clm_lake)) + allocate(Tbd%lake_rho0(IM)) + allocate(Tbd%lake_ht(IM)) + allocate(Tbd%lake_clay3d(IM,Model%nlevsoil_clm_lake)) + allocate(Tbd%lake_sand3d(IM,Model%nlevsoil_clm_lake)) + allocate(Tbd%clm_lake_initialized(IM)) + + Tbd%lake_albedo = clear_val + Tbd%lake_z3d = clear_val + Tbd%lake_dz3d = clear_val + Tbd%lake_watsat3d = clear_val + Tbd%lake_csol3d = clear_val + Tbd%lake_tkmg3d = clear_val + Tbd%lake_tkdry3d = clear_val + Tbd%lake_tksatu3d = clear_val + Tbd%lake_h2osno2d = clear_val + Tbd%lake_dp2dsno = clear_val + Tbd%lake_snl2d = clear_val + Tbd%lake_snow_z3d = clear_val + Tbd%lake_snow_dz3d = clear_val + Tbd%lake_snow_zi3d = clear_val + Tbd%lake_t_h2osoi_vol3d = clear_val + Tbd%lake_t_h2osoi_liq3d = clear_val + Tbd%lake_t_h2osoi_ice3d = clear_val + Tbd%lake_t_grnd2d = clear_val + Tbd%lake_t_soisno3d = clear_val + Tbd%lake_t_lake3d = clear_val + Tbd%lake_savedtke12d = clear_val + Tbd%lake_icefrac3d = clear_val + Tbd%lake_rho0 = -111 + Tbd%lake_ht = -111 + Tbd%lake_clay3d = clear_val + Tbd%lake_sand3d = clear_val + Tbd%clm_lake_initialized = 0 + endif + end subroutine tbd_create diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 938df59a9..a304dd8ef 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -619,12 +619,28 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys -[use_flake] - standard_name = flag_for_using_flake - long_name = flag indicating lake points using flake model +[use_lake_model] + standard_name = flag_for_using_lake_model + long_name = flag indicating lake points using a lake model units = flag dimensions = (horizontal_loop_extent) type = integer +[lake_t2m] + standard_name = temperature_at_2m_from_clm_lake + long_name = temperature at 2m from clm lake + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection > 0) +[lake_q2m] + standard_name = specific_humidity_at_2m_from_clm_lake + long_name = specific humidity at 2m from clm lake + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection > 0) [h_ML] standard_name = mixed_layer_depth_of_lakes long_name = depth of lake mixing layer @@ -4173,6 +4189,41 @@ units = count dimensions = () type = integer +[nlevlake_clm_lake] + standard_name = lake_vertical_dimension_for_clm_lake_model + long_name = lake vertical dimension for clm lake model + units = count + dimensions = () + type = integer + active = (control_for_lake_surface_scheme == 2) +[nlevsoil_clm_lake] + standard_name = soil_vertical_dimension_for_clm_lake_model + long_name = soil vertical dimension for clm lake model + units = count + dimensions = () + type = integer + active = (control_for_lake_surface_scheme == 2) +[nlevsnow_clm_lake] + standard_name = snow_vertical_dimension_for_clm_lake_model + long_name = snow vertical dimension for clm lake model + units = count + dimensions = () + type = integer + active = (control_for_lake_surface_scheme == 2) +[nlevsnowsoil_clm_lake] + standard_name = snow_plus_soil_vertical_dimension_for_clm_lake_model + long_name = snow plus soil vertical dimension for clm lake model + units = count + dimensions = () + type = integer + active = (control_for_lake_surface_scheme == 2) +[nlevsnowsoil1_clm_lake] + standard_name = snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model + long_name = snow plus soil minus one vertical dimension for clm lake model + units = count + dimensions = () + type = integer + active = (control_for_lake_surface_scheme == 2) [lsoil] standard_name = vertical_dimension_of_soil long_name = number of soil layers @@ -4402,9 +4453,41 @@ dimensions = () type = real kind = kind_phys +[lakefrac_threshold] + standard_name = lakefrac_threshold_for_enabling_lake_model + long_name = fraction of horizontal grid area occupied by lake must be greater than this value to enable a lake model + units = frac + dimensions = () + type = real + kind = kind_phys +[lakedepth_threshold] + standard_name = lake_depth_threshold_for_enabling_lake_model + long_name = lake depth must be greater than this value to enable a lake model + units = m + dimensions = () + type = real + kind = kind_phys +[iopt_lake] + standard_name = control_for_lake_model_selection + long_name = control for lake model selection + units = 1 + dimensions = () + type = integer +[iopt_lake_flake] + standard_name = flake_model_control_selection_value + long_name = value that indicates flake model in the control for lake model selection + units = 1 + dimensions = () + type = integer +[iopt_lake_clm] + standard_name = clm_lake_model_control_selection_value + long_name = value that indicates clm lake model in the control for lake model selection + units = 1 + dimensions = () + type = integer [lkm] - standard_name = control_for_lake_surface_scheme - long_name = flag for lake surface model + standard_name = control_for_lake_model_execution_method + long_name = control for lake model execution: 0=no lake, 1=lake, 2=lake+nsst units = flag dimensions = () type = integer @@ -6434,6 +6517,21 @@ units = flag dimensions = () type = logical +[clm_lake_depth_default] + standard_name = default_lake_depth_in_clm_lake_model + long_name = default lake depth in clm lake model + units = m + dimensions = () + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[clm_lake_use_lakedepth] + standard_name = flag_for_initializing_clm_lake_depth_from_lake_depth + long_name = flag for initializing clm lake depth from lake depth + units = flag + dimensions = () + type = logical + active = (control_for_lake_model_selection == 3) ######################################################################## [ccpp-table-properties] @@ -7189,6 +7287,209 @@ type = real kind = kind_phys active = (flag_for_mellor_yamada_janjic_surface_layer_scheme .or. flag_for_mellor_yamada_janjic_pbl_scheme) +[lake_albedo] + standard_name = mid_day_surface_albedo_over_lake + long_name = mid day surface albedo over lake + units = fraction + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_z3d] + standard_name = depth_of_lake_interface_layers + long_name = depth of lake interface layers + units = fraction + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_dz3d] + standard_name = thickness_of_lake_layers + long_name = thickness of lake layers + units = fraction + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_watsat3d] + standard_name = saturated_volumetric_soil_water_in_lake_model + long_name = saturated volumetric soil water in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_csol3d] + standard_name = soil_heat_capacity_in_lake_model + long_name = soil heat capacity in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_tkmg3d] + standard_name = soil_mineral_thermal_conductivity_in_lake_model + long_name = soil mineral thermal conductivity in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_tkdry3d] + standard_name = dry_soil_thermal_conductivity_in_lake_model + long_name = dry soil thermal conductivity in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_tksatu3d] + standard_name = saturated_soil_thermal_conductivity_in_lake_model + long_name = saturated soil thermal conductivity in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_h2osno2d] + standard_name = water_equivalent_accumulated_snow_depth_in_clm_lake_model + long_name = water equiv of acc snow depth over lake in clm lake model + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_dp2dsno] + standard_name = actual_snow_depth_in_clm_lake_model + long_name = actual acc snow depth over lake in clm lake model + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_snl2d] + standard_name = snow_layers_in_clm_lake_model + long_name = snow layers in clm lake model (treated as integer) + units = count + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_snow_z3d] + standard_name = snow_level_depth_in_clm_lake_model + long_name = snow level depth in clm lake model + units = m + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_snow_dz3d] + standard_name = snow_level_thickness_in_clm_lake_model + long_name = snow level thickness in clm lake model + units = m + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_snow_zi3d] + standard_name = snow_interface_depth_in_clm_lake_model + long_name = snow interface_depth in clm lake model + units = m + dimensions = (horizontal_loop_extent,snow_plus_soil_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_t_h2osoi_vol3d] + standard_name = volumetric_soil_water_in_clm_lake_model + long_name = volumetric soil water in clm lake model + units = m3 m-3 + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_t_h2osoi_liq3d] + standard_name = soil_liquid_water_content_in_clm_lake_model + long_name = soil liquid water content in clm lake model + units = kg m-3 + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_t_h2osoi_ice3d] + standard_name = soil_ice_water_content_in_clm_lake_model + long_name = soil ice water content in clm lake model + units = kg m-3 + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_t_grnd2d] + standard_name = skin_temperature_from_clm_lake_model + long_name = skin temperature from clm lake model + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_t_soisno3d] + standard_name = soil_or_snow_layer_temperature_from_clm_lake_model + long_name = soil or snow layer temperature from clm lake model + units = K + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_t_lake3d] + standard_name = lake_layer_temperature_from_clm_lake_model + long_name = lake layer temperature from clm lake model + units = K + dimensions = (horizontal_loop_extent,lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_savedtke12d] + standard_name = top_level_eddy_conductivity_from_previous_timestep_in_clm_lake_model + long_name = top level eddy conductivity from previous timestep in clm lake model + units = kg m-3 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_icefrac3d] + standard_name = lake_fractional_ice_cover_on_clm_lake_levels + long_name = lake fractional ice cover on clm lake levels + units = kg m-3 + dimensions = (horizontal_loop_extent,lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[lake_ht] + standard_name = test_lake_ht + long_name = test_lake_ht + dimensions = (horizontal_loop_extent) + units = unitless + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 3) +[clm_lake_initialized] + standard_name = flag_for_clm_lake_initialization + long_name = set to true in clm_lake_run after likeini is called, as a workaround for ccpp limitation + units = flag + dimensions = (horizontal_loop_extent) + type = integer + active = (control_for_lake_model_selection == 3) +[lake_clay3d] + standard_name = clm_lake_percent_clay + long_name = percent clay in clm lake model + units = percent + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) + type = integer +[lake_sand3d] + standard_name = clm_lake_percent_sand + long_name = percent sand in clm lake model + units = percent + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) + type = integer [dfi_radar_tten] standard_name = radar_derived_microphysics_temperature_tendency long_name = radar-derived microphysics temperature tendency diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index dd8eaed80..e43a53ed1 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -2457,6 +2457,162 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop enddo endif + if (Model%lkm/=0) then + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'lakefrac' + ExtDiag(idx)%desc = 'Lake Fraction' + ExtDiag(idx)%unit = 'fraction' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%intpl_method = 'nearest_stod' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lakefrac(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'lakedepth' + ExtDiag(idx)%desc = 'Lake Depth' + ExtDiag(idx)%unit = 'm' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%intpl_method = 'nearest_stod' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lakedepth(:) + enddo + + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'use_lake_model' + ExtDiag(idx)%desc = 'Lake Model Flag' + ExtDiag(idx)%unit = 'flag' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%intpl_method = 'nearest_stod' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%int2 => Sfcprop(nb)%use_lake_model(:) + enddo + + if(Model%iopt_lake==Model%iopt_lake_clm) then + + ! Populate the 3D arrays separately since the code is complicated: + call clm_lake_externaldiag_populate(ExtDiag, Model, Tbd, idx, cn_one, nblks) + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'lake_t2m' + ExtDiag(idx)%desc = 'Temperature at 2 m from Lake Model' + ExtDiag(idx)%unit = 'K' + ExtDiag(idx)%intpl_method = 'nearest_stod' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lake_t2m(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'lake_q2m' + ExtDiag(idx)%desc = 'Humidity at 2 m from Lake Model' + ExtDiag(idx)%unit = '%' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%intpl_method = 'nearest_stod' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lake_q2m(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'lake_albedo' + ExtDiag(idx)%desc = 'mid day surface albedo over lake' + ExtDiag(idx)%unit = 'fraction' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%intpl_method = 'nearest_stod' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Tbd(nb)%lake_albedo(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'lake_h2osno2d' + ExtDiag(idx)%desc = 'water equiv of acc snow depth over lake' + ExtDiag(idx)%unit = 'mm' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%intpl_method = 'nearest_stod' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Tbd(nb)%lake_h2osno2d(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'lake_dp2dsno' + ExtDiag(idx)%desc = 'actual acc snow depth over lake in clm lake model' + ExtDiag(idx)%unit = 'mm' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%intpl_method = 'nearest_stod' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Tbd(nb)%lake_dp2dsno(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'lake_snl2d' + ExtDiag(idx)%desc = 'snow layers in clm lake model (treated as integer)' + ExtDiag(idx)%unit = 'count' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%intpl_method = 'nearest_stod' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Tbd(nb)%lake_snl2d(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'lake_t_grnd2d' + ExtDiag(idx)%desc = 'skin temperature from clm lake model' + ExtDiag(idx)%unit = 'K' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%intpl_method = 'nearest_stod' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Tbd(nb)%lake_t_grnd2d(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'lake_savedtke12d' + ExtDiag(idx)%desc = 'top level eddy conductivity from previous timestep in clm lake model' + ExtDiag(idx)%unit = 'kg m-3' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%intpl_method = 'nearest_stod' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Tbd(nb)%lake_savedtke12d(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'lake_ht' + ExtDiag(idx)%desc = 'lake_ht' + ExtDiag(idx)%unit = 'unitless' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%intpl_method = 'nearest_stod' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Tbd(nb)%lake_ht(:) + enddo + + endif + + endif + if (Model%ldiag_ugwp) THEN ! ! VAY-2018: Momentum and Temp-re tendencies @@ -4058,6 +4214,131 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop end subroutine GFS_externaldiag_populate + subroutine clm_lake_externaldiag_populate(ExtDiag, Model, Tbd, idx, cn_one, nblks) + implicit none + type(GFS_externaldiag_type), intent(inout) :: ExtDiag(:) + type(GFS_control_type), intent(in) :: Model + type(GFS_tbd_type), intent(in) :: Tbd(:) + integer, intent(inout) :: idx + integer, intent(in) :: nblks + real(kind=kind_phys), intent(in) :: cn_one + character(:), allocatable :: fullname + + integer :: nk, idx0, iblk + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_z3d, 'lake_z3d', 'lake_depth_on_interface_levels', 'm') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_clay3d, 'lake_clay3d', 'percent clay on soil levels in clm lake model', '%') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_sand3d, 'lake_sand3d', 'percent sand on soil levels in clm lake model', '%') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_dz3d, 'lake_dz3d', 'lake level thickness', 'm') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_watsat3d, 'lake_watsat3d', 'saturated volumetric soil water', 'm3 m-3') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_csol3d, 'lake_csol3d', 'soil heat capacity', 'J m-3 K-1') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_tkmg3d, 'lake_tkmg3d', 'soil thermal conductivity, minerals', 'W m-1 K-1') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_tkdry3d, 'lake_tkdry3d', 'soil thermal conductivity, dry soil', 'W m-1 K-1') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_tksatu3d, 'lake_tksatu3d', 'soil thermal conductivity, saturated soil', 'W m-1 K-1') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_snow_z3d, 'lake_snow_z3d', 'lake snow level depth', 'm') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_snow_dz3d, 'lake_snow_dz3d', 'lake snow level thickness', 'm') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_snow_zi3d, 'lake_snow_zi3d', 'lake snow interface depth', 'm') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_t_h2osoi_vol3d, 'lake_t_h2osoi_vol3d', 'volumetric soil water', 'm3 m-3') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_t_h2osoi_liq3d, 'lake_t_h2osoi_liq3d', 'soil liquid water content', 'kg m-2') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_t_h2osoi_ice3d, 'lake_t_h2osoi_ice3d', 'soil ice water content', 'kg m-2') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_t_soisno3d, 'lake_t_soisno3d', 'snow or soil level temperature', 'K') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_t_lake3d, 'lake_t_lake3d', 'lake layer temperature', 'K') + enddo + + do iblk=1,nblks + call link_all_levels(Tbd(iblk)%lake_icefrac3d, 'lake_icefrac3d', 'lake fractional ice cover', 'fraction') + enddo + + contains + + subroutine link_all_levels(var3d, varname, levelname, unit) + implicit none + real(kind=kind_phys), target :: var3d(:,:) + character(len=*), intent(in) :: varname, levelname, unit + integer k, b, namelen + + if(iblk==1) then + namelen = 30+max(len(varname),len(levelname)) + allocate(character(namelen) :: fullname) + idx0 = idx + endif + + var_z_loop: do k=1,size(var3d,2) + idx = idx0 + k + if(iblk==1) then + ExtDiag(idx)%axes = 2 + write(fullname,"(A,'_',I0)") trim(varname),k + ExtDiag(idx)%name = trim(fullname) + write(fullname,"(A,' level ',I0,' of ',I0)") trim(levelname),k,size(var3d,2) + ExtDiag(idx)%desc = trim(fullname) + ExtDiag(idx)%unit = trim(unit) + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%intpl_method = 'nearest_stod' + + allocate (ExtDiag(idx)%data(nblks)) + do b=1,nblks + nullify(ExtDiag(idx)%data(b)%var2) + enddo + endif + + ExtDiag(idx)%data(iblk)%var2 => var3d(:,k) + enddo var_z_loop + + if(iblk==nblks) then + deallocate(fullname) + endif + end subroutine link_all_levels + end subroutine clm_lake_externaldiag_populate + function soil_layer_depth(lsm, lsm_ruc, lsm_noah, layer) result(layer_depth) character(len=30) :: layer_depth integer, intent(in) :: lsm, lsm_ruc, lsm_noah, layer diff --git a/ccpp/physics b/ccpp/physics index a343c92e0..23290c37b 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit a343c92e06e02b7c19f7823f8fe7db013767deb6 +Subproject commit 23290c37b305181bbd801b29b33bafd1a6f75e01 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 93d070f2c..4cb1d9d96 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -99,7 +99,7 @@ module FV3GFS_io_mod real(kind=kind_phys),dimension(:,:,:),allocatable:: uwork3d logical :: uwork_set = .false. character(128) :: uwindname - integer, parameter, public :: DIAG_SIZE = 500 + integer, parameter, public :: DIAG_SIZE = 800 real, parameter :: missing_value = 9.99e20_r8 real, parameter:: stndrd_atmos_ps = 101325.0_r8 real, parameter:: stndrd_atmos_lapse = 0.0065_r8 From 9486b54edf79f4af0b0b6ca596024539eec983fd Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 11 Aug 2022 20:29:09 +0000 Subject: [PATCH 05/74] point to Sam's repo --- .gitmodules | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitmodules b/.gitmodules index 23bf4bf35..9bfbb3a44 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,7 +8,7 @@ branch = main [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/HelinWei-NOAA/ccpp-physics + url = https://github.com/SamuelTrahanNOAA/ccpp-physics branch = flake [submodule "upp"] path = upp From f8e6405358f9a22b082102c786d11c9a1f30c59b Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 16 Aug 2022 22:48:16 +0000 Subject: [PATCH 06/74] bug fixes, clm lake restart, and clm lake suite --- ccpp/data/GFS_typedefs.F90 | 4 +- ccpp/data/GFS_typedefs.meta | 12 +- ccpp/driver/GFS_diagnostics.F90 | 22 ++++ ccpp/driver/GFS_restart.F90 | 128 +++++++++++++++++++++ ccpp/physics | 2 +- ccpp/suites/suite_FV3_GFS_v16_clm_lake.xml | 95 +++++++++++++++ io/FV3GFS_io.F90 | 4 +- 7 files changed, 261 insertions(+), 6 deletions(-) create mode 100644 ccpp/suites/suite_FV3_GFS_v16_clm_lake.xml diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index e19137c74..d7c6e5593 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -1,7 +1,7 @@ module GFS_typedefs use machine, only: kind_phys, kind_dbl_prec, kind_sngl_prec - use physcons, only: con_cp, con_fvirt, con_g, & + use physcons, only: con_cp, con_fvirt, con_g, rhoice, & con_hvap, con_hfus, con_pi, con_rd, con_rv, & con_t0c, con_cvap, con_cliq, con_eps, con_epsq, & con_epsm1, con_ttp, rlapse, con_jcal, con_rhw0, & @@ -1629,7 +1629,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: lake_ht(:)=> null() real (kind=kind_phys), pointer :: lake_clay3d(:,:) => null() real (kind=kind_phys), pointer :: lake_sand3d(:,:) => null() - integer, pointer :: clm_lake_initialized(:) => null() !< lakeini was called + real (kind=kind_phys), pointer :: clm_lake_initialized(:) => null() !< lakeini was called !--- DFI Radar real (kind=kind_phys), pointer :: dfi_radar_tten(:,:,:) => null() ! diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index a304dd8ef..015e0c986 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -7473,10 +7473,11 @@ active = (control_for_lake_model_selection == 3) [clm_lake_initialized] standard_name = flag_for_clm_lake_initialization - long_name = set to true in clm_lake_run after likeini is called, as a workaround for ccpp limitation + long_name = set to true in clm_lake_run after likeini is called for that gridpoint units = flag dimensions = (horizontal_loop_extent) - type = integer + type = real + kind = kind_phys active = (control_for_lake_model_selection == 3) [lake_clay3d] standard_name = clm_lake_percent_clay @@ -9200,6 +9201,13 @@ dimensions = () type = real kind = kind_phys +[rhoice] + standard_name = density_of_ice_on_lake + long_name = density of ice on a lake + units = kg m-3 + dimensions = () + type = real + kind = kind_phys [con_csol] standard_name = specific_heat_of_ice_at_constant_pressure long_name = specific heat of ice at constant pressure diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index e43a53ed1..0b08220e8 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -3264,6 +3264,28 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%weasd(:) enddo + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'weasdi' + ExtDiag(idx)%desc = 'surface snow water equivalent over ice' + ExtDiag(idx)%unit = 'kg/m**2' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%weasdi(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'snodi' + ExtDiag(idx)%desc = 'water equivalent snow depth over ice' + ExtDiag(idx)%unit = 'mm' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => sfcprop(nb)%weasdi(:) + enddo + idx = idx + 1 ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'hgtsfc' diff --git a/ccpp/driver/GFS_restart.F90 b/ccpp/driver/GFS_restart.F90 index 4774ff299..d51aab801 100644 --- a/ccpp/driver/GFS_restart.F90 +++ b/ccpp/driver/GFS_restart.F90 @@ -97,6 +97,13 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & Restart%ldiag = 3 + Model%ntot2d + Model%nctp + ndiag_rst Restart%num2d = 3 + Model%ntot2d + Model%nctp + ndiag_rst + ! CLM Lake + if(Model%iopt_lake == Model%iopt_lake_clm) then + print *,'num2d was ',Restart%num2d + call clm_lake_define_restart(Restart%num2d,.true.) + print *,'num2d became ',Restart%num2d + endif + ! GF if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then Restart%num2d = Restart%num2d + 3 @@ -419,6 +426,11 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & enddo endif + ! CLM Lake + if(Model%iopt_lake == Model%iopt_lake_clm) then + call clm_lake_define_restart(num,.false.) + endif + !--- phy_f3d variables do num = 1,Model%ntot3d !--- set the variable name @@ -551,6 +563,122 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & enddo endif + contains + + subroutine clm_lake_define_restart(ix,count) + implicit none + logical, intent(in) :: count ! true = increment num; false = link vars + integer, intent(inout) :: ix ! Restart%num2d when count=true, or num when count=false + integer :: lb ! last block to process (1 if count, else nblks) + integer :: ih ! value of ix before processing current variable + integer :: nb ! block being processed + logical :: c ! alias for count, to shorten macro + c=count + + if(count) then + ! We're just counting variables, so there's no need to process multiple blocks + lb=1 + else + ! We're linking data, so we must process all blocks + lb=nblks + endif + + ! Macro to call lvar3d. This simplifies the code tremendously. + ! container = Sfcprop or Tbd + ! varname = lake_z3d, lake_t_lake3d, etc. + ! The varname is converted to a string using the cpp magic #varname + ! due to limitations of the C and Fortran standards +#define call_lvar3d(container,varname) \ +ih=ix;\ +do nb=1,lb;\ +ix=ih;\ +call lvar3d(c,nb,ix,container(nb)%varname,#varname);\ +enddo; + + ! Macro to call lvar2d. This simplifies the code tremendously. + ! container = Sfcprop or Tbd + ! varname = lake_snl2d, clm_lake_initialized, etc. + ! The varname is converted to a string using the cpp magic #varname + ! Total size of the expanded macro must be less than 132 chars + ! due to limitations of the C and Fortran standards +#define call_lvar2d(container,varname) \ +ih=ix;\ +do nb=1,lb;\ +ix=ih;\ +call lvar2d(c,nb,ix,container(nb)%varname,#varname);\ +enddo; + + ! 2D vars + call_lvar2d(Tbd,lake_snl2d) + call_lvar2d(Tbd,lake_h2osno2d) + call_lvar2d(Tbd,lake_t_grnd2d) + call_lvar2d(Tbd,lake_savedtke12d) + call_lvar2d(Tbd,lake_dp2dsno) + call_lvar2d(Tbd,clm_lake_initialized) + + ! 3D vars + call_lvar3d(Tbd,lake_z3d) + call_lvar3d(Tbd,lake_dz3d) + call_lvar3d(Tbd,lake_watsat3d) + call_lvar3d(Tbd,lake_csol3d) + call_lvar3d(Tbd,lake_tkmg3d) + call_lvar3d(Tbd,lake_tkdry3d) + call_lvar3d(Tbd,lake_tksatu3d) + call_lvar3d(Tbd,lake_snow_z3d) + call_lvar3d(Tbd,lake_snow_dz3d) + call_lvar3d(Tbd,lake_snow_zi3d) + call_lvar3d(Tbd,lake_t_h2osoi_vol3d) + call_lvar3d(Tbd,lake_t_h2osoi_liq3d) + call_lvar3d(Tbd,lake_t_h2osoi_ice3d) + call_lvar3d(Tbd,lake_t_soisno3d) + call_lvar3d(Tbd,lake_t_lake3d) + call_lvar3d(Tbd,lake_icefrac3d) + call_lvar3d(Tbd,lake_clay3d) + call_lvar3d(Tbd,lake_sand3d) + end subroutine clm_lake_define_restart + + subroutine lvar3d(count, nb, ix, var3d, varname) + implicit none + logical, intent(in) :: count + real(kind=kind_phys), target :: var3d(:,:) ! 3d ij-k variable + character(len=*), intent(in) :: varname ! variable name without level number + integer, intent(in) :: nb ! current block being processed + integer, intent(inout) :: ix ! num or Restart%num2d + character(400) :: fullname ! full variable name with level appended + integer :: k ! vertical level number + if(count) then + ix=ix+size(var3d,2) + return + endif + do k=1,size(var3d,2) + ix=ix+1 + if(nb==1) then + write(fullname,"(A,'_',I0)") trim(varname),k + print '(A,A,A)', 'Fullname="',trim(fullname),'"' + Restart%name2d(ix) = trim(fullname) + endif + Restart%data(nb,ix)%var2p => var3d(:,k) + enddo + end subroutine lvar3d + + subroutine lvar2d(count, nb, ix, var2d, varname) + implicit none + logical, intent(in) :: count + real(kind=kind_phys), target :: var2d(:) ! 2d ij variable + character(len=*), intent(in) :: varname ! variable name + integer, intent(in) :: nb ! current block being processed + integer, intent(inout) :: ix ! num or Restart%num2d + ix=ix+1 + if(count) then + return + endif + if(nb==1) then + print '(A,A,A)', 'Fullname="',trim(varname),'"' + Restart%name2d(ix) = trim(varname) + endif + Restart%data(nb,ix)%var2p => var2d + end subroutine lvar2d + end subroutine GFS_restart_populate end module GFS_restart diff --git a/ccpp/physics b/ccpp/physics index 23290c37b..0f2b5a7d8 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 23290c37b305181bbd801b29b33bafd1a6f75e01 +Subproject commit 0f2b5a7d8463f76b30870f71c3b7b8f82f550d79 diff --git a/ccpp/suites/suite_FV3_GFS_v16_clm_lake.xml b/ccpp/suites/suite_FV3_GFS_v16_clm_lake.xml new file mode 100644 index 000000000..fb8dcd3ec --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v16_clm_lake.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 + rad_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 + clm_lake + 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 + 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/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 4cb1d9d96..1d418aa7e 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -2510,7 +2510,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2me+7) = Sfcprop(nb)%t_bot2(ix) sfc_var2(i,j,nvar2me+8) = Sfcprop(nb)%c_t(ix) sfc_var2(i,j,nvar2me+9) = Sfcprop(nb)%T_snow(ix) - sfc_var2(i,j,nvar2me+10) = Sfcprop(nb)%T_ice(ix) + sfc_var2(i,j,nvar2me+10) = Sfcprop(nb)%T_ice(ix) ! this is never used nvar2me = nvar2m + 10 endif @@ -2777,11 +2777,13 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta do num = 1,nvar2d var2_p => phy_var2(:,:,num) + print '(A,A,A)', 'Register 2d restart field "',trim(GFS_Restart%name2d(num)),'"' call register_restart_field(Phy_restart, trim(GFS_Restart%name2d(num)), var2_p, dimensions=(/'xaxis_1','yaxis_1','Time '/),& &is_optional=.true.) enddo do num = 1,nvar3d var3_p => phy_var3(:,:,:,num) + print '(A,A,A)', 'Register 2d restart field "',trim(GFS_Restart%name3d(num)),'"' call register_restart_field(Phy_restart, trim(GFS_Restart%name3d(num)), var3_p, dimensions=(/'xaxis_1','yaxis_1','zaxis_1','Time '/),& &is_optional=.true.) enddo From 2ddec5910302e5f541c48d49d425421519d0502b Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 18 Aug 2022 22:03:50 +0000 Subject: [PATCH 07/74] bug fixes for gfortran and "all suites" build --- ccpp/driver/GFS_restart.F90 | 91 ++++++++++++++++++++++++------------- ccpp/physics | 2 +- 2 files changed, 60 insertions(+), 33 deletions(-) diff --git a/ccpp/driver/GFS_restart.F90 b/ccpp/driver/GFS_restart.F90 index d51aab801..a125baba7 100644 --- a/ccpp/driver/GFS_restart.F90 +++ b/ccpp/driver/GFS_restart.F90 @@ -586,55 +586,82 @@ subroutine clm_lake_define_restart(ix,count) ! Macro to call lvar3d. This simplifies the code tremendously. ! container = Sfcprop or Tbd ! varname = lake_z3d, lake_t_lake3d, etc. - ! The varname is converted to a string using the cpp magic #varname + ! varstr = varname in quotes (gfortran does not like #varname magic) + ! Total size of the expanded macro must be less than 132 chars ! due to limitations of the C and Fortran standards -#define call_lvar3d(container,varname) \ +#define run_lvar3d(container,varname,varstr) \ ih=ix;\ do nb=1,lb;\ ix=ih;\ -call lvar3d(c,nb,ix,container(nb)%varname,#varname);\ -enddo; +call lvar3d(c,nb,ix,container(nb)%varname,varstr);\ +enddo ! Macro to call lvar2d. This simplifies the code tremendously. ! container = Sfcprop or Tbd ! varname = lake_snl2d, clm_lake_initialized, etc. - ! The varname is converted to a string using the cpp magic #varname + ! varstr = varname in quotes (gfortran does not like #varname magic) ! Total size of the expanded macro must be less than 132 chars ! due to limitations of the C and Fortran standards -#define call_lvar2d(container,varname) \ +#define run_lvar2d(container,varname,varstr) \ ih=ix;\ do nb=1,lb;\ ix=ih;\ -call lvar2d(c,nb,ix,container(nb)%varname,#varname);\ -enddo; +call lvar2d(c,nb,ix,container(nb)%varname,varstr);\ +enddo ! 2D vars - call_lvar2d(Tbd,lake_snl2d) - call_lvar2d(Tbd,lake_h2osno2d) - call_lvar2d(Tbd,lake_t_grnd2d) - call_lvar2d(Tbd,lake_savedtke12d) - call_lvar2d(Tbd,lake_dp2dsno) - call_lvar2d(Tbd,clm_lake_initialized) + run_lvar2d(Tbd,lake_snl2d,"lake_snl2d") + + run_lvar2d(Tbd,lake_h2osno2d,"lake_h2osno2d") + + run_lvar2d(Tbd,lake_t_grnd2d,"lake_t_grnd2d") + + run_lvar2d(Tbd,lake_savedtke12d,"lake_savedtke12d") + + run_lvar2d(Tbd,lake_dp2dsno,"lake_dp2dsno") + + run_lvar2d(Tbd,clm_lake_initialized,"clm_lake_initialized") ! 3D vars - call_lvar3d(Tbd,lake_z3d) - call_lvar3d(Tbd,lake_dz3d) - call_lvar3d(Tbd,lake_watsat3d) - call_lvar3d(Tbd,lake_csol3d) - call_lvar3d(Tbd,lake_tkmg3d) - call_lvar3d(Tbd,lake_tkdry3d) - call_lvar3d(Tbd,lake_tksatu3d) - call_lvar3d(Tbd,lake_snow_z3d) - call_lvar3d(Tbd,lake_snow_dz3d) - call_lvar3d(Tbd,lake_snow_zi3d) - call_lvar3d(Tbd,lake_t_h2osoi_vol3d) - call_lvar3d(Tbd,lake_t_h2osoi_liq3d) - call_lvar3d(Tbd,lake_t_h2osoi_ice3d) - call_lvar3d(Tbd,lake_t_soisno3d) - call_lvar3d(Tbd,lake_t_lake3d) - call_lvar3d(Tbd,lake_icefrac3d) - call_lvar3d(Tbd,lake_clay3d) - call_lvar3d(Tbd,lake_sand3d) + run_lvar3d(Tbd,lake_z3d,"lake_z3d") + + run_lvar3d(Tbd,lake_dz3d,"lake_dz3d") + + run_lvar3d(Tbd,lake_watsat3d,"lake_watsat3d") + + run_lvar3d(Tbd,lake_csol3d,"lake_csol3d") + + run_lvar3d(Tbd,lake_tkmg3d,"lake_tkmg3d") + + run_lvar3d(Tbd,lake_tkdry3d,"lake_tkdry3d") + + run_lvar3d(Tbd,lake_tksatu3d,"lake_tksatu3d") + + run_lvar3d(Tbd,lake_snow_z3d,"lake_snow_z3d") + + run_lvar3d(Tbd,lake_snow_dz3d,"lake_snow_dz3d") + + run_lvar3d(Tbd,lake_snow_zi3d,"lake_snow_zi3d") + + run_lvar3d(Tbd,lake_t_h2osoi_vol3d,"lake_t_h2osoi_vol3d") + + run_lvar3d(Tbd,lake_t_h2osoi_liq3d,"lake_t_h2osoi_liq3d") + + run_lvar3d(Tbd,lake_t_h2osoi_ice3d,"lake_t_h2osoi_ice3d") + + run_lvar3d(Tbd,lake_t_soisno3d,"lake_t_soisno3d") + + run_lvar3d(Tbd,lake_t_lake3d,"lake_t_lake3d") + + run_lvar3d(Tbd,lake_icefrac3d,"lake_icefrac3d") + + run_lvar3d(Tbd,lake_clay3d,"lake_clay3d") + + run_lvar3d(Tbd,lake_sand3d,"lake_sand3d") + +#undef run_lvar3d +#undef run_lvar2d + end subroutine clm_lake_define_restart subroutine lvar3d(count, nb, ix, var3d, varname) diff --git a/ccpp/physics b/ccpp/physics index 0f2b5a7d8..ab90e244e 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 0f2b5a7d8463f76b30870f71c3b7b8f82f550d79 +Subproject commit ab90e244ec689589d16bc0cd3e33547466af3124 From 69a63f3100cb62750f91b2a2eb8b36c5307de272 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 25 Aug 2022 18:34:26 +0000 Subject: [PATCH 08/74] various snow bug fixes --- atmos_model.F90 | 1 + ccpp/data/GFS_typedefs.F90 | 2 +- ccpp/data/GFS_typedefs.meta | 2 +- ccpp/driver/GFS_diagnostics.F90 | 25 ++++++++++++++++++++++++- ccpp/physics | 2 +- 5 files changed, 28 insertions(+), 4 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index b4caa2aaa..faa1712bb 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -2684,6 +2684,7 @@ subroutine assign_importdata(jdat, rc) fldname = 't2m' if (trim(impfield_name) == trim(fldname)) then + print *,'overwrite t2m with imported data' findex = queryImportFields(fldname) if (importFieldsValid(findex)) then !$omp parallel do default(shared) private(i,j,nb,ix) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index d7c6e5593..2b1f6c263 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -2168,7 +2168,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%lakefrac = clear_val Sfcprop%lakedepth = clear_val - Sfcprop%use_lake_model = clear_val + Sfcprop%use_lake_model = zero Sfcprop%h_ML = clear_val Sfcprop%t_ML = clear_val Sfcprop%t_mnw = clear_val diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 015e0c986..76795b88c 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -628,7 +628,7 @@ [lake_t2m] standard_name = temperature_at_2m_from_clm_lake long_name = temperature at 2m from clm lake - units = frac + units = K dimensions = (horizontal_loop_extent) type = real kind = kind_phys diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index 0b08220e8..b9439d70e 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -2482,7 +2482,30 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop do nb = 1,nblks ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lakedepth(:) enddo - + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'T_snow' + ExtDiag(idx)%desc = 'Temperature of snow on a lake' + ExtDiag(idx)%unit = 'K' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%intpl_method = 'nearest_stod' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%T_snow(:) + enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'T_ice' + ExtDiag(idx)%desc = 'Temperature of ice on a lake' + ExtDiag(idx)%unit = 'K' + ExtDiag(idx)%mod_name = 'gfs_sfc' + ExtDiag(idx)%intpl_method = 'nearest_stod' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%T_ice(:) + enddo idx = idx + 1 ExtDiag(idx)%axes = 2 diff --git a/ccpp/physics b/ccpp/physics index ab90e244e..be305d579 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit ab90e244ec689589d16bc0cd3e33547466af3124 +Subproject commit be305d579b35c779d096df969906a2c22bbf23b4 From 647496c8a8ad39142c1d183eb7b342a0f8fae483 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Thu, 25 Aug 2022 19:11:48 +0000 Subject: [PATCH 09/74] rainnc and rainc do not exist --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index be305d579..0c1f94999 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit be305d579b35c779d096df969906a2c22bbf23b4 +Subproject commit 0c1f94999109915823e9b1824dfa889ce1791ff7 From f3dd187528d84781b2a8f978a69a81c3c978c015 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 25 Aug 2022 19:35:09 +0000 Subject: [PATCH 10/74] remove bad unit conversion --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index be305d579..0a3abbb40 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit be305d579b35c779d096df969906a2c22bbf23b4 +Subproject commit 0a3abbb4085f487551bd5f470fd29e21147c7ae4 From 29473b690901b95caeb4b050375c1cb7ef7085b7 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 25 Aug 2022 19:37:26 +0000 Subject: [PATCH 11/74] remove bad unit conversion --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 0a3abbb40..0ecd6207a 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 0a3abbb4085f487551bd5f470fd29e21147c7ae4 +Subproject commit 0ecd6207a41f3e806fc6fa062247e96743f6fbf5 From 23ff88b4cef1f54bf696027734234d0f5d4d20ad Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Thu, 25 Aug 2022 20:24:21 +0000 Subject: [PATCH 12/74] unit conversion issue --- ccpp/data/GFS_typedefs.meta | 2 +- ccpp/physics | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 76795b88c..70164f238 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -7362,7 +7362,7 @@ [lake_dp2dsno] standard_name = actual_snow_depth_in_clm_lake_model long_name = actual acc snow depth over lake in clm lake model - units = mm + units = m dimensions = (horizontal_loop_extent) type = real kind = kind_phys diff --git a/ccpp/physics b/ccpp/physics index 0ecd6207a..bbe1a16d3 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 0ecd6207a41f3e806fc6fa062247e96743f6fbf5 +Subproject commit bbe1a16d30037b33849e1ebed64cb888da383a20 From 9bb06265d72aea46373e5fcdcc154b20faf9b17a Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 25 Aug 2022 21:20:35 +0000 Subject: [PATCH 13/74] LAKEDEBUG is now clm_lake_debug namelist parameter --- ccpp/data/GFS_typedefs.F90 | 4 ++++ ccpp/data/GFS_typedefs.meta | 7 +++++++ ccpp/driver/GFS_diagnostics.F90 | 2 +- ccpp/driver/GFS_restart.F90 | 4 ---- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 2 -- 6 files changed, 13 insertions(+), 8 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 2b1f6c263..c42a13f5c 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -987,6 +987,7 @@ module GFS_typedefs integer :: nlevsnowsoil1_clm_lake !< -nlevsnow+1:nlevsoil dimensioned variables real(kind_phys) :: clm_lake_depth_default !< minimum lake elevation in clm lake model logical :: clm_lake_use_lakedepth !< initialize lake from lakedepth + logical :: clm_lake_debug !< verbose debugging in clm_lake !--- tuning parameters for physical parameterizations logical :: ras !< flag for ras convection scheme @@ -3184,6 +3185,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- CLM Lake configurables real(kind_phys) :: clm_lake_depth_default = 50 !< default lake depth in clm lake model logical :: clm_lake_use_lakedepth = .true. !< initialize depth from lakedepth + logical :: clm_lake_debug = .false. !< verbose debugging in clm_lake !--- land/surface model parameters integer :: lsm = 1 !< flag for land surface model to use =0 for osu lsm; =1 for noah lsm; =2 for noah mp lsm; =3 for RUC lsm @@ -3604,6 +3606,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- lake model control lkm, iopt_lake, lakedepth_threshold, lakefrac_threshold, & clm_lake_depth_default, clm_lake_use_lakedepth, & + clm_lake_debug, & !--- physical parameterizations ras, trans_trac, old_monin, cnvgwd, mstrat, moist_adj, & cscnv, cal_pre, do_aw, do_shoc, shocaftcnv, shoc_cld, & @@ -4245,6 +4248,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%nlevsnowsoil1_clm_lake = nlevsnowsoil1_clm_lake Model%clm_lake_depth_default = clm_lake_depth_default Model%clm_lake_use_lakedepth = clm_lake_use_lakedepth + Model%clm_lake_debug = clm_lake_debug ! Noah MP options from namelist ! diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 70164f238..fcd61ca6f 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -6532,6 +6532,13 @@ dimensions = () type = logical active = (control_for_lake_model_selection == 3) +[clm_lake_debug] + standard_name = flag_for_verbose_debugging_in_clm_lake_model + long_name = flag for verbose debugging in clm lake model + units = flag + dimensions = () + type = logical + active = (control_for_lake_model_selection == 3) ######################################################################## [ccpp-table-properties] diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index b9439d70e..62ae43e64 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -2576,7 +2576,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%axes = 2 ExtDiag(idx)%name = 'lake_dp2dsno' ExtDiag(idx)%desc = 'actual acc snow depth over lake in clm lake model' - ExtDiag(idx)%unit = 'mm' + ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' allocate (ExtDiag(idx)%data(nblks)) diff --git a/ccpp/driver/GFS_restart.F90 b/ccpp/driver/GFS_restart.F90 index a125baba7..209319026 100644 --- a/ccpp/driver/GFS_restart.F90 +++ b/ccpp/driver/GFS_restart.F90 @@ -99,9 +99,7 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & ! CLM Lake if(Model%iopt_lake == Model%iopt_lake_clm) then - print *,'num2d was ',Restart%num2d call clm_lake_define_restart(Restart%num2d,.true.) - print *,'num2d became ',Restart%num2d endif ! GF @@ -681,7 +679,6 @@ subroutine lvar3d(count, nb, ix, var3d, varname) ix=ix+1 if(nb==1) then write(fullname,"(A,'_',I0)") trim(varname),k - print '(A,A,A)', 'Fullname="',trim(fullname),'"' Restart%name2d(ix) = trim(fullname) endif Restart%data(nb,ix)%var2p => var3d(:,k) @@ -700,7 +697,6 @@ subroutine lvar2d(count, nb, ix, var2d, varname) return endif if(nb==1) then - print '(A,A,A)', 'Fullname="',trim(varname),'"' Restart%name2d(ix) = trim(varname) endif Restart%data(nb,ix)%var2p => var2d diff --git a/ccpp/physics b/ccpp/physics index bbe1a16d3..9a07ae9ab 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit bbe1a16d30037b33849e1ebed64cb888da383a20 +Subproject commit 9a07ae9abbe47516b5415997712a0f887a8aa57f diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 1d418aa7e..fee5835c4 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -2777,13 +2777,11 @@ subroutine phys_restart_write (GFS_Restart, Atm_block, Model, fv_domain, timesta do num = 1,nvar2d var2_p => phy_var2(:,:,num) - print '(A,A,A)', 'Register 2d restart field "',trim(GFS_Restart%name2d(num)),'"' call register_restart_field(Phy_restart, trim(GFS_Restart%name2d(num)), var2_p, dimensions=(/'xaxis_1','yaxis_1','Time '/),& &is_optional=.true.) enddo do num = 1,nvar3d var3_p => phy_var3(:,:,:,num) - print '(A,A,A)', 'Register 2d restart field "',trim(GFS_Restart%name3d(num)),'"' call register_restart_field(Phy_restart, trim(GFS_Restart%name3d(num)), var3_p, dimensions=(/'xaxis_1','yaxis_1','zaxis_1','Time '/),& &is_optional=.true.) enddo From b96563c211d2dde978fad9b420d097127b123120 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Fri, 26 Aug 2022 19:30:27 +0000 Subject: [PATCH 14/74] tweaks for salty lakes --- ccpp/data/GFS_typedefs.F90 | 3 +++ ccpp/data/GFS_typedefs.meta | 6 ++++++ ccpp/driver/GFS_diagnostics.F90 | 11 +++++++++++ ccpp/physics | 2 +- 4 files changed, 21 insertions(+), 1 deletion(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index c42a13f5c..769c1c508 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -1630,6 +1630,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: lake_ht(:)=> null() real (kind=kind_phys), pointer :: lake_clay3d(:,:) => null() real (kind=kind_phys), pointer :: lake_sand3d(:,:) => null() + integer, pointer :: lake_is_salty(:) => null() real (kind=kind_phys), pointer :: clm_lake_initialized(:) => null() !< lakeini was called !--- DFI Radar @@ -6577,6 +6578,7 @@ subroutine tbd_create (Tbd, IM, Model) allocate(Tbd%lake_ht(IM)) allocate(Tbd%lake_clay3d(IM,Model%nlevsoil_clm_lake)) allocate(Tbd%lake_sand3d(IM,Model%nlevsoil_clm_lake)) + allocate(Tbd%lake_is_salty(IM)) allocate(Tbd%clm_lake_initialized(IM)) Tbd%lake_albedo = clear_val @@ -6605,6 +6607,7 @@ subroutine tbd_create (Tbd, IM, Model) Tbd%lake_ht = -111 Tbd%lake_clay3d = clear_val Tbd%lake_sand3d = clear_val + Tbd%lake_is_salty = 0 Tbd%clm_lake_initialized = 0 endif diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index fcd61ca6f..1951d7607 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -7498,6 +7498,12 @@ units = percent dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) type = integer +[lake_is_salty] + standard_name = clm_lake_is_salty + long_name = lake at this point is salty (1) or not (0) + units = 1 + dimensions = (horizontal_loop_extent) + type = integer [dfi_radar_tten] standard_name = radar_derived_microphysics_temperature_tendency long_name = radar-derived microphysics temperature tendency diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index 62ae43e64..db7165fdb 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -2523,6 +2523,17 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ! Populate the 3D arrays separately since the code is complicated: call clm_lake_externaldiag_populate(ExtDiag, Model, Tbd, idx, cn_one, nblks) + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'lake_is_salty' + ExtDiag(idx)%desc = 'lake point is considered salty by clm lake model' + ExtDiag(idx)%unit = '1' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%int2 => Tbd(nb)%lake_is_salty(:) + enddo idx = idx + 1 ExtDiag(idx)%axes = 2 diff --git a/ccpp/physics b/ccpp/physics index 9a07ae9ab..757a4eb2a 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 9a07ae9abbe47516b5415997712a0f887a8aa57f +Subproject commit 757a4eb2a18d62fcad2df6112b9865b915b12b7a From 32dabe183e6a00a6b57fb9b2a6906cf502ef405a Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Fri, 26 Aug 2022 20:37:25 +0000 Subject: [PATCH 15/74] fix bugs in salty code and add Caspian & Dead seas --- ccpp/data/GFS_typedefs.F90 | 4 ++-- ccpp/physics | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 769c1c508..a56b7d1c5 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -6607,8 +6607,8 @@ subroutine tbd_create (Tbd, IM, Model) Tbd%lake_ht = -111 Tbd%lake_clay3d = clear_val Tbd%lake_sand3d = clear_val - Tbd%lake_is_salty = 0 - Tbd%clm_lake_initialized = 0 + Tbd%lake_is_salty = zero + Tbd%clm_lake_initialized = zero endif end subroutine tbd_create diff --git a/ccpp/physics b/ccpp/physics index 757a4eb2a..947037546 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 757a4eb2a18d62fcad2df6112b9865b915b12b7a +Subproject commit 9470375468f8495c38474dcd96be1d29ed67878a From 6fdf62ea32f930fdffd465e1f83ed241d1738ecc Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 16 Sep 2022 00:54:28 +0000 Subject: [PATCH 16/74] clm lake restart in sfc files; fix some bugs, and make some bugs --- ccpp/data/GFS_typedefs.F90 | 238 +++++----- ccpp/data/GFS_typedefs.meta | 438 ++++++++++--------- ccpp/driver/GFS_diagnostics.F90 | 58 +-- ccpp/driver/GFS_restart.F90 | 109 ----- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 744 +++++++++++++++++++++++++++----- 6 files changed, 1013 insertions(+), 576 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index a56b7d1c5..d923f098f 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -418,6 +418,36 @@ module GFS_typedefs real (kind=kind_phys), pointer :: dsnowprv (:) => null() !< snow precipitation rate from previous timestep real (kind=kind_phys), pointer :: dgraupelprv(:) => null() !< graupel precipitation rate from previous timestep + ! CLM Lake model internal variables: + real (kind=kind_phys), pointer :: lake_albedo(:) => null() ! + real (kind=kind_phys), pointer :: lake_z3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_dz3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_watsat3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_csol3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_tkmg3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_tkdry3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_tksatu3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_h2osno2d(:) => null() ! + real (kind=kind_phys), pointer :: lake_dp2dsno(:) => null() ! + real (kind=kind_phys), pointer :: lake_snl2d(:) => null() ! + real (kind=kind_phys), pointer :: lake_snow_z3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_snow_dz3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_snow_zi3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_t_h2osoi_vol3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_t_h2osoi_liq3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_t_h2osoi_ice3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_t_grnd2d(:) => null() ! + real (kind=kind_phys), pointer :: lake_t_soisno3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_t_lake3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_savedtke12d(:)=> null() ! + real (kind=kind_phys), pointer :: lake_icefrac3d(:,:)=> null() + real (kind=kind_phys), pointer :: lake_rho0(:)=> null() + real (kind=kind_phys), pointer :: lake_ht(:)=> null() + real (kind=kind_phys), pointer :: lake_clay3d(:,:) => null() + real (kind=kind_phys), pointer :: lake_sand3d(:,:) => null() + integer, pointer :: lake_is_salty(:) => null() + real (kind=kind_phys), pointer :: clm_lake_initialized(:) => null() !< lakeini was called + contains procedure :: create => sfcprop_create !< allocate array data end type GFS_sfcprop_type @@ -1603,36 +1633,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: phy_myj_a1t(:) => null() ! real (kind=kind_phys), pointer :: phy_myj_a1q(:) => null() ! - ! CLM Lake model internal variables: - real (kind=kind_phys), pointer :: lake_albedo(:) => null() ! - real (kind=kind_phys), pointer :: lake_z3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_dz3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_watsat3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_csol3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_tkmg3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_tkdry3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_tksatu3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_h2osno2d(:) => null() ! - real (kind=kind_phys), pointer :: lake_dp2dsno(:) => null() ! - real (kind=kind_phys), pointer :: lake_snl2d(:) => null() ! - real (kind=kind_phys), pointer :: lake_snow_z3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_snow_dz3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_snow_zi3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_t_h2osoi_vol3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_t_h2osoi_liq3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_t_h2osoi_ice3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_t_grnd2d(:) => null() ! - real (kind=kind_phys), pointer :: lake_t_soisno3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_t_lake3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_savedtke12d(:)=> null() ! - real (kind=kind_phys), pointer :: lake_icefrac3d(:,:)=> null() - real (kind=kind_phys), pointer :: lake_rho0(:)=> null() - real (kind=kind_phys), pointer :: lake_ht(:)=> null() - real (kind=kind_phys), pointer :: lake_clay3d(:,:) => null() - real (kind=kind_phys), pointer :: lake_sand3d(:,:) => null() - integer, pointer :: lake_is_salty(:) => null() - real (kind=kind_phys), pointer :: clm_lake_initialized(:) => null() !< lakeini was called - !--- DFI Radar real (kind=kind_phys), pointer :: dfi_radar_tten(:,:,:) => null() ! real (kind=kind_phys), pointer :: cap_suppress(:,:) => null() ! @@ -2125,16 +2125,21 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%lakedepth(IM)) allocate (Sfcprop%use_lake_model(IM)) - allocate (Sfcprop%h_ML (IM)) - allocate (Sfcprop%t_ML (IM)) - allocate (Sfcprop%t_mnw (IM)) - allocate (Sfcprop%h_talb (IM)) - allocate (Sfcprop%t_talb (IM)) - allocate (Sfcprop%t_bot1 (IM)) - allocate (Sfcprop%t_bot2 (IM)) - allocate (Sfcprop%c_t (IM)) - allocate (Sfcprop%T_snow (IM)) - allocate (Sfcprop%T_ice (IM)) + + if(Model%lkm > 0) then + if(Model%iopt_lake==Model%iopt_lake_flake ) then + allocate (Sfcprop%h_ML (IM)) + allocate (Sfcprop%t_ML (IM)) + allocate (Sfcprop%t_mnw (IM)) + allocate (Sfcprop%h_talb (IM)) + allocate (Sfcprop%t_talb (IM)) + allocate (Sfcprop%t_bot1 (IM)) + allocate (Sfcprop%t_bot2 (IM)) + allocate (Sfcprop%c_t (IM)) + endif + allocate (Sfcprop%T_snow (IM)) + allocate (Sfcprop%T_ice (IM)) + endif allocate (Sfcprop%tsfc (IM)) allocate (Sfcprop%tsfco (IM)) @@ -2171,16 +2176,20 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%lakedepth = clear_val Sfcprop%use_lake_model = zero - Sfcprop%h_ML = clear_val - Sfcprop%t_ML = clear_val - Sfcprop%t_mnw = clear_val - Sfcprop%h_talb = clear_val - Sfcprop%t_talb = clear_val - Sfcprop%t_bot1 = clear_val - Sfcprop%t_bot2 = clear_val - Sfcprop%c_t = clear_val - Sfcprop%T_snow = clear_val - Sfcprop%T_ice = clear_val + if(Model%lkm > 0) then + if(Model%iopt_lake==Model%iopt_lake_flake ) then + Sfcprop%h_ML = clear_val + Sfcprop%t_ML = clear_val + Sfcprop%t_mnw = clear_val + Sfcprop%h_talb = clear_val + Sfcprop%t_talb = clear_val + Sfcprop%t_bot1 = clear_val + Sfcprop%t_bot2 = clear_val + Sfcprop%c_t = clear_val + endif + Sfcprop%T_snow = clear_val + Sfcprop%T_ice = clear_val + endif Sfcprop%tsfc = clear_val Sfcprop%tsfco = clear_val @@ -2550,13 +2559,71 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%conv_act = zero Sfcprop%conv_act_m = zero end if + + ! CLM Lake Model variables if (Model%lkm/=0 .and. Model%iopt_lake==Model%iopt_lake_clm) then - allocate(Sfcprop%lake_t2m(IM)) - allocate(Sfcprop%lake_q2m(IM)) - Sfcprop%lake_t2m = clear_val - Sfcprop%lake_q2m = clear_val + allocate(Sfcprop%lake_t2m(IM)) + allocate(Sfcprop%lake_q2m(IM)) + allocate(Sfcprop%lake_albedo(IM)) + allocate(Sfcprop%lake_z3d(IM,Model%nlevlake_clm_lake)) + allocate(Sfcprop%lake_dz3d(IM,Model%nlevlake_clm_lake)) + allocate(Sfcprop%lake_watsat3d(IM,Model%nlevlake_clm_lake)) + allocate(Sfcprop%lake_csol3d(IM,Model%nlevlake_clm_lake)) + allocate(Sfcprop%lake_tkmg3d(IM,Model%nlevlake_clm_lake)) + allocate(Sfcprop%lake_tkdry3d(IM,Model%nlevlake_clm_lake)) + allocate(Sfcprop%lake_tksatu3d(IM,Model%nlevlake_clm_lake)) + allocate(Sfcprop%lake_h2osno2d(IM)) + allocate(Sfcprop%lake_dp2dsno(IM)) + allocate(Sfcprop%lake_snl2d(IM)) + allocate(Sfcprop%lake_snow_z3d(IM,Model%nlevsnowsoil1_clm_lake)) + allocate(Sfcprop%lake_snow_dz3d(IM,Model%nlevsnowsoil1_clm_lake)) + allocate(Sfcprop%lake_snow_zi3d(IM,Model%nlevsnowsoil_clm_lake)) + allocate(Sfcprop%lake_t_h2osoi_vol3d(IM,Model%nlevsnowsoil1_clm_lake)) + allocate(Sfcprop%lake_t_h2osoi_liq3d(IM,Model%nlevsnowsoil1_clm_lake)) + allocate(Sfcprop%lake_t_h2osoi_ice3d(IM,Model%nlevsnowsoil1_clm_lake)) + allocate(Sfcprop%lake_t_grnd2d(IM)) + allocate(Sfcprop%lake_t_soisno3d(IM,Model%nlevsnowsoil1_clm_lake)) + allocate(Sfcprop%lake_t_lake3d(IM,Model%nlevlake_clm_lake)) + allocate(Sfcprop%lake_savedtke12d(IM)) + allocate(Sfcprop%lake_icefrac3d(IM,Model%nlevlake_clm_lake)) + allocate(Sfcprop%lake_rho0(IM)) + allocate(Sfcprop%lake_ht(IM)) + allocate(Sfcprop%lake_clay3d(IM,Model%nlevsoil_clm_lake)) + allocate(Sfcprop%lake_sand3d(IM,Model%nlevsoil_clm_lake)) + allocate(Sfcprop%lake_is_salty(IM)) + allocate(Sfcprop%clm_lake_initialized(IM)) + + Sfcprop%lake_t2m = clear_val + Sfcprop%lake_q2m = clear_val + Sfcprop%lake_albedo = clear_val + Sfcprop%lake_z3d = clear_val + Sfcprop%lake_dz3d = clear_val + Sfcprop%lake_watsat3d = clear_val + Sfcprop%lake_csol3d = clear_val + Sfcprop%lake_tkmg3d = clear_val + Sfcprop%lake_tkdry3d = clear_val + Sfcprop%lake_tksatu3d = clear_val + Sfcprop%lake_h2osno2d = clear_val + Sfcprop%lake_dp2dsno = clear_val + Sfcprop%lake_snl2d = clear_val + Sfcprop%lake_snow_z3d = clear_val + Sfcprop%lake_snow_dz3d = clear_val + Sfcprop%lake_snow_zi3d = clear_val + Sfcprop%lake_t_h2osoi_vol3d = clear_val + Sfcprop%lake_t_h2osoi_liq3d = clear_val + Sfcprop%lake_t_h2osoi_ice3d = clear_val + Sfcprop%lake_t_grnd2d = clear_val + Sfcprop%lake_t_soisno3d = clear_val + Sfcprop%lake_t_lake3d = clear_val + Sfcprop%lake_savedtke12d = clear_val + Sfcprop%lake_icefrac3d = clear_val + Sfcprop%lake_rho0 = -111 + Sfcprop%lake_ht = -111 + Sfcprop%lake_clay3d = clear_val + Sfcprop%lake_sand3d = clear_val + Sfcprop%lake_is_salty = zero + Sfcprop%clm_lake_initialized = zero endif - end subroutine sfcprop_create @@ -6550,67 +6617,6 @@ subroutine tbd_create (Tbd, IM, Model) Tbd%phy_myj_a1q = clear_val end if - ! CLM Lake Model variables - if(Model%iopt_lake==Model%iopt_lake_clm) then - allocate(Tbd%lake_albedo(IM)) - allocate(Tbd%lake_z3d(IM,Model%nlevlake_clm_lake)) - allocate(Tbd%lake_dz3d(IM,Model%nlevlake_clm_lake)) - allocate(Tbd%lake_watsat3d(IM,Model%nlevlake_clm_lake)) - allocate(Tbd%lake_csol3d(IM,Model%nlevlake_clm_lake)) - allocate(Tbd%lake_tkmg3d(IM,Model%nlevlake_clm_lake)) - allocate(Tbd%lake_tkdry3d(IM,Model%nlevlake_clm_lake)) - allocate(Tbd%lake_tksatu3d(IM,Model%nlevlake_clm_lake)) - allocate(Tbd%lake_h2osno2d(IM)) - allocate(Tbd%lake_dp2dsno(IM)) - allocate(Tbd%lake_snl2d(IM)) - allocate(Tbd%lake_snow_z3d(IM,Model%nlevsnowsoil1_clm_lake)) - allocate(Tbd%lake_snow_dz3d(IM,Model%nlevsnowsoil1_clm_lake)) - allocate(Tbd%lake_snow_zi3d(IM,Model%nlevsnowsoil_clm_lake)) - allocate(Tbd%lake_t_h2osoi_vol3d(IM,Model%nlevsnowsoil1_clm_lake)) - allocate(Tbd%lake_t_h2osoi_liq3d(IM,Model%nlevsnowsoil1_clm_lake)) - allocate(Tbd%lake_t_h2osoi_ice3d(IM,Model%nlevsnowsoil1_clm_lake)) - allocate(Tbd%lake_t_grnd2d(IM)) - allocate(Tbd%lake_t_soisno3d(IM,Model%nlevsnowsoil1_clm_lake)) - allocate(Tbd%lake_t_lake3d(IM,Model%nlevlake_clm_lake)) - allocate(Tbd%lake_savedtke12d(IM)) - allocate(Tbd%lake_icefrac3d(IM,Model%nlevlake_clm_lake)) - allocate(Tbd%lake_rho0(IM)) - allocate(Tbd%lake_ht(IM)) - allocate(Tbd%lake_clay3d(IM,Model%nlevsoil_clm_lake)) - allocate(Tbd%lake_sand3d(IM,Model%nlevsoil_clm_lake)) - allocate(Tbd%lake_is_salty(IM)) - allocate(Tbd%clm_lake_initialized(IM)) - - Tbd%lake_albedo = clear_val - Tbd%lake_z3d = clear_val - Tbd%lake_dz3d = clear_val - Tbd%lake_watsat3d = clear_val - Tbd%lake_csol3d = clear_val - Tbd%lake_tkmg3d = clear_val - Tbd%lake_tkdry3d = clear_val - Tbd%lake_tksatu3d = clear_val - Tbd%lake_h2osno2d = clear_val - Tbd%lake_dp2dsno = clear_val - Tbd%lake_snl2d = clear_val - Tbd%lake_snow_z3d = clear_val - Tbd%lake_snow_dz3d = clear_val - Tbd%lake_snow_zi3d = clear_val - Tbd%lake_t_h2osoi_vol3d = clear_val - Tbd%lake_t_h2osoi_liq3d = clear_val - Tbd%lake_t_h2osoi_ice3d = clear_val - Tbd%lake_t_grnd2d = clear_val - Tbd%lake_t_soisno3d = clear_val - Tbd%lake_t_lake3d = clear_val - Tbd%lake_savedtke12d = clear_val - Tbd%lake_icefrac3d = clear_val - Tbd%lake_rho0 = -111 - Tbd%lake_ht = -111 - Tbd%lake_clay3d = clear_val - Tbd%lake_sand3d = clear_val - Tbd%lake_is_salty = zero - Tbd%clm_lake_initialized = zero - endif - end subroutine tbd_create diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 1951d7607..d1bc5f333 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -632,7 +632,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_lake_model_selection > 0) + active = (control_for_lake_model_selection == 2) [lake_q2m] standard_name = specific_humidity_at_2m_from_clm_lake long_name = specific humidity at 2m from clm lake @@ -640,7 +640,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_lake_model_selection > 0) + active = (control_for_lake_model_selection == 2) [h_ML] standard_name = mixed_layer_depth_of_lakes long_name = depth of lake mixing layer @@ -648,6 +648,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (control_for_lake_model_selection == 1) [t_ML] standard_name = lake_mixed_layer_temperature long_name = temperature of lake mixing layer @@ -655,6 +656,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (control_for_lake_model_selection == 1) [t_mnw] standard_name = mean_temperature_of_the_water_column long_name = thee mean temperature of the water column @@ -662,6 +664,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (control_for_lake_model_selection == 1) [h_talb] standard_name = the_thermally_active_layer_depth_of_the_bottom_sediment long_name = the depth of the thermally active layer of the bottom sediment @@ -669,6 +672,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (control_for_lake_model_selection == 1) [t_talb] standard_name = temperature_at_the_bottom_of_the_sediment_upper_layer long_name = the temperature at the bottom of the sediment upper layer @@ -676,6 +680,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (control_for_lake_model_selection == 1) [t_bot1] standard_name = lake_bottom_temperature long_name = the temperature at the water-bottom sediment interface @@ -683,6 +688,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (control_for_lake_model_selection == 1) [t_bot2] standard_name = temperature_for_bottom_layer_of_water long_name = the temperature at the lake bottom layer water @@ -690,6 +696,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (control_for_lake_model_selection == 1) [c_t] standard_name = shape_factor_of_water_temperature_vertical_profile long_name = the shape factor of water temperature vertical profile @@ -697,6 +704,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (control_for_lake_model_selection == 1) [T_snow] standard_name = temperature_of_snow_on_lake long_name = temperature of snow on a lake @@ -1953,6 +1961,219 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[lake_albedo] + standard_name = mid_day_surface_albedo_over_lake + long_name = mid day surface albedo over lake + units = fraction + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_z3d] + standard_name = depth_of_lake_interface_layers + long_name = depth of lake interface layers + units = fraction + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_dz3d] + standard_name = thickness_of_lake_layers + long_name = thickness of lake layers + units = fraction + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_watsat3d] + standard_name = saturated_volumetric_soil_water_in_lake_model + long_name = saturated volumetric soil water in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_csol3d] + standard_name = soil_heat_capacity_in_lake_model + long_name = soil heat capacity in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_tkmg3d] + standard_name = soil_mineral_thermal_conductivity_in_lake_model + long_name = soil mineral thermal conductivity in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_tkdry3d] + standard_name = dry_soil_thermal_conductivity_in_lake_model + long_name = dry soil thermal conductivity in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_tksatu3d] + standard_name = saturated_soil_thermal_conductivity_in_lake_model + long_name = saturated soil thermal conductivity in lake model + units = m + dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_h2osno2d] + standard_name = water_equivalent_accumulated_snow_depth_in_clm_lake_model + long_name = water equiv of acc snow depth over lake in clm lake model + units = mm + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_dp2dsno] + standard_name = actual_snow_depth_in_clm_lake_model + long_name = actual acc snow depth over lake in clm lake model + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_snl2d] + standard_name = snow_layers_in_clm_lake_model + long_name = snow layers in clm lake model (treated as integer) + units = count + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_snow_z3d] + standard_name = snow_level_depth_in_clm_lake_model + long_name = snow level depth in clm lake model + units = m + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_snow_dz3d] + standard_name = snow_level_thickness_in_clm_lake_model + long_name = snow level thickness in clm lake model + units = m + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_snow_zi3d] + standard_name = snow_interface_depth_in_clm_lake_model + long_name = snow interface_depth in clm lake model + units = m + dimensions = (horizontal_loop_extent,snow_plus_soil_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_t_h2osoi_vol3d] + standard_name = volumetric_soil_water_in_clm_lake_model + long_name = volumetric soil water in clm lake model + units = m3 m-3 + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_t_h2osoi_liq3d] + standard_name = soil_liquid_water_content_in_clm_lake_model + long_name = soil liquid water content in clm lake model + units = kg m-3 + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_t_h2osoi_ice3d] + standard_name = soil_ice_water_content_in_clm_lake_model + long_name = soil ice water content in clm lake model + units = kg m-3 + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_t_grnd2d] + standard_name = skin_temperature_from_clm_lake_model + long_name = skin temperature from clm lake model + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_t_soisno3d] + standard_name = soil_or_snow_layer_temperature_from_clm_lake_model + long_name = soil or snow layer temperature from clm lake model + units = K + dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_t_lake3d] + standard_name = lake_layer_temperature_from_clm_lake_model + long_name = lake layer temperature from clm lake model + units = K + dimensions = (horizontal_loop_extent,lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_savedtke12d] + standard_name = top_level_eddy_conductivity_from_previous_timestep_in_clm_lake_model + long_name = top level eddy conductivity from previous timestep in clm lake model + units = kg m-3 + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_icefrac3d] + standard_name = lake_fractional_ice_cover_on_clm_lake_levels + long_name = lake fractional ice cover on clm lake levels + units = kg m-3 + dimensions = (horizontal_loop_extent,lake_vertical_dimension_for_clm_lake_model) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_ht] + standard_name = test_lake_ht + long_name = test_lake_ht + dimensions = (horizontal_loop_extent) + units = unitless + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[clm_lake_initialized] + standard_name = flag_for_clm_lake_initialization + long_name = set to true in clm_lake_run after likeini is called for that gridpoint + units = flag + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 2) +[lake_clay3d] + standard_name = clm_lake_percent_clay + long_name = percent clay in clm lake model + units = percent + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) + type = integer + active = (control_for_lake_model_selection == 2) +[lake_sand3d] + standard_name = clm_lake_percent_sand + long_name = percent sand in clm lake model + units = percent + dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) + type = integer + active = (control_for_lake_model_selection == 2) +[lake_is_salty] + standard_name = clm_lake_is_salty + long_name = lake at this point is salty (1) or not (0) + units = 1 + dimensions = (horizontal_loop_extent) + type = integer + active = (control_for_lake_model_selection == 2) ######################################################################## [ccpp-table-properties] @@ -6524,21 +6745,18 @@ dimensions = () type = real kind = kind_phys - active = (control_for_lake_model_selection == 3) [clm_lake_use_lakedepth] standard_name = flag_for_initializing_clm_lake_depth_from_lake_depth long_name = flag for initializing clm lake depth from lake depth units = flag dimensions = () type = logical - active = (control_for_lake_model_selection == 3) [clm_lake_debug] standard_name = flag_for_verbose_debugging_in_clm_lake_model long_name = flag for verbose debugging in clm lake model units = flag dimensions = () type = logical - active = (control_for_lake_model_selection == 3) ######################################################################## [ccpp-table-properties] @@ -7294,216 +7512,6 @@ type = real kind = kind_phys active = (flag_for_mellor_yamada_janjic_surface_layer_scheme .or. flag_for_mellor_yamada_janjic_pbl_scheme) -[lake_albedo] - standard_name = mid_day_surface_albedo_over_lake - long_name = mid day surface albedo over lake - units = fraction - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_z3d] - standard_name = depth_of_lake_interface_layers - long_name = depth of lake interface layers - units = fraction - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_dz3d] - standard_name = thickness_of_lake_layers - long_name = thickness of lake layers - units = fraction - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_watsat3d] - standard_name = saturated_volumetric_soil_water_in_lake_model - long_name = saturated volumetric soil water in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_csol3d] - standard_name = soil_heat_capacity_in_lake_model - long_name = soil heat capacity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_tkmg3d] - standard_name = soil_mineral_thermal_conductivity_in_lake_model - long_name = soil mineral thermal conductivity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_tkdry3d] - standard_name = dry_soil_thermal_conductivity_in_lake_model - long_name = dry soil thermal conductivity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_tksatu3d] - standard_name = saturated_soil_thermal_conductivity_in_lake_model - long_name = saturated soil thermal conductivity in lake model - units = m - dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_h2osno2d] - standard_name = water_equivalent_accumulated_snow_depth_in_clm_lake_model - long_name = water equiv of acc snow depth over lake in clm lake model - units = mm - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_dp2dsno] - standard_name = actual_snow_depth_in_clm_lake_model - long_name = actual acc snow depth over lake in clm lake model - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_snl2d] - standard_name = snow_layers_in_clm_lake_model - long_name = snow layers in clm lake model (treated as integer) - units = count - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_snow_z3d] - standard_name = snow_level_depth_in_clm_lake_model - long_name = snow level depth in clm lake model - units = m - dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_snow_dz3d] - standard_name = snow_level_thickness_in_clm_lake_model - long_name = snow level thickness in clm lake model - units = m - dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_snow_zi3d] - standard_name = snow_interface_depth_in_clm_lake_model - long_name = snow interface_depth in clm lake model - units = m - dimensions = (horizontal_loop_extent,snow_plus_soil_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_t_h2osoi_vol3d] - standard_name = volumetric_soil_water_in_clm_lake_model - long_name = volumetric soil water in clm lake model - units = m3 m-3 - dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_t_h2osoi_liq3d] - standard_name = soil_liquid_water_content_in_clm_lake_model - long_name = soil liquid water content in clm lake model - units = kg m-3 - dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_t_h2osoi_ice3d] - standard_name = soil_ice_water_content_in_clm_lake_model - long_name = soil ice water content in clm lake model - units = kg m-3 - dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_t_grnd2d] - standard_name = skin_temperature_from_clm_lake_model - long_name = skin temperature from clm lake model - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_t_soisno3d] - standard_name = soil_or_snow_layer_temperature_from_clm_lake_model - long_name = soil or snow layer temperature from clm lake model - units = K - dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_t_lake3d] - standard_name = lake_layer_temperature_from_clm_lake_model - long_name = lake layer temperature from clm lake model - units = K - dimensions = (horizontal_loop_extent,lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_savedtke12d] - standard_name = top_level_eddy_conductivity_from_previous_timestep_in_clm_lake_model - long_name = top level eddy conductivity from previous timestep in clm lake model - units = kg m-3 - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_icefrac3d] - standard_name = lake_fractional_ice_cover_on_clm_lake_levels - long_name = lake fractional ice cover on clm lake levels - units = kg m-3 - dimensions = (horizontal_loop_extent,lake_vertical_dimension_for_clm_lake_model) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_ht] - standard_name = test_lake_ht - long_name = test_lake_ht - dimensions = (horizontal_loop_extent) - units = unitless - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[clm_lake_initialized] - standard_name = flag_for_clm_lake_initialization - long_name = set to true in clm_lake_run after likeini is called for that gridpoint - units = flag - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 3) -[lake_clay3d] - standard_name = clm_lake_percent_clay - long_name = percent clay in clm lake model - units = percent - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) - type = integer -[lake_sand3d] - standard_name = clm_lake_percent_sand - long_name = percent sand in clm lake model - units = percent - dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) - type = integer -[lake_is_salty] - standard_name = clm_lake_is_salty - long_name = lake at this point is salty (1) or not (0) - units = 1 - dimensions = (horizontal_loop_extent) - type = integer [dfi_radar_tten] standard_name = radar_derived_microphysics_temperature_tendency long_name = radar-derived microphysics temperature tendency diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index db7165fdb..c91f657e7 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -2522,7 +2522,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop if(Model%iopt_lake==Model%iopt_lake_clm) then ! Populate the 3D arrays separately since the code is complicated: - call clm_lake_externaldiag_populate(ExtDiag, Model, Tbd, idx, cn_one, nblks) + call clm_lake_externaldiag_populate(ExtDiag, Model, Sfcprop, idx, cn_one, nblks) idx = idx + 1 ExtDiag(idx)%axes = 2 @@ -2532,7 +2532,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%mod_name = 'gfs_sfc' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%int2 => Tbd(nb)%lake_is_salty(:) + ExtDiag(idx)%data(nb)%int2 => Sfcprop(nb)%lake_is_salty(:) enddo idx = idx + 1 @@ -2568,7 +2568,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%intpl_method = 'nearest_stod' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Tbd(nb)%lake_albedo(:) + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lake_albedo(:) enddo idx = idx + 1 @@ -2580,7 +2580,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%intpl_method = 'nearest_stod' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Tbd(nb)%lake_h2osno2d(:) + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lake_h2osno2d(:) enddo idx = idx + 1 @@ -2592,7 +2592,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%intpl_method = 'nearest_stod' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Tbd(nb)%lake_dp2dsno(:) + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lake_dp2dsno(:) enddo idx = idx + 1 @@ -2604,7 +2604,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%intpl_method = 'nearest_stod' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Tbd(nb)%lake_snl2d(:) + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lake_snl2d(:) enddo idx = idx + 1 @@ -2616,7 +2616,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%intpl_method = 'nearest_stod' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Tbd(nb)%lake_t_grnd2d(:) + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lake_t_grnd2d(:) enddo idx = idx + 1 @@ -2628,7 +2628,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%intpl_method = 'nearest_stod' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Tbd(nb)%lake_savedtke12d(:) + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lake_savedtke12d(:) enddo idx = idx + 1 @@ -2640,7 +2640,7 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%intpl_method = 'nearest_stod' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Tbd(nb)%lake_ht(:) + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lake_ht(:) enddo endif @@ -4270,11 +4270,11 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop end subroutine GFS_externaldiag_populate - subroutine clm_lake_externaldiag_populate(ExtDiag, Model, Tbd, idx, cn_one, nblks) + subroutine clm_lake_externaldiag_populate(ExtDiag, Model, Sfcprop, idx, cn_one, nblks) implicit none type(GFS_externaldiag_type), intent(inout) :: ExtDiag(:) type(GFS_control_type), intent(in) :: Model - type(GFS_tbd_type), intent(in) :: Tbd(:) + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) integer, intent(inout) :: idx integer, intent(in) :: nblks real(kind=kind_phys), intent(in) :: cn_one @@ -4283,75 +4283,75 @@ subroutine clm_lake_externaldiag_populate(ExtDiag, Model, Tbd, idx, cn_one, nblk integer :: nk, idx0, iblk do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_z3d, 'lake_z3d', 'lake_depth_on_interface_levels', 'm') + call link_all_levels(Sfcprop(iblk)%lake_z3d, 'lake_z3d', 'lake_depth_on_interface_levels', 'm') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_clay3d, 'lake_clay3d', 'percent clay on soil levels in clm lake model', '%') + call link_all_levels(Sfcprop(iblk)%lake_clay3d, 'lake_clay3d', 'percent clay on soil levels in clm lake model', '%') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_sand3d, 'lake_sand3d', 'percent sand on soil levels in clm lake model', '%') + call link_all_levels(Sfcprop(iblk)%lake_sand3d, 'lake_sand3d', 'percent sand on soil levels in clm lake model', '%') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_dz3d, 'lake_dz3d', 'lake level thickness', 'm') + call link_all_levels(Sfcprop(iblk)%lake_dz3d, 'lake_dz3d', 'lake level thickness', 'm') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_watsat3d, 'lake_watsat3d', 'saturated volumetric soil water', 'm3 m-3') + call link_all_levels(Sfcprop(iblk)%lake_watsat3d, 'lake_watsat3d', 'saturated volumetric soil water', 'm3 m-3') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_csol3d, 'lake_csol3d', 'soil heat capacity', 'J m-3 K-1') + call link_all_levels(Sfcprop(iblk)%lake_csol3d, 'lake_csol3d', 'soil heat capacity', 'J m-3 K-1') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_tkmg3d, 'lake_tkmg3d', 'soil thermal conductivity, minerals', 'W m-1 K-1') + call link_all_levels(Sfcprop(iblk)%lake_tkmg3d, 'lake_tkmg3d', 'soil thermal conductivity, minerals', 'W m-1 K-1') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_tkdry3d, 'lake_tkdry3d', 'soil thermal conductivity, dry soil', 'W m-1 K-1') + call link_all_levels(Sfcprop(iblk)%lake_tkdry3d, 'lake_tkdry3d', 'soil thermal conductivity, dry soil', 'W m-1 K-1') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_tksatu3d, 'lake_tksatu3d', 'soil thermal conductivity, saturated soil', 'W m-1 K-1') + call link_all_levels(Sfcprop(iblk)%lake_tksatu3d, 'lake_tksatu3d', 'soil thermal conductivity, saturated soil', 'W m-1 K-1') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_snow_z3d, 'lake_snow_z3d', 'lake snow level depth', 'm') + call link_all_levels(Sfcprop(iblk)%lake_snow_z3d, 'lake_snow_z3d', 'lake snow level depth', 'm') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_snow_dz3d, 'lake_snow_dz3d', 'lake snow level thickness', 'm') + call link_all_levels(Sfcprop(iblk)%lake_snow_dz3d, 'lake_snow_dz3d', 'lake snow level thickness', 'm') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_snow_zi3d, 'lake_snow_zi3d', 'lake snow interface depth', 'm') + call link_all_levels(Sfcprop(iblk)%lake_snow_zi3d, 'lake_snow_zi3d', 'lake snow interface depth', 'm') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_t_h2osoi_vol3d, 'lake_t_h2osoi_vol3d', 'volumetric soil water', 'm3 m-3') + call link_all_levels(Sfcprop(iblk)%lake_t_h2osoi_vol3d, 'lake_t_h2osoi_vol3d', 'volumetric soil water', 'm3 m-3') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_t_h2osoi_liq3d, 'lake_t_h2osoi_liq3d', 'soil liquid water content', 'kg m-2') + call link_all_levels(Sfcprop(iblk)%lake_t_h2osoi_liq3d, 'lake_t_h2osoi_liq3d', 'soil liquid water content', 'kg m-2') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_t_h2osoi_ice3d, 'lake_t_h2osoi_ice3d', 'soil ice water content', 'kg m-2') + call link_all_levels(Sfcprop(iblk)%lake_t_h2osoi_ice3d, 'lake_t_h2osoi_ice3d', 'soil ice water content', 'kg m-2') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_t_soisno3d, 'lake_t_soisno3d', 'snow or soil level temperature', 'K') + call link_all_levels(Sfcprop(iblk)%lake_t_soisno3d, 'lake_t_soisno3d', 'snow or soil level temperature', 'K') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_t_lake3d, 'lake_t_lake3d', 'lake layer temperature', 'K') + call link_all_levels(Sfcprop(iblk)%lake_t_lake3d, 'lake_t_lake3d', 'lake layer temperature', 'K') enddo do iblk=1,nblks - call link_all_levels(Tbd(iblk)%lake_icefrac3d, 'lake_icefrac3d', 'lake fractional ice cover', 'fraction') + call link_all_levels(Sfcprop(iblk)%lake_icefrac3d, 'lake_icefrac3d', 'lake fractional ice cover', 'fraction') enddo contains diff --git a/ccpp/driver/GFS_restart.F90 b/ccpp/driver/GFS_restart.F90 index 209319026..e06a13dd1 100644 --- a/ccpp/driver/GFS_restart.F90 +++ b/ccpp/driver/GFS_restart.F90 @@ -97,11 +97,6 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & Restart%ldiag = 3 + Model%ntot2d + Model%nctp + ndiag_rst Restart%num2d = 3 + Model%ntot2d + Model%nctp + ndiag_rst - ! CLM Lake - if(Model%iopt_lake == Model%iopt_lake_clm) then - call clm_lake_define_restart(Restart%num2d,.true.) - endif - ! GF if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then Restart%num2d = Restart%num2d + 3 @@ -424,11 +419,6 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & enddo endif - ! CLM Lake - if(Model%iopt_lake == Model%iopt_lake_clm) then - call clm_lake_define_restart(num,.false.) - endif - !--- phy_f3d variables do num = 1,Model%ntot3d !--- set the variable name @@ -563,105 +553,6 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & contains - subroutine clm_lake_define_restart(ix,count) - implicit none - logical, intent(in) :: count ! true = increment num; false = link vars - integer, intent(inout) :: ix ! Restart%num2d when count=true, or num when count=false - integer :: lb ! last block to process (1 if count, else nblks) - integer :: ih ! value of ix before processing current variable - integer :: nb ! block being processed - logical :: c ! alias for count, to shorten macro - c=count - - if(count) then - ! We're just counting variables, so there's no need to process multiple blocks - lb=1 - else - ! We're linking data, so we must process all blocks - lb=nblks - endif - - ! Macro to call lvar3d. This simplifies the code tremendously. - ! container = Sfcprop or Tbd - ! varname = lake_z3d, lake_t_lake3d, etc. - ! varstr = varname in quotes (gfortran does not like #varname magic) - ! Total size of the expanded macro must be less than 132 chars - ! due to limitations of the C and Fortran standards -#define run_lvar3d(container,varname,varstr) \ -ih=ix;\ -do nb=1,lb;\ -ix=ih;\ -call lvar3d(c,nb,ix,container(nb)%varname,varstr);\ -enddo - - ! Macro to call lvar2d. This simplifies the code tremendously. - ! container = Sfcprop or Tbd - ! varname = lake_snl2d, clm_lake_initialized, etc. - ! varstr = varname in quotes (gfortran does not like #varname magic) - ! Total size of the expanded macro must be less than 132 chars - ! due to limitations of the C and Fortran standards -#define run_lvar2d(container,varname,varstr) \ -ih=ix;\ -do nb=1,lb;\ -ix=ih;\ -call lvar2d(c,nb,ix,container(nb)%varname,varstr);\ -enddo - - ! 2D vars - run_lvar2d(Tbd,lake_snl2d,"lake_snl2d") - - run_lvar2d(Tbd,lake_h2osno2d,"lake_h2osno2d") - - run_lvar2d(Tbd,lake_t_grnd2d,"lake_t_grnd2d") - - run_lvar2d(Tbd,lake_savedtke12d,"lake_savedtke12d") - - run_lvar2d(Tbd,lake_dp2dsno,"lake_dp2dsno") - - run_lvar2d(Tbd,clm_lake_initialized,"clm_lake_initialized") - - ! 3D vars - run_lvar3d(Tbd,lake_z3d,"lake_z3d") - - run_lvar3d(Tbd,lake_dz3d,"lake_dz3d") - - run_lvar3d(Tbd,lake_watsat3d,"lake_watsat3d") - - run_lvar3d(Tbd,lake_csol3d,"lake_csol3d") - - run_lvar3d(Tbd,lake_tkmg3d,"lake_tkmg3d") - - run_lvar3d(Tbd,lake_tkdry3d,"lake_tkdry3d") - - run_lvar3d(Tbd,lake_tksatu3d,"lake_tksatu3d") - - run_lvar3d(Tbd,lake_snow_z3d,"lake_snow_z3d") - - run_lvar3d(Tbd,lake_snow_dz3d,"lake_snow_dz3d") - - run_lvar3d(Tbd,lake_snow_zi3d,"lake_snow_zi3d") - - run_lvar3d(Tbd,lake_t_h2osoi_vol3d,"lake_t_h2osoi_vol3d") - - run_lvar3d(Tbd,lake_t_h2osoi_liq3d,"lake_t_h2osoi_liq3d") - - run_lvar3d(Tbd,lake_t_h2osoi_ice3d,"lake_t_h2osoi_ice3d") - - run_lvar3d(Tbd,lake_t_soisno3d,"lake_t_soisno3d") - - run_lvar3d(Tbd,lake_t_lake3d,"lake_t_lake3d") - - run_lvar3d(Tbd,lake_icefrac3d,"lake_icefrac3d") - - run_lvar3d(Tbd,lake_clay3d,"lake_clay3d") - - run_lvar3d(Tbd,lake_sand3d,"lake_sand3d") - -#undef run_lvar3d -#undef run_lvar2d - - end subroutine clm_lake_define_restart - subroutine lvar3d(count, nb, ix, var3d, varname) implicit none logical, intent(in) :: count diff --git a/ccpp/physics b/ccpp/physics index 947037546..405621763 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 9470375468f8495c38474dcd96be1d29ed67878a +Subproject commit 405621763e00169e7edd7253491b5ea21aea9f29 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index fee5835c4..fd43b3536 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -111,6 +111,65 @@ module FV3GFS_io_mod logical :: use_wrtgridcomp_output = .FALSE. logical :: module_is_initialized = .FALSE. + type clm_lake_data_type + ! The clm_lake_data_type derived type is a class that stores + ! temporary arrays used to read or write CLM Lake model restart + ! and axis variables. It can safely be declared and unused, but + ! you should only call these routines if the CLM Lake Model was + ! (or will be) used by this execution of the FV3. It is the + ! responsibility of the caller to ensure the necessary data is in + ! Sfc_restart, Sfcprop, and Model. + + ! All 2D variables needed for a restart + real(kind_phys), pointer, private, dimension(:,:) :: & + lake_snl2d=>null(), lake_h2osno2d=>null(), lake_t_grnd2d=>null(), & + lake_savedtke12d=>null(), lake_dp2dsno=>null(), clm_lake_initialized=>null() + + ! All 3D variables needed for a restart + real(kind_phys), pointer, private, dimension(:,:,:) :: & + lake_z3d=>null(), lake_dz3d=>null(), lake_watsat3d=>null(), & + lake_csol3d=>null(), lake_tkmg3d=>null(), lake_tkdry3d=>null(), & + lake_tksatu3d=>null(), lake_snow_z3d=>null(), lake_snow_dz3d=>null(), & + lake_snow_zi3d=>null(), lake_t_h2osoi_vol3d=>null(), lake_t_h2osoi_liq3d=>null(), & + lake_t_h2osoi_ice3d=>null(), lake_t_soisno3d=>null(), lake_t_lake3d=>null(), & + lake_icefrac3d=>null(), lake_clay3d=>null(), lake_sand3d=>null() + + contains + + ! register_axes calls registers_axis on Sfc_restart for all required axes + procedure, public :: register_axes => clm_lake_register_axes + + ! allocate_data allocates all of the pointers in this object + procedure, public :: allocate_data => clm_lake_allocate_data + + ! fill_with_zero allocates fills the temporary arrays with 0 + procedure, public :: fill_with_zero => clm_lake_fill_with_zero + + ! register_fields calls register_field on Sfc_restart for all CLM Lake model restart variables + procedure, public :: register_fields => clm_lake_register_fields + + ! deallocate_data deallocates all pointers, allowing this object to be used repeatedly. + ! It is safe to call deallocate_data if no data has been allocated. + procedure, public :: deallocate_data => clm_lake_deallocate_data + + ! write_axes writes variables to Sfc_restart, with the name of + ! each axis, containing the appropriate information + procedure, public :: write_axes => clm_lake_write_axes + + ! copy_to_temporaries copies from Sfcprop to internal pointers (declared above) + procedure, public :: copy_to_temporaries => clm_lake_copy_to_temporaries + + ! copy_to_temporaries copies from internal pointers (declared above) to Sfcprop + procedure, public :: copy_from_temporaries => clm_lake_copy_from_temporaries + + ! A fortran 2003 compliant compiler will call clm_lake_final + ! automatically when an object of this type goes out of + ! scope. This will deallocate any arrays via a call to + ! deallocate_data. It is safe to call this routine if no data has + ! been allocated. + final :: clm_lake_final + end type clm_lake_data_type + CONTAINS !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -204,9 +263,12 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) nsfcprop2d = nsfcprop2d + 16 endif -! Flake - if(Model%lkm > 0 ) then - nsfcprop2d = nsfcprop2d + 10 +! CLM Lake and Flake + if(Model%lkm > 0) then + nsfcprop2d = nsfcprop2d + 2 + if(Model%iopt_lake==Model%iopt_lake_flake ) then + nsfcprop2d = nsfcprop2d + 8 + endif endif allocate (temp2d(isc:iec,jsc:jec,nsfcprop2d+Model%ntot2d+Model%nctp)) @@ -440,21 +502,22 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) idx_opt = idx_opt + 15 endif -! Flake - if (Model%lkm > 0 ) then - temp2d(i,j,idx_opt+ 1) = GFS_Data(nb)%Sfcprop%h_ML(ix) - temp2d(i,j,idx_opt+ 2) = GFS_Data(nb)%Sfcprop%t_ML(ix) - temp2d(i,j,idx_opt+ 3) = GFS_Data(nb)%Sfcprop%t_mnw(ix) - temp2d(i,j,idx_opt+ 4) = GFS_Data(nb)%Sfcprop%h_talb(ix) - temp2d(i,j,idx_opt+ 5) = GFS_Data(nb)%Sfcprop%t_talb(ix) - temp2d(i,j,idx_opt+ 6) = GFS_Data(nb)%Sfcprop%t_bot1(ix) - temp2d(i,j,idx_opt+ 7) = GFS_Data(nb)%Sfcprop%t_bot2(ix) - temp2d(i,j,idx_opt+ 8) = GFS_Data(nb)%Sfcprop%c_t(ix) - temp2d(i,j,idx_opt+ 9) = GFS_Data(nb)%Sfcprop%T_snow(ix) - temp2d(i,j,idx_opt+ 10) = GFS_Data(nb)%Sfcprop%T_ice(ix) +! CLM Lake / Flake + if (Model%lkm > 0) then + temp2d(i,j,idx_opt+ 1) = GFS_Data(nb)%Sfcprop%T_snow(ix) + temp2d(i,j,idx_opt+ 2) = GFS_Data(nb)%Sfcprop%T_ice(ix) + if(Model%iopt_lake==Model%iopt_lake_flake ) then + temp2d(i,j,idx_opt+ 3) = GFS_Data(nb)%Sfcprop%h_ML(ix) + temp2d(i,j,idx_opt+ 4) = GFS_Data(nb)%Sfcprop%t_ML(ix) + temp2d(i,j,idx_opt+ 5) = GFS_Data(nb)%Sfcprop%t_mnw(ix) + temp2d(i,j,idx_opt+ 6) = GFS_Data(nb)%Sfcprop%h_talb(ix) + temp2d(i,j,idx_opt+ 7) = GFS_Data(nb)%Sfcprop%t_talb(ix) + temp2d(i,j,idx_opt+ 8) = GFS_Data(nb)%Sfcprop%t_bot1(ix) + temp2d(i,j,idx_opt+ 9) = GFS_Data(nb)%Sfcprop%t_bot2(ix) + temp2d(i,j,idx_opt+ 10) = GFS_Data(nb)%Sfcprop%c_t(ix) + endif endif - - + do l = 1,Model%ntot2d temp2d(i,j,nsfcprop2d+l) = GFS_Data(nb)%Tbd%phy_f2d(ix,l) enddo @@ -563,6 +626,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta logical :: amiopen logical :: is_lsoil + type(clm_lake_data_type) :: clm_lake + nvar_o2 = 19 nvar_oro_ls_ss = 10 nvar_s2o = 18 @@ -638,7 +703,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta oro_name2(15) = 'orog_filt' ! oro oro_name2(16) = 'orog_raw' ! oro_uf oro_name2(17) = 'land_frac' ! land fraction [0:1] - !--- variables below here are optional + !--- variables below here are optional if lkm==0 oro_name2(18) = 'lake_frac' ! lake fraction [0:1] oro_name2(19) = 'lake_depth' ! lake depth(m) @@ -648,7 +713,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !--- register the 2D fields do num = 1,nvar_o2 var2_p => oro_var2(:,:,num) - if (trim(oro_name2(num)) == 'lake_frac' .or. trim(oro_name2(num)) == 'lake_depth') then + if ((trim(oro_name2(num)) == 'lake_frac' .or. trim(oro_name2(num)) == 'lake_depth') & + .and. Model%lkm==0) then call register_restart_field(Oro_restart, oro_name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.true.) else call register_restart_field(Oro_restart, oro_name2(num), var2_p, dimensions=(/'lat','lon'/)) @@ -699,12 +765,16 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%landfrac(ix) = oro_var2(i,j,17) !land frac [0:1] - if (Model%lkm > 0 ) then + if (Model%lkm > 0 ) then + if(oro_var2(i,j,18)>Model%lakefrac_threshold .and. & + oro_var2(i,j,19)>Model%lakedepth_threshold) then Sfcprop(nb)%lakefrac(ix) = oro_var2(i,j,18) !lake frac [0:1] Sfcprop(nb)%lakedepth(ix) = oro_var2(i,j,19) !lake depth [m] !YWu + else + Sfcprop(nb)%lakefrac(ix) = 0 + endif endif - enddo enddo @@ -716,12 +786,20 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (Model%cplwav) then nvar_s2m = nvar_s2m + 1 endif -! Flake - if (Model%lkm > 0 ) then - nvar_s2l = 10 +! CLM Lake and Flake + if (Model%lkm > 0) then + if(Model%iopt_lake==Model%iopt_lake_flake ) then + write(0,*) 'flake iopt_lake=',Model%iopt_lake + nvar_s2l = 10 + else + write(0,*) 'clm_lake iopt_lake=',Model%iopt_lake + nvar_s2l = 2 + endif else + write(0,*) 'no lake lkm=',Model%lkm nvar_s2l = 0 endif + write(0,*) 'nvar_s2l=',nvar_s2l !--- deallocate containers and free restart container deallocate(oro_name2, oro_var2) @@ -1142,19 +1220,22 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(nvar_s2m+19) = 'lai' nvar_s2me = nvar_s2m+19 endif -!Flake - if (Model%lkm > 0 ) then - sfc_name2(nvar_s2me+1) = 'h_ML' - sfc_name2(nvar_s2me+2) = 't_ML' - sfc_name2(nvar_s2me+3) = 't_mnw' - sfc_name2(nvar_s2me+4) = 'h_talb' - sfc_name2(nvar_s2me+5) = 't_talb' - sfc_name2(nvar_s2me+6) = 't_bot1' - sfc_name2(nvar_s2me+7) = 't_bot2' - sfc_name2(nvar_s2me+8) = 'c_t' - sfc_name2(nvar_s2me+9) = 'T_snow' - sfc_name2(nvar_s2me+10) = 'T_ice' +!CLM Lake and Flake + if (Model%lkm > 0) then + sfc_name2(nvar_s2me+1) = 'T_snow' + sfc_name2(nvar_s2me+2) = 'T_ice' + if( Model%iopt_lake==Model%iopt_lake_flake ) then + sfc_name2(nvar_s2me+3) = 'h_ML' + sfc_name2(nvar_s2me+4) = 't_ML' + sfc_name2(nvar_s2me+5) = 't_mnw' + sfc_name2(nvar_s2me+6) = 'h_talb' + sfc_name2(nvar_s2me+7) = 't_talb' + sfc_name2(nvar_s2me+8) = 't_bot1' + sfc_name2(nvar_s2me+9) = 't_bot2' + sfc_name2(nvar_s2me+10) = 'c_t' + write(0,*) 'ten sfc_name2' endif + endif is_lsoil=.false. if ( .not. warm_start ) then @@ -1186,6 +1267,14 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta call register_axis(Sfc_restart, 'Time', unlimited) end if + ! Tell CLM Lake to allocate data, and register its axes and fields + if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then + call clm_lake%allocate_data(Model) + call clm_lake%fill_with_zero(Model, Sfcprop, Atm_block) + call clm_lake%register_axes(Model) + call clm_lake%register_fields + endif + !--- register the 2D fields do num = 1,nvar_s2m var2_p => sfc_var2(:,:,num) @@ -1254,8 +1343,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta end if enddo endif ! noahmp -! Flake - if (Model%lkm > 0 ) then +! CLM Lake and Flake + if (Model%lkm > 0) then mand = .false. do num = nvar_s2me+1,nvar_s2me+nvar_s2l var2_p => sfc_var2(:,:,num) @@ -1270,7 +1359,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta nullify(var2_p) endif ! if not allocated - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. (.not.warm_start)) then !--- names of the 3D variables to save sfc_name3(1) = 'stc' @@ -1348,6 +1436,11 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta call read_restart(Sfc_restart, ignore_checksum=ignore_rst_cksum) call close_file(Sfc_restart) + ! Tell clm_lake to copy data to temporary arrays + if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then + call clm_lake%copy_from_temporaries(Model,Sfcprop,Atm_block) + endif + ! write(0,*)' stype read in min,max=',minval(sfc_var2(:,:,35)),maxval(sfc_var2(:,:,35)),' sfc_name2=',sfc_name2(35) ! write(0,*)' stype read in min,max=',minval(sfc_var2(:,:,18)),maxval(sfc_var2(:,:,18)) ! write(0,*)' sfc_var2=',sfc_var2(:,:,12) @@ -1635,18 +1728,21 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%rechxy(ix) = sfc_var2(i,j,nvar_s2m+47) nvar_s2me = nvar_s2m+47 endif -!Flake - if (Model%lkm > 0 ) then - Sfcprop(nb)%h_ML(ix) = sfc_var2(i,j,nvar_s2me+1) - Sfcprop(nb)%t_ML(ix) = sfc_var2(i,j,nvar_s2me+2) - Sfcprop(nb)%t_mnw(ix) = sfc_var2(i,j,nvar_s2me+3) - Sfcprop(nb)%h_talb(ix) = sfc_var2(i,j,nvar_s2me+4) - Sfcprop(nb)%t_talb(ix) = sfc_var2(i,j,nvar_s2me+5) - Sfcprop(nb)%t_bot1(ix) = sfc_var2(i,j,nvar_s2me+6) - Sfcprop(nb)%t_bot2(ix) = sfc_var2(i,j,nvar_s2me+7) - Sfcprop(nb)%c_t(ix) = sfc_var2(i,j,nvar_s2me+8) - Sfcprop(nb)%T_snow(ix) = sfc_var2(i,j,nvar_s2me+9) - Sfcprop(nb)%T_ice(ix) = sfc_var2(i,j,nvar_s2me+10) +!CLM Lake and Flake + if (Model%lkm > 0) then + Sfcprop(nb)%T_snow(ix) = sfc_var2(i,j,nvar_s2me+1) + Sfcprop(nb)%T_ice(ix) = sfc_var2(i,j,nvar_s2me+2) + if(Model%iopt_lake==Model%iopt_lake_flake ) then + Sfcprop(nb)%h_ML(ix) = sfc_var2(i,j,nvar_s2me+3) + Sfcprop(nb)%t_ML(ix) = sfc_var2(i,j,nvar_s2me+4) + Sfcprop(nb)%t_mnw(ix) = sfc_var2(i,j,nvar_s2me+5) + Sfcprop(nb)%h_talb(ix) = sfc_var2(i,j,nvar_s2me+6) + Sfcprop(nb)%t_talb(ix) = sfc_var2(i,j,nvar_s2me+7) + Sfcprop(nb)%t_bot1(ix) = sfc_var2(i,j,nvar_s2me+8) + Sfcprop(nb)%t_bot2(ix) = sfc_var2(i,j,nvar_s2me+9) + Sfcprop(nb)%c_t(ix) = sfc_var2(i,j,nvar_s2me+10) + write(0,*) 'copy ten sfc_name2' + endif endif if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. (.not.warm_start)) then @@ -1900,6 +1996,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta enddo endif + ! A fortran 2003 compliant compiler will call clm_lake_final automatically here + end subroutine sfc_prop_restart_read @@ -1929,6 +2027,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta integer :: nvar2me, nvar2l !for flake logical :: mand character(len=32) :: fn_srf = 'sfc_data.nc' + logical :: must_reallocate ! reallocate module variables if they're the wrong size real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p1 => NULL() @@ -1942,6 +2041,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta !--- variables used for fms2_io register axis integer :: is, ie integer, allocatable, dimension(:) :: buffer + type(clm_lake_data_type), target :: clm_lake nvar2m = 48 if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then @@ -1967,13 +2067,15 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nvar2mp = 29 nvar3mp = 5 endif -!Flake - if (Model%lkm > 0 ) then +!CLM Lake and Flake + if (Model%lkm > 0) then + if( Model%iopt_lake==Model%iopt_lake_flake ) then nvar2l = 10 - nvar2me = nvar2m + else + nvar2l = 2 + endif else - nvar2l = 0 - nvar2me = 0 + nvar2l = 0 endif isc = Atm_block%isc @@ -1984,21 +2086,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nx = (iec - isc + 1) ny = (jec - jsc + 1) - if (Model%lsm == Model%lsm_ruc) then - if (allocated(sfc_name2)) then - ! Re-allocate if one or more of the dimensions don't match - if (size(sfc_name2).ne.nvar2m+nvar2o+nvar2mp+nvar2r .or. & - size(sfc_name3).ne.nvar3+nvar3mp .or. & - size(sfc_var3,dim=3).ne.Model%lsoil_lsm) then - !--- deallocate containers and free restart container - deallocate(sfc_name2) - deallocate(sfc_name3) - deallocate(sfc_var2) - deallocate(sfc_var3) - end if - end if - end if - !--- set filename infile=trim(indir)//'/'//trim(fn_srf) if( present(timestamp) ) infile=trim(indir)//'/'//trim(timestamp)//'.'//trim(fn_srf) @@ -2071,9 +2158,50 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta call mpp_error(FATAL, 'Error in opening file'//trim(infile) ) end if + ! Tell clm_lake to allocate data, register its axes, and call write_data for each axis's variable + if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then + call clm_lake%allocate_data(Model) + call clm_lake%register_axes(Model) + call clm_lake%write_axes(Model) + endif - if (.not. allocated(sfc_name2)) then - !--- allocate the various containers needed for restarts + check_containers: if(allocated(sfc_name2)) then + !--- Check if the containers are the right size. + !--- This must match the allocate block, below. + must_reallocate = .false. + if(size(sfc_name2) /= nvar2m+nvar2o+nvar2mp+nvar2r+nvar2l .or. & + size(sfc_name3) /= nvar3+nvar3mp .or. & + size(sfc_var2,1) /= nx .or. & + size(sfc_var2,2) /= ny .or. & + size(sfc_var2,3) /= nvar2m+nvar2o+nvar2mp+nvar2r+nvar2l) then + must_reallocate = .true. + else + if(Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then + if(size(sfc_var3,1) /= nx .or. size(sfc_var3,2) /= ny .or. & + size(sfc_var3,3) /= Model%lsoil .or. size(sfc_var3,4) /= nvar3) then + must_reallocate = .true. + endif + else if(model%lsm == Model%lsm_ruc) then + if(size(sfc_var3,1) /= nx .or. size(sfc_var3,2) /= ny .or. & + size(sfc_var3,3) /= Model%lsoil_lsm .or. size(sfc_var3,4) /= nvar3) then + must_reallocate = .true. + endif + endif + endif + if(must_reallocate) then + if(allocated(sfc_name2)) deallocate(sfc_name2) + if(allocated(sfc_name3)) deallocate(sfc_name3) + if(allocated(sfc_var2)) deallocate(sfc_var2) + if(allocated(sfc_var3)) deallocate(sfc_var3) + if(allocated(sfc_var3sn)) deallocate(sfc_var3sn) + if(allocated(sfc_var3eq)) deallocate(sfc_var3eq) + if(allocated(sfc_var3zn)) deallocate(sfc_var3zn) + endif + endif check_containers + + allocate_containers: if (.not. allocated(sfc_name2)) then + !--- Allocate the various containers needed for restarts + !--- which must match the reallocate block, above. allocate(sfc_name2(nvar2m+nvar2o+nvar2mp+nvar2r+nvar2l)) allocate(sfc_name3(0:nvar3+nvar3mp)) allocate(sfc_var2(nx,ny,nvar2m+nvar2o+nvar2mp+nvar2r+nvar2l)) @@ -2145,13 +2273,15 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(46) = 'sncovr_ice' sfc_name2(47) = 'snodi' !snowd on ice portion of a cell sfc_name2(48) = 'weasdi'!weasd on ice portion of a cell - + nvar2me = 48 if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then sfc_name2(49) = 'albdirvis_ice' sfc_name2(50) = 'albdifvis_ice' sfc_name2(51) = 'albdirnir_ice' sfc_name2(52) = 'albdifnir_ice' + nvar2me = 52 ! sfc_name2(53) = 'sfalb_ice' +! nvar2me = 53 endif if (Model%cplwav) then @@ -2176,6 +2306,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+16) = 'ifd' sfc_name2(nvar2m+17) = 'dt_cool' sfc_name2(nvar2m+18) = 'qrain' + nvar2me = nvar2m+18 if (Model%lsm == Model%lsm_ruc) then sfc_name2(nvar2m+19) = 'wetness' sfc_name2(nvar2m+20) = 'clw_surf_land' @@ -2189,8 +2320,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+28) = 'sfalb_lnd' sfc_name2(nvar2m+29) = 'sfalb_lnd_bck' sfc_name2(nvar2m+30) = 'sfalb_ice' + nvar2me = nvar2m+30 if (Model%rdlai) then sfc_name2(nvar2m+31) = 'lai' + nvar2me = nvar2m+31 endif else if(Model%lsm == Model%lsm_noahmp) then ! Only needed when Noah MP LSM is used - 29 2D @@ -2223,22 +2356,40 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+45) = 'smcwtdxy' sfc_name2(nvar2m+46) = 'deeprechxy' sfc_name2(nvar2m+47) = 'rechxy' + nvar2me = nvar2m+47 endif -!Flake - if(Model%lkm > 0 ) then - sfc_name2(nvar2me+1) = 'h_ML' - sfc_name2(nvar2me+2) = 't_ML' - sfc_name2(nvar2me+3) = 't_mnw' - sfc_name2(nvar2me+4) = 'h_talb' - sfc_name2(nvar2me+5) = 't_talb' - sfc_name2(nvar2me+6) = 't_bot1' - sfc_name2(nvar2me+7) = 't_bot2' - sfc_name2(nvar2me+8) = 'c_t' - sfc_name2(nvar2me+9) = 'T_snow' - sfc_name2(nvar2me+10) = 'T_ice' - endif - end if +!CLM Lake Flake + if(Model%lkm > 0) then + sfc_name2(nvar2me+1) = 'T_snow' + sfc_name2(nvar2me+2) = 'T_ice' + if(Model%iopt_lake==Model%iopt_lake_flake ) then + sfc_name2(nvar2me+3) = 'h_ML' + sfc_name2(nvar2me+4) = 't_ML' + sfc_name2(nvar2me+5) = 't_mnw' + sfc_name2(nvar2me+6) = 'h_talb' + sfc_name2(nvar2me+7) = 't_talb' + sfc_name2(nvar2me+8) = 't_bot1' + sfc_name2(nvar2me+9) = 't_bot2' + sfc_name2(nvar2me+10) = 'c_t' + if(Model%me==0) then + do i=1,nvar2me+10 + print 1048,i,sfc_name2(i) +1048 format("sfc_name2(",I0,') = "',A,'"') + enddo + if(size(sfc_name2)/=nvar2me+10) then +3814 format("ERROR: size mismatch size(sfc_name2)=",I0," /= nvar2me+10=",I0) + write(0,3814) size(sfc_name2),nvar2me+10 + endif + endif + endif + endif + end if allocate_containers + ! Tell clm_lake to register all of its fields + if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then + call clm_lake%register_fields + endif + !--- register the 2D fields do num = 1,nvar2m var2_p => sfc_var2(:,:,num) @@ -2281,13 +2432,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta &is_optional=.not.mand) enddo endif -!Flake - nvar2me=nvar2m+nvar2o+nvar2r+nvar2mp +!CLM Lake and Flake if(Model%lkm > 0) then mand = .false. do num = nvar2me+1,nvar2me+nvar2l -! do num = -! nvar2m+nvar2o+nvar2r+nvar2mp+1,nvar2m+nvar2o+nvar2r+nvar2mp+nvar2l var2_p => sfc_var2(:,:,num) call register_restart_field(Sfc_restart, sfc_name2(num),var2_p,dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/),& &is_optional=.not.mand) @@ -2359,6 +2507,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nullify(var3_p3) endif ! lsm = lsm_noahmp + ! Tell clm_lake to copy Sfcprop data to its internal temporary arrays. + if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then + call clm_lake%copy_to_temporaries(Model,Sfcprop,Atm_block) + endif !$omp parallel do default(shared) private(i, j, nb, ix, lsoil) do nb = 1, Atm_block%nblks @@ -2423,6 +2575,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta endif if (Model%cplwav) then sfc_var2(i,j,nvar2m) = Sfcprop(nb)%zorlwav(ix) !--- zorlwav (zorl from wav) + nvar2me = nvar2m endif !--- NSSTM variables if (Model%nstf_name(1) > 0) then @@ -2499,20 +2652,21 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+47) = Sfcprop(nb)%rechxy(ix) nvar2me = nvar2m + 47 endif -!Flake - if(Model%lkm > 0 ) then - sfc_var2(i,j,nvar2me+1) = Sfcprop(nb)%h_ML(ix) - sfc_var2(i,j,nvar2me+2) = Sfcprop(nb)%t_ML(ix) - sfc_var2(i,j,nvar2me+3) = Sfcprop(nb)%t_mnw(ix) - sfc_var2(i,j,nvar2me+4) = Sfcprop(nb)%h_talb(ix) - sfc_var2(i,j,nvar2me+5) = Sfcprop(nb)%t_talb(ix) - sfc_var2(i,j,nvar2me+6) = Sfcprop(nb)%t_bot1(ix) - sfc_var2(i,j,nvar2me+7) = Sfcprop(nb)%t_bot2(ix) - sfc_var2(i,j,nvar2me+8) = Sfcprop(nb)%c_t(ix) - sfc_var2(i,j,nvar2me+9) = Sfcprop(nb)%T_snow(ix) - sfc_var2(i,j,nvar2me+10) = Sfcprop(nb)%T_ice(ix) ! this is never used - nvar2me = nvar2m + 10 - endif +!CLM Lake and Flake + if(Model%lkm > 0) then + sfc_var2(i,j,nvar2me+1) = Sfcprop(nb)%T_snow(ix) + sfc_var2(i,j,nvar2me+2) = Sfcprop(nb)%T_ice(ix) ! this is never used + if(Model%iopt_lake==Model%iopt_lake_flake ) then + sfc_var2(i,j,nvar2me+3) = Sfcprop(nb)%h_ML(ix) + sfc_var2(i,j,nvar2me+4) = Sfcprop(nb)%t_ML(ix) + sfc_var2(i,j,nvar2me+5) = Sfcprop(nb)%t_mnw(ix) + sfc_var2(i,j,nvar2me+6) = Sfcprop(nb)%h_talb(ix) + sfc_var2(i,j,nvar2me+7) = Sfcprop(nb)%t_talb(ix) + sfc_var2(i,j,nvar2me+8) = Sfcprop(nb)%t_bot1(ix) + sfc_var2(i,j,nvar2me+9) = Sfcprop(nb)%t_bot2(ix) + sfc_var2(i,j,nvar2me+10) = Sfcprop(nb)%c_t(ix) + endif + endif do k = 1,Model%kice sfc_var3ice(i,j,k) = Sfcprop(nb)%tiice(ix,k) !--- internal ice temperature @@ -2561,8 +2715,386 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta call write_restart(Sfc_restart) call close_file(Sfc_restart) + ! A fortran 2003 compliant compiler will call clm_lake_final automatically here + end subroutine sfc_prop_restart_write + subroutine clm_lake_allocate_data(data,Model) + ! Deallocate all data, and reallocate to the size specified in Model + implicit none + class(clm_lake_data_type) :: data + type(GFS_control_type), intent(in) :: Model + + integer :: nx, ny + print *,'clm_lake_allocate_data' + call data%deallocate_data + + nx=Model%nx + ny=Model%ny + + allocate(data%lake_snl2d(nx,ny)) + allocate(data%lake_h2osno2d(nx,ny)) + allocate(data%lake_t_grnd2d(nx,ny)) + allocate(data%lake_savedtke12d(nx,ny)) + allocate(data%lake_dp2dsno(nx,ny)) + allocate(data%clm_lake_initialized(nx,ny)) + + allocate(data%lake_z3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_dz3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_watsat3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_csol3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_tkmg3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_tkdry3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_tksatu3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_snow_z3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(data%lake_snow_dz3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(data%lake_snow_zi3d(nx,ny,Model%nlevsnowsoil_clm_lake)) + allocate(data%lake_t_h2osoi_vol3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(data%lake_t_h2osoi_liq3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(data%lake_t_h2osoi_ice3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(data%lake_t_soisno3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(data%lake_t_lake3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_icefrac3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_clay3d(nx,ny,Model%nlevsoil_clm_lake)) + allocate(data%lake_sand3d(nx,ny,Model%nlevsoil_clm_lake)) + end subroutine clm_lake_allocate_data + + subroutine clm_lake_register_axes(data,Model) + ! Register all five axes needed by CLM Lake restart data + implicit none + class(clm_lake_data_type) :: data + type(GFS_control_type), intent(in) :: Model + print *,'clm_lake_register_axes' + call register_axis(Sfc_restart, 'levlake_clm_lake', dimension_length=Model%nlevlake_clm_lake) + + call register_axis(Sfc_restart, 'levsoil_clm_lake', dimension_length=Model%nlevsoil_clm_lake) + + call register_axis(Sfc_restart, 'levsnow_clm_lake', dimension_length=Model%nlevsnow_clm_lake) + + call register_axis(Sfc_restart, 'levsnowsoil_clm_lake', dimension_length=Model%nlevsnowsoil_clm_lake) + + call register_axis(Sfc_restart, 'levsnowsoil1_clm_lake', dimension_length=Model%nlevsnowsoil1_clm_lake) + end subroutine clm_lake_register_axes + + subroutine clm_lake_write_axes(data, Model) + ! Create variables with the name name as each clm_lake axis, and + ! fill the variable with the appropriate indices + implicit none + class(clm_lake_data_type) :: data + type(GFS_control_type), intent(in) :: Model + real(kind_phys) :: levlake_clm_lake(Model%nlevlake_clm_lake) + real(kind_phys) :: levsoil_clm_lake(Model%nlevsoil_clm_lake) + real(kind_phys) :: levsnow_clm_lake(Model%nlevsnow_clm_lake) + real(kind_phys) :: levsnowsoil_clm_lake(Model%nlevsnowsoil_clm_lake) + real(kind_phys) :: levsnowsoil1_clm_lake(Model%nlevsnowsoil1_clm_lake) + integer :: i + print *,'clm_lake_write_axes' + call register_field(Sfc_restart, 'levlake_clm_lake', 'double', (/'levlake_clm_lake'/)) + call register_variable_attribute(Sfc_restart, 'levlake_clm_lake', 'cartesian_axis' ,'Z', str_len=1) + + call register_field(Sfc_restart, 'levsoil_clm_lake', 'double', (/'levsoil_clm_lake'/)) + call register_variable_attribute(Sfc_restart, 'levsoil_clm_lake', 'cartesian_axis' ,'Z', str_len=1) + + call register_field(Sfc_restart, 'levsnow_clm_lake', 'double', (/'levsnow_clm_lake'/)) + call register_variable_attribute(Sfc_restart, 'levsnow_clm_lake', 'cartesian_axis' ,'Z', str_len=1) + + call register_field(Sfc_restart, 'levsnowsoil_clm_lake', 'double', (/'levsnowsoil_clm_lake'/)) + call register_variable_attribute(Sfc_restart, 'levsnowsoil_clm_lake', 'cartesian_axis' ,'Z', str_len=1) + + call register_field(Sfc_restart, 'levsnowsoil1_clm_lake', 'double', (/'levsnowsoil1_clm_lake'/)) + call register_variable_attribute(Sfc_restart, 'levsnowsoil1_clm_lake', 'cartesian_axis' ,'Z', str_len=1) + + do i=1,Model%nlevlake_clm_lake + levlake_clm_lake(i) = i + enddo + do i=1,Model%nlevsoil_clm_lake + levsoil_clm_lake(i) = i + enddo + do i=1,Model%nlevsnow_clm_lake + levsnow_clm_lake(i) = i + enddo + do i=-Model%nlevsnow_clm_lake,Model%nlevsoil_clm_lake + levsnowsoil_clm_lake(i+Model%nlevsnow_clm_lake+1) = i + enddo + do i=-Model%nlevsnow_clm_lake+1,Model%nlevsoil_clm_lake + levsnowsoil1_clm_lake(i+Model%nlevsnow_clm_lake) = i + enddo + + call write_data(Sfc_restart, 'levlake_clm_lake', levlake_clm_lake) + call write_data(Sfc_restart, 'levsoil_clm_lake', levsoil_clm_lake) + call write_data(Sfc_restart, 'levsnow_clm_lake', levsnow_clm_lake) + call write_data(Sfc_restart, 'levsnowsoil_clm_lake', levsnowsoil_clm_lake) + call write_data(Sfc_restart, 'levsnowsoil1_clm_lake', levsnowsoil1_clm_lake) + end subroutine clm_lake_write_axes + + subroutine clm_lake_copy_to_temporaries(data, Model, Sfcprop, Atm_block) + ! Copies from Sfcprop variables to the corresponding data temporary variables. + ! Terrible things will happen if you don't call data%allocate_data first. + implicit none + class(clm_lake_data_type) :: data + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + integer :: nb, ix, isc, jsc, i, j + print *,'clm_lake_copy_to_temporaries' + isc = Model%isc + jsc = Model%jsc + + ! Copy data to temporary arrays + +!$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - isc + 1 + j = Atm_block%index(nb)%jj(ix) - jsc + 1 + + data%lake_snl2d(i,j) = Sfcprop(nb)%lake_snl2d(ix) + data%lake_h2osno2d(i,j) = Sfcprop(nb)%lake_h2osno2d(ix) + data%lake_t_grnd2d(i,j) = Sfcprop(nb)%lake_t_grnd2d(ix) + data%lake_savedtke12d(i,j) = Sfcprop(nb)%lake_savedtke12d(ix) + data%lake_dp2dsno(i,j) = Sfcprop(nb)%lake_dp2dsno(ix) + data%clm_lake_initialized(i,j) = Sfcprop(nb)%clm_lake_initialized(ix) + + data%lake_z3d(i,j,:) = Sfcprop(nb)%lake_z3d(ix,:) + data%lake_dz3d(i,j,:) = Sfcprop(nb)%lake_dz3d(ix,:) + data%lake_watsat3d(i,j,:) = Sfcprop(nb)%lake_watsat3d(ix,:) + data%lake_csol3d(i,j,:) = Sfcprop(nb)%lake_csol3d(ix,:) + data%lake_tkmg3d(i,j,:) = Sfcprop(nb)%lake_tkmg3d(ix,:) + data%lake_tkdry3d(i,j,:) = Sfcprop(nb)%lake_tkdry3d(ix,:) + data%lake_tksatu3d(i,j,:) = Sfcprop(nb)%lake_tksatu3d(ix,:) + data%lake_snow_z3d(i,j,:) = Sfcprop(nb)%lake_snow_z3d(ix,:) + data%lake_snow_dz3d(i,j,:) = Sfcprop(nb)%lake_snow_dz3d(ix,:) + data%lake_snow_zi3d(i,j,:) = Sfcprop(nb)%lake_snow_zi3d(ix,:) + data%lake_t_h2osoi_vol3d(i,j,:) = Sfcprop(nb)%lake_t_h2osoi_vol3d(ix,:) + data%lake_t_h2osoi_liq3d(i,j,:) = Sfcprop(nb)%lake_t_h2osoi_liq3d(ix,:) + data%lake_t_h2osoi_ice3d(i,j,:) = Sfcprop(nb)%lake_t_h2osoi_ice3d(ix,:) + data%lake_t_soisno3d(i,j,:) = Sfcprop(nb)%lake_t_soisno3d(ix,:) + data%lake_t_lake3d(i,j,:) = Sfcprop(nb)%lake_t_lake3d(ix,:) + data%lake_icefrac3d(i,j,:) = Sfcprop(nb)%lake_icefrac3d(ix,:) + data%lake_clay3d(i,j,:) = Sfcprop(nb)%lake_clay3d(ix,:) + data%lake_sand3d(i,j,:) = Sfcprop(nb)%lake_sand3d(ix,:) + enddo + enddo + end subroutine clm_lake_copy_to_temporaries + + subroutine clm_lake_fill_with_zero(data, Model, Sfcprop, Atm_block) + ! Fills all temporary variables with 0. + ! Terrible things will happen if you don't call data%allocate_data first. + implicit none + class(clm_lake_data_type) :: data + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + integer :: nb, ix, isc, jsc, i, j + print *,'clm_lake_copy_to_temporaries' + isc = Model%isc + jsc = Model%jsc + + ! Copy data to temporary arrays + +!$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - isc + 1 + j = Atm_block%index(nb)%jj(ix) - jsc + 1 + + data%lake_snl2d(i,j) = 0 + data%lake_h2osno2d(i,j) = 0 + data%lake_t_grnd2d(i,j) = 0 + data%lake_savedtke12d(i,j) = 0 + data%lake_dp2dsno(i,j) = 0 + data%clm_lake_initialized(i,j) = 0 + + data%lake_z3d(i,j,:) = 0 + data%lake_dz3d(i,j,:) = 0 + data%lake_watsat3d(i,j,:) = 0 + data%lake_csol3d(i,j,:) = 0 + data%lake_tkmg3d(i,j,:) = 0 + data%lake_tkdry3d(i,j,:) = 0 + data%lake_tksatu3d(i,j,:) = 0 + data%lake_snow_z3d(i,j,:) = 0 + data%lake_snow_dz3d(i,j,:) = 0 + data%lake_snow_zi3d(i,j,:) = 0 + data%lake_t_h2osoi_vol3d(i,j,:) = 0 + data%lake_t_h2osoi_liq3d(i,j,:) = 0 + data%lake_t_h2osoi_ice3d(i,j,:) = 0 + data%lake_t_soisno3d(i,j,:) = 0 + data%lake_t_lake3d(i,j,:) = 0 + data%lake_icefrac3d(i,j,:) = 0 + data%lake_clay3d(i,j,:) = 0 + data%lake_sand3d(i,j,:) = 0 + enddo + enddo + end subroutine clm_lake_fill_with_zero + + subroutine clm_lake_copy_from_temporaries(data, Model, Sfcprop, Atm_block) + ! Copies from data temporary variables to the corresponding Sfcprop variables. + ! Terrible things will happen if you don't call data%allocate_data first. + implicit none + class(clm_lake_data_type) :: data + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + integer :: nb, ix, isc, jsc, i, j + print *,'clm_lake_copy_from_temporaries' + isc = Model%isc + jsc = Model%jsc + + ! Copy data to temporary arrays + +!$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - isc + 1 + j = Atm_block%index(nb)%jj(ix) - jsc + 1 + + Sfcprop(nb)%lake_snl2d(ix) = data%lake_snl2d(i,j) + Sfcprop(nb)%lake_h2osno2d(ix) = data%lake_h2osno2d(i,j) + Sfcprop(nb)%lake_t_grnd2d(ix) = data%lake_t_grnd2d(i,j) + Sfcprop(nb)%lake_savedtke12d(ix) = data%lake_savedtke12d(i,j) + Sfcprop(nb)%lake_dp2dsno(ix) = data%lake_dp2dsno(i,j) + Sfcprop(nb)%clm_lake_initialized(ix) = data%clm_lake_initialized(i,j) + + Sfcprop(nb)%lake_z3d(ix,:) = data%lake_z3d(i,j,:) + Sfcprop(nb)%lake_dz3d(ix,:) = data%lake_dz3d(i,j,:) + Sfcprop(nb)%lake_watsat3d(ix,:) = data%lake_watsat3d(i,j,:) + Sfcprop(nb)%lake_csol3d(ix,:) = data%lake_csol3d(i,j,:) + Sfcprop(nb)%lake_tkmg3d(ix,:) = data%lake_tkmg3d(i,j,:) + Sfcprop(nb)%lake_tkdry3d(ix,:) = data%lake_tkdry3d(i,j,:) + Sfcprop(nb)%lake_tksatu3d(ix,:) = data%lake_tksatu3d(i,j,:) + Sfcprop(nb)%lake_snow_z3d(ix,:) = data%lake_snow_z3d(i,j,:) + Sfcprop(nb)%lake_snow_dz3d(ix,:) = data%lake_snow_dz3d(i,j,:) + Sfcprop(nb)%lake_snow_zi3d(ix,:) = data%lake_snow_zi3d(i,j,:) + Sfcprop(nb)%lake_t_h2osoi_vol3d(ix,:) = data%lake_t_h2osoi_vol3d(i,j,:) + Sfcprop(nb)%lake_t_h2osoi_liq3d(ix,:) = data%lake_t_h2osoi_liq3d(i,j,:) + Sfcprop(nb)%lake_t_h2osoi_ice3d(ix,:) = data%lake_t_h2osoi_ice3d(i,j,:) + Sfcprop(nb)%lake_t_soisno3d(ix,:) = data%lake_t_soisno3d(i,j,:) + Sfcprop(nb)%lake_t_lake3d(ix,:) = data%lake_t_lake3d(i,j,:) + Sfcprop(nb)%lake_icefrac3d(ix,:) = data%lake_icefrac3d(i,j,:) + Sfcprop(nb)%lake_clay3d(ix,:) = data%lake_clay3d(i,j,:) + Sfcprop(nb)%lake_sand3d(ix,:) = data%lake_sand3d(i,j,:) + enddo + enddo + end subroutine clm_lake_copy_from_temporaries + + subroutine clm_lake_register_fields(data) + ! Registers all restart fields needed by the CLM Lake Model. + ! Terrible things will happen if you don't call data%allocate_data + ! and data%register_axes first. + implicit none + class(clm_lake_data_type) :: data + + print *,'clm_lake_register_fields' + + ! Register 2D fields + call register_restart_field(Sfc_restart, 'lake_snl2d', data%lake_snl2d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_h2osno2d', data%lake_h2osno2d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_t_grnd2d', data%lake_t_grnd2d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_savedtke12d', data%lake_savedtke12d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_dp2dsno', data%lake_dp2dsno, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'clm_lake_initialized', data%clm_lake_initialized, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + + ! Register 3D fields + call register_restart_field(Sfc_restart, 'lake_z3d', data%lake_z3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_dz3d', data%lake_dz3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_watsat3d', data%lake_watsat3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_csol3d', data%lake_csol3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_tkmg3d', data%lake_tkmg3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_tkdry3d', data%lake_tkdry3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_tksatu3d', data%lake_tksatu3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_snow_z3d', data%lake_snow_z3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_snow_dz3d', data%lake_snow_dz3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_snow_zi3d', data%lake_snow_zi3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levsnowsoil_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_t_h2osoi_vol3d', data%lake_t_h2osoi_vol3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_t_h2osoi_liq3d', data%lake_t_h2osoi_liq3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_t_h2osoi_ice3d', data%lake_t_h2osoi_ice3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_t_soisno3d', data%lake_t_soisno3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_t_lake3d', data%lake_t_lake3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_icefrac3d', data%lake_icefrac3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_clay3d', data%lake_clay3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levsoil_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_sand3d', data%lake_sand3d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'levsoil_clm_lake', 'Time '/), is_optional=.true.) + end subroutine clm_lake_register_fields + + subroutine clm_lake_final(data) + ! Final routine for clm_lake_data_type, called automatically when + ! an object of that type goes out of scope. This is simply a + ! wrapper around data%deallocate_data(). + implicit none + type(clm_lake_data_type) :: data + call clm_lake_deallocate_data(data) + end subroutine clm_lake_final + + subroutine clm_lake_deallocate_data(data) + ! Deallocates all data used, and nullifies the pointers. The data + ! object can safely be used again after this call. This is also + ! the implementation of the clm_lake_data_type final routine. + implicit none + class(clm_lake_data_type) :: data + + ! Deallocate and nullify any associated pointers + + ! This #define reduces code length by a lot +#define IF_ASSOC_DEALLOC_NULL(var) \ + if(associated(data%var)) then ; \ + deallocate(data%var) ; \ + nullify(data%var) ; \ + endif + + IF_ASSOC_DEALLOC_NULL(lake_snl2d) + IF_ASSOC_DEALLOC_NULL(lake_h2osno2d) + IF_ASSOC_DEALLOC_NULL(lake_t_grnd2d) + IF_ASSOC_DEALLOC_NULL(lake_savedtke12d) + IF_ASSOC_DEALLOC_NULL(lake_dp2dsno) + IF_ASSOC_DEALLOC_NULL(clm_lake_initialized) + + IF_ASSOC_DEALLOC_NULL(lake_z3d) + IF_ASSOC_DEALLOC_NULL(lake_dz3d) + IF_ASSOC_DEALLOC_NULL(lake_watsat3d) + IF_ASSOC_DEALLOC_NULL(lake_csol3d) + IF_ASSOC_DEALLOC_NULL(lake_tkmg3d) + IF_ASSOC_DEALLOC_NULL(lake_tkdry3d) + IF_ASSOC_DEALLOC_NULL(lake_tksatu3d) + IF_ASSOC_DEALLOC_NULL(lake_snow_z3d) + IF_ASSOC_DEALLOC_NULL(lake_snow_dz3d) + IF_ASSOC_DEALLOC_NULL(lake_snow_zi3d) + IF_ASSOC_DEALLOC_NULL(lake_t_h2osoi_vol3d) + IF_ASSOC_DEALLOC_NULL(lake_t_h2osoi_liq3d) + IF_ASSOC_DEALLOC_NULL(lake_t_h2osoi_ice3d) + IF_ASSOC_DEALLOC_NULL(lake_t_soisno3d) + IF_ASSOC_DEALLOC_NULL(lake_t_lake3d) + IF_ASSOC_DEALLOC_NULL(lake_icefrac3d) + IF_ASSOC_DEALLOC_NULL(lake_clay3d) + IF_ASSOC_DEALLOC_NULL(lake_sand3d) + +#undef IF_ASSOC_DEALLOC_NULL + end subroutine clm_lake_deallocate_data !---------------------------------------------------------------------- ! phys_restart_read From cbcd70a15f76d9e2558c9be589def67eb7dc96e6 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 19 Sep 2022 22:05:06 +0000 Subject: [PATCH 17/74] set roughness length over ice & water in clm lake model --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 405621763..2014d7b54 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 405621763e00169e7edd7253491b5ea21aea9f29 +Subproject commit 2014d7b54491a965d462ab83f047fd9847c1f1d6 From 7b9486b30a37d5890ecea7323b0442ca521f6e5d Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 11 Oct 2022 18:49:21 +0000 Subject: [PATCH 18/74] several fixes to initialization --- ccpp/data/GFS_typedefs.F90 | 24 ++++++++++++++++++++++-- ccpp/data/GFS_typedefs.meta | 13 +++++++++++++ ccpp/physics | 2 +- io/FV3GFS_io.F90 | 9 ++++++++- 4 files changed, 44 insertions(+), 4 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index d923f098f..a6eefc612 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -212,6 +212,7 @@ module GFS_typedefs !--- In (lakes) real (kind=kind_phys), pointer :: lakefrac(:) => null() !< lake fraction [0:1] real (kind=kind_phys), pointer :: lakedepth(:) => null() !< lake depth [ m ] + real (kind=kind_phys), pointer :: clm_lakedepth(:) => null() !< clm internal lake depth [ m ] integer, pointer :: use_lake_model(:) => null()!1=run lake, 2=run lake&nsst, 0=no lake real (kind=kind_phys), pointer :: lake_t2m (:) => null() !< 2 meter temperature from CLM Lake model real (kind=kind_phys), pointer :: lake_q2m (:) => null() !< 2 meter humidity from CLM Lake model @@ -1209,6 +1210,7 @@ module GFS_typedefs !< nstf_name(5) : zsea2 in mm !--- fractional grid logical :: frac_grid !< flag for fractional grid + logical :: frac_ice !< flag for fractional ice when fractional grid is not in use logical :: ignore_lake !< flag for ignoring lakes real(kind=kind_phys) :: min_lakeice !< minimum lake ice value real(kind=kind_phys) :: min_seaice !< minimum sea ice value @@ -2136,6 +2138,8 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%t_bot1 (IM)) allocate (Sfcprop%t_bot2 (IM)) allocate (Sfcprop%c_t (IM)) + else + allocate (Sfcprop%clm_lakedepth(IM)) endif allocate (Sfcprop%T_snow (IM)) allocate (Sfcprop%T_ice (IM)) @@ -2186,6 +2190,8 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%t_bot1 = clear_val Sfcprop%t_bot2 = clear_val Sfcprop%c_t = clear_val + else + Sfcprop%clm_lakedepth = clear_val endif Sfcprop%T_snow = clear_val Sfcprop%T_ice = clear_val @@ -3487,6 +3493,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !< nstf_name(5) : zsea2 in mm !--- fractional grid logical :: frac_grid = .false. !< flag for fractional grid + logical :: frac_ice = .false. !< flag for fractional ice when fractional grid is not in use logical :: ignore_lake = .true. !< flag for ignoring lakes real(kind=kind_phys) :: min_lakeice = 0.15d0 !< minimum lake ice value real(kind=kind_phys) :: min_seaice = 1.0d-11 !< minimum sea ice value @@ -3717,7 +3724,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- near surface sea temperature model nst_anl, lsea, nstf_name, & frac_grid, min_lakeice, min_seaice, min_lake_height, & - ignore_lake, & + ignore_lake, frac_ice, & !--- surface layer sfc_z0_type, & !--- switch beteeen local and standard potential temperature @@ -4510,6 +4517,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- fractional grid Model%frac_grid = frac_grid + Model%frac_ice = frac_ice Model%ignore_lake = ignore_lake Model%min_lakeice = min_lakeice Model%min_seaice = min_seaice @@ -4729,6 +4737,18 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%ntocl = get_tracer_index(Model%tracer_names, 'oc2', Model%me, Model%master, Model%debug) end if + ! Lake & fractional grid safety checks + if(Model%me==Model%master) then + if(Model%lkm>0 .and. Model%frac_grid) then + write(0,*) 'WARNING: Lake fractional grid support is experimental. Use at your own risk!' + else if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm .and. .not. Model%frac_ice) then + write(0,*) 'WARNING: CLM Lake Model will not work without frac_ice=.true.' + endif + if(Model%lkm==2) then + write(0,*) 'WARNING: Running both lake and nsst on lake points is experimental. Use at your own risk!' + endif + endif + if(ldiag3d) then ! Flags used to turn on or off tracer "causes" have_pbl_edmf = Model%hybedmf .or. Model%satmedmf .or. Model%do_mynnedmf @@ -5236,7 +5256,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ! endif print *,' nst_anl=',Model%nst_anl,' use_ufo=',Model%use_ufo,' frac_grid=',Model%frac_grid,& - ' ignore_lake=',ignore_lake + ' ignore_lake=',ignore_lake,' frac_ice=',Model%frac_ice print *,' min_lakeice=',Model%min_lakeice,' min_seaice=',Model%min_seaice, & 'min_lake_height=',Model%min_lake_height diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index d1bc5f333..059532ee6 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -619,6 +619,13 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[clm_lakedepth] + standard_name = clm_lake_depth + long_name = clm internal copy of lake depth with 10.0 replaced by default lake depth + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [use_lake_model] standard_name = flag_for_using_lake_model long_name = flag indicating lake points using a lake model @@ -5256,6 +5263,12 @@ units = flag dimensions = () type = logical +[frac_ice] + standard_name = flag_for_fractional_ice_when_fractional_landmask_is_disabled + long_name = flag for fractional ice when fractional landmask is disabled + units = flag + dimensions = () + type = logical [min_lakeice] standard_name = min_lake_ice_area_fraction long_name = minimum lake ice value diff --git a/ccpp/physics b/ccpp/physics index 2014d7b54..789ddb933 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 2014d7b54491a965d462ab83f047fd9847c1f1d6 +Subproject commit 789ddb933c1e4ca238a31cabd8a26901230e972a diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index fd43b3536..455101aba 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -122,7 +122,7 @@ module FV3GFS_io_mod ! All 2D variables needed for a restart real(kind_phys), pointer, private, dimension(:,:) :: & - lake_snl2d=>null(), lake_h2osno2d=>null(), lake_t_grnd2d=>null(), & + lake_snl2d=>null(), lake_h2osno2d=>null(), lake_t_grnd2d=>null(), clm_lakedepth=>null(), & lake_savedtke12d=>null(), lake_dp2dsno=>null(), clm_lake_initialized=>null() ! All 3D variables needed for a restart @@ -2737,6 +2737,7 @@ subroutine clm_lake_allocate_data(data,Model) allocate(data%lake_t_grnd2d(nx,ny)) allocate(data%lake_savedtke12d(nx,ny)) allocate(data%lake_dp2dsno(nx,ny)) + allocate(data%clm_lakedepth(nx,ny)) allocate(data%clm_lake_initialized(nx,ny)) allocate(data%lake_z3d(nx,ny,Model%nlevlake_clm_lake)) @@ -2854,6 +2855,7 @@ subroutine clm_lake_copy_to_temporaries(data, Model, Sfcprop, Atm_block) data%lake_t_grnd2d(i,j) = Sfcprop(nb)%lake_t_grnd2d(ix) data%lake_savedtke12d(i,j) = Sfcprop(nb)%lake_savedtke12d(ix) data%lake_dp2dsno(i,j) = Sfcprop(nb)%lake_dp2dsno(ix) + data%clm_lakedepth(i,j) = Sfcprop(nb)%clm_lakedepth(ix) data%clm_lake_initialized(i,j) = Sfcprop(nb)%clm_lake_initialized(ix) data%lake_z3d(i,j,:) = Sfcprop(nb)%lake_z3d(ix,:) @@ -2905,6 +2907,7 @@ subroutine clm_lake_fill_with_zero(data, Model, Sfcprop, Atm_block) data%lake_t_grnd2d(i,j) = 0 data%lake_savedtke12d(i,j) = 0 data%lake_dp2dsno(i,j) = 0 + data%clm_lakedepth(i,j) = 0 data%clm_lake_initialized(i,j) = 0 data%lake_z3d(i,j,:) = 0 @@ -2956,6 +2959,7 @@ subroutine clm_lake_copy_from_temporaries(data, Model, Sfcprop, Atm_block) Sfcprop(nb)%lake_t_grnd2d(ix) = data%lake_t_grnd2d(i,j) Sfcprop(nb)%lake_savedtke12d(ix) = data%lake_savedtke12d(i,j) Sfcprop(nb)%lake_dp2dsno(ix) = data%lake_dp2dsno(i,j) + Sfcprop(nb)%clm_lakedepth(ix) = data%clm_lakedepth(i,j) Sfcprop(nb)%clm_lake_initialized(ix) = data%clm_lake_initialized(i,j) Sfcprop(nb)%lake_z3d(ix,:) = data%lake_z3d(i,j,:) @@ -3000,6 +3004,8 @@ subroutine clm_lake_register_fields(data) dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart, 'lake_dp2dsno', data%lake_dp2dsno, & dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'clm_lakedepth', data%clm_lakedepth, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart, 'clm_lake_initialized', data%clm_lake_initialized, & dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) @@ -3072,6 +3078,7 @@ subroutine clm_lake_deallocate_data(data) IF_ASSOC_DEALLOC_NULL(lake_t_grnd2d) IF_ASSOC_DEALLOC_NULL(lake_savedtke12d) IF_ASSOC_DEALLOC_NULL(lake_dp2dsno) + IF_ASSOC_DEALLOC_NULL(clm_lakedepth) IF_ASSOC_DEALLOC_NULL(clm_lake_initialized) IF_ASSOC_DEALLOC_NULL(lake_z3d) From 342c0a7a96737e3ea7e43889deb5b4b689ebad5b Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 11 Oct 2022 18:53:52 +0000 Subject: [PATCH 19/74] unneeded commit to satisfy git's eccentricites --- ccpp/data/GFS_typedefs.F90 | 24 ++++++++++++++++++++++-- ccpp/data/GFS_typedefs.meta | 13 +++++++++++++ ccpp/physics | 2 +- io/FV3GFS_io.F90 | 9 ++++++++- 4 files changed, 44 insertions(+), 4 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index d923f098f..a6eefc612 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -212,6 +212,7 @@ module GFS_typedefs !--- In (lakes) real (kind=kind_phys), pointer :: lakefrac(:) => null() !< lake fraction [0:1] real (kind=kind_phys), pointer :: lakedepth(:) => null() !< lake depth [ m ] + real (kind=kind_phys), pointer :: clm_lakedepth(:) => null() !< clm internal lake depth [ m ] integer, pointer :: use_lake_model(:) => null()!1=run lake, 2=run lake&nsst, 0=no lake real (kind=kind_phys), pointer :: lake_t2m (:) => null() !< 2 meter temperature from CLM Lake model real (kind=kind_phys), pointer :: lake_q2m (:) => null() !< 2 meter humidity from CLM Lake model @@ -1209,6 +1210,7 @@ module GFS_typedefs !< nstf_name(5) : zsea2 in mm !--- fractional grid logical :: frac_grid !< flag for fractional grid + logical :: frac_ice !< flag for fractional ice when fractional grid is not in use logical :: ignore_lake !< flag for ignoring lakes real(kind=kind_phys) :: min_lakeice !< minimum lake ice value real(kind=kind_phys) :: min_seaice !< minimum sea ice value @@ -2136,6 +2138,8 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%t_bot1 (IM)) allocate (Sfcprop%t_bot2 (IM)) allocate (Sfcprop%c_t (IM)) + else + allocate (Sfcprop%clm_lakedepth(IM)) endif allocate (Sfcprop%T_snow (IM)) allocate (Sfcprop%T_ice (IM)) @@ -2186,6 +2190,8 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%t_bot1 = clear_val Sfcprop%t_bot2 = clear_val Sfcprop%c_t = clear_val + else + Sfcprop%clm_lakedepth = clear_val endif Sfcprop%T_snow = clear_val Sfcprop%T_ice = clear_val @@ -3487,6 +3493,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !< nstf_name(5) : zsea2 in mm !--- fractional grid logical :: frac_grid = .false. !< flag for fractional grid + logical :: frac_ice = .false. !< flag for fractional ice when fractional grid is not in use logical :: ignore_lake = .true. !< flag for ignoring lakes real(kind=kind_phys) :: min_lakeice = 0.15d0 !< minimum lake ice value real(kind=kind_phys) :: min_seaice = 1.0d-11 !< minimum sea ice value @@ -3717,7 +3724,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- near surface sea temperature model nst_anl, lsea, nstf_name, & frac_grid, min_lakeice, min_seaice, min_lake_height, & - ignore_lake, & + ignore_lake, frac_ice, & !--- surface layer sfc_z0_type, & !--- switch beteeen local and standard potential temperature @@ -4510,6 +4517,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- fractional grid Model%frac_grid = frac_grid + Model%frac_ice = frac_ice Model%ignore_lake = ignore_lake Model%min_lakeice = min_lakeice Model%min_seaice = min_seaice @@ -4729,6 +4737,18 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%ntocl = get_tracer_index(Model%tracer_names, 'oc2', Model%me, Model%master, Model%debug) end if + ! Lake & fractional grid safety checks + if(Model%me==Model%master) then + if(Model%lkm>0 .and. Model%frac_grid) then + write(0,*) 'WARNING: Lake fractional grid support is experimental. Use at your own risk!' + else if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm .and. .not. Model%frac_ice) then + write(0,*) 'WARNING: CLM Lake Model will not work without frac_ice=.true.' + endif + if(Model%lkm==2) then + write(0,*) 'WARNING: Running both lake and nsst on lake points is experimental. Use at your own risk!' + endif + endif + if(ldiag3d) then ! Flags used to turn on or off tracer "causes" have_pbl_edmf = Model%hybedmf .or. Model%satmedmf .or. Model%do_mynnedmf @@ -5236,7 +5256,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & ! endif print *,' nst_anl=',Model%nst_anl,' use_ufo=',Model%use_ufo,' frac_grid=',Model%frac_grid,& - ' ignore_lake=',ignore_lake + ' ignore_lake=',ignore_lake,' frac_ice=',Model%frac_ice print *,' min_lakeice=',Model%min_lakeice,' min_seaice=',Model%min_seaice, & 'min_lake_height=',Model%min_lake_height diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index d1bc5f333..059532ee6 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -619,6 +619,13 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys +[clm_lakedepth] + standard_name = clm_lake_depth + long_name = clm internal copy of lake depth with 10.0 replaced by default lake depth + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys [use_lake_model] standard_name = flag_for_using_lake_model long_name = flag indicating lake points using a lake model @@ -5256,6 +5263,12 @@ units = flag dimensions = () type = logical +[frac_ice] + standard_name = flag_for_fractional_ice_when_fractional_landmask_is_disabled + long_name = flag for fractional ice when fractional landmask is disabled + units = flag + dimensions = () + type = logical [min_lakeice] standard_name = min_lake_ice_area_fraction long_name = minimum lake ice value diff --git a/ccpp/physics b/ccpp/physics index 2014d7b54..9968755f4 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 2014d7b54491a965d462ab83f047fd9847c1f1d6 +Subproject commit 9968755f4dbba1157f535c51fee15ee3d736949e diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index fd43b3536..455101aba 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -122,7 +122,7 @@ module FV3GFS_io_mod ! All 2D variables needed for a restart real(kind_phys), pointer, private, dimension(:,:) :: & - lake_snl2d=>null(), lake_h2osno2d=>null(), lake_t_grnd2d=>null(), & + lake_snl2d=>null(), lake_h2osno2d=>null(), lake_t_grnd2d=>null(), clm_lakedepth=>null(), & lake_savedtke12d=>null(), lake_dp2dsno=>null(), clm_lake_initialized=>null() ! All 3D variables needed for a restart @@ -2737,6 +2737,7 @@ subroutine clm_lake_allocate_data(data,Model) allocate(data%lake_t_grnd2d(nx,ny)) allocate(data%lake_savedtke12d(nx,ny)) allocate(data%lake_dp2dsno(nx,ny)) + allocate(data%clm_lakedepth(nx,ny)) allocate(data%clm_lake_initialized(nx,ny)) allocate(data%lake_z3d(nx,ny,Model%nlevlake_clm_lake)) @@ -2854,6 +2855,7 @@ subroutine clm_lake_copy_to_temporaries(data, Model, Sfcprop, Atm_block) data%lake_t_grnd2d(i,j) = Sfcprop(nb)%lake_t_grnd2d(ix) data%lake_savedtke12d(i,j) = Sfcprop(nb)%lake_savedtke12d(ix) data%lake_dp2dsno(i,j) = Sfcprop(nb)%lake_dp2dsno(ix) + data%clm_lakedepth(i,j) = Sfcprop(nb)%clm_lakedepth(ix) data%clm_lake_initialized(i,j) = Sfcprop(nb)%clm_lake_initialized(ix) data%lake_z3d(i,j,:) = Sfcprop(nb)%lake_z3d(ix,:) @@ -2905,6 +2907,7 @@ subroutine clm_lake_fill_with_zero(data, Model, Sfcprop, Atm_block) data%lake_t_grnd2d(i,j) = 0 data%lake_savedtke12d(i,j) = 0 data%lake_dp2dsno(i,j) = 0 + data%clm_lakedepth(i,j) = 0 data%clm_lake_initialized(i,j) = 0 data%lake_z3d(i,j,:) = 0 @@ -2956,6 +2959,7 @@ subroutine clm_lake_copy_from_temporaries(data, Model, Sfcprop, Atm_block) Sfcprop(nb)%lake_t_grnd2d(ix) = data%lake_t_grnd2d(i,j) Sfcprop(nb)%lake_savedtke12d(ix) = data%lake_savedtke12d(i,j) Sfcprop(nb)%lake_dp2dsno(ix) = data%lake_dp2dsno(i,j) + Sfcprop(nb)%clm_lakedepth(ix) = data%clm_lakedepth(i,j) Sfcprop(nb)%clm_lake_initialized(ix) = data%clm_lake_initialized(i,j) Sfcprop(nb)%lake_z3d(ix,:) = data%lake_z3d(i,j,:) @@ -3000,6 +3004,8 @@ subroutine clm_lake_register_fields(data) dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart, 'lake_dp2dsno', data%lake_dp2dsno, & dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'clm_lakedepth', data%clm_lakedepth, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart, 'clm_lake_initialized', data%clm_lake_initialized, & dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) @@ -3072,6 +3078,7 @@ subroutine clm_lake_deallocate_data(data) IF_ASSOC_DEALLOC_NULL(lake_t_grnd2d) IF_ASSOC_DEALLOC_NULL(lake_savedtke12d) IF_ASSOC_DEALLOC_NULL(lake_dp2dsno) + IF_ASSOC_DEALLOC_NULL(clm_lakedepth) IF_ASSOC_DEALLOC_NULL(clm_lake_initialized) IF_ASSOC_DEALLOC_NULL(lake_z3d) From b255fa8ba193c0d068c28f0d0e6227b3e9e58c75 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 17 Oct 2022 22:27:15 +0000 Subject: [PATCH 20/74] more updates from tanya --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 789ddb933..3acd145d1 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 789ddb933c1e4ca238a31cabd8a26901230e972a +Subproject commit 3acd145d13e076e0dc5a55ace0975fc6070818d8 From e6b139e41516b50bcfc357310947c8f189e8bbea Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 20 Oct 2022 16:52:52 +0000 Subject: [PATCH 21/74] rework lake variables and add fractional ice --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 3acd145d1..833905039 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 3acd145d13e076e0dc5a55ace0975fc6070818d8 +Subproject commit 833905039101dc13ccf6a46ec94b47470f4b5a78 From 60981301561aa6556d8f2a4c62d8de6f0f3c0aad Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 20 Oct 2022 17:06:50 +0000 Subject: [PATCH 22/74] FV3_HRRR_clm_lake suite --- ccpp/suites/suite_FV3_HRRR_clm_lake.xml | 80 +++++++++++++++++++++++++ 1 file changed, 80 insertions(+) create mode 100644 ccpp/suites/suite_FV3_HRRR_clm_lake.xml diff --git a/ccpp/suites/suite_FV3_HRRR_clm_lake.xml b/ccpp/suites/suite_FV3_HRRR_clm_lake.xml new file mode 100644 index 000000000..f7873d68a --- /dev/null +++ b/ccpp/suites/suite_FV3_HRRR_clm_lake.xml @@ -0,0 +1,80 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + 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 + + + + mynnsfc_wrapper + GFS_surface_loop_control_part1 + lsm_ruc + clm_lake + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + mynnedmf_wrapper + GFS_GWD_generic_pre + drag_suite + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_suite_interstitial_4 + GFS_MP_generic_pre + mp_thompson_pre + mp_thompson + mp_thompson_post + GFS_MP_generic_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + From aec741393bf7cf1a8143311f5ecc7701b9df2320 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 20 Oct 2022 19:53:07 +0000 Subject: [PATCH 23/74] bug fixes to get fractional ice working --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 833905039..217a8bf49 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 833905039101dc13ccf6a46ec94b47470f4b5a78 +Subproject commit 217a8bf497c484842a0d26c3fa3425160d3f2e7e From b558b8c8f37094c3d9cf0594815417a7ded31509 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 24 Oct 2022 19:30:37 +0000 Subject: [PATCH 24/74] bug fixes for restart (not enough though) --- ccpp/data/GFS_typedefs.F90 | 14 ++++++++------ ccpp/data/GFS_typedefs.meta | 4 ++-- ccpp/driver/GFS_restart.F90 | 29 +++++++++++++++++++++++++++++ ccpp/physics | 2 +- 4 files changed, 40 insertions(+), 9 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index a6eefc612..f55af5ca8 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -2385,18 +2385,20 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%xlaixy = clear_val Sfcprop%rca = clear_val end if - if (Model%lsm == Model%lsm_ruc .or. Model%lsm == Model%lsm_noahmp) then - allocate(Sfcprop%raincprv (IM)) - allocate(Sfcprop%rainncprv (IM)) + if (Model%lsm == Model%lsm_ruc .or. Model%lsm == Model%lsm_noahmp .or. & + (Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm)) then + allocate(Sfcprop%raincprv (IM)) + allocate(Sfcprop%rainncprv (IM)) + Sfcprop%raincprv = clear_val + Sfcprop%rainncprv = clear_val + if (Model%lsm == Model%lsm_ruc .or. Model%lsm == Model%lsm_noahmp) then allocate(Sfcprop%iceprv (IM)) allocate(Sfcprop%snowprv (IM)) allocate(Sfcprop%graupelprv(IM)) - - Sfcprop%raincprv = clear_val - Sfcprop%rainncprv = clear_val Sfcprop%iceprv = clear_val Sfcprop%snowprv = clear_val Sfcprop%graupelprv = clear_val + end if end if ! Noah MP allocate and init when used ! diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 059532ee6..37371b285 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -1867,7 +1867,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .or. control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme) + active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .or. control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme .or. control_for_lake_model_selection == 2) [rainncprv] standard_name = lwe_thickness_of_explicit_precipitation_amount_on_previous_timestep long_name = explicit rainfall from previous timestep @@ -1875,7 +1875,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .or. control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme) + active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .or. control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme .or. control_for_lake_model_selection == 2) [iceprv] standard_name = lwe_thickness_of_ice_precipitation_amount_on_previous_timestep long_name = ice amount from previous timestep diff --git a/ccpp/driver/GFS_restart.F90 b/ccpp/driver/GFS_restart.F90 index e06a13dd1..2a2413b98 100644 --- a/ccpp/driver/GFS_restart.F90 +++ b/ccpp/driver/GFS_restart.F90 @@ -63,6 +63,7 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & integer :: ndiag_idx(20), itime integer :: nblks, num, nb, max_rstrt, offset character(len=2) :: c2 = '' + logical :: surface_layer_saves_rainprev nblks = size(Init_parm%blksz) max_rstrt = size(Restart%name2d) @@ -97,6 +98,12 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & Restart%ldiag = 3 + Model%ntot2d + Model%nctp + ndiag_rst Restart%num2d = 3 + Model%ntot2d + Model%nctp + ndiag_rst + ! The CLM Lake Model needs raincprev and rainncprv, which some + ! surface layer schemes save, and some don't. If the surface layer + ! scheme does not save that variable, then it'll be saved + ! separately for clm_lake. + surface_layer_saves_rainprev = .false. + ! GF if (Model%imfdeepcnv == Model%imfdeepcnv_gf) then Restart%num2d = Restart%num2d + 3 @@ -108,14 +115,22 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & ! NoahMP if (Model%lsm == Model%lsm_noahmp) then Restart%num2d = Restart%num2d + 10 + surface_layer_saves_rainprev = .true. endif ! RUC if (Model%lsm == Model%lsm_ruc) then Restart%num2d = Restart%num2d + 5 + surface_layer_saves_rainprev = .true. endif ! MYNN SFC if (Model%do_mynnsfclay) then Restart%num2d = Restart%num2d + 13 + surface_layer_saves_rainprev = .false. + endif + ! Save rain prev for lake if surface layer doesn't. + if (Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm .and. & + .not.surface_layer_saves_rainprev) then + Restart%num2d = Restart%num2d + 2 endif ! Thompson aerosol-aware if (Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then @@ -388,6 +403,20 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & Restart%data(nb,num)%var2p => Sfcprop(nb)%qss(:) enddo endif + ! Save rain prev for lake if surface layer doesn't. + if (Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm .and. & + .not.surface_layer_saves_rainprev) then + num = num + 1 + Restart%name2d(num) = 'raincprv' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Sfcprop(nb)%raincprv(:) + enddo + num = num + 1 + Restart%name2d(num) = 'rainncprv' + do nb = 1,nblks + Restart%data(nb,num)%var2p => Sfcprop(nb)%rainncprv(:) + enddo + endif ! Thompson aerosol-aware if (Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then num = num + 1 diff --git a/ccpp/physics b/ccpp/physics index 217a8bf49..c34a3d381 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 217a8bf497c484842a0d26c3fa3425160d3f2e7e +Subproject commit c34a3d381b5930d1a3f8eb83e9e5c163f4e24b31 From 45853f53c759e648a786c3f8b09332f729bd9a0d Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 21 Nov 2022 20:51:03 +0000 Subject: [PATCH 25/74] merge develop --- CMakeLists.txt | 8 +- README.md | 1 - atmos_cubed_sphere | 2 +- atmos_model.F90 | 70 ++- ccpp/data/CCPP_typedefs.F90 | 2 + ccpp/data/CCPP_typedefs.meta | 6 + ccpp/data/GFS_typedefs.F90 | 107 ++-- ccpp/data/GFS_typedefs.meta | 75 ++- ccpp/driver/GFS_diagnostics.F90 | 122 ++-- ccpp/physics | 2 +- ccpp/suites/suite_FV3_WoFS_v0.xml | 80 +++ cpl/module_block_data.F90 | 142 +++++ cpl/module_cplfields.F90 | 10 +- fv3_cap.F90 | 54 +- io/inline_post.F90 | 77 --- io/inline_post_stub.F90 | 57 -- io/module_write_internal_state.F90 | 32 +- io/module_wrt_grid_comp.F90 | 878 ++++++++++++++--------------- io/post_fv3.F90 | 405 +++++++------ io/post_nems_routines.F90 | 7 +- 20 files changed, 1196 insertions(+), 941 deletions(-) create mode 100644 ccpp/suites/suite_FV3_WoFS_v0.xml delete mode 100644 io/inline_post.F90 delete mode 100644 io/inline_post_stub.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index 967c3be82..ed34916b3 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -25,10 +25,8 @@ add_subdirectory(atmos_cubed_sphere) if(INLINE_POST) set(BUILD_POSTEXEC OFF) add_subdirectory(upp) - set(POST_SRC io/inline_post.F90 io/post_nems_routines.F90 io/post_fv3.F90) -else() - set(POST_SRC io/inline_post_stub.F90) - list(APPEND _fv3atm_defs_private NO_INLINE_POST) + set(POST_SRC io/post_nems_routines.F90 io/post_fv3.F90) + list(APPEND _fv3atm_defs_private INLINE_POST) endif() if(CCPP_32BIT) @@ -83,7 +81,7 @@ target_link_libraries(fv3atm PUBLIC fv3 stochastic_physics fms) -target_link_libraries(fv3atm PUBLIC w3nco::w3nco_d +target_link_libraries(fv3atm PUBLIC w3emc::w3emc_d sp::sp_d bacio::bacio_4 esmf) diff --git a/README.md b/README.md index 83df0fe66..56ef866d1 100644 --- a/README.md +++ b/README.md @@ -26,7 +26,6 @@ Laboratory](https://www.gfdl.noaa.gov/). This package requires the following [NCEPLIBS](https://github.com/NOAA-EMC/NCEPLIBS) packages: - - [NCEPLIBS-w3nco](https://github.com/NOAA-EMC/NCEPLIBS-w3nco) - [NCEPLIBS-w3emc](https://github.com/NOAA-EMC/NCEPLIBS-w3emc) - [NCEPLIBS-bacio](https://github.com/NOAA-EMC/NCEPLIBS-bacio) - [NCEPLIBS-nemsio](https://github.com/NOAA-EMC/NCEPLIBS-nemsio) diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere index 153cd903f..aa42f6e13 160000 --- a/atmos_cubed_sphere +++ b/atmos_cubed_sphere @@ -1 +1 @@ -Subproject commit 153cd903f8f95a7bc41fb242fe96fd7cdd4c2b64 +Subproject commit aa42f6e135839492b0a3b80fc3f2c25d766ad437 diff --git a/atmos_model.F90 b/atmos_model.F90 index faa1712bb..08e6c3981 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -1685,22 +1685,22 @@ subroutine update_atmos_chemistry(state, rc) enddo ! -- zero out accumulated fields + if (.not. GFS_control%cplflx .and. .not. GFS_control%cpllnd) then !$OMP parallel do default (none) & !$OMP shared (nj, ni, Atm_block, GFS_control, GFS_data) & !$OMP private (j, jb, i, ib, nb, ix) - do j = 1, nj - jb = j + Atm_block%jsc - 1 - do i = 1, ni - ib = i + Atm_block%isc - 1 - nb = Atm_block%blkno(ib,jb) - ix = Atm_block%ixp(ib,jb) - GFS_data(nb)%coupling%rainc_cpl(ix) = zero - if (.not.GFS_control%cplflx) then + do j = 1, nj + jb = j + Atm_block%jsc - 1 + do i = 1, ni + ib = i + Atm_block%isc - 1 + nb = Atm_block%blkno(ib,jb) + ix = Atm_block%ixp(ib,jb) + GFS_data(nb)%coupling%rainc_cpl(ix) = zero GFS_data(nb)%coupling%rain_cpl(ix) = zero GFS_data(nb)%coupling%snow_cpl(ix) = zero - end if + enddo enddo - enddo + end if if (GFS_control%debug) then ! -- diagnostics @@ -2884,7 +2884,6 @@ subroutine setup_exportdata(rc) ! Instantaneous u wind (m/s) 10 m above ground case ('inst_zonal_wind_height10m') call block_data_copy(datar82d, GFS_data(nb)%coupling%u10mi_cpl, Atm_block, nb, rc=localrc) - !call block_data_copy(datar82d, GFS_data(nb)%coupling%u10mi_cpl, Atm_block, nb, rc=localrc) ! Instantaneous v wind (m/s) 10 m above ground case ('inst_merid_wind_height10m') call block_data_copy(datar82d, GFS_data(nb)%coupling%v10mi_cpl, Atm_block, nb, rc=localrc) @@ -3006,6 +3005,9 @@ subroutine setup_exportdata(rc) ! MEAN precipitation rate (kg/m2/s) case ('mean_prec_rate') call block_data_copy(datar82d, GFS_data(nb)%coupling%rain_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc) + ! MEAN convective precipitation rate (kg/m2/s) + case ('mean_prec_rate_conv') + call block_data_copy(datar82d, GFS_Data(nb)%Coupling%rainc_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc) ! MEAN snow precipitation rate (kg/m2/s) case ('mean_fprec_rate') call block_data_copy(datar82d, GFS_data(nb)%coupling%snow_cpl, Atm_block, nb, scale_factor=rtimek, rc=localrc) @@ -3016,19 +3018,38 @@ subroutine setup_exportdata(rc) ! bottom layer temperature (t) case('inst_temp_height_lowest') call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%t_bot, zeror8, Atm_block, nb, rc=localrc) + case('inst_temp_height_lowest_from_phys') + call block_data_copy_or_fill(datar82d, GFS_data(nb)%Statein%tgrs, 1, zeror8, Atm_block, nb, rc=localrc) ! bottom layer specific humidity (q) ! ! ! CHECK if tracer 1 is for specific humidity ! ! ! case('inst_spec_humid_height_lowest') call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%tr_bot, 1, zeror8, Atm_block, nb, rc=localrc) + case('inst_spec_humid_height_lowest_from_phys') + call block_data_copy_or_fill(datar82d, GFS_data(nb)%Statein%qgrs, 1, GFS_Control%ntqv, zeror8, Atm_block, nb, rc=localrc) ! bottom layer zonal wind (u) case('inst_zonal_wind_height_lowest') call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%u_bot, zeror8, Atm_block, nb, rc=localrc) - ! bottom layer meridionalw wind (v) + ! bottom layer meridional wind (v) case('inst_merid_wind_height_lowest') call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%v_bot, zeror8, Atm_block, nb, rc=localrc) + ! bottom layer zonal wind (u) from physics + case('inst_zonal_wind_height_lowest_from_phys') + call block_data_copy_or_fill(datar82d, GFS_data(nb)%Statein%ugrs, 1, zeror8, Atm_block, nb, rc=localrc) + ! bottom layer meridional wind (v) from physics + case('inst_merid_wind_height_lowest_from_phys') + call block_data_copy_or_fill(datar82d, GFS_data(nb)%Statein%vgrs, 1, zeror8, Atm_block, nb, rc=localrc) + ! surface friction velocity + case('surface_friction_velocity') + call block_data_copy_or_fill(datar82d, GFS_data(nb)%Sfcprop%uustar, zeror8, Atm_block, nb, rc=localrc) ! bottom layer pressure (p) case('inst_pres_height_lowest') call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%p_bot, zeror8, Atm_block, nb, rc=localrc) + ! bottom layer pressure (p) from physics + case('inst_pres_height_lowest_from_phys') + call block_data_copy_or_fill(datar82d, GFS_data(nb)%Statein%prsl, 1, zeror8, Atm_block, nb, rc=localrc) + ! dimensionless exner function at surface adjacent layer + case('inst_exner_function_height_lowest') + call block_data_copy_or_fill(datar82d, GFS_data(nb)%Statein%prslk, 1, zeror8, Atm_block, nb, rc=localrc) ! bottom layer height (z) case('inst_height_lowest') call block_data_copy_or_fill(datar82d, DYCORE_data(nb)%coupling%z_bot, zeror8, Atm_block, nb, rc=localrc) @@ -3106,24 +3127,37 @@ subroutine setup_exportdata(rc) GFS_data(nb)%coupling%dvsfc_cpl(ix) = zero GFS_data(nb)%coupling%dtsfc_cpl(ix) = zero GFS_data(nb)%coupling%dqsfc_cpl(ix) = zero - GFS_data(nb)%coupling%dlwsfc_cpl(ix) = zero - GFS_data(nb)%coupling%dswsfc_cpl(ix) = zero - GFS_data(nb)%coupling%rain_cpl(ix) = zero GFS_data(nb)%coupling%nlwsfc_cpl(ix) = zero - GFS_data(nb)%coupling%nswsfc_cpl(ix) = zero GFS_data(nb)%coupling%dnirbm_cpl(ix) = zero GFS_data(nb)%coupling%dnirdf_cpl(ix) = zero GFS_data(nb)%coupling%dvisbm_cpl(ix) = zero GFS_data(nb)%coupling%dvisdf_cpl(ix) = zero + enddo + enddo + if (mpp_pe() == mpp_root_pe()) print *,'zeroing coupling accumulated fields at kdt= ',GFS_control%kdt + endif !cplflx +!--- + if (GFS_control%cplflx .or. GFS_control%cpllnd) then +! zero out accumulated fields +!$omp parallel do default(shared) private(i,j,nb,ix) + do j=jsc,jec + do i=isc,iec + nb = Atm_block%blkno(i,j) + ix = Atm_block%ixp(i,j) + GFS_data(nb)%coupling%dlwsfc_cpl(ix) = zero + GFS_data(nb)%coupling%dswsfc_cpl(ix) = zero + GFS_data(nb)%coupling%rain_cpl(ix) = zero + GFS_data(nb)%coupling%rainc_cpl(ix) = zero + GFS_data(nb)%coupling%snow_cpl(ix) = zero + GFS_data(nb)%coupling%nswsfc_cpl(ix) = zero GFS_data(nb)%coupling%nnirbm_cpl(ix) = zero GFS_data(nb)%coupling%nnirdf_cpl(ix) = zero GFS_data(nb)%coupling%nvisbm_cpl(ix) = zero GFS_data(nb)%coupling%nvisdf_cpl(ix) = zero - GFS_data(nb)%coupling%snow_cpl(ix) = zero enddo enddo if (mpp_pe() == mpp_root_pe()) print *,'zeroing coupling accumulated fields at kdt= ',GFS_control%kdt - endif !cplflx + endif !cplflx or cpllnd end subroutine setup_exportdata diff --git a/ccpp/data/CCPP_typedefs.F90 b/ccpp/data/CCPP_typedefs.F90 index 4d70de07b..e08111092 100644 --- a/ccpp/data/CCPP_typedefs.F90 +++ b/ccpp/data/CCPP_typedefs.F90 @@ -221,6 +221,7 @@ module CCPP_typedefs integer :: nday !< integer :: nf_aelw !< integer :: nf_aesw !< + integer :: nf_albd !< integer :: nn !< integer :: nsamftrac !< integer :: nscav !< @@ -986,6 +987,7 @@ subroutine gfs_interstitial_create (Interstitial, IM, Model) Interstitial%nbdsw = NBDSW Interstitial%nf_aelw = NF_AELW Interstitial%nf_aesw = NF_AESW + Interstitial%nf_albd = NF_ALBD Interstitial%nspc1 = NSPC1 if (Model%oz_phys .or. Model%oz_phys_2015) then Interstitial%oz_coeffp5 = oz_coeff+5 diff --git a/ccpp/data/CCPP_typedefs.meta b/ccpp/data/CCPP_typedefs.meta index f36f0e06f..0d6eba72c 100644 --- a/ccpp/data/CCPP_typedefs.meta +++ b/ccpp/data/CCPP_typedefs.meta @@ -1454,6 +1454,12 @@ units = count dimensions = () type = integer +[nf_albd] + standard_name = number_of_components_for_surface_albedo + long_name = number of IR/VIS/UV compinents for surface albedo + units = count + dimensions = () + type = integer [nn] standard_name = number_of_tracers_for_convective_transport long_name = number of tracers for convective transport diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index f55af5ca8..e70016467 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -722,6 +722,7 @@ module GFS_typedefs logical :: cplwav2atm !< default no wav->atm coupling logical :: cplaqm !< default no cplaqm collection logical :: cplchm !< default no cplchm collection + logical :: cpllnd !< default no cpllnd collection logical :: rrfs_smoke !< default no rrfs_smoke collection integer :: dust_smoke_rrtmg_band_number !< band number to affect in rrtmg_pre from smoke and dust logical :: use_cice_alb !< default .false. - i.e. don't use albedo imported from the ice model @@ -804,6 +805,9 @@ module GFS_typedefs logical :: norad_precip !< radiation precip flag for Ferrier/Moorthi logical :: lwhtr !< flag to output lw heating rate (Radtend%lwhc) logical :: swhtr !< flag to output sw heating rate (Radtend%swhc) + logical :: lrseeds !< flag to use host-provided random seeds + integer :: nrstreams !< number of random number streams in host-provided random seed array + logical :: lextop !< flag for using an extra top layer for radiation ! RRTMGP logical :: do_RRTMGP !< Use RRTMGP @@ -931,6 +935,7 @@ module GFS_typedefs !--- Thompson's microphysical parameters logical :: ltaerosol !< flag for aerosol version + logical :: mraerosol !< flag for merra2_aerosol_aware logical :: lradar !< flag for radar reflectivity real(kind=kind_phys) :: nsradar_reset !< seconds between resetting radar reflectivity calculation real(kind=kind_phys) :: ttendlim !< temperature tendency limiter per time step in K/s @@ -1564,6 +1569,7 @@ module GFS_typedefs integer, pointer :: icsdlw (:) => null() !< (rad. only) radiations. if isubcsw/isubclw (input to init) !< (rad. only) are set to 2, the arrays contains provided !< (rad. only) random seeds for sub-column clouds generators + integer, pointer :: rseeds (:,:) => null() !< (rad. only) random seeds provided by host !--- In real (kind=kind_phys), pointer :: ozpl (:,:,:) => null() !< ozone forcing data @@ -2689,7 +2695,7 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%tsfc_radtime = clear_val endif - if (Model%cplflx .or. Model%do_sppt .or. Model%cplchm .or. Model%ca_global) then + if (Model%cplflx .or. Model%do_sppt .or. Model%cplchm .or. Model%ca_global .or. Model%cpllnd) then allocate (Coupling%rain_cpl (IM)) allocate (Coupling%snow_cpl (IM)) Coupling%rain_cpl = clear_val @@ -2705,7 +2711,7 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%v10mi_cpl = clear_val endif - if (Model%cplflx .or. Model%cplchm) then + if (Model%cplflx .or. Model%cplchm .or. Model%cpllnd) then !--- instantaneous quantities allocate (Coupling%tsfci_cpl (IM)) Coupling%tsfci_cpl = clear_val @@ -2718,6 +2724,36 @@ subroutine coupling_create (Coupling, IM, Model) ! Coupling%zorlwav_cpl = clear_val ! endif + if (Model%cplflx .or. Model%cpllnd) then + allocate (Coupling%dlwsfc_cpl (IM)) + allocate (Coupling%dswsfc_cpl (IM)) + allocate (Coupling%psurfi_cpl (IM)) + allocate (Coupling%nswsfc_cpl (IM)) + allocate (Coupling%nswsfci_cpl (IM)) + allocate (Coupling%nnirbmi_cpl (IM)) + allocate (Coupling%nnirdfi_cpl (IM)) + allocate (Coupling%nvisbmi_cpl (IM)) + allocate (Coupling%nvisdfi_cpl (IM)) + allocate (Coupling%nnirbm_cpl (IM)) + allocate (Coupling%nnirdf_cpl (IM)) + allocate (Coupling%nvisbm_cpl (IM)) + allocate (Coupling%nvisdf_cpl (IM)) + + Coupling%dlwsfc_cpl = clear_val + Coupling%dswsfc_cpl = clear_val + Coupling%psurfi_cpl = clear_val + Coupling%nswsfc_cpl = clear_val + Coupling%nswsfci_cpl = clear_val + Coupling%nnirbmi_cpl = clear_val + Coupling%nnirdfi_cpl = clear_val + Coupling%nvisbmi_cpl = clear_val + Coupling%nvisdfi_cpl = clear_val + Coupling%nnirbm_cpl = clear_val + Coupling%nnirdf_cpl = clear_val + Coupling%nvisbm_cpl = clear_val + Coupling%nvisdf_cpl = clear_val + end if + if (Model%cplflx) then !--- incoming quantities allocate (Coupling%slimskin_cpl (IM)) @@ -2772,35 +2808,21 @@ subroutine coupling_create (Coupling, IM, Model) allocate (Coupling%dvsfc_cpl (IM)) allocate (Coupling%dtsfc_cpl (IM)) allocate (Coupling%dqsfc_cpl (IM)) - allocate (Coupling%dlwsfc_cpl (IM)) - allocate (Coupling%dswsfc_cpl (IM)) allocate (Coupling%dnirbm_cpl (IM)) allocate (Coupling%dnirdf_cpl (IM)) allocate (Coupling%dvisbm_cpl (IM)) allocate (Coupling%dvisdf_cpl (IM)) allocate (Coupling%nlwsfc_cpl (IM)) - allocate (Coupling%nswsfc_cpl (IM)) - allocate (Coupling%nnirbm_cpl (IM)) - allocate (Coupling%nnirdf_cpl (IM)) - allocate (Coupling%nvisbm_cpl (IM)) - allocate (Coupling%nvisdf_cpl (IM)) Coupling%dusfc_cpl = clear_val Coupling%dvsfc_cpl = clear_val Coupling%dtsfc_cpl = clear_val Coupling%dqsfc_cpl = clear_val - Coupling%dlwsfc_cpl = clear_val - Coupling%dswsfc_cpl = clear_val Coupling%dnirbm_cpl = clear_val Coupling%dnirdf_cpl = clear_val Coupling%dvisbm_cpl = clear_val Coupling%dvisdf_cpl = clear_val Coupling%nlwsfc_cpl = clear_val - Coupling%nswsfc_cpl = clear_val - Coupling%nnirbm_cpl = clear_val - Coupling%nnirdf_cpl = clear_val - Coupling%nvisbm_cpl = clear_val - Coupling%nvisdf_cpl = clear_val !--- instantaneous quantities allocate (Coupling%dusfci_cpl (IM)) @@ -2814,14 +2836,8 @@ subroutine coupling_create (Coupling, IM, Model) allocate (Coupling%dvisbmi_cpl (IM)) allocate (Coupling%dvisdfi_cpl (IM)) allocate (Coupling%nlwsfci_cpl (IM)) - allocate (Coupling%nswsfci_cpl (IM)) - allocate (Coupling%nnirbmi_cpl (IM)) - allocate (Coupling%nnirdfi_cpl (IM)) - allocate (Coupling%nvisbmi_cpl (IM)) - allocate (Coupling%nvisdfi_cpl (IM)) allocate (Coupling%t2mi_cpl (IM)) allocate (Coupling%q2mi_cpl (IM)) - allocate (Coupling%psurfi_cpl (IM)) allocate (Coupling%oro_cpl (IM)) allocate (Coupling%slmsk_cpl (IM)) @@ -2836,14 +2852,8 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%dvisbmi_cpl = clear_val Coupling%dvisdfi_cpl = clear_val Coupling%nlwsfci_cpl = clear_val - Coupling%nswsfci_cpl = clear_val - Coupling%nnirbmi_cpl = clear_val - Coupling%nnirdfi_cpl = clear_val - Coupling%nvisbmi_cpl = clear_val - Coupling%nvisdfi_cpl = clear_val Coupling%t2mi_cpl = clear_val Coupling%q2mi_cpl = clear_val - Coupling%psurfi_cpl = clear_val Coupling%oro_cpl = clear_val !< pointer to sfcprop%oro Coupling%slmsk_cpl = clear_val !< pointer to sfcprop%slmsk endif @@ -2874,17 +2884,20 @@ subroutine coupling_create (Coupling, IM, Model) if (Model%cplchm .or. Model%rrfs_smoke) then !--- outgoing instantaneous quantities allocate (Coupling%ushfsfci (IM)) - !--- accumulated convective rainfall - allocate (Coupling%rainc_cpl (IM)) ! -- instantaneous 3d fluxes of nonconvective ice and liquid precipitations allocate (Coupling%pfi_lsan (IM,Model%levs)) allocate (Coupling%pfl_lsan (IM,Model%levs)) - Coupling%rainc_cpl = clear_val Coupling%ushfsfci = clear_val Coupling%pfi_lsan = clear_val Coupling%pfl_lsan = clear_val endif + if (Model%cplchm .or. Model%rrfs_smoke .or. Model%cplflx .or. Model%cpllnd) then + !--- accumulated convective rainfall + allocate (Coupling%rainc_cpl (IM)) + Coupling%rainc_cpl = clear_val + end if + ! -- additional coupling options for air quality if (Model%cplaqm .and. .not.Model%cplflx) then !--- outgoing instantaneous quantities @@ -2952,7 +2965,7 @@ subroutine coupling_create (Coupling, IM, Model) endif !--- needed for Thompson's aerosol option - if(Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then + if(Model%imp_physics == Model%imp_physics_thompson .and. (Model%ltaerosol .or. Model%mraerosol)) then allocate (Coupling%nwfa2d (IM)) allocate (Coupling%nifa2d (IM)) Coupling%nwfa2d = clear_val @@ -3093,6 +3106,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: cplwav2atm = .false. !< default no cplwav2atm coupling logical :: cplaqm = .false. !< default no cplaqm collection logical :: cplchm = .false. !< default no cplchm collection + logical :: cpllnd = .false. !< default no cpllnd collection logical :: rrfs_smoke = .false. !< default no rrfs_smoke collection integer :: dust_smoke_rrtmg_band_number = 10!< band number to affect in rrtmg_pre from smoke and dust logical :: use_cice_alb = .false. !< default no cice albedo @@ -3152,6 +3166,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & logical :: norad_precip = .false. !< radiation precip flag for Ferrier/Moorthi logical :: lwhtr = .true. !< flag to output lw heating rate (Radtend%lwhc) logical :: swhtr = .true. !< flag to output sw heating rate (Radtend%swhc) + logical :: lrseeds = .false. !< flag to use host-provided random seeds + integer :: nrstreams = 2 !< number of random number streams in host-provided random seed array + logical :: lextop = .false. !< flag for using an extra top layer for radiation ! RRTMGP logical :: do_RRTMGP = .false. !< Use RRTMGP? character(len=128) :: active_gases = '' !< Character list of active gases used in RRTMGP @@ -3237,6 +3254,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- Thompson microphysical parameters logical :: ltaerosol = .false. !< flag for aerosol version + logical :: mraerosol = .false. !< flag for merra2_aerosol_aware logical :: lradar = .false. !< flag for radar reflectivity real(kind=kind_phys) :: nsradar_reset = -999.0 !< seconds between resetting radar reflectivity calculation, set to <0 for every time step real(kind=kind_phys) :: ttendlim = -999.0 !< temperature tendency limiter, set to <0 to deactivate @@ -3631,7 +3649,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & thermodyn_id, sfcpress_id, & !--- coupling parameters cplflx, cplice, cplocn2atm, cplwav, cplwav2atm, cplaqm, & - cplchm, cpl_imp_mrg, cpl_imp_dbg, rrfs_smoke, & + cplchm, cpllnd, cpl_imp_mrg, cpl_imp_dbg, rrfs_smoke, & use_cice_alb, dust_smoke_rrtmg_band_number, & #ifdef IDEA_PHYS lsidea, weimer_model, f107_kp_size, f107_kp_interval, & @@ -3654,7 +3672,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & use_LW_jacobian, doGP_lwscat, damp_LW_fluxadj, lfnc_k, & lfnc_p0, iovr_convcld, doGP_sgs_cnv, doGP_sgs_mynn, & ! IN CCN forcing - iccn, & + iccn, mraerosol, & !--- microphysical parameterizations imp_physics, psautco, prautco, evpco, wminco, & fprcp, pdfflag, mg_dcs, mg_qcvar, mg_ts_auto_ice, mg_rhmini, & @@ -3955,6 +3973,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%cplwav2atm = cplwav2atm Model%cplaqm = cplaqm Model%cplchm = cplchm .or. cplaqm + Model%cpllnd = cpllnd Model%use_cice_alb = use_cice_alb Model%cpl_imp_mrg = cpl_imp_mrg Model%cpl_imp_dbg = cpl_imp_dbg @@ -4062,6 +4081,9 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & Model%ccnorm = ccnorm Model%lwhtr = lwhtr Model%swhtr = swhtr + Model%lrseeds = lrseeds + Model%nrstreams = nrstreams + Model%lextop = (ltp > 0) ! RRTMGP Model%do_RRTMGP = do_RRTMGP @@ -4195,6 +4217,11 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- Thompson MP parameters Model%ltaerosol = ltaerosol + Model%mraerosol = mraerosol + if (Model%ltaerosol .and. Model%mraerosol) then + write(0,*) 'Logic error: Only one Thompson aerosol option can be true, either ltaerosol or mraerosol)' + stop + end if Model%lradar = lradar Model%nsradar_reset = nsradar_reset Model%ttendlim = ttendlim @@ -5518,6 +5545,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & end if if (Model%me == Model%master) print *,' Using Thompson double moment microphysics', & ' ltaerosol = ',Model%ltaerosol, & + ' mraerosol = ',Model%mraerosol, & ' ttendlim =',Model%ttendlim, & ' ext_diag_thompson =',Model%ext_diag_thompson, & ' dt_inner =',Model%dt_inner, & @@ -5909,6 +5937,7 @@ subroutine control_print(Model) print *, ' cplwav2atm : ', Model%cplwav2atm print *, ' cplaqm : ', Model%cplaqm print *, ' cplchm : ', Model%cplchm + print *, ' cpllnd : ', Model%cpllnd print *, ' rrfs_smoke : ', Model%rrfs_smoke print *, ' use_cice_alb : ', Model%use_cice_alb print *, ' cpl_imp_mrg : ', Model%cpl_imp_mrg @@ -5977,6 +6006,9 @@ subroutine control_print(Model) print *, ' norad_precip : ', Model%norad_precip print *, ' lwhtr : ', Model%lwhtr print *, ' swhtr : ', Model%swhtr + print *, ' lrseeds : ', Model%lrseeds + print *, ' nrstreams : ', Model%nrstreams + print *, ' lextop : ', Model%lextop if (Model%do_RRTMGP) then print *, ' rrtmgp_nrghice : ', Model%rrtmgp_nrghice print *, ' do_GPsw_Glw : ', Model%do_GPsw_Glw @@ -6019,6 +6051,7 @@ subroutine control_print(Model) if (Model%imp_physics == Model%imp_physics_wsm6 .or. Model%imp_physics == Model%imp_physics_thompson) then print *, ' Thompson microphysical parameters' print *, ' ltaerosol : ', Model%ltaerosol + print *, ' mraerosol : ', Model%mraerosol print *, ' lradar : ', Model%lradar print *, ' nsradar_reset : ', Model%nsradar_reset print *, ' lrefres : ', Model%lrefres @@ -6466,6 +6499,10 @@ subroutine tbd_create (Tbd, IM, Model) allocate (Tbd%icsdlw (IM)) Tbd%icsdsw = zero Tbd%icsdlw = zero + if (Model%lrseeds) then + allocate (Tbd%rseeds(IM,Model%nrstreams)) + Tbd%rseeds = zero + endif endif !--- DFI radar forcing @@ -6522,7 +6559,7 @@ subroutine tbd_create (Tbd, IM, Model) Tbd%acvb = clear_val Tbd%acvt = clear_val - if (Model%cplflx .or. Model%cplchm) then + if (Model%cplflx .or. Model%cplchm .or. Model%cpllnd) then allocate (Tbd%drain_cpl (IM)) allocate (Tbd%dsnow_cpl (IM)) Tbd%drain_cpl = clear_val diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 37371b285..2ade678ef 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -2282,7 +2282,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling .or. flag_for_stochastic_physics_perturbations .or. flag_for_chemistry_coupling .or. flag_for_global_cellular_automata) + active = (flag_for_surface_flux_coupling .or. flag_for_stochastic_physics_perturbations .or. flag_for_chemistry_coupling .or. flag_for_global_cellular_automata .or. flag_for_land_coupling) [rainc_cpl] standard_name = cumulative_lwe_thickness_of_convective_precipitation_amount_for_coupling long_name = total convective precipitation @@ -2290,7 +2290,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_chemistry_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_chemistry_coupling .or. flag_for_land_coupling) [snow_cpl] standard_name = cumulative_lwe_thickness_of_snow_amount_for_coupling long_name = total snow precipitation @@ -2298,7 +2298,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling .or. flag_for_stochastic_physics_perturbations .or. flag_for_chemistry_coupling .or. flag_for_global_cellular_automata) + active = (flag_for_surface_flux_coupling .or. flag_for_stochastic_physics_perturbations .or. flag_for_chemistry_coupling .or. flag_for_global_cellular_automata .or. flag_for_land_coupling) [dusfc_cpl] standard_name = cumulative_surface_x_momentum_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc x momentum flux multiplied by timestep @@ -2338,7 +2338,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_land_coupling) [dswsfc_cpl] standard_name = cumulative_surface_downwelling_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc downward sw flux multiplied by timestep @@ -2346,7 +2346,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_land_coupling) [dnirbm_cpl] standard_name = cumulative_surface_downwelling_direct_nir_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative sfc nir beam downward sw flux multiplied by timestep @@ -2394,7 +2394,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_land_coupling) [nnirbm_cpl] standard_name = cumulative_surface_net_downwelling_direct_nir_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net nir beam downward sw flux multiplied by timestep @@ -2402,7 +2402,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_land_coupling) [nnirdf_cpl] standard_name = cumulative_surface_net_downwellling_diffuse_nir_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net nir diff downward sw flux multiplied by timestep @@ -2410,7 +2410,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_land_coupling) [nvisbm_cpl] standard_name = cumulative_surface_net_downwelling_direct_uv_and_vis_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net uv+vis beam downward sw rad flux multiplied by timestep @@ -2418,7 +2418,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_land_coupling) [nvisdf_cpl] standard_name = cumulative_surface_net_downwelling_diffuse_uv_and_vis_shortwave_flux_for_coupling_multiplied_by_timestep long_name = cumulative net uv+vis diff downward sw rad flux multiplied by timestep @@ -2426,7 +2426,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_land_coupling) [dusfci_cpl] standard_name = surface_x_momentum_flux_for_coupling long_name = instantaneous sfc x momentum flux @@ -2522,7 +2522,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling .or. flag_for_land_coupling) [nnirbmi_cpl] standard_name = surface_net_downwelling_direct_nir_shortwave_flux_for_coupling long_name = instantaneous net nir beam sfc downward sw flux @@ -2530,7 +2530,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_land_coupling) [nnirdfi_cpl] standard_name = surface_net_downwelling_diffuse_nir_shortwave_flux_for_coupling long_name = instantaneous net nir diff sfc downward sw flux @@ -2538,7 +2538,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_land_coupling) [nvisbmi_cpl] standard_name = surface_net_downwelling_direct_uv_and_vis_shortwave_flux_for_coupling long_name = instantaneous net uv+vis beam downward sw flux @@ -2546,7 +2546,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_land_coupling) [nvisdfi_cpl] standard_name = surface_net_downwelling_diffuse_uv_and_vis_shortwave_flux_for_coupling long_name = instantaneous net uv+vis diff downward sw flux @@ -2554,7 +2554,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_land_coupling) [t2mi_cpl] standard_name = temperature_at_2m_for_coupling long_name = instantaneous T2m @@ -2602,7 +2602,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_air_quality_coupling .or. flag_for_land_coupling) [ulwsfcin_cpl] standard_name = surface_upwelling_longwave_flux_from_coupled_process long_name = surface upwelling LW flux for coupling @@ -3317,6 +3317,12 @@ units = flag dimensions = () type = logical +[cpllnd] + standard_name = flag_for_land_coupling + long_name = flag controlling cpllnd collection (default off) + units = flag + dimensions = () + type = logical [rrfs_smoke] standard_name = do_smoke_coupling long_name = flag controlling rrfs_smoke collection (default off) @@ -3592,6 +3598,24 @@ units = flag dimensions = () type = logical +[lrseeds] + standard_name = do_host_provided_random_seeds + long_name = flag to use host-provided random seeds + units = flag + dimensions = () + type = logical +[nrstreams] + standard_name = number_of_host_provided_random_number_streams + long_name = number of host-provided random number streams + units = count + dimensions = () + type = integer +[lextop] + standard_name = do_extra_top_layer_for_radiation + long_name = use an extra top layer for radiation + units = flag + dimensions = () + type = logical [active_gases] standard_name = active_gases_used_by_RRTMGP long_name = active gases used by RRTMGP @@ -4337,6 +4361,12 @@ units = flag dimensions = () type = logical +[mraerosol] + standard_name = do_merra2_aerosol_awareness + long_name = flag for merra2 aerosol-aware physics for example the thompson microphysics + units = flag + dimensions = () + type = logical [lradar] standard_name = flag_for_radar_reflectivity long_name = flag for radar reflectivity @@ -7022,6 +7052,13 @@ dimensions = (horizontal_loop_extent) type = integer active = (flag_for_lw_clouds_sub_grid_approximation == 2 .or. flag_for_sw_clouds_grid_approximation == 2) +[rseeds] + standard_name = random_number_seeds_from_host + long_name = random number seeds from host + units = none + dimensions = (horizontal_loop_extent, number_of_host_provided_random_number_streams) + type = integer + active = ((flag_for_lw_clouds_sub_grid_approximation == 2 .or. flag_for_sw_clouds_grid_approximation == 2) .and. do_host_provided_random_seeds) [tau_amf] standard_name = absolute_momentum_flux_due_to_nonorographic_gravity_wave_drag long_name = ngw_absolute_momentum_flux @@ -7142,7 +7179,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling .or. flag_for_chemistry_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_chemistry_coupling .or. flag_for_land_coupling) [dsnow_cpl] standard_name = tendency_of_lwe_thickness_of_snowfall_amount_on_dynamics_timestep_for_coupling long_name = change in show_cpl (coupling_type) @@ -7150,7 +7187,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (flag_for_surface_flux_coupling .or. flag_for_chemistry_coupling) + active = (flag_for_surface_flux_coupling .or. flag_for_chemistry_coupling .or. flag_for_land_coupling) [phy_fctd] standard_name = atmosphere_updraft_convective_mass_flux_at_cloud_base_by_cloud_type long_name = cloud base mass flux for CS convection @@ -9036,7 +9073,7 @@ [LTP] standard_name = extra_top_layer long_name = extra top layer for radiation - units = none + units = count dimensions = () type = integer [con_cliq] diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index c91f657e7..323248c86 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -929,6 +929,22 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%fluxr(:,39) enddo +!--- air quality diagnostics --- + if (Model%cplaqm) then + if (associated(IntDiag(1)%aod)) then + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'aod' + ExtDiag(idx)%desc = 'total aerosol optical depth at 550 nm' + ExtDiag(idx)%unit = 'numerical' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => IntDiag(nb)%aod + enddo + endif + endif + ! ! !--- accumulated diagnostics --- @@ -3684,51 +3700,77 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop !--------------------------aerosols if (Model%ntwa>0) then - idx = idx + 1 - ExtDiag(idx)%axes = 3 - ExtDiag(idx)%name = 'nwfa' - ExtDiag(idx)%desc = 'number concentration of water-friendly aerosols' - ExtDiag(idx)%unit = 'kg-1' - ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Statein(nb)%qgrs(:,:,Model%ntwa) - enddo + if (Model%ltaerosol) then + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'nwfa' + ExtDiag(idx)%desc = 'number concentration of water-friendly aerosols' + ExtDiag(idx)%unit = 'kg-1' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var3 => Statein(nb)%qgrs(:,:,Model%ntwa) + enddo - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'nwfa2d' - ExtDiag(idx)%desc = 'water-friendly surface aerosol source' - ExtDiag(idx)%unit = 'kg-1 s-1' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%nwfa2d - enddo + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'nwfa2d' + ExtDiag(idx)%desc = 'water-friendly surface aerosol source' + ExtDiag(idx)%unit = 'kg-1 s-1' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%nwfa2d + enddo + elseif (Model%mraerosol) then + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'nwfa' + ExtDiag(idx)%desc = 'number concentration of water-friendly aerosols' + ExtDiag(idx)%unit = 'kg-1' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var3 => Stateout(nb)%gq0(:,:,Model%ntwa) + enddo + endif endif if (Model%ntia>0) then - idx = idx + 1 - ExtDiag(idx)%axes = 3 - ExtDiag(idx)%name = 'nifa' - ExtDiag(idx)%desc = 'number concentration of ice-friendly aerosols' - ExtDiag(idx)%unit = 'kg-1' - ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Statein(nb)%qgrs(:,:,Model%ntia) - enddo + if (Model%ltaerosol) then + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'nifa' + ExtDiag(idx)%desc = 'number concentration of ice-friendly aerosols' + ExtDiag(idx)%unit = 'kg-1' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var3 => Statein(nb)%qgrs(:,:,Model%ntia) + enddo - idx = idx + 1 - ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'nifa2d' - ExtDiag(idx)%desc = 'ice-friendly surface aerosol source' - ExtDiag(idx)%unit = 'kg-1 s-1' - ExtDiag(idx)%mod_name = 'gfs_sfc' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%nifa2d - enddo + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'nifa2d' + ExtDiag(idx)%desc = 'ice-friendly surface aerosol source' + ExtDiag(idx)%unit = 'kg-1 s-1' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%nifa2d + enddo + else if (Model%mraerosol) then + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'nifa' + ExtDiag(idx)%desc = 'number concentration of ice-friendly aerosols' + ExtDiag(idx)%unit = 'kg-1' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var3 => Stateout(nb)%gq0(:,:,Model%ntia) + enddo + end if endif ! Extended diagnostics from Thompson MP diff --git a/ccpp/physics b/ccpp/physics index c34a3d381..5709bfab9 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit c34a3d381b5930d1a3f8eb83e9e5c163f4e24b31 +Subproject commit 5709bfab97793ec6ec38e312013bd0b79735c130 diff --git a/ccpp/suites/suite_FV3_WoFS_v0.xml b/ccpp/suites/suite_FV3_WoFS_v0.xml new file mode 100644 index 000000000..1a34ba1a1 --- /dev/null +++ b/ccpp/suites/suite_FV3_WoFS_v0.xml @@ -0,0 +1,80 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + 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 + + + + mynnsfc_wrapper + 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 + mynnedmf_wrapper + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_MP_generic_pre + mp_nssl + GFS_MP_generic_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + diff --git a/cpl/module_block_data.F90 b/cpl/module_block_data.F90 index ff91f6633..1149bd252 100644 --- a/cpl/module_block_data.F90 +++ b/cpl/module_block_data.F90 @@ -17,12 +17,14 @@ module module_block_data module procedure block_copy_2d_r8_to_3d_r8 module procedure block_copy_3d_r8_to_3d_r8 module procedure block_copy_1dslice_r8_to_2d_r8 + module procedure block_copy_1dslice2_r8_to_2d_r8 module procedure block_copy_3dslice_r8_to_3d_r8 module procedure block_copy_1d_r4_to_2d_r8 module procedure block_copy_2d_r4_to_2d_r8 module procedure block_copy_2d_r4_to_3d_r8 module procedure block_copy_3d_r4_to_3d_r8 module procedure block_copy_1dslice_r4_to_2d_r8 + module procedure block_copy_1dslice2_r4_to_2d_r8 module procedure block_copy_3dslice_r4_to_3d_r8 end interface block_data_copy @@ -35,9 +37,11 @@ module module_block_data module procedure block_copy_or_fill_1d_r8_to_2d_r8 module procedure block_copy_or_fill_2d_r8_to_3d_r8 module procedure block_copy_or_fill_1dslice_r8_to_2d_r8 + module procedure block_copy_or_fill_1dslice2_r8_to_2d_r8 module procedure block_copy_or_fill_1d_r4_to_2d_r8 module procedure block_copy_or_fill_2d_r4_to_3d_r8 module procedure block_copy_or_fill_1dslice_r4_to_2d_r8 + module procedure block_copy_or_fill_1dslice2_r4_to_2d_r8 end interface block_data_copy_or_fill interface block_data_combine_fractions @@ -178,6 +182,48 @@ subroutine block_copy_1dslice_r8_to_2d_r8(destin_ptr, source_ptr, slice, block, end subroutine block_copy_1dslice_r8_to_2d_r8 + ! -- copy: 1D slice to 2D + + subroutine block_copy_1dslice2_r8_to_2d_r8(destin_ptr, source_ptr, slice1, slice2, block, block_index, scale_factor, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + real(kind=8), pointer :: source_ptr(:,:,:) + integer, intent(in) :: slice1 + integer, intent(in) :: slice2 + type (block_control_type), intent(in) :: block + integer, intent(in) :: block_index + real(kind=8), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb + real(kind=8) :: factor + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr) .and. associated(source_ptr)) then + localrc = ESMF_RC_VAL_OUTOFRANGE + if (slice1 > 0 .and. slice1 <= size(source_ptr, dim=2) .and. slice2 > 0 .and. slice2 <= size(source_ptr, dim=3)) then + factor = 1._8 + if (present(scale_factor)) factor = scale_factor +!$omp parallel do private(ix,ib,jb,i,j) + do ix = 1, block%blksz(block_index) + ib = block%index(block_index)%ii(ix) + jb = block%index(block_index)%jj(ix) + i = ib - block%isc + 1 + j = jb - block%jsc + 1 + destin_ptr(i,j) = factor * source_ptr(ix,slice1,slice2) + enddo + localrc = ESMF_SUCCESS + end if + end if + + if (present(rc)) rc = localrc + + end subroutine block_copy_1dslice2_r8_to_2d_r8 + ! -- copy: 2D to 3D subroutine block_copy_2d_r8_to_3d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) @@ -568,6 +614,33 @@ subroutine block_copy_or_fill_1dslice_r8_to_2d_r8(destin_ptr, source_ptr, slice, end subroutine block_copy_or_fill_1dslice_r8_to_2d_r8 + ! -- copy/fill: 1D slice to 2D + + subroutine block_copy_or_fill_1dslice2_r8_to_2d_r8(destin_ptr, source_ptr, slice1, slice2, fill_value, block, block_index, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + real(kind=8), pointer :: source_ptr(:,:,:) + integer, intent(in) :: slice1 + integer, intent(in) :: slice2 + real(ESMF_KIND_R8), intent(in) :: fill_value + type (block_control_type), intent(in) :: block + integer, intent(in) :: block_index + integer, optional, intent(out) :: rc + + ! -- begin + if (present(rc)) rc = ESMF_RC_PTR_NOTALLOC + + if (associated(destin_ptr)) then + if (associated(source_ptr)) then + call block_copy_1dslice2_r8_to_2d_r8(destin_ptr, source_ptr, slice1, slice2, block, block_index, rc=rc) + else + call block_fill_2d_r8(destin_ptr, fill_value, block, block_index, rc=rc) + end if + end if + + end subroutine block_copy_or_fill_1dslice2_r8_to_2d_r8 + ! -- copy/fill: 2D to 3D subroutine block_copy_or_fill_2d_r8_to_3d_r8(destin_ptr, source_ptr, fill_value, block, block_index, rc) @@ -712,6 +785,48 @@ subroutine block_copy_1dslice_r4_to_2d_r8(destin_ptr, source_ptr, slice, block, end subroutine block_copy_1dslice_r4_to_2d_r8 + ! -- copy: 1D slice to 2D + + subroutine block_copy_1dslice2_r4_to_2d_r8(destin_ptr, source_ptr, slice1, slice2, block, block_index, scale_factor, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + real(kind=4), pointer :: source_ptr(:,:,:) + integer, intent(in) :: slice1 + integer, intent(in) :: slice2 + type (block_control_type), intent(in) :: block + integer, intent(in) :: block_index + real(kind=4), optional, intent(in) :: scale_factor + integer, optional, intent(out) :: rc + + ! -- local variables + integer :: localrc + integer :: i, ib, ix, j, jb + real(kind=4) :: factor + + ! -- begin + localrc = ESMF_RC_PTR_NOTALLOC + if (associated(destin_ptr) .and. associated(source_ptr)) then + localrc = ESMF_RC_VAL_OUTOFRANGE + if (slice1 > 0 .and. slice1 <= size(source_ptr, dim=2) .and. slice2 > 0 .and. slice2 <= size(source_ptr, dim=3)) then + factor = 1._4 + if (present(scale_factor)) factor = scale_factor +!$omp parallel do private(ix,ib,jb,i,j) + do ix = 1, block%blksz(block_index) + ib = block%index(block_index)%ii(ix) + jb = block%index(block_index)%jj(ix) + i = ib - block%isc + 1 + j = jb - block%jsc + 1 + destin_ptr(i,j) = factor * source_ptr(ix,slice1,slice2) + enddo + localrc = ESMF_SUCCESS + end if + end if + + if (present(rc)) rc = localrc + + end subroutine block_copy_1dslice2_r4_to_2d_r8 + ! -- copy: 2D to 3D subroutine block_copy_2d_r4_to_3d_r8(destin_ptr, source_ptr, block, block_index, scale_factor, rc) @@ -1034,6 +1149,33 @@ subroutine block_copy_or_fill_1dslice_r4_to_2d_r8(destin_ptr, source_ptr, slice, end subroutine block_copy_or_fill_1dslice_r4_to_2d_r8 + ! -- copy/fill: 1D slice to 2D + + subroutine block_copy_or_fill_1dslice2_r4_to_2d_r8(destin_ptr, source_ptr, slice1, slice2, fill_value, block, block_index, rc) + + ! -- arguments + real(ESMF_KIND_R8), pointer :: destin_ptr(:,:) + real(kind=4), pointer :: source_ptr(:,:,:) + integer, intent(in) :: slice1 + integer, intent(in) :: slice2 + real(ESMF_KIND_R8), intent(in) :: fill_value + type (block_control_type), intent(in) :: block + integer, intent(in) :: block_index + integer, optional, intent(out) :: rc + + ! -- begin + if (present(rc)) rc = ESMF_RC_PTR_NOTALLOC + + if (associated(destin_ptr)) then + if (associated(source_ptr)) then + call block_copy_1dslice2_r4_to_2d_r8(destin_ptr, source_ptr, slice1, slice2, block, block_index, rc=rc) + else + call block_fill_2d_r8(destin_ptr, fill_value, block, block_index, rc=rc) + end if + end if + + end subroutine block_copy_or_fill_1dslice2_r4_to_2d_r8 + ! -- copy/fill: 2D to 3D subroutine block_copy_or_fill_2d_r4_to_3d_r8(destin_ptr, source_ptr, fill_value, block, block_index, rc) diff --git a/cpl/module_cplfields.F90 b/cpl/module_cplfields.F90 index 48c430eaa..56eb372ad 100644 --- a/cpl/module_cplfields.F90 +++ b/cpl/module_cplfields.F90 @@ -26,7 +26,7 @@ module module_cplfields ! l : model levels (3D) ! s : surface (2D) ! t : tracers (4D) - integer, public, parameter :: NexportFields = 111 + integer, public, parameter :: NexportFields = 119 type(ESMF_Field), target, public :: exportFields(NexportFields) type(FieldInfo), dimension(NexportFields), public, parameter :: exportFieldsInfo = [ & @@ -116,6 +116,14 @@ module module_cplfields FieldInfo("leaf_area_index ", "s"), & FieldInfo("temperature_of_soil_layer ", "g"), & FieldInfo("height ", "s"), & + FieldInfo("inst_zonal_wind_height_lowest_from_phys ", "s"), & + FieldInfo("inst_merid_wind_height_lowest_from_phys ", "s"), & + FieldInfo("inst_pres_height_lowest_from_phys ", "s"), & + FieldInfo("inst_spec_humid_height_lowest_from_phys ", "s"), & + FieldInfo("mean_prec_rate_conv ", "s"), & + FieldInfo("inst_temp_height_lowest_from_phys ", "s"), & + FieldInfo("inst_exner_function_height_lowest ", "s"), & + FieldInfo("surface_friction_velocity ", "s"), & ! For JEDI diff --git a/fv3_cap.F90 b/fv3_cap.F90 index 3f09cbf3b..b647414a8 100644 --- a/fv3_cap.F90 +++ b/fv3_cap.F90 @@ -205,6 +205,8 @@ subroutine InitializeAdvertise(gcomp, rc) real(kind=8) :: MPI_Wtime, timeis, timerhs integer :: wrttasks_per_group_from_parent, wrtLocalPet + character(len=64) :: rh_filename + logical :: use_saved_routehandles, rh_file_exist ! !------------------------------------------------------------------------ @@ -280,6 +282,11 @@ subroutine InitializeAdvertise(gcomp, rc) ! nfhout = 0 ; nfhmax_hf = 0 ; nfhout_hf = 0 ; nsout = 0 if ( quilting ) then + call ESMF_ConfigGetAttribute(config=CF,value=use_saved_routehandles, & + label ='use_saved_routehandles:', & + default=.false., rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_ConfigGetAttribute(config=CF,value=write_groups, & label ='write_groups:',rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return @@ -696,22 +703,39 @@ subroutine InitializeAdvertise(gcomp, rc) call ESMF_LogWrite(msgString, ESMF_LOGMSG_INFO, rc=rc) if (i==1) then - ! this is a Store() for the first wrtComp -> must do the Store() - call ESMF_TraceRegionEnter("ESMF_FieldBundleRegridStore()", rc=rc) - call ESMF_FieldBundleRegridStore(fcstFB(j), wrtFB(j,1), & - regridMethod=regridmethod, routehandle=routehandle(j,1), & - unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & - srcTermProcessing=isrcTermProcessing, rc=rc) - -! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (rc /= ESMF_SUCCESS) then - write(0,*)'fv3_cap.F90:InitializeAdvertise error in ESMF_FieldBundleRegridStore' - call ESMF_LogWrite('fv3_cap.F90:InitializeAdvertise error in ESMF_FieldBundleRegridStore', ESMF_LOGMSG_ERROR, rc=rc) - call ESMF_Finalize(endflag=ESMF_END_ABORT) + write(rh_filename,'(A,I2.2)') 'routehandle_fb', j + + inquire(FILE=trim(rh_filename), EXIST=rh_file_exist) + + if (rh_file_exist .and. use_saved_routehandles) then + if(mype==0) print *,'in fv3cap init, routehandle file ',trim(rh_filename), ' exists' + routehandle(j,1) = ESMF_RouteHandleCreate(fileName=trim(rh_filename), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else + ! this is a Store() for the first wrtComp -> must do the Store() + call ESMF_TraceRegionEnter("ESMF_FieldBundleRegridStore()", rc=rc) + call ESMF_FieldBundleRegridStore(fcstFB(j), wrtFB(j,1), & + regridMethod=regridmethod, routehandle=routehandle(j,1), & + unmappedaction=ESMF_UNMAPPEDACTION_IGNORE, & + srcTermProcessing=isrcTermProcessing, rc=rc) + + ! if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (rc /= ESMF_SUCCESS) then + write(0,*)'fv3_cap.F90:InitializeAdvertise error in ESMF_FieldBundleRegridStore' + call ESMF_LogWrite('fv3_cap.F90:InitializeAdvertise error in ESMF_FieldBundleRegridStore', ESMF_LOGMSG_ERROR, rc=rc) + call ESMF_Finalize(endflag=ESMF_END_ABORT) + endif + call ESMF_TraceRegionExit("ESMF_FieldBundleRegridStore()", rc=rc) + call ESMF_LogWrite('af FieldBundleRegridStore', ESMF_LOGMSG_INFO, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + + if (use_saved_routehandles) then + call ESMF_RouteHandleWrite(routehandle(j,1), fileName=trim(rh_filename), rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if(mype==0) print *,'in fv3cap init, saved routehandle file ',trim(rh_filename) + endif + endif - call ESMF_TraceRegionExit("ESMF_FieldBundleRegridStore()", rc=rc) - call ESMF_LogWrite('af FieldBundleRegridStore', ESMF_LOGMSG_INFO, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return originPetList(1:num_pes_fcst) = fcstPetList(:) originPetList(num_pes_fcst+1:) = petList(:) diff --git a/io/inline_post.F90 b/io/inline_post.F90 deleted file mode 100644 index 57b9f8d5d..000000000 --- a/io/inline_post.F90 +++ /dev/null @@ -1,77 +0,0 @@ -!----------------------------------------------------------------------- -!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -!----------------------------------------------------------------------- -! -module inline_post - - use module_fv3_io_def, only : wrttasks_per_group,filename_base, & - output_grid - use write_internal_state, only : wrt_internal_state - use post_fv3, only : post_getattr_fv3, post_run_fv3 - - implicit none - - public inline_post_run, inline_post_getattr - - contains - - subroutine inline_post_run(wrt_int_state,grid_id,mypei,mpicomp,lead_write, & - mynfhr,mynfmin,mynfsec) -! -! revision history: -! Jul 2019 J. Wang create interface to run inline post for FV3 -! Apr 2022 W. Meng unify global and regional inline posts -! -! -!----------------------------------------------------------------------- -! - implicit none -! -!----------------------------------------------------------------------- -! - type(wrt_internal_state),intent(in) :: wrt_int_state - integer,intent(in) :: grid_id - integer,intent(in) :: mypei - integer,intent(in) :: mpicomp - integer,intent(in) :: lead_write - integer,intent(in) :: mynfhr - integer,intent(in) :: mynfmin - integer,intent(in) :: mynfsec -! - if(mypei == 0) print *,'inline_post_run, output_grid=',trim(output_grid(grid_id)), & - ', call post_run_fv3' - if(trim(output_grid(grid_id)) == 'gaussian_grid' & - .or. trim(output_grid(grid_id)) == 'global_latlon' & - .or. trim(output_grid(grid_id)) == 'regional_latlon' & - .or. trim(output_grid(grid_id)) == 'rotated_latlon' & - .or. trim(output_grid(grid_id)) == 'lambert_conformal') then - call post_run_fv3(wrt_int_state, mypei, mpicomp, lead_write, & - mynfhr, mynfmin,mynfsec) - endif - -! - end subroutine inline_post_run -! -!----------------------------------------------------------------------- -! - subroutine inline_post_getattr(wrt_int_state,grid_id) -! - use esmf -! - implicit none -! - type(wrt_internal_state),intent(inout) :: wrt_int_state - integer, intent(in) :: grid_id -! - if(trim(output_grid(grid_id)) == 'gaussian_grid' & - .or. trim(output_grid(grid_id)) == 'global_latlon' & - .or. trim(output_grid(grid_id)) == 'regional_latlon' & - .or. trim(output_grid(grid_id)) == 'rotated_latlon' & - .or. trim(output_grid(grid_id)) == 'lambert_conformal') then - call post_getattr_fv3(wrt_int_state,grid_id) - endif -! - end subroutine inline_post_getattr - - - end module inline_post diff --git a/io/inline_post_stub.F90 b/io/inline_post_stub.F90 deleted file mode 100644 index 40ad2a203..000000000 --- a/io/inline_post_stub.F90 +++ /dev/null @@ -1,57 +0,0 @@ -!----------------------------------------------------------------------- -!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -!----------------------------------------------------------------------- -! -module inline_post - - use module_fv3_io_def, only : wrttasks_per_group,filename_base - use write_internal_state, only : wrt_internal_state - - implicit none - - public inline_post_run, inline_post_getattr - - contains - - subroutine inline_post_run(wrt_int_state,grid_id,mypei,mpicomp,lead_write, & - mynfhr,mynfmin,mynfsec) -! -! revision history: -! Oct 2020 J. Wang create interface to run inline post -! -! -!----------------------------------------------------------------------- -! - implicit none -! -!----------------------------------------------------------------------- -! - type(wrt_internal_state),intent(in) :: wrt_int_state - integer,intent(in) :: mypei - integer,intent(in) :: grid_id - integer,intent(in) :: mpicomp - integer,intent(in) :: lead_write - integer,intent(in) :: mynfhr - integer,intent(in) :: mynfmin - integer,intent(in) :: mynfsec -! - print *,'in stub inline_post_run - not supported on this machine, return' -! - end subroutine inline_post_run -! -!----------------------------------------------------------------------- -! - subroutine inline_post_getattr(wrt_int_state,grid_id) -! - implicit none -! - type(wrt_internal_state),intent(inout) :: wrt_int_state - integer,intent(in) :: grid_id -! -! - print *,'in stub inline_post_getattr - not supported on this machine, return' -! - end subroutine inline_post_getattr - - - end module inline_post diff --git a/io/module_write_internal_state.F90 b/io/module_write_internal_state.F90 index b370793e1..28e41b1cf 100644 --- a/io/module_write_internal_state.F90 +++ b/io/module_write_internal_state.F90 @@ -19,6 +19,15 @@ module write_internal_state ! !----------------------------------------------------------------------- ! + type output_grid_info + integer :: im, jm, lm + integer :: i_start,i_end, j_start,j_end + real,dimension(:,:),allocatable :: lonPtr, latPtr + integer,dimension(:),allocatable :: i_start_wrtgrp, i_end_wrtgrp, j_start_wrtgrp, j_end_wrtgrp + real :: latse, latnw, lonse, lonnw + real :: latstart, latlast, lonstart, lonlast + end type output_grid_info + type wrt_internal_state !-------------------------------- @@ -31,27 +40,9 @@ module write_internal_state !-------------------- !*** grid information !-------------------- - character(64) :: output_grid type(esmf_grid) :: wrtgrid -! -!----------------------------- -!*** full domain information -!----------------------------- -! - integer :: im - integer :: jm - integer :: lm -! -!----------------------------- -!*** subdomain domain information -!----------------------------- -! - integer :: lat_start, lon_start - integer :: lat_end, lon_end - real :: latstart, latlast, lonstart, lonlast - integer,dimension(:),allocatable :: lat_start_wrtgrp, lon_start_wrtgrp - integer,dimension(:),allocatable :: lat_end_wrtgrp, lon_end_wrtgrp - real,dimension(:,:),allocatable :: lonPtr, latPtr + + type(output_grid_info) ,dimension(:), allocatable :: out_grid_info ! !-------------------------- !*** file bundle for output @@ -95,7 +86,6 @@ module write_internal_state logical :: write_dopost character(80) :: post_namelist ! - integer :: post_maptype integer :: fhzero integer :: ntrac integer :: ncld diff --git a/io/module_wrt_grid_comp.F90 b/io/module_wrt_grid_comp.F90 index 5bfb1486d..ff142b559 100644 --- a/io/module_wrt_grid_comp.F90 +++ b/io/module_wrt_grid_comp.F90 @@ -42,7 +42,9 @@ module module_wrt_grid_comp ideflate, lflname_fulltime use module_write_netcdf, only : write_netcdf use physcons, only : pi => con_pi - use inline_post, only : inline_post_run, inline_post_getattr +#ifdef INLINE_POST + use post_fv3, only : post_run_fv3 +#endif ! !----------------------------------------------------------------------- ! @@ -59,6 +61,7 @@ module module_wrt_grid_comp integer,save :: last_write_task !<-- Rank of the last write task in the write group integer,save :: ntasks !<-- # of write tasks in the current group integer,save :: itasks, jtasks !<-- # of write tasks in i/j direction in the current group + integer,save :: ngrids integer,save :: wrt_mpi_comm !<-- the mpi communicator in the write comp integer,save :: idate(7) @@ -133,7 +136,6 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, !*** INITIALIZE THE WRITE GRIDDED COMPONENT. !----------------------------------------------------------------------- ! - use ctlblk_mod, only: numx type(esmf_GridComp) :: wrt_comp type(ESMF_State) :: imp_state_write, exp_state_write type(esmf_Clock) :: clock @@ -198,7 +200,7 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, ! logical :: lprnt - integer :: ngrids, grid_id + integer :: grid_id logical :: top_parent_is_global ! !----------------------------------------------------------------------- @@ -265,16 +267,17 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, line=__LINE__, file=__FILE__)) return if( wrt_int_state%write_dopost ) then -#ifdef NO_INLINE_POST +#ifdef INLINE_POST + call ESMF_ConfigGetAttribute(config=CF,value=wrt_int_state%post_namelist,default='itag', & + label ='post_namelist:',rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return +#else rc = ESMF_RC_NOT_IMPL print *,'inline post not available on this machine' if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return #endif - call ESMF_ConfigGetAttribute(config=CF,value=wrt_int_state%post_namelist,default='itag', & - label ='post_namelist:',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & - line=__LINE__, file=__FILE__)) return endif allocate(output_file(num_files)) @@ -345,6 +348,8 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, allocate(ideflate(ngrids)) allocate(nbits(ngrids)) + allocate(wrt_int_state%out_grid_info(ngrids)) + do n=1, ngrids if (n == 1) then @@ -358,461 +363,408 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return end if - if (allocated(wrt_int_state%lat_start_wrtgrp)) deallocate (wrt_int_state%lat_start_wrtgrp) - if (allocated(wrt_int_state%lat_end_wrtgrp )) deallocate (wrt_int_state%lat_end_wrtgrp ) - if (allocated(wrt_int_state%lon_start_wrtgrp)) deallocate (wrt_int_state%lon_start_wrtgrp) - if (allocated(wrt_int_state%lon_end_wrtgrp )) deallocate (wrt_int_state%lon_end_wrtgrp ) - if (allocated(wrt_int_state%latPtr) ) deallocate (wrt_int_state%latPtr) - if (allocated(wrt_int_state%lonPtr) ) deallocate (wrt_int_state%lonPtr) - - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=output_grid(n), label ='output_grid:',rc=rc) - if (lprnt) then - print *,'grid_id= ', n, ' output_grid= ', trim(output_grid(n)) - end if + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=output_grid(n), label ='output_grid:',rc=rc) + if (lprnt) then + print *,'grid_id= ', n, ' output_grid= ', trim(output_grid(n)) + end if - call ESMF_ConfigGetAttribute(config=CF, value=itasks,default=1,label ='itasks:',rc=rc) - jtasks = ntasks - if(itasks > 0 ) jtasks = ntasks/itasks - if( itasks*jtasks /= ntasks ) then - itasks = 1 + call ESMF_ConfigGetAttribute(config=CF, value=itasks,default=1,label ='itasks:',rc=rc) jtasks = ntasks - endif - numx = itasks - if (lprnt) print *,'jtasks=',jtasks,' itasks=',itasks,' numx=',numx + if(itasks > 0 ) jtasks = ntasks/itasks + if( itasks*jtasks /= ntasks ) then + itasks = 1 + jtasks = ntasks + endif - if (trim(output_grid(n)) == 'gaussian_grid' .or. trim(output_grid(n)) == 'global_latlon') then - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=imo(n), label ='imo:',rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=jmo(n), label ='jmo:',rc=rc) - if (lprnt) then - print *,'imo=',imo(n),'jmo=',jmo(n) - end if - else if (trim(output_grid(n)) == 'regional_latlon') then - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon1(n), label ='lon1:',rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lat1(n), label ='lat1:',rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon2(n), label ='lon2:',rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lat2(n), label ='lat2:',rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlon(n), label ='dlon:',rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlat(n), label ='dlat:',rc=rc) - imo(n) = (lon2(n)-lon1(n))/dlon(n) + 1 - jmo(n) = (lat2(n)-lat1(n))/dlat(n) + 1 - if (lprnt) then - print *,'lon1=',lon1(n),' lat1=',lat1(n) - print *,'lon2=',lon2(n),' lat2=',lat2(n) - print *,'dlon=',dlon(n),' dlat=',dlat(n) - print *,'imo =',imo(n), ' jmo =',jmo(n) - end if - else if (trim(output_grid(n)) == 'rotated_latlon') then - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=cen_lon(n), label ='cen_lon:',rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=cen_lat(n), label ='cen_lat:',rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon1(n), label ='lon1:', rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lat1(n), label ='lat1:', rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon2(n), label ='lon2:', rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lat2(n), label ='lat2:', rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlon(n), label ='dlon:', rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlat(n), label ='dlat:', rc=rc) - imo(n) = (lon2(n)-lon1(n))/dlon(n) + 1 - jmo(n) = (lat2(n)-lat1(n))/dlat(n) + 1 - if (lprnt) then - print *,'cen_lon=',cen_lon(n),' cen_lat=',cen_lat(n) - print *,'lon1 =',lon1(n), ' lat1 =',lat1(n) - print *,'lon2 =',lon2(n), ' lat2 =',lat2(n) - print *,'dlon =',dlon(n), ' dlat =',dlat(n) - print *,'imo =',imo(n), ' jmo =',jmo(n) - end if - else if (trim(output_grid(n)) == 'rotated_latlon_moving' .or. & - trim(output_grid(n)) == 'regional_latlon_moving') then - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=imo(n), label ='imo:', rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=jmo(n), label ='jmo:', rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlon(n), label ='dlon:',rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlat(n), label ='dlat:',rc=rc) + if (trim(output_grid(n)) == 'gaussian_grid' .or. trim(output_grid(n)) == 'global_latlon') then + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=imo(n), label ='imo:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=jmo(n), label ='jmo:',rc=rc) + if (lprnt) then + print *,'imo=',imo(n),'jmo=',jmo(n) + end if + else if (trim(output_grid(n)) == 'regional_latlon') then + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon1(n), label ='lon1:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lat1(n), label ='lat1:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon2(n), label ='lon2:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lat2(n), label ='lat2:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlon(n), label ='dlon:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlat(n), label ='dlat:',rc=rc) + imo(n) = (lon2(n)-lon1(n))/dlon(n) + 1 + jmo(n) = (lat2(n)-lat1(n))/dlat(n) + 1 + if (lprnt) then + print *,'lon1=',lon1(n),' lat1=',lat1(n) + print *,'lon2=',lon2(n),' lat2=',lat2(n) + print *,'dlon=',dlon(n),' dlat=',dlat(n) + print *,'imo =',imo(n), ' jmo =',jmo(n) + end if + else if (trim(output_grid(n)) == 'rotated_latlon') then + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=cen_lon(n), label ='cen_lon:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=cen_lat(n), label ='cen_lat:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon1(n), label ='lon1:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lat1(n), label ='lat1:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon2(n), label ='lon2:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lat2(n), label ='lat2:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlon(n), label ='dlon:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlat(n), label ='dlat:', rc=rc) + imo(n) = (lon2(n)-lon1(n))/dlon(n) + 1 + jmo(n) = (lat2(n)-lat1(n))/dlat(n) + 1 + if (lprnt) then + print *,'cen_lon=',cen_lon(n),' cen_lat=',cen_lat(n) + print *,'lon1 =',lon1(n), ' lat1 =',lat1(n) + print *,'lon2 =',lon2(n), ' lat2 =',lat2(n) + print *,'dlon =',dlon(n), ' dlat =',dlat(n) + print *,'imo =',imo(n), ' jmo =',jmo(n) + end if + else if (trim(output_grid(n)) == 'rotated_latlon_moving' .or. & + trim(output_grid(n)) == 'regional_latlon_moving') then + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=imo(n), label ='imo:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=jmo(n), label ='jmo:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlon(n), label ='dlon:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dlat(n), label ='dlat:',rc=rc) + if (lprnt) then + print *,'imo =',imo(n), ' jmo =',jmo(n) + print *,'dlon=',dlon(n),' dlat=',dlat(n) + end if + else if (trim(output_grid(n)) == 'lambert_conformal') then + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=cen_lon(n), label ='cen_lon:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=cen_lat(n), label ='cen_lat:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=stdlat1(n), label ='stdlat1:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=stdlat2(n), label ='stdlat2:',rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=imo(n), label ='nx:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=jmo(n), label ='ny:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon1(n), label ='lon1:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lat1(n), label ='lat1:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dx(n), label ='dx:', rc=rc) + call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dy(n), label ='dy:', rc=rc) + if (lprnt) then + print *,'cen_lon=',cen_lon(n),' cen_lat=',cen_lat(n) + print *,'stdlat1=',stdlat1(n),' stdlat2=',stdlat2(n) + print *,'lon1=',lon1(n),' lat1=',lat1(n) + print *,'nx=',imo(n), ' ny=',jmo(n) + print *,'dx=',dx(n),' dy=',dy(n) + endif + endif ! output_grid + + ! chunksizes for netcdf_parallel + call ESMF_ConfigGetAttribute(config=CF,value=ichunk2d(n),default=0,label ='ichunk2d:',rc=rc) + call ESMF_ConfigGetAttribute(config=CF,value=jchunk2d(n),default=0,label ='jchunk2d:',rc=rc) + call ESMF_ConfigGetAttribute(config=CF,value=ichunk3d(n),default=0,label ='ichunk3d:',rc=rc) + call ESMF_ConfigGetAttribute(config=CF,value=jchunk3d(n),default=0,label ='jchunk3d:',rc=rc) + call ESMF_ConfigGetAttribute(config=CF,value=kchunk3d(n),default=0,label ='kchunk3d:',rc=rc) + + ! zlib compression flag + call ESMF_ConfigGetAttribute(config=CF,value=ideflate(n),default=0,label ='ideflate:',rc=rc) + if (ideflate(n) < 0) ideflate(n)=0 + + call ESMF_ConfigGetAttribute(config=CF,value=nbits(n),default=0,label ='nbits:',rc=rc) if (lprnt) then - print *,'imo =',imo(n), ' jmo =',jmo(n) - print *,'dlon=',dlon(n),' dlat=',dlat(n) + print *,'ideflate=',ideflate(n),' nbits=',nbits(n) end if - else if (trim(output_grid(n)) == 'lambert_conformal') then - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=cen_lon(n), label ='cen_lon:',rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=cen_lat(n), label ='cen_lat:',rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=stdlat1(n), label ='stdlat1:',rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=stdlat2(n), label ='stdlat2:',rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=imo(n), label ='nx:', rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=jmo(n), label ='ny:', rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lon1(n), label ='lon1:', rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=lat1(n), label ='lat1:', rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dx(n), label ='dx:', rc=rc) - call ESMF_ConfigGetAttribute(config=cf_output_grid, value=dy(n), label ='dy:', rc=rc) - if (lprnt) then - print *,'cen_lon=',cen_lon(n),' cen_lat=',cen_lat(n) - print *,'stdlat1=',stdlat1(n),' stdlat2=',stdlat2(n) - print *,'lon1=',lon1(n),' lat1=',lat1(n) - print *,'nx=',imo(n), ' ny=',jmo(n) - print *,'dx=',dx(n),' dy=',dy(n) + ! nbits quantization level for lossy compression (must be between 1 and 31) + ! 1 is most compression, 31 is least. If outside this range, set to zero + ! which means use lossless compression. + if (nbits(n) < 1 .or. nbits(n) > 31) nbits(n)=0 ! lossless compression (no quantization) + + if (cf_output_grid /= cf) then + ! destroy the temporary config object created for nest domains + call ESMF_ConfigDestroy(config=cf_output_grid, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return endif - endif ! output_grid - - ! chunksizes for netcdf_parallel - call ESMF_ConfigGetAttribute(config=CF,value=ichunk2d(n),default=0,label ='ichunk2d:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF,value=jchunk2d(n),default=0,label ='jchunk2d:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF,value=ichunk3d(n),default=0,label ='ichunk3d:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF,value=jchunk3d(n),default=0,label ='jchunk3d:',rc=rc) - call ESMF_ConfigGetAttribute(config=CF,value=kchunk3d(n),default=0,label ='kchunk3d:',rc=rc) - - ! zlib compression flag - call ESMF_ConfigGetAttribute(config=CF,value=ideflate(n),default=0,label ='ideflate:',rc=rc) - if (ideflate(n) < 0) ideflate(n)=0 - - call ESMF_ConfigGetAttribute(config=CF,value=nbits(n),default=0,label ='nbits:',rc=rc) - if (lprnt) then - print *,'ideflate=',ideflate(n),' nbits=',nbits(n) - end if - ! nbits quantization level for lossy compression (must be between 1 and 31) - ! 1 is most compression, 31 is least. If outside this range, set to zero - ! which means use lossless compression. - if (nbits(n) < 1 .or. nbits(n) > 31) nbits(n)=0 ! lossless compression (no quantization) - - if (cf_output_grid /= cf) then - ! destroy the temporary config object created for nest domains - call ESMF_ConfigDestroy(config=cf_output_grid, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - endif - if ( trim(output_grid(n)) == 'cubed_sphere_grid' ) then - !*** Create cubed sphere grid from file - if (top_parent_is_global .and. n==1) then - gridfile = 'grid_spec.nc' ! global top-level parent - do tl=1,6 - decomptile(1,tl) = 1 - decomptile(2,tl) = jidx - decompflagPTile(:,tl) = (/ESMF_DECOMP_SYMMEDGEMAX,ESMF_DECOMP_SYMMEDGEMAX/) - enddo - call ESMF_AttributeGet(imp_state_write, convention="NetCDF", purpose="FV3", & - name="gridfile", value=gridfile, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if ( trim(output_grid(n)) == 'cubed_sphere_grid' ) then + !*** Create cubed sphere grid from file + if (top_parent_is_global .and. n==1) then + gridfile = 'grid_spec.nc' ! global top-level parent + do tl=1,6 + decomptile(1,tl) = 1 + decomptile(2,tl) = jidx + decompflagPTile(:,tl) = (/ESMF_DECOMP_SYMMEDGEMAX,ESMF_DECOMP_SYMMEDGEMAX/) + enddo + call ESMF_AttributeGet(imp_state_write, convention="NetCDF", purpose="FV3", & + name="gridfile", value=gridfile, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_LogWrite("wrtComp: gridfile:"//trim(gridfile),ESMF_LOGMSG_INFO,rc=rc) - wrtGrid(n) = ESMF_GridCreateMosaic(filename="INPUT/"//trim(gridfile), & - regDecompPTile=decomptile,tileFilePath="INPUT/", & - decompflagPTile=decompflagPTile, & - staggerlocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & - name='wrt_grid', rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - else - if (top_parent_is_global) then - write(gridfile,'(A,I2.2,A,I1,A)') 'grid.nest', n, '.tile', n+5, '.nc' + call ESMF_LogWrite("wrtComp: gridfile:"//trim(gridfile),ESMF_LOGMSG_INFO,rc=rc) + wrtGrid(n) = ESMF_GridCreateMosaic(filename="INPUT/"//trim(gridfile), & + regDecompPTile=decomptile,tileFilePath="INPUT/", & + decompflagPTile=decompflagPTile, & + staggerlocList=(/ESMF_STAGGERLOC_CENTER, ESMF_STAGGERLOC_CORNER/), & + name='wrt_grid', rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return else - if (n == 1) then - gridfile='grid.tile7.halo0.nc' ! regional top-level parent + if (top_parent_is_global) then + write(gridfile,'(A,I2.2,A,I1,A)') 'grid.nest', n, '.tile', n+5, '.nc' else - write(gridfile,'(A,I2.2,A,I1,A)') 'grid.nest', n, '.tile', n, '.nc' - endif - end if - regDecomp(1) = 1 - regDecomp(2) = ntasks - allocate(petMap(ntasks)) - do i=1, ntasks - petMap(i) = i-1 - enddo - delayout = ESMF_DELayoutCreate(petMap=petMap, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (n == 1) then + gridfile='grid.tile7.halo0.nc' ! regional top-level parent + else + write(gridfile,'(A,I2.2,A,I1,A)') 'grid.nest', n, '.tile', n, '.nc' + endif + end if + regDecomp(1) = 1 + regDecomp(2) = ntasks + allocate(petMap(ntasks)) + do i=1, ntasks + petMap(i) = i-1 + enddo + delayout = ESMF_DELayoutCreate(petMap=petMap, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - ! create the nest Grid by reading it from file but use DELayout - call ESMF_LogWrite("wrtComp: gridfile:"//trim(gridfile),ESMF_LOGMSG_INFO,rc=rc) - wrtGrid(n) = ESMF_GridCreate(filename="INPUT/"//trim(gridfile), & - fileformat=ESMF_FILEFORMAT_GRIDSPEC, regDecomp=regDecomp, & - decompflag=(/ESMF_DECOMP_SYMMEDGEMAX,ESMF_DECOMP_SYMMEDGEMAX/), & - delayout=delayout, isSphere=.false., indexflag=ESMF_INDEX_DELOCAL, & - rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + ! create the nest Grid by reading it from file but use DELayout + call ESMF_LogWrite("wrtComp: gridfile:"//trim(gridfile),ESMF_LOGMSG_INFO,rc=rc) + wrtGrid(n) = ESMF_GridCreate(filename="INPUT/"//trim(gridfile), & + fileformat=ESMF_FILEFORMAT_GRIDSPEC, regDecomp=regDecomp, & + decompflag=(/ESMF_DECOMP_SYMMEDGEMAX,ESMF_DECOMP_SYMMEDGEMAX/), & + delayout=delayout, isSphere=.false., indexflag=ESMF_INDEX_DELOCAL, & + rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (lprnt) print *,'in nested/regional cubed_sphere grid, regDecomp=',regDecomp,' PetMap=',petMap(1),petMap(ntasks), & - 'gridfile=',trim(gridfile) - deallocate(petMap) - endif - else if ( trim(output_grid(n)) == 'gaussian_grid') then + if (lprnt) print *,'in nested/regional cubed_sphere grid, regDecomp=',regDecomp,' PetMap=',petMap(1),petMap(ntasks), & + 'gridfile=',trim(gridfile) + deallocate(petMap) + endif + else ! non 'cubed_sphere_grid' + if ( trim(output_grid(n)) == 'gaussian_grid') then - wrtGrid(n) = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & - maxIndex=(/imo(n),jmo(n)/), regDecomp=(/itasks,jtasks/), & - indexflag=ESMF_INDEX_GLOBAL, & - name='wrt_grid',rc=rc) + wrtGrid(n) = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & + maxIndex=(/imo(n),jmo(n)/), regDecomp=(/itasks,jtasks/), & + indexflag=ESMF_INDEX_GLOBAL, & + name='wrt_grid',rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridAddCoord(wrtGrid(n), staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridAddCoord(wrtGrid(n), staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(wrtGrid(n), coordDim=1, farrayPtr=lonPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(wrtGrid(n), coordDim=1, farrayPtr=lonPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(wrtGrid(n), coordDim=2, farrayPtr=latPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! - allocate(slat(jmo(n)), lat(jmo(n)), lon(imo(n))) - call splat(4, jmo(n), slat) - if(write_nsflip) then - do j=1,jmo(n) - lat(j) = asin(slat(j)) * radi - enddo - else - do j=1,jmo(n) - lat(jmo(n)-j+1) = asin(slat(j)) * radi - enddo - endif - wrt_int_state%latstart = lat(1) - wrt_int_state%latlast = lat(jmo(n)) - do j=1,imo(n) - lon(j) = 360.d0/real(imo(n),8) *real(j-1,8) - enddo - wrt_int_state%lonstart = lon(1) - wrt_int_state%lonlast = lon(imo(n)) - do j=lbound(latPtr,2),ubound(latPtr,2) - do i=lbound(lonPtr,1),ubound(lonPtr,1) - lonPtr(i,j) = 360.d0/real(imo(n),8) * real(i-1,8) - latPtr(i,j) = lat(j) - enddo - enddo - if(lprnt) print *,'aft wrtgrd, Gaussian, dimi,i=',lbound(lonPtr,1),ubound(lonPtr,1), & - lbound(lonPtr,2),ubound(lonPtr,2),'j(i)=',lbound(latPtr,1),ubound(latPtr,1),& - ' j(j)=',lbound(latPtr,2),ubound(latPtr,2),'imo=',imo,'jmo=',jmo -! if(wrt_int_state%mype==0) print *,'aft wrtgrd, lon=',lonPtr(1:5,1), & -! 'lat=',latPtr(1,1:5),'imo,jmo=',imo,jmo -! lonPtr(lbound(lonPtr,1),ubound(lonPtr,2)),'lat=',latPtr(lbound(lonPtr,1),lbound(lonPtr,2)), & -! latPtr(lbound(lonPtr,1),ubound(lonPtr,2)) - wrt_int_state%lat_start = lbound(latPtr,2) - wrt_int_state%lat_end = ubound(latPtr,2) - wrt_int_state%lon_start = lbound(lonPtr,1) - wrt_int_state%lon_end = ubound(lonPtr,1) - allocate( wrt_int_state%lat_start_wrtgrp(wrt_int_state%petcount)) - allocate( wrt_int_state%lat_end_wrtgrp (wrt_int_state%petcount)) - allocate( wrt_int_state%lon_start_wrtgrp(wrt_int_state%petcount)) - allocate( wrt_int_state%lon_end_wrtgrp (wrt_int_state%petcount)) - call mpi_allgather(wrt_int_state%lat_start,1,MPI_INTEGER, & - wrt_int_state%lat_start_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) - call mpi_allgather(wrt_int_state%lat_end, 1,MPI_INTEGER, & - wrt_int_state%lat_end_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) - call mpi_allgather(wrt_int_state%lon_start,1,MPI_INTEGER, & - wrt_int_state%lon_start_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) - call mpi_allgather(wrt_int_state%lon_end, 1,MPI_INTEGER, & - wrt_int_state%lon_end_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) - if( lprnt ) print *,'aft wrtgrd, Gaussian, dimj_start=',wrt_int_state%lat_start_wrtgrp, & - 'dimj_end=',wrt_int_state%lat_end_wrtgrp, 'wrt_group=',n_group, & - 'lon_start,end=',wrt_int_state%lon_start,wrt_int_state%lon_end, & - 'lat_start,end=',wrt_int_state%lat_start, wrt_int_state%lat_end - allocate( wrt_int_state%latPtr(wrt_int_state%lon_start:wrt_int_state%lon_end, & - wrt_int_state%lat_start:wrt_int_state%lat_end)) - allocate( wrt_int_state%lonPtr(wrt_int_state%lon_start:wrt_int_state%lon_end, & - wrt_int_state%lat_start:wrt_int_state%lat_end)) - do j=wrt_int_state%lat_start,wrt_int_state%lat_end - do i=wrt_int_state%lon_start,wrt_int_state%lon_end - wrt_int_state%latPtr(i,j) = latPtr(i,j) - wrt_int_state%lonPtr(i,j) = lonPtr(i,j) - enddo - enddo - wrt_int_state%im = imo(n) - wrt_int_state%jm = jmo(n) - wrt_int_state%post_maptype = 4 + call ESMF_GridGetCoord(wrtGrid(n), coordDim=2, farrayPtr=latPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - deallocate(slat, lat, lon) + allocate(slat(jmo(n)), lat(jmo(n)), lon(imo(n))) + call splat(4, jmo(n), slat) + if(write_nsflip) then + do j=1,jmo(n) + lat(j) = asin(slat(j)) * radi + enddo + else + do j=1,jmo(n) + lat(jmo(n)-j+1) = asin(slat(j)) * radi + enddo + endif + do j=1,imo(n) + lon(j) = 360.d0/real(imo(n),8) *real(j-1,8) + enddo + do j=lbound(latPtr,2),ubound(latPtr,2) + do i=lbound(lonPtr,1),ubound(lonPtr,1) + lonPtr(i,j) = 360.d0/real(imo(n),8) * real(i-1,8) + latPtr(i,j) = lat(j) + enddo + enddo + lon1(n) = lon(1) + lon2(n) = lon(imo(n)) + lat1(n) = lat(1) + lat2(n) = lat(jmo(n)) + dlon(n) = 360.d0/real(imo(n),8) + dlat(n) = 180.d0/real(jmo(n),8) - else if ( trim(output_grid(n)) == 'global_latlon') then - wrtGrid(n) = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & - maxIndex=(/imo(n),jmo(n)/), regDecomp=(/itasks,jtasks/), & - indexflag=ESMF_INDEX_GLOBAL, & - name='wrt_grid',rc=rc) + deallocate(slat, lat, lon) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + else if ( trim(output_grid(n)) == 'global_latlon') then + wrtGrid(n) = ESMF_GridCreate1PeriDim(minIndex=(/1,1/), & + maxIndex=(/imo(n),jmo(n)/), regDecomp=(/itasks,jtasks/), & + indexflag=ESMF_INDEX_GLOBAL, & + name='wrt_grid',rc=rc) - call ESMF_GridAddCoord(wrtGrid(n), staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(wrtGrid(n), coordDim=1, farrayPtr=lonPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridAddCoord(wrtGrid(n), staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(wrtGrid(n), coordDim=2, farrayPtr=latPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return -! - allocate(lat(jmo(n)), lon(imo(n))) - if (mod(jmo(n),2) == 0) then - ! if jmo even, lats do not include poles and equator - delat = 180.d0/real(jmo(n),8) - if(write_nsflip) then - do j=1,jmo(n) - lat(j) = 90.d0 - 0.5*delat - real(j-1,8)*delat - enddo - else - do j=1,jmo(n) - lat(j) = -90.d0 + 0.5*delat + real(j-1,8)*delat - enddo - endif - else - ! if jmo odd, lats include poles and equator - delat = 180.d0/real(jmo(n)-1,8) - if(write_nsflip) then - do j=1,jmo(n) - lat(j) = 90.d0 - real(j-1,8)*delat - enddo - else - do j=1,jmo(n) - lat(j) = -90.d0 + real(j-1,8)*delat - enddo - endif - endif - wrt_int_state%latstart = lat(1) - wrt_int_state%latlast = lat(jmo(n)) - delon = 360.d0/real(imo(n),8) - do i=1,imo(n) - lon(i) = real(i-1,8)*delon - enddo - wrt_int_state%lonstart = lon(1) - wrt_int_state%lonlast = lon(imo(n)) - do j=lbound(latPtr,2),ubound(latPtr,2) - do i=lbound(lonPtr,1),ubound(lonPtr,1) - lonPtr(i,j) = lon(i) - latPtr(i,j) = lat(j) - enddo - enddo - wrt_int_state%lat_start = lbound(latPtr,2) - wrt_int_state%lat_end = ubound(latPtr,2) - wrt_int_state%lon_start = lbound(lonPtr,1) - wrt_int_state%lon_end = ubound(lonPtr,1) - lon1(n) = wrt_int_state%lonstart - lon2(n) = wrt_int_state%lonlast - lat1(n) = wrt_int_state%latstart - lat2(n) = wrt_int_state%latlast - dlon(n) = delon - dlat(n) = delat - allocate( wrt_int_state%lat_start_wrtgrp(wrt_int_state%petcount)) - allocate( wrt_int_state%lat_end_wrtgrp (wrt_int_state%petcount)) - allocate( wrt_int_state%lon_start_wrtgrp(wrt_int_state%petcount)) - allocate( wrt_int_state%lon_end_wrtgrp (wrt_int_state%petcount)) - call mpi_allgather(wrt_int_state%lat_start,1,MPI_INTEGER, & - wrt_int_state%lat_start_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) - call mpi_allgather(wrt_int_state%lat_end, 1,MPI_INTEGER, & - wrt_int_state%lat_end_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) - call mpi_allgather(wrt_int_state%lon_start,1,MPI_INTEGER, & - wrt_int_state%lon_start_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) - call mpi_allgather(wrt_int_state%lon_end, 1,MPI_INTEGER, & - wrt_int_state%lon_end_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) - if( lprnt ) print *,'aft wrtgrd, latlon, dimj_start=',wrt_int_state%lat_start_wrtgrp, & - 'dimj_end=',wrt_int_state%lat_end_wrtgrp, 'wrt_group=',n_group - allocate( wrt_int_state%latPtr(wrt_int_state%lon_start:wrt_int_state%lon_end, & - wrt_int_state%lat_start:wrt_int_state%lat_end)) - allocate( wrt_int_state%lonPtr(wrt_int_state%lon_start:wrt_int_state%lon_end, & - wrt_int_state%lat_start:wrt_int_state%lat_end)) - do j=wrt_int_state%lat_start,wrt_int_state%lat_end - do i=wrt_int_state%lon_start,wrt_int_state%lon_end - wrt_int_state%latPtr(i,j) = latPtr(i,j) - wrt_int_state%lonPtr(i,j) = lonPtr(i,j) - enddo - enddo - wrt_int_state%im = imo(n) - wrt_int_state%jm = jmo(n) - wrt_int_state%post_maptype = 0 + call ESMF_GridGetCoord(wrtGrid(n), coordDim=1, farrayPtr=lonPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - deallocate(lat, lon) + call ESMF_GridGetCoord(wrtGrid(n), coordDim=2, farrayPtr=latPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - else if ( trim(output_grid(n)) == 'regional_latlon' .or. & - trim(output_grid(n)) == 'regional_latlon_moving' .or. & - trim(output_grid(n)) == 'rotated_latlon' .or. & - trim(output_grid(n)) == 'rotated_latlon_moving' .or. & - trim(output_grid(n)) == 'lambert_conformal' ) then + allocate(lat(jmo(n)), lon(imo(n))) + if (mod(jmo(n),2) == 0) then + ! if jmo even, lats do not include poles and equator + delat = 180.d0/real(jmo(n),8) + if(write_nsflip) then + do j=1,jmo(n) + lat(j) = 90.d0 - 0.5*delat - real(j-1,8)*delat + enddo + else + do j=1,jmo(n) + lat(j) = -90.d0 + 0.5*delat + real(j-1,8)*delat + enddo + endif + else + ! if jmo odd, lats include poles and equator + delat = 180.d0/real(jmo(n)-1,8) + if(write_nsflip) then + do j=1,jmo(n) + lat(j) = 90.d0 - real(j-1,8)*delat + enddo + else + do j=1,jmo(n) + lat(j) = -90.d0 + real(j-1,8)*delat + enddo + endif + endif + delon = 360.d0/real(imo(n),8) + do i=1,imo(n) + lon(i) = real(i-1,8)*delon + enddo + do j=lbound(latPtr,2),ubound(latPtr,2) + do i=lbound(lonPtr,1),ubound(lonPtr,1) + lonPtr(i,j) = lon(i) + latPtr(i,j) = lat(j) + enddo + enddo + lon1(n) = lon(1) + lon2(n) = lon(imo(n)) + lat1(n) = lat(1) + lat2(n) = lat(jmo(n)) + dlon(n) = delon + dlat(n) = delat + + deallocate(lat, lon) + + else if ( trim(output_grid(n)) == 'regional_latlon' .or. & + trim(output_grid(n)) == 'regional_latlon_moving' .or. & + trim(output_grid(n)) == 'rotated_latlon' .or. & + trim(output_grid(n)) == 'rotated_latlon_moving' .or. & + trim(output_grid(n)) == 'lambert_conformal' ) then + + wrtGrid(n) = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), & + maxIndex=(/imo(n),jmo(n)/), regDecomp=(/itasks,jtasks/), & + indexflag=ESMF_INDEX_GLOBAL, & + name='wrt_grid',rc=rc) - wrtGrid(n) = ESMF_GridCreateNoPeriDim(minIndex=(/1,1/), & - maxIndex=(/imo(n),jmo(n)/), regDecomp=(/itasks,jtasks/), & - indexflag=ESMF_INDEX_GLOBAL, & - name='wrt_grid',rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridAddCoord(wrtGrid(n), staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridAddCoord(wrtGrid(n), staggerLoc=ESMF_STAGGERLOC_CENTER, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(wrtGrid(n), coordDim=1, farrayPtr=lonPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(wrtGrid(n), coordDim=1, farrayPtr=lonPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + call ESMF_GridGetCoord(wrtGrid(n), coordDim=2, farrayPtr=latPtr, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - call ESMF_GridGetCoord(wrtGrid(n), coordDim=2, farrayPtr=latPtr, rc=rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + if ( trim(output_grid(n)) == 'regional_latlon' ) then + do j=lbound(lonPtr,2),ubound(lonPtr,2) + do i=lbound(lonPtr,1),ubound(lonPtr,1) + lonPtr(i,j) = lon1(n) + (lon2(n)-lon1(n))/(imo(n)-1) * (i-1) + latPtr(i,j) = lat1(n) + (lat2(n)-lat1(n))/(jmo(n)-1) * (j-1) + enddo + enddo + else if ( trim(output_grid(n)) == 'regional_latlon_moving' ) then + ! Do not compute lonPtr, latPtr here. Will be done in the run phase + else if ( trim(output_grid(n)) == 'rotated_latlon' ) then + do j=lbound(lonPtr,2),ubound(lonPtr,2) + do i=lbound(lonPtr,1),ubound(lonPtr,1) + rot_lon = lon1(n) + (lon2(n)-lon1(n))/(imo(n)-1) * (i-1) + rot_lat = lat1(n) + (lat2(n)-lat1(n))/(jmo(n)-1) * (j-1) + call rtll(rot_lon, rot_lat, geo_lon, geo_lat, dble(cen_lon(n)), dble(cen_lat(n))) + if (geo_lon < 0.0) geo_lon = geo_lon + 360.0 + lonPtr(i,j) = geo_lon + latPtr(i,j) = geo_lat + enddo + enddo + rot_lon = lon1(n) + rot_lat = lat1(n) + call rtll(rot_lon, rot_lat, geo_lon, geo_lat, dble(cen_lon(n)), dble(cen_lat(n))) + if (geo_lon < 0.0) geo_lon = geo_lon + 360.0 + wrt_int_state%out_grid_info(n)%lonstart = geo_lon + wrt_int_state%out_grid_info(n)%latstart = geo_lat + + rot_lon = lon2(n) + rot_lat = lat1(n) + call rtll(rot_lon, rot_lat, geo_lon, geo_lat, dble(cen_lon(n)), dble(cen_lat(n))) + if (geo_lon < 0.0) geo_lon = geo_lon + 360.0 + wrt_int_state%out_grid_info(n)%lonse = geo_lon + wrt_int_state%out_grid_info(n)%latse = geo_lat + + rot_lon = lon1(n) + rot_lat = lat2(n) + call rtll(rot_lon, rot_lat, geo_lon, geo_lat, dble(cen_lon(n)), dble(cen_lat(n))) + if (geo_lon < 0.0) geo_lon = geo_lon + 360.0 + wrt_int_state%out_grid_info(n)%lonnw = geo_lon + wrt_int_state%out_grid_info(n)%latnw = geo_lat + + rot_lon = lon2(n) + rot_lat = lat2(n) + call rtll(rot_lon, rot_lat, geo_lon, geo_lat, dble(cen_lon(n)), dble(cen_lat(n))) + if (geo_lon < 0.0) geo_lon = geo_lon + 360.0 + wrt_int_state%out_grid_info(n)%lonlast = geo_lon + wrt_int_state%out_grid_info(n)%latlast = geo_lat + else if ( trim(output_grid(n)) == 'rotated_latlon_moving' ) then + ! Do not compute lonPtr, latPtr here. Will be done in the run phase + else if ( trim(output_grid(n)) == 'lambert_conformal' ) then + lon1_r8 = dble(lon1(n)) + lat1_r8 = dble(lat1(n)) + call lambert(dble(stdlat1(n)),dble(stdlat2(n)),dble(cen_lat(n)),dble(cen_lon(n)), & + lon1_r8,lat1_r8,x1,y1, 1) + do j=lbound(lonPtr,2),ubound(lonPtr,2) + do i=lbound(lonPtr,1),ubound(lonPtr,1) + x = x1 + dx(n) * (i-1) + y = y1 + dy(n) * (j-1) + call lambert(dble(stdlat1(n)),dble(stdlat2(n)),dble(cen_lat(n)),dble(cen_lon(n)), & + geo_lon,geo_lat,x,y,-1) + if (geo_lon <0.0) geo_lon = geo_lon + 360.0 + lonPtr(i,j) = geo_lon + latPtr(i,j) = geo_lat + enddo + enddo + endif - wrt_int_state%im = imo(n) - wrt_int_state%jm = jmo(n) - if ( trim(output_grid(n)) == 'regional_latlon' ) then - do j=lbound(lonPtr,2),ubound(lonPtr,2) - do i=lbound(lonPtr,1),ubound(lonPtr,1) - lonPtr(i,j) = lon1(n) + (lon2(n)-lon1(n))/(imo(n)-1) * (i-1) - latPtr(i,j) = lat1(n) + (lat2(n)-lat1(n))/(jmo(n)-1) * (j-1) - enddo - enddo - wrt_int_state%post_maptype = 0 - else if ( trim(output_grid(n)) == 'regional_latlon_moving' ) then - ! Do not compute lonPtr, latPtr here. Will be done in the run phase - wrt_int_state%post_maptype = 0 - else if ( trim(output_grid(n)) == 'rotated_latlon' ) then - do j=lbound(lonPtr,2),ubound(lonPtr,2) - do i=lbound(lonPtr,1),ubound(lonPtr,1) - rot_lon = lon1(n) + (lon2(n)-lon1(n))/(imo(n)-1) * (i-1) - rot_lat = lat1(n) + (lat2(n)-lat1(n))/(jmo(n)-1) * (j-1) - call rtll(rot_lon, rot_lat, geo_lon, geo_lat, dble(cen_lon(n)), dble(cen_lat(n))) - if (geo_lon < 0.0) geo_lon = geo_lon + 360.0 - lonPtr(i,j) = geo_lon - latPtr(i,j) = geo_lat - enddo - enddo - wrt_int_state%post_maptype = 207 - else if ( trim(output_grid(n)) == 'rotated_latlon_moving' ) then - ! Do not compute lonPtr, latPtr here. Will be done in the run phase - wrt_int_state%post_maptype = 207 - else if ( trim(output_grid(n)) == 'lambert_conformal' ) then - lon1_r8 = dble(lon1(n)) - lat1_r8 = dble(lat1(n)) - call lambert(dble(stdlat1(n)),dble(stdlat2(n)),dble(cen_lat(n)),dble(cen_lon(n)), & - lon1_r8,lat1_r8,x1,y1, 1) - do j=lbound(lonPtr,2),ubound(lonPtr,2) - do i=lbound(lonPtr,1),ubound(lonPtr,1) - x = x1 + dx(n) * (i-1) - y = y1 + dy(n) * (j-1) - call lambert(dble(stdlat1(n)),dble(stdlat2(n)),dble(cen_lat(n)),dble(cen_lon(n)), & - geo_lon,geo_lat,x,y,-1) - if (geo_lon <0.0) geo_lon = geo_lon + 360.0 - lonPtr(i,j) = geo_lon - latPtr(i,j) = geo_lat - enddo - enddo - wrt_int_state%post_maptype = 1 - endif + else - wrt_int_state%lat_start = lbound(latPtr,2) - wrt_int_state%lat_end = ubound(latPtr,2) - wrt_int_state%lon_start = lbound(lonPtr,1) - wrt_int_state%lon_end = ubound(lonPtr,1) - allocate( wrt_int_state%lat_start_wrtgrp(wrt_int_state%petcount)) - allocate( wrt_int_state%lat_end_wrtgrp (wrt_int_state%petcount)) - allocate( wrt_int_state%lon_start_wrtgrp(wrt_int_state%petcount)) - allocate( wrt_int_state%lon_end_wrtgrp (wrt_int_state%petcount)) - call mpi_allgather(wrt_int_state%lat_start,1,MPI_INTEGER, & - wrt_int_state%lat_start_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) - call mpi_allgather(wrt_int_state%lat_end, 1,MPI_INTEGER, & - wrt_int_state%lat_end_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) - call mpi_allgather(wrt_int_state%lon_start,1,MPI_INTEGER, & - wrt_int_state%lon_start_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) - call mpi_allgather(wrt_int_state%lon_end, 1,MPI_INTEGER, & - wrt_int_state%lon_end_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) - allocate( wrt_int_state%latPtr(wrt_int_state%lon_start:wrt_int_state%lon_end, & - wrt_int_state%lat_start:wrt_int_state%lat_end)) - allocate( wrt_int_state%lonPtr(wrt_int_state%lon_start:wrt_int_state%lon_end, & - wrt_int_state%lat_start:wrt_int_state%lat_end)) - do j=wrt_int_state%lat_start,wrt_int_state%lat_end - do i=wrt_int_state%lon_start,wrt_int_state%lon_end - wrt_int_state%latPtr(i,j) = latPtr(i,j) - wrt_int_state%lonPtr(i,j) = lonPtr(i,j) - enddo - enddo + write(0,*)"wrt_initialize_p1: Unknown output_grid ", trim(output_grid(n)) + call ESMF_LogWrite("wrt_initialize_p1: Unknown output_grid "//trim(output_grid(n)),ESMF_LOGMSG_ERROR,rc=RC) + call ESMF_Finalize(endflag=ESMF_END_ABORT) - else + endif - write(0,*)"wrt_initialize_p1: Unknown output_grid ", trim(output_grid(n)) - call ESMF_LogWrite("wrt_initialize_p1: Unknown output_grid "//trim(output_grid(n)),ESMF_LOGMSG_ERROR,rc=RC) - call ESMF_Finalize(endflag=ESMF_END_ABORT) + wrt_int_state%out_grid_info(n)%i_start = lbound(lonPtr,1) + wrt_int_state%out_grid_info(n)%i_end = ubound(lonPtr,1) + wrt_int_state%out_grid_info(n)%j_start = lbound(latPtr,2) + wrt_int_state%out_grid_info(n)%j_end = ubound(latPtr,2) + + allocate( wrt_int_state%out_grid_info(n)%i_start_wrtgrp(wrt_int_state%petcount) ) + allocate( wrt_int_state%out_grid_info(n)%i_end_wrtgrp (wrt_int_state%petcount) ) + allocate( wrt_int_state%out_grid_info(n)%j_start_wrtgrp(wrt_int_state%petcount) ) + allocate( wrt_int_state%out_grid_info(n)%j_end_wrtgrp (wrt_int_state%petcount) ) + + call mpi_allgather(wrt_int_state%out_grid_info(n)%i_start, 1, MPI_INTEGER, & + wrt_int_state%out_grid_info(n)%i_start_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) + call mpi_allgather(wrt_int_state%out_grid_info(n)%i_end, 1, MPI_INTEGER, & + wrt_int_state%out_grid_info(n)%i_end_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) + call mpi_allgather(wrt_int_state%out_grid_info(n)%j_start, 1, MPI_INTEGER, & + wrt_int_state%out_grid_info(n)%j_start_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) + call mpi_allgather(wrt_int_state%out_grid_info(n)%j_end, 1, MPI_INTEGER, & + wrt_int_state%out_grid_info(n)%j_end_wrtgrp, 1, MPI_INTEGER, wrt_mpi_comm, rc) + + allocate( wrt_int_state%out_grid_info(n)%lonPtr(wrt_int_state%out_grid_info(n)%i_start:wrt_int_state%out_grid_info(n)%i_end, & + wrt_int_state%out_grid_info(n)%j_start:wrt_int_state%out_grid_info(n)%j_end) ) + allocate( wrt_int_state%out_grid_info(n)%latPtr(wrt_int_state%out_grid_info(n)%i_start:wrt_int_state%out_grid_info(n)%i_end, & + wrt_int_state%out_grid_info(n)%j_start:wrt_int_state%out_grid_info(n)%j_end) ) + + do j=wrt_int_state%out_grid_info(n)%j_start, wrt_int_state%out_grid_info(n)%j_end + do i=wrt_int_state%out_grid_info(n)%i_start, wrt_int_state%out_grid_info(n)%i_end + wrt_int_state%out_grid_info(n)%latPtr(i,j) = latPtr(i,j) + wrt_int_state%out_grid_info(n)%lonPtr(i,j) = lonPtr(i,j) + enddo + enddo - endif + wrt_int_state%out_grid_info(n)%im = imo(n) + wrt_int_state%out_grid_info(n)%jm = jmo(n) + end if ! non 'cubed_sphere_grid' end do ! n = 1, ngrids ! !----------------------------------------------------------------------- @@ -1441,16 +1393,6 @@ subroutine wrt_initialize_p1(wrt_comp, imp_state_write, exp_state_write, clock, deallocate(attNameList, attNameList2, typekindList) ! -!----------------------------------------------------------------------- -!*** Initialize for POST -!----------------------------------------------------------------------- -! - call ESMF_LogWrite("before initialize for POST", ESMF_LOGMSG_INFO, rc=rc) - if (lprnt) print *,'in wrt grid comp, dopost=',wrt_int_state%write_dopost - if( wrt_int_state%write_dopost ) then - call inline_post_getattr(wrt_int_state,1) - endif -! ! write_init_tim = MPI_Wtime() - btim0 ! !----------------------------------------------------------------------- @@ -1933,6 +1875,8 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) do ii=lbound(lonPtr,1),ubound(lonPtr,1) lonPtr(ii,jj) = lon1(n) + (lon2(n)-lon1(n))/(imo(n)-1) * (ii-1) latPtr(ii,jj) = lat1(n) + (lat2(n)-lat1(n))/(jmo(n)-1) * (jj-1) + wrt_int_state%out_grid_info(n)%latPtr(ii,jj) = latPtr(ii,jj) + wrt_int_state%out_grid_info(n)%lonPtr(ii,jj) = lonPtr(ii,jj) enddo enddo else if (trim(output_grid(grid_id)) == 'rotated_latlon_moving') then @@ -1948,6 +1892,8 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (geo_lon < 0.0) geo_lon = geo_lon + 360.0 lonPtr(ii,jj) = geo_lon latPtr(ii,jj) = geo_lat + wrt_int_state%out_grid_info(n)%latPtr(ii,jj) = latPtr(ii,jj) + wrt_int_state%out_grid_info(n)%lonPtr(ii,jj) = lonPtr(ii,jj) enddo enddo endif @@ -1982,28 +1928,37 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) !----------------------------------------------------------------------- lmask_fields = .false. if( wrt_int_state%write_dopost ) then -! +#ifdef INLINE_POST wbeg = MPI_Wtime() - if (trim(output_grid(1)) == 'regional_latlon' .or. & - trim(output_grid(1)) == 'rotated_latlon' .or. & - trim(output_grid(1)) == 'lambert_conformal') then - - !mask fields according to sfc pressure - do nbdl=1, wrt_int_state%FBCount - call mask_fields(wrt_int_state%wrtFB(nbdl),rc) - if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return - enddo - lmask_fields = .true. - endif + do n=1,ngrids + if (trim(output_grid(n)) == 'regional_latlon' .or. & + trim(output_grid(n)) == 'regional_latlon_moving' .or. & + trim(output_grid(n)) == 'rotated_latlon' .or. & + trim(output_grid(n)) == 'rotated_latlon_moving' .or. & + trim(output_grid(n)) == 'lambert_conformal') then + + !mask fields according to sfc pressure + do nbdl=1, wrt_int_state%FBCount + call mask_fields(wrt_int_state%wrtFB(nbdl),rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return + enddo + lmask_fields = .true. + endif - call inline_post_run(wrt_int_state, 1, mype, wrt_mpi_comm, lead_write_task, & - nf_hours, nf_minutes, nf_seconds) + call post_run_fv3(wrt_int_state, n, mype, wrt_mpi_comm, lead_write_task, & + itasks, jtasks, nf_hours, nf_minutes, nf_seconds) + enddo wend = MPI_Wtime() if (lprnt) then write(*,'(A,F10.5,A,I4.2,A,I2.2)')' actual inline post Time is ',wend-wbeg & ,' at Fcst ',nf_hours,':',nf_minutes endif - +#else + rc = ESMF_RC_NOT_IMPL + print *,'inline post not available on this machine' + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return +#endif endif ! !----------------------------------------------------------------------- @@ -2071,22 +2026,22 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) if (output_file(nnnn)(1:6) == 'netcdf') then if (ichunk2d(grid_id) == 0) then if( wrt_int_state%mype == 0 ) & - ichunk2d(grid_id) = wrt_int_state%lon_end-wrt_int_state%lon_start+1 + ichunk2d(grid_id) = wrt_int_state%out_grid_info(grid_id)%i_end - wrt_int_state%out_grid_info(grid_id)%i_start + 1 call mpi_bcast(ichunk2d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) endif if (jchunk2d(grid_id) == 0) then if( wrt_int_state%mype == 0 ) & - jchunk2d(grid_id) = wrt_int_state%lat_end-wrt_int_state%lat_start+1 + jchunk2d(grid_id) = wrt_int_state%out_grid_info(grid_id)%j_end - wrt_int_state%out_grid_info(grid_id)%j_start + 1 call mpi_bcast(jchunk2d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) endif if (ichunk3d(grid_id) == 0) then if( wrt_int_state%mype == 0 ) & - ichunk3d(grid_id) = wrt_int_state%lon_end-wrt_int_state%lon_start+1 + ichunk3d(grid_id) = wrt_int_state%out_grid_info(grid_id)%i_end - wrt_int_state%out_grid_info(grid_id)%i_start + 1 call mpi_bcast(ichunk3d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) endif if (jchunk3d(grid_id) == 0) then if( wrt_int_state%mype == 0 ) & - jchunk3d(grid_id) = wrt_int_state%lat_end-wrt_int_state%lat_start+1 + jchunk3d(grid_id) = wrt_int_state%out_grid_info(grid_id)%j_end - wrt_int_state%out_grid_info(grid_id)%j_start + 1 call mpi_bcast(jchunk3d(grid_id),1,mpi_integer,0,wrt_mpi_comm,rc) endif if (kchunk3d(grid_id) == 0 .and. nbdl == 1) then @@ -2228,21 +2183,12 @@ subroutine wrt_run(wrt_comp, imp_state_write, exp_state_write,clock,rc) !** write out log file ! if (mype == lead_write_task) then - do n=701,900 - inquire(n,opened=OPENED) - if(.not.opened)then - nolog = n - exit - endif - enddo -! - open(nolog,file='logf'//trim(cfhour),form='FORMATTED') + open(newunit=nolog,file='logf'//trim(cfhour),form='FORMATTED') write(nolog,100)nfhour,idate(1:6) 100 format(' completed fv3gfs fhour=',f10.3,2x,6(i4,2x)) close(nolog) endif ! -! !----------------------------------------------------------------------- ! call ESMF_VMBarrier(VM, rc=rc) diff --git a/io/post_fv3.F90 b/io/post_fv3.F90 index 634e55910..6b08c4785 100644 --- a/io/post_fv3.F90 +++ b/io/post_fv3.F90 @@ -1,27 +1,21 @@ -!----------------------------------------------------------------------- -!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -!----------------------------------------------------------------------- -! module post_fv3 - use module_fv3_io_def, only : wrttasks_per_group,filename_base, & - lon1, lat1, lon2, lat2, dlon, dlat, & + use mpi + + use module_fv3_io_def, only : wrttasks_per_group, filename_base, & + lon1, lat1, lon2, lat2, dlon, dlat, & cen_lon, cen_lat, dxin=>dx, dyin=>dy, & stdlat1, stdlat2, output_grid use write_internal_state, only : wrt_internal_state implicit none - include 'mpif.h' - - integer mype, nbdl - logical setvar_atmfile, setvar_sfcfile, read_postcntrl - public post_run_fv3, post_getattr_fv3 + public post_run_fv3 contains - subroutine post_run_fv3(wrt_int_state,mypei,mpicomp,lead_write, & - mynfhr,mynfmin,mynfsec) + subroutine post_run_fv3(wrt_int_state,grid_id,mype,mpicomp,lead_write, & + itasks,jtasks,mynfhr,mynfmin,mynfsec) ! ! revision history: ! Jul 2019 J. Wang create interface to run inline post for FV3 @@ -31,19 +25,22 @@ subroutine post_run_fv3(wrt_int_state,mypei,mpicomp,lead_write, & ! 2)add bug fix for dx/dy computation ! 3)add reading pwat from FV3 ! 4)remove some variable initializations -! 5)read max/min 2m T from tmax_max2m/tmin_min2m +! 5)read max/min 2m T from tmax_max2m/tmin_min2m ! for GFS, and from t02max/min for RRFS -! and HAFS. +! and HAFS. ! 6)read 3D cloud fraction from cld_amt for GFDL MP, ! and from cldfra for other MPs. ! Jun 2022 J. Meng 2D decomposition +! Jul 2022 W. Meng 1)output lat/lon of four corner point for rotated +! lat-lon grid. +! 2)read instant model top logwave ! !----------------------------------------------------------------------- !*** run post on write grid comp !----------------------------------------------------------------------- ! use ctlblk_mod, only : komax,ifhr,ifmin,modelname,datapd,fld_info, & - npset,grib,gocart_on,icount_calmict, jsta, & + npset,grib,gocart_on,jsta, & jend,ista,iend, im, nsoil, filenameflat,numx use gridspec_mod, only : maptype, gridtype,latstart,latlast, & lonstart,lonlast @@ -56,10 +53,12 @@ subroutine post_run_fv3(wrt_int_state,mypei,mpicomp,lead_write, & ! !----------------------------------------------------------------------- ! - type(wrt_internal_state),intent(in) :: wrt_int_state - integer,intent(in) :: mypei + type(wrt_internal_state),intent(inout) :: wrt_int_state + integer,intent(in) :: grid_id + integer,intent(in) :: mype integer,intent(in) :: mpicomp integer,intent(in) :: lead_write + integer,intent(in) :: itasks, jtasks integer,intent(in) :: mynfhr integer,intent(in) :: mynfmin integer,intent(in) :: mynfsec @@ -68,88 +67,83 @@ subroutine post_run_fv3(wrt_int_state,mypei,mpicomp,lead_write, & !*** LOCAL VARIABLES !----------------------------------------------------------------------- ! - integer n,nwtpg,ieof,lcntrl,ierr,i,j,k,jts,jte,mynsoil - integer,allocatable :: jstagrp(:),jendgrp(:) - integer its,ite - integer,allocatable :: istagrp(:),iendgrp(:) + integer :: n,nwtpg,ierr,i,j,k,its,ite,jts,jte + integer,allocatable :: istagrp(:),iendgrp(:),jstagrp(:),jendgrp(:) integer,save :: kpo,kth,kpv - logical,save :: log_postalct=.false. + logical,save :: first_run=.true. + logical,save :: read_postcntrl=.false. real(4),dimension(komax),save :: po, th, pv - logical :: Log_runpost - character(255) :: post_fname*255 - - integer,save :: iostatusD3D=-1 -! - real(kind=8) :: btim0, btim1, btim2, btim3,btim4,btim5,btim6,btim7 + character(255) :: post_fname + integer,save :: iostatusD3D=-1 ! -! print *,'in post_run start' !----------------------------------------------------------------------- !*** set up dimensions !----------------------------------------------------------------------- ! - btim0 = MPI_Wtime() + numx = itasks + + call post_getattr_fv3(wrt_int_state, grid_id) grib = "grib2" gridtype = "A" nsoil = 4 - mype = mypei nwtpg = wrt_int_state%petcount - jts = wrt_int_state%lat_start !<-- Starting J of this write task's subsection - jte = wrt_int_state%lat_end !<-- Ending J of this write task's subsection - its = wrt_int_state%lon_start !<-- Starting I of this write task's subsection - ite = wrt_int_state%lon_end !<-- Ending I of this write task's subsection - maptype = wrt_int_state%post_maptype - nbdl = wrt_int_state%FBCount + jts = wrt_int_state%out_grid_info(grid_id)%j_start !<-- Starting J of this write task's subsection + jte = wrt_int_state%out_grid_info(grid_id)%j_end !<-- Ending J of this write task's subsection + its = wrt_int_state%out_grid_info(grid_id)%i_start !<-- Starting I of this write task's subsection + ite = wrt_int_state%out_grid_info(grid_id)%i_end !<-- Ending I of this write task's subsection - if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg,'nwtpg=',nwtpg, & - 'jts=',jts,'jte=',jte,'maptype=',maptype,'nbdl=',nbdl,'log_postalct=',log_postalct + if(mype==0) print *,'in post_run,jts=',jts,'jte=',jte,'nwtpg=',nwtpg, & + 'jts=',jts,'jte=',jte,'maptype=',maptype,'wrt_int_state%FBCount=',wrt_int_state%FBCount ! !----------------------------------------------------------------------- !*** set up fields to run post !----------------------------------------------------------------------- ! - if (.not.log_postalct) then -! - allocate(jstagrp(nwtpg),jendgrp(nwtpg)) - allocate(istagrp(nwtpg),iendgrp(nwtpg)) -! - do n=0,nwtpg-1 - jstagrp(n+1) = wrt_int_state%lat_start_wrtgrp(n+1) - jendgrp(n+1) = wrt_int_state%lat_end_wrtgrp (n+1) - istagrp(n+1) = wrt_int_state%lon_start_wrtgrp(n+1) - iendgrp(n+1) = wrt_int_state%lon_end_wrtgrp (n+1) - enddo - if(mype==0) print *,'in post_run,jstagrp=',jstagrp,'jendgrp=',jendgrp - if(mype==0) print *,'in post_run,istagrp=',istagrp,'iendgrp=',iendgrp + if (allocated(jstagrp)) deallocate(jstagrp) + if (allocated(jendgrp)) deallocate(jendgrp) + if (allocated(istagrp)) deallocate(istagrp) + if (allocated(iendgrp)) deallocate(iendgrp) + allocate(jstagrp(nwtpg),jendgrp(nwtpg)) + allocate(istagrp(nwtpg),iendgrp(nwtpg)) +! + do n=0,nwtpg-1 + jstagrp(n+1) = wrt_int_state%out_grid_info(grid_id)%j_start_wrtgrp(n+1) + jendgrp(n+1) = wrt_int_state%out_grid_info(grid_id)%j_end_wrtgrp (n+1) + istagrp(n+1) = wrt_int_state%out_grid_info(grid_id)%i_start_wrtgrp(n+1) + iendgrp(n+1) = wrt_int_state%out_grid_info(grid_id)%i_end_wrtgrp (n+1) + enddo + if(mype==0) print *,'in post_run,jstagrp=',jstagrp,'jendgrp=',jendgrp + if(mype==0) print *,'in post_run,istagrp=',istagrp,'iendgrp=',iendgrp !----------------------------------------------------------------------- !*** read namelist for pv,th,po !----------------------------------------------------------------------- ! - call read_postnmlt(kpo,kth,kpv,po,th,pv,wrt_int_state%post_namelist) + call read_postnmlt(kpo,kth,kpv,po,th,pv,wrt_int_state%post_namelist) ! !----------------------------------------------------------------------- !*** allocate post variables !----------------------------------------------------------------------- ! - if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%im, & - wrt_int_state%jm, wrt_int_state%lm,'mype=',mype,'wrttasks_per_group=', & - wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & - 'jstagrp=',jstagrp,'jendgrp=',jendgrp - call post_alctvars(wrt_int_state%im,wrt_int_state%jm, & - wrt_int_state%lm,mype,wrttasks_per_group,lead_write, & - mpicomp,jts,jte,jstagrp,jendgrp,its,ite,istagrp,iendgrp) + if(mype==0) print *,'in post_run,be post_alctvars, dim=',wrt_int_state%out_grid_info(grid_id)%im, & + wrt_int_state%out_grid_info(grid_id)%jm, wrt_int_state%out_grid_info(grid_id)%lm,'mype=',mype,'wrttasks_per_group=', & + wrttasks_per_group,'lead_write=',lead_write,'jts=',jts,'jte=',jte, & + 'jstagrp=',jstagrp,'jendgrp=',jendgrp + + call post_alctvars(wrt_int_state%out_grid_info(grid_id)%im, & + wrt_int_state%out_grid_info(grid_id)%jm, & + wrt_int_state%out_grid_info(grid_id)%lm, & + mype,wrttasks_per_group,lead_write, & + mpicomp,jts,jte,jstagrp,jendgrp,its,ite,istagrp,iendgrp) ! !----------------------------------------------------------------------- !*** read namelist for pv,th,po !----------------------------------------------------------------------- ! - log_postalct = .true. - first_grbtbl = .true. - read_postcntrl = .true. -! - ENDIF + first_grbtbl = first_run + read_postcntrl = .true. ! !----------------------------------------------------------------------- !*** fill post variables with values from forecast results @@ -157,82 +151,68 @@ subroutine post_run_fv3(wrt_int_state,mypei,mpicomp,lead_write, & ! ifhr = mynfhr ifmin = mynfmin - if (ifhr == 0 ) ifmin = 0 - if(mype==0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr - setvar_atmfile=.false. - setvar_sfcfile=.false. - call set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & - setvar_sfcfile) - -! print *,'af set_postvars,setvar_atmfile=',setvar_atmfile, & -! 'setvar_sfcfile=',setvar_sfcfile -! - if (setvar_atmfile.and.setvar_sfcfile) then -! 20190807 no need to call microinit for GFDLMP -! call MICROINIT -! - if(grib=="grib2" .and. read_postcntrl) then - if (ifhr == 0) then - filenameflat = 'postxconfig-NT_FH00.txt' - call read_xml() - if(mype==0) print *,'af read_xml at fh00,name=',trim(filenameflat) - else if(ifhr > 0) then - filenameflat = 'postxconfig-NT.txt' - if(associated(paramset)) then - if(size(paramset)>0) then - do i=1,size(paramset) - if (associated(paramset(i)%param)) then - if (size(paramset(i)%param)>0) then - deallocate(paramset(i)%param) - nullify(paramset(i)%param) - endif + if (ifhr == 0) ifmin = 0 + if (mype == 0) print *,'bf set_postvars,ifmin=',ifmin,'ifhr=',ifhr + + call set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp) + + if (read_postcntrl) then + if (ifhr == 0) then + filenameflat = 'postxconfig-NT_FH00.txt' + call read_xml() + else if(ifhr > 0) then + filenameflat = 'postxconfig-NT.txt' + if(associated(paramset)) then + if(size(paramset)>0) then + do i=1,size(paramset) + if (associated(paramset(i)%param)) then + if (size(paramset(i)%param)>0) then + deallocate(paramset(i)%param) + nullify(paramset(i)%param) endif - enddo - endif - deallocate(paramset) - nullify(paramset) + endif + enddo endif - num_pset = 0 - call read_xml() - if(mype==0) print *,'af read_xml,name=',trim(filenameflat),'ifhr=',ifhr - read_postcntrl = .false. + deallocate(paramset) + nullify(paramset) endif + num_pset = 0 + call read_xml() + read_postcntrl = .false. endif + if(mype==0) print *,'af read_xml,name=',trim(filenameflat),' ifhr=',ifhr,' num_pset=',num_pset + endif ! - IEOF = 0 - npset = 0 - icount_calmict = 0 - do while( IEOF == 0) -! - if(grib == "grib2") then - npset = npset + 1 - call set_outflds(kth,th,kpv,pv) - if(allocated(datapd))deallocate(datapd) - allocate(datapd(ite-its+1,jte-jts+1,nrecout+100)) + do npset = 1, num_pset + call set_outflds(kth,th,kpv,pv) + if(allocated(datapd))deallocate(datapd) + allocate(datapd(ite-its+1,jte-jts+1,nrecout+100)) !$omp parallel do default(none),private(i,j,k),shared(nrecout,jend,jsta,im,datapd,ista,iend) - do k=1,nrecout+100 - do j=1,jend+1-jsta - do i=1,iend+1-ista - datapd(i,j,k) = 0. - enddo - enddo + do k=1,nrecout+100 + do j=1,jend+1-jsta + do i=1,iend+1-ista + datapd(i,j,k) = 0. enddo - call get_postfilename(post_fname) - if (mype==0) write(0,*)'post_fname=',trim(post_fname) -! - if ( ieof == 0) call process(kth,kpv,th(1:kth),pv(1:kpv),iostatusD3D) -! - call mpi_barrier(mpicomp,ierr) - call gribit2(post_fname) - if(allocated(datapd))deallocate(datapd) - if(allocated(fld_info))deallocate(fld_info) - if(npset >= num_pset) exit - - endif -! + enddo enddo -! + call get_postfilename(post_fname) + if (grid_id > 1) then + write(post_fname, '(A,I2.2)') trim(post_fname)//".nest", grid_id + endif + if (mype==0) print *,'post_fname=',trim(post_fname) + + call process(kth,kpv,th(1:kth),pv(1:kpv),iostatusD3D) + + call mpi_barrier(mpicomp,ierr) + call gribit2(post_fname) + if(allocated(datapd))deallocate(datapd) + if(allocated(fld_info))deallocate(fld_info) + enddo + + if( first_run ) then + first_run = .false. endif + call post_finalize('grib2') end subroutine post_run_fv3 ! @@ -242,14 +222,14 @@ subroutine post_getattr_fv3(wrt_int_state,grid_id) ! use esmf use ctlblk_mod, only: im, jm, mpi_comm_comp,gdsdegr,spval - use masks, only: gdlat, gdlon, dx, dy use gridspec_mod, only: latstart, latlast, lonstart, & lonlast, cenlon, cenlat, dxval, & dyval, truelat2, truelat1,psmapf, & lonstartv, lonlastv, cenlonv, & latstartv, latlastv, cenlatv, & latstart_r,latlast_r,lonstart_r, & - lonlast_r, STANDLON, maptype, gridtype + lonlast_r, STANDLON, maptype, gridtype, & + latse,lonse,latnw,lonnw ! implicit none ! @@ -278,7 +258,8 @@ subroutine post_getattr_fv3(wrt_int_state,grid_id) ! if(mype==0) print*,'in post_getattr_lam, lon1=',lon1,lon2,lat1,lat2,dlon,dlat gdsdegr = 1000000. - if(trim(output_grid(grid_id)) == 'regional_latlon') then + if(trim(output_grid(grid_id)) == 'regional_latlon' .or. & + trim(output_grid(grid_id)) == 'regional_latlon_moving') then MAPTYPE=0 gridtype='A' @@ -330,7 +311,8 @@ subroutine post_getattr_fv3(wrt_int_state,grid_id) endif STANDLON = cenlon - else if(trim(output_grid(grid_id)) == 'rotated_latlon') then + else if(trim(output_grid(grid_id)) == 'rotated_latlon' .or. & + trim(output_grid(grid_id)) == 'rotated_latlon_moving') then MAPTYPE=207 GRIDTYPE='A' @@ -356,6 +338,14 @@ subroutine post_getattr_fv3(wrt_int_state,grid_id) lonstart_r = lonstart latlast_r = latlast lonlast_r = lonlast + lonstart = nint(wrt_int_state%out_grid_info(grid_id)%lonstart*gdsdegr) + latstart = nint(wrt_int_state%out_grid_info(grid_id)%latstart*gdsdegr) + lonse = nint(wrt_int_state%out_grid_info(grid_id)%lonse*gdsdegr) + latse = nint(wrt_int_state%out_grid_info(grid_id)%latse*gdsdegr) + lonnw = nint(wrt_int_state%out_grid_info(grid_id)%lonnw*gdsdegr) + latnw = nint(wrt_int_state%out_grid_info(grid_id)%latnw*gdsdegr) + lonlast = nint(wrt_int_state%out_grid_info(grid_id)%lonlast*gdsdegr) + latlast = nint(wrt_int_state%out_grid_info(grid_id)%latlast*gdsdegr) if(dlon(grid_id) con_g, fv => con_fvirt, rgas => con_rd, & @@ -542,20 +554,19 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & !----------------------------------------------------------------------- ! implicit none -! - include 'mpif.h' ! !----------------------------------------------------------------------- ! type(wrt_internal_state),intent(in) :: wrt_int_state + integer,intent(in) :: grid_id + integer,intent(in) :: mype integer,intent(in) :: mpicomp - logical,intent(inout) :: setvar_atmfile,setvar_sfcfile ! !----------------------------------------------------------------------- ! integer i, ip1, j, l, k, n, iret, ibdl, rc, kstart, kend integer i1,i2,j1,j2,k1,k2 - integer fieldDimCount,gridDimCount,ncount_field + integer fieldDimCount,gridDimCount,ncount_field,bundle_grid_id integer jdate(8) logical foundland, foundice, found, mvispresent integer totalLBound3d(3), totalUBound3d(3) @@ -571,7 +582,7 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & real,external::FPVSNEW real,dimension(:,:),allocatable :: dummy, p2d, t2d, q2d, qs2d, & cw2d, cfr2d - character(len=80) :: fieldname, wrtFBName + character(len=80) :: fieldname, wrtFBName, flatlon type(ESMF_Grid) :: wrtGrid type(ESMF_Field) :: theField type(ESMF_Field), allocatable :: fcstField(:) @@ -596,7 +607,7 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & tsrfc = tprec tmaxmin = tprec td3d = tprec -! if(mype==0)print*,'MP_PHYSICS= ',imp_physics,'nbdl=',nbdl, 'tprec=',tprec,'tclod=',tclod, & +! if(mype==0)print*,'MP_PHYSICS= ',imp_physics,'tprec=',tprec,'tclod=',tclod, & ! 'dtp=',dtp,'tmaxmin=',tmaxmin,'jsta=',jsta,jend,im,jm ! write(6,*) 'maptype and gridtype is ', maptype,gridtype @@ -604,8 +615,8 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & !$omp parallel do default(shared),private(i,j) do j=jsta,jend do i=ista,iend - gdlat(i,j) = wrt_int_state%latPtr(i,j) - gdlon(i,j) = wrt_int_state%lonPtr(i,j) + gdlat(i,j) = wrt_int_state%out_grid_info(grid_id)%latPtr(i,j) + gdlon(i,j) = wrt_int_state%out_grid_info(grid_id)%lonPtr(i,j) enddo enddo @@ -714,14 +725,13 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & ! time averaged cloud fraction, set acfrst to spval, ncfrst to 1 ! UNDERGROUND RUNOFF, bgroff ! inst incoming sfc longwave -! inst model top outgoing longwave,rlwtoa ! inst incoming sfc shortwave, rswin ! inst incoming clear sky sfc shortwave, rswinc ! inst outgoing sfc shortwave, rswout ! snow phase change heat flux, snopcx ! GFS does not use total momentum flux,sfcuvx !$omp parallel do default(none),private(i,j),shared(jsta,jend,im,spval,ista,iend), & -!$omp& shared(acfrcv,ncfrcv,acfrst,ncfrst,bgroff,rlwtoa,rswin,rswinc,rswout,snopcx,sfcuvx) +!$omp& shared(acfrcv,ncfrcv,acfrst,ncfrst,bgroff,rswin,rswinc,rswout,snopcx,sfcuvx) do j=jsta,jend do i=ista,iend acfrcv(i,j) = spval @@ -729,7 +739,6 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & acfrst(i,j) = spval ncfrst(i,j) = 1.0 bgroff(i,j) = spval - rlwtoa(i,j) = spval rswinc(i,j) = spval enddo enddo @@ -848,6 +857,13 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & get_lsmsk: do ibdl=1, wrt_int_state%FBCount + call ESMF_AttributeGet(wrt_int_state%wrtFB(ibdl), convention="NetCDF", purpose="FV3", & + name="grid_id", value=bundle_grid_id, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + if (grid_id /= bundle_grid_id) cycle + ! find lans sea mask found = .false. call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl),fieldName='land',isPresent=found, rc=rc) @@ -916,13 +932,21 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & line=__LINE__, file=__FILE__)) return ! bail out endif -! if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'nbdl=',wrt_int_state%FBCount +! if(mype==0) print *,'after find sm and sice,imp_physics=',imp_physics,'wrt_int_state%FBCount=',wrt_int_state%FBCount ! file_loop_all: do ibdl=1, wrt_int_state%FBCount ! ! get grid dimension count ! if(mype==0) print *,'in setvar, read field, ibdl=',ibdl,'idim=', & ! ista,iend,'jdim=',jsta,jend + + call ESMF_AttributeGet(wrt_int_state%wrtFB(ibdl), convention="NetCDF", purpose="FV3", & + name="grid_id", value=bundle_grid_id, rc=rc) + if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & + line=__LINE__, file=__FILE__)) return ! bail out + + if (grid_id /= bundle_grid_id) cycle + call ESMF_FieldBundleGet(wrt_int_state%wrtFB(ibdl), grid=wrtGrid, & fieldCount=ncount_field, name=wrtFBName,rc=rc) if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, & @@ -1678,6 +1702,17 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & enddo endif + ! outgoing model top logwave + if(trim(fieldname)=='ulwrf_toa') then + !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rlwtoa,arrayr42d,fillValue,spval) + do j=jsta,jend + do i=ista, iend + rlwtoa(i,j) = arrayr42d(i,j) + if( abs(arrayr42d(i,j)-fillValue)< small) rlwtoa(i,j) = spval + enddo + enddo + endif + ! time averaged incoming sfc shortwave if(trim(fieldname)=='dswrf_ave') then !$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,aswin,arrayr42d,fillValue,spval) @@ -2531,7 +2566,7 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & enddo enddo endif - + ! snow phase change heat flux if(trim(fieldname)=='pwat') then @@ -3020,20 +3055,13 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & enddo endif endif - + !3d fields endif ! end loop ncount_field enddo - if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(1))) > 0) then - setvar_atmfile = .true. - endif - if ( index(trim(wrt_int_state%wrtFB_names(ibdl)),trim(filename_base(2))) > 0) then - setvar_sfcfile = .true. - endif - if(mype==0) print *,'setvar_atmfile=',setvar_atmfile,'setvar_sfcfile=',setvar_sfcfile,'ibdl=',ibdl deallocate(fcstField) ! end file_loop_all @@ -3128,7 +3156,7 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & end do end do -! compute zmid +! compute zmid do l=lm,1,-1 !$omp parallel do default(none) private(i,j) shared(l,jsta,jend,im,zmid,zint,pmid,alpint,spval,ista,iend) do j=jsta,jend @@ -3265,7 +3293,20 @@ subroutine set_postvars_fv3(wrt_int_state,mpicomp,setvar_atmfile, & ! !more fields need to be computed ! - end subroutine set_postvars_fv3 - - end module post_fv3 +! write lat/lon of the four corner point for rotated lat-lon grid + if(mype == 0 .and. maptype == 207)then + write(flatlon,1001)ifhr + open(112,file=trim(flatlon),form='formatted',status='unknown') + write(112,1002)latstart/1000,lonstart/1000,& + latse/1000,lonse/1000,latnw/1000,lonnw/1000, & + latlast/1000,lonlast/1000 + 1001 format('latlons_corners.txt.f',I3.3) + 1002 format(4(I6,I7,X)) + close(112) + endif + end subroutine set_postvars_fv3 +! +!----------------------------------------------------------------------- +! +end module post_fv3 diff --git a/io/post_nems_routines.F90 b/io/post_nems_routines.F90 index 6ea6c83e3..2c61c65e6 100644 --- a/io/post_nems_routines.F90 +++ b/io/post_nems_routines.F90 @@ -4,7 +4,6 @@ ! subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & jts,jte,jtsgrp,jtegrp,its,ite,itsgrp,itegrp) -! jts,jte,jtsgrp,jtegrp) ! ! ! revision history: @@ -124,6 +123,10 @@ subroutine post_alctvars(imi,jmi,lmi,mype,nwtlpes,lead_write, mpicomp, & ! isumm=0 isumm2=0 + if(allocated(isxa)) deallocate(isxa) + if(allocated(jsxa)) deallocate(jsxa) + if(allocated(iexa)) deallocate(iexa) + if(allocated(jexa)) deallocate(jexa) allocate(isxa(0:num_procs-1) ) allocate(jsxa(0:num_procs-1) ) allocate(iexa(0:num_procs-1) ) @@ -339,7 +342,7 @@ subroutine post_finalize(post_gribversion) character(*),intent(in) :: post_gribversion ! IF(trim(post_gribversion)=='grib2') then - call grib_info_finalize() + ! call grib_info_finalize() ENDIF ! call de_allocate From bae1630926d3a4b8fb6c726b1af7ad83d6b81e04 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 23 Nov 2022 02:53:31 +0000 Subject: [PATCH 26/74] correct space-padding and remove changes that broke stuff --- atmos_model.F90 | 1 - io/FV3GFS_io.F90 | 110 +++++++++++++++++++++++++++-------------------- 2 files changed, 63 insertions(+), 48 deletions(-) diff --git a/atmos_model.F90 b/atmos_model.F90 index 08e6c3981..35e7328ac 100644 --- a/atmos_model.F90 +++ b/atmos_model.F90 @@ -2684,7 +2684,6 @@ subroutine assign_importdata(jdat, rc) fldname = 't2m' if (trim(impfield_name) == trim(fldname)) then - print *,'overwrite t2m with imported data' findex = queryImportFields(fldname) if (importFieldsValid(findex)) then !$omp parallel do default(shared) private(i,j,nb,ix) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 455101aba..238dfbbd5 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -703,7 +703,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta oro_name2(15) = 'orog_filt' ! oro oro_name2(16) = 'orog_raw' ! oro_uf oro_name2(17) = 'land_frac' ! land fraction [0:1] - !--- variables below here are optional if lkm==0 + !--- variables below here are optional oro_name2(18) = 'lake_frac' ! lake fraction [0:1] oro_name2(19) = 'lake_depth' ! lake depth(m) @@ -713,8 +713,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta !--- register the 2D fields do num = 1,nvar_o2 var2_p => oro_var2(:,:,num) - if ((trim(oro_name2(num)) == 'lake_frac' .or. trim(oro_name2(num)) == 'lake_depth') & - .and. Model%lkm==0) then + if (trim(oro_name2(num)) == 'lake_frac' .or. trim(oro_name2(num)) == 'lake_depth') then call register_restart_field(Oro_restart, oro_name2(num), var2_p, dimensions=(/'lat','lon'/), is_optional=.true.) else call register_restart_field(Oro_restart, oro_name2(num), var2_p, dimensions=(/'lat','lon'/)) @@ -773,6 +772,9 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta else Sfcprop(nb)%lakefrac(ix) = 0 endif + else + Sfcprop(nb)%lakefrac(ix) = oro_var2(i,j,18) !lake frac [0:1] + Sfcprop(nb)%lakedepth(ix) = oro_var2(i,j,19) !lake depth [m] !YWu endif enddo @@ -1516,27 +1518,23 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorlw(ix) endif - if(Sfcprop(nb)%lakefrac(ix) < zero) Sfcprop(nb)%lakefrac(ix) =zero - if(Sfcprop(nb)%landfrac(ix) < zero) Sfcprop(nb)%landfrac(ix) =zero - if(Sfcprop(nb)%fice(ix) < zero) Sfcprop(nb)%fice(ix) =zero -! Sfcprop(nb)%oceanfrac(ix)=one-Sfcprop(nb)%landfrac(ix)-Sfcprop(nb)%lakefrac(ix)-Sfcprop(nb)%fice(ix) - Sfcprop(nb)%oceanfrac(ix)=one-Sfcprop(nb)%landfrac(ix)-Sfcprop(nb)%lakefrac(ix) - if(Sfcprop(nb)%oceanfrac(ix) < zero) Sfcprop(nb)%oceanfrac(ix)=zero -! write(35,75) ix, Sfcprop(nb)%fice(ix), Sfcprop(nb)%oceanfrac(ix), & -! & Sfcprop(nb)%landfrac(ix), Sfcprop(nb)%lakefrac(ix) if (Sfcprop(nb)%stype(ix) == 14 .or. Sfcprop(nb)%stype(ix) <= 0) then Sfcprop(nb)%landfrac(ix) = zero Sfcprop(nb)%stype(ix) = 0 + if (Sfcprop(nb)%lakefrac(ix) > zero) then + Sfcprop(nb)%lakefrac(ix) = one + endif endif if (Model%frac_grid) then - if (Sfcprop(nb)%landfrac(ix) > zero) then + if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)-1.0e-6) - if (Sfcprop(nb)%slmsk(ix) == 1 .and. Sfcprop(nb)%stype(ix) == 14) Sfcprop(nb)%slmsk(ix) = 0 + if (Sfcprop(nb)%slmsk(ix) == 1 .and. Sfcprop(nb)%stype(ix) == 14) & + Sfcprop(nb)%slmsk(ix) = 0 if (Sfcprop(nb)%lakefrac(ix) > zero) then -! Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell + Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then if(Sfcprop(nb)%fice(ix) >= Model%min_lakeice) then Sfcprop(nb)%slmsk(ix) = 2 @@ -1546,7 +1544,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta endif else Sfcprop(nb)%lakefrac(ix) = zero -! Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) + Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix) if (nint(Sfcprop(nb)%slmsk(ix)) /= 1) then if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) then Sfcprop(nb)%slmsk(ix) = 2 @@ -1560,16 +1558,16 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (nint(Sfcprop(nb)%slmsk(ix)) == 1) then Sfcprop(nb)%landfrac(ix) = one Sfcprop(nb)%lakefrac(ix) = zero -! Sfcprop(nb)%oceanfrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero else if (Sfcprop(nb)%slmsk(ix) < 0.1_r8 .or. Sfcprop(nb)%slmsk(ix) > 1.9_r8) then Sfcprop(nb)%landfrac(ix) = zero if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes Sfcprop(nb)%lakefrac(ix) = one -! Sfcprop(nb)%oceanfrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero else ! ocean Sfcprop(nb)%lakefrac(ix) = zero -! Sfcprop(nb)%oceanfrac(ix) = one + Sfcprop(nb)%oceanfrac(ix) = one endif endif endif @@ -1577,9 +1575,9 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta else ! not a fractional grid if (Sfcprop(nb)%landfrac(ix) > zero) then if (Sfcprop(nb)%lakefrac(ix) > zero) then -! Sfcprop(nb)%oceanfrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero Sfcprop(nb)%landfrac(ix) = zero -! Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = one Sfcprop(nb)%slmsk(ix) = zero if (Sfcprop(nb)%fice(ix) >= Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 else @@ -1587,32 +1585,32 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (Sfcprop(nb)%stype(ix) <= 0 .or. Sfcprop(nb)%stype(ix) == 14) & Sfcprop(nb)%slmsk(ix) = zero if (nint(Sfcprop(nb)%slmsk(ix)) == 0) then -! Sfcprop(nb)%oceanfrac(ix) = one + Sfcprop(nb)%oceanfrac(ix) = one Sfcprop(nb)%landfrac(ix) = zero -! Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%lakefrac(ix) = zero if (Sfcprop(nb)%fice(ix) >= Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 else Sfcprop(nb)%landfrac(ix) = one -! Sfcprop(nb)%lakefrac(ix) = zero -! Sfcprop(nb)%oceanfrac(ix) = zero + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero endif endif else if (nint(Sfcprop(nb)%slmsk(ix)) == 1 .and. Sfcprop(nb)%stype(ix) > 0 & .and. Sfcprop(nb)%stype(ix) /= 14) then Sfcprop(nb)%landfrac(ix) = one -! Sfcprop(nb)%lakefrac(ix) = zero -! Sfcprop(nb)%oceanfrac(ix) = zero + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = zero else Sfcprop(nb)%slmsk(ix) = zero Sfcprop(nb)%landfrac(ix) = zero if (Sfcprop(nb)%oro_uf(ix) > min_lake_orog) then ! lakes -! Sfcprop(nb)%lakefrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = one Sfcprop(nb)%oceanfrac(ix) = zero if (Sfcprop(nb)%fice(ix) > Model%min_lakeice) Sfcprop(nb)%slmsk(ix) = 2.0 else ! ocean -! Sfcprop(nb)%lakefrac(ix) = zero -! Sfcprop(nb)%oceanfrac(ix) = one + Sfcprop(nb)%lakefrac(ix) = zero + Sfcprop(nb)%oceanfrac(ix) = one if (Sfcprop(nb)%fice(ix) > Model%min_seaice) Sfcprop(nb)%slmsk(ix) = 2.0 endif endif @@ -3011,41 +3009,59 @@ subroutine clm_lake_register_fields(data) ! Register 3D fields call register_restart_field(Sfc_restart, 'lake_z3d', data%lake_z3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart, 'lake_dz3d', data%lake_dz3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_watsat3d', data%lake_watsat3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_csol3d', data%lake_csol3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_tkmg3d', data%lake_tkmg3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_tkdry3d', data%lake_tkdry3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_tksatu3d', data%lake_tksatu3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_snow_z3d', data%lake_snow_z3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_snow_dz3d', data%lake_snow_dz3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_snow_zi3d', data%lake_snow_zi3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levsnowsoil_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil_clm_lake ', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_t_h2osoi_vol3d', data%lake_t_h2osoi_vol3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_t_h2osoi_liq3d', data%lake_t_h2osoi_liq3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_t_h2osoi_ice3d', data%lake_t_h2osoi_ice3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_t_soisno3d', data%lake_t_soisno3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_t_lake3d', data%lake_t_lake3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_icefrac3d', data%lake_icefrac3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levlake_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_clay3d', data%lake_clay3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levsoil_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsoil_clm_lake ', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_sand3d', data%lake_sand3d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'levsoil_clm_lake', 'Time '/), is_optional=.true.) + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsoil_clm_lake ', 'Time '/), is_optional=.true.) end subroutine clm_lake_register_fields subroutine clm_lake_final(data) From c9b2f47712cae3ced274be7a534d60da0b1cbafd Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 28 Nov 2022 16:47:31 +0000 Subject: [PATCH 27/74] revert some changes --- ccpp/data/GFS_typedefs.F90 | 2 +- ccpp/data/GFS_typedefs.meta | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index e70016467..1c515bf70 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -1,7 +1,7 @@ module GFS_typedefs use machine, only: kind_phys, kind_dbl_prec, kind_sngl_prec - use physcons, only: con_cp, con_fvirt, con_g, rhoice, & + use physcons, only: con_cp, con_fvirt, con_g, rholakeice, & con_hvap, con_hfus, con_pi, con_rd, con_rv, & con_t0c, con_cvap, con_cliq, con_eps, con_epsq, & con_epsm1, con_ttp, rlapse, con_jcal, con_rhw0, & diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 2ade678ef..6f3333d9a 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -9272,7 +9272,7 @@ dimensions = () type = real kind = kind_phys -[rhoice] +[rholakeice] standard_name = density_of_ice_on_lake long_name = density of ice on a lake units = kg m-3 From dcb4317fa436a6fa0042f7454a560d8d42d9eac1 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 28 Nov 2022 18:09:41 +0000 Subject: [PATCH 28/74] remove unused code --- ccpp/driver/GFS_restart.F90 | 42 ------------------------------------- 1 file changed, 42 deletions(-) diff --git a/ccpp/driver/GFS_restart.F90 b/ccpp/driver/GFS_restart.F90 index 2a2413b98..c4bfaa046 100644 --- a/ccpp/driver/GFS_restart.F90 +++ b/ccpp/driver/GFS_restart.F90 @@ -580,48 +580,6 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & enddo endif - contains - - subroutine lvar3d(count, nb, ix, var3d, varname) - implicit none - logical, intent(in) :: count - real(kind=kind_phys), target :: var3d(:,:) ! 3d ij-k variable - character(len=*), intent(in) :: varname ! variable name without level number - integer, intent(in) :: nb ! current block being processed - integer, intent(inout) :: ix ! num or Restart%num2d - character(400) :: fullname ! full variable name with level appended - integer :: k ! vertical level number - if(count) then - ix=ix+size(var3d,2) - return - endif - do k=1,size(var3d,2) - ix=ix+1 - if(nb==1) then - write(fullname,"(A,'_',I0)") trim(varname),k - Restart%name2d(ix) = trim(fullname) - endif - Restart%data(nb,ix)%var2p => var3d(:,k) - enddo - end subroutine lvar3d - - subroutine lvar2d(count, nb, ix, var2d, varname) - implicit none - logical, intent(in) :: count - real(kind=kind_phys), target :: var2d(:) ! 2d ij variable - character(len=*), intent(in) :: varname ! variable name - integer, intent(in) :: nb ! current block being processed - integer, intent(inout) :: ix ! num or Restart%num2d - ix=ix+1 - if(count) then - return - endif - if(nb==1) then - Restart%name2d(ix) = trim(varname) - endif - Restart%data(nb,ix)%var2p => var2d - end subroutine lvar2d - end subroutine GFS_restart_populate end module GFS_restart From dfa2a55bc104f23a8da15d49760e310887c3fc80 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 28 Nov 2022 18:09:52 +0000 Subject: [PATCH 29/74] move a variable up to module level --- io/FV3GFS_io.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 238dfbbd5..dc4d03486 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -87,7 +87,7 @@ module FV3GFS_io_mod integer :: tot_diag_idx = 0 integer :: total_outputlevel = 0 integer :: isco,ieco,jsco,jeco,levo,num_axes_phys - integer :: fhzero, ncld, nsoil, imp_physics, landsfcmdl, k + integer :: fhzero, ncld, nsoil, imp_physics, landsfcmdl, nvar_s2me real(4) :: dtp logical :: lprecip_accu character(len=64) :: Sprecip_accu @@ -606,7 +606,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta integer :: isc, iec, jsc, jec, npz, nx, ny integer :: id_restart integer :: nvar_o2, nvar_s2m, nvar_s2o, nvar_s3 - integer :: nvar_s2me, nvar_s2l + integer :: nvar_s2l integer :: nvar_oro_ls_ss integer :: nvar_s2r, nvar_s2mp, nvar_s3mp, isnow integer :: nvar_emi, nvar_dust12m, nvar_gbbepx From 8701b845d4e499ac741c6f96347839c3ad301f27 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 28 Nov 2022 18:10:05 +0000 Subject: [PATCH 30/74] revert changes in ccpp physics --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 5709bfab9..e079dc7ab 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 5709bfab97793ec6ec38e312013bd0b79735c130 +Subproject commit e079dc7abc2964b6e232cf4dcee779e1a5581636 From ff7a2910475d853563a5605b81ed938b55f75f70 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 28 Nov 2022 19:24:27 +0000 Subject: [PATCH 31/74] remove flake changes --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index e079dc7ab..405fc8518 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit e079dc7abc2964b6e232cf4dcee779e1a5581636 +Subproject commit 405fc8518a54b4527c0bda30c4efc6c5c9c3a20c From 4d5df7b1622dfa78d48350003b57a887928c13ee Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 28 Nov 2022 22:25:25 +0000 Subject: [PATCH 32/74] remove flake variables --- ccpp/data/GFS_typedefs.F90 | 30 ++--------------- ccpp/data/GFS_typedefs.meta | 64 ------------------------------------- 2 files changed, 2 insertions(+), 92 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 1c515bf70..032ba98f7 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -217,14 +217,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: lake_t2m (:) => null() !< 2 meter temperature from CLM Lake model real (kind=kind_phys), pointer :: lake_q2m (:) => null() !< 2 meter humidity from CLM Lake model - real (kind=kind_phys), pointer :: h_ML(:) => null() !Mixed Layer depth of lakes [m] - real (kind=kind_phys), pointer :: t_ML(:) => null() !Mixing layer temperature in K - real (kind=kind_phys), pointer :: t_mnw(:) => null() !Mean temperature of the water column [K] - real (kind=kind_phys), pointer :: h_talb(:) => null() !the thermally active layer depth of the bottom sediments [m] - real (kind=kind_phys), pointer :: t_talb(:) => null() !Temperature at the bottom of the sediment upper layer [K] - real (kind=kind_phys), pointer :: t_bot1(:) => null() !Temperature at the water-bottom sediment interface [K] - real (kind=kind_phys), pointer :: t_bot2(:) => null() !Temperature for bottom layer of water [K] - real (kind=kind_phys), pointer :: c_t(:) => null() !Shape factor of water temperature vertical profile real (kind=kind_phys), pointer :: T_snow(:) => null() !temperature of snow on a lake [K] real (kind=kind_phys), pointer :: T_ice(:) => null() !temperature of ice on a lake [K] @@ -2135,16 +2127,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%use_lake_model(IM)) if(Model%lkm > 0) then - if(Model%iopt_lake==Model%iopt_lake_flake ) then - allocate (Sfcprop%h_ML (IM)) - allocate (Sfcprop%t_ML (IM)) - allocate (Sfcprop%t_mnw (IM)) - allocate (Sfcprop%h_talb (IM)) - allocate (Sfcprop%t_talb (IM)) - allocate (Sfcprop%t_bot1 (IM)) - allocate (Sfcprop%t_bot2 (IM)) - allocate (Sfcprop%c_t (IM)) - else + if(Model%iopt_lake==Model%iopt_lake_clm ) then allocate (Sfcprop%clm_lakedepth(IM)) endif allocate (Sfcprop%T_snow (IM)) @@ -2187,16 +2170,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%use_lake_model = zero if(Model%lkm > 0) then - if(Model%iopt_lake==Model%iopt_lake_flake ) then - Sfcprop%h_ML = clear_val - Sfcprop%t_ML = clear_val - Sfcprop%t_mnw = clear_val - Sfcprop%h_talb = clear_val - Sfcprop%t_talb = clear_val - Sfcprop%t_bot1 = clear_val - Sfcprop%t_bot2 = clear_val - Sfcprop%c_t = clear_val - else + if(Model%iopt_lake==Model%iopt_lake_clm ) then Sfcprop%clm_lakedepth = clear_val endif Sfcprop%T_snow = clear_val diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 6f3333d9a..7bfdd1e67 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -648,70 +648,6 @@ type = real kind = kind_phys active = (control_for_lake_model_selection == 2) -[h_ML] - standard_name = mixed_layer_depth_of_lakes - long_name = depth of lake mixing layer - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 1) -[t_ML] - standard_name = lake_mixed_layer_temperature - long_name = temperature of lake mixing layer - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 1) -[t_mnw] - standard_name = mean_temperature_of_the_water_column - long_name = thee mean temperature of the water column - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 1) -[h_talb] - standard_name = the_thermally_active_layer_depth_of_the_bottom_sediment - long_name = the depth of the thermally active layer of the bottom sediment - units = m - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 1) -[t_talb] - standard_name = temperature_at_the_bottom_of_the_sediment_upper_layer - long_name = the temperature at the bottom of the sediment upper layer - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 1) -[t_bot1] - standard_name = lake_bottom_temperature - long_name = the temperature at the water-bottom sediment interface - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 1) -[t_bot2] - standard_name = temperature_for_bottom_layer_of_water - long_name = the temperature at the lake bottom layer water - units = K - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 1) -[c_t] - standard_name = shape_factor_of_water_temperature_vertical_profile - long_name = the shape factor of water temperature vertical profile - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - active = (control_for_lake_model_selection == 1) [T_snow] standard_name = temperature_of_snow_on_lake long_name = temperature of snow on a lake From df1e091451df7225bd92ef512b219c6709dd2bae Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 28 Nov 2022 22:25:46 +0000 Subject: [PATCH 33/74] put clm lake restart vars back in --- CMakeLists.txt | 1 + io/FV3GFS_io.F90 | 718 +++------------------------------------------ io/clm_lake_io.F90 | 496 +++++++++++++++++++++++++++++++ 3 files changed, 531 insertions(+), 684 deletions(-) create mode 100644 io/clm_lake_io.F90 diff --git a/CMakeLists.txt b/CMakeLists.txt index ed34916b3..4486c1cdb 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -52,6 +52,7 @@ add_library(fv3atm cpl/module_block_data.F90 cpl/module_cplfields.F90 cpl/module_cap_cpl.F90 + io/clm_lake_io.F90 io/FV3GFS_io.F90 io/module_write_netcdf.F90 io/module_fv3_io_def.F90 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index dc4d03486..1c0d30c46 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -33,7 +33,7 @@ module FV3GFS_io_mod use diag_util_mod, only: find_input_field use constants_mod, only: grav, rdgas use physcons, only: con_tice !saltwater freezing temp (K) - + use clm_lake_io, only: clm_lake_data_type ! !--- GFS_typedefs use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, & @@ -87,7 +87,7 @@ module FV3GFS_io_mod integer :: tot_diag_idx = 0 integer :: total_outputlevel = 0 integer :: isco,ieco,jsco,jeco,levo,num_axes_phys - integer :: fhzero, ncld, nsoil, imp_physics, landsfcmdl, nvar_s2me + integer :: fhzero, ncld, nsoil, imp_physics, landsfcmdl, k real(4) :: dtp logical :: lprecip_accu character(len=64) :: Sprecip_accu @@ -99,7 +99,7 @@ module FV3GFS_io_mod real(kind=kind_phys),dimension(:,:,:),allocatable:: uwork3d logical :: uwork_set = .false. character(128) :: uwindname - integer, parameter, public :: DIAG_SIZE = 800 + integer, parameter, public :: DIAG_SIZE = 500 real, parameter :: missing_value = 9.99e20_r8 real, parameter:: stndrd_atmos_ps = 101325.0_r8 real, parameter:: stndrd_atmos_lapse = 0.0065_r8 @@ -111,65 +111,6 @@ module FV3GFS_io_mod logical :: use_wrtgridcomp_output = .FALSE. logical :: module_is_initialized = .FALSE. - type clm_lake_data_type - ! The clm_lake_data_type derived type is a class that stores - ! temporary arrays used to read or write CLM Lake model restart - ! and axis variables. It can safely be declared and unused, but - ! you should only call these routines if the CLM Lake Model was - ! (or will be) used by this execution of the FV3. It is the - ! responsibility of the caller to ensure the necessary data is in - ! Sfc_restart, Sfcprop, and Model. - - ! All 2D variables needed for a restart - real(kind_phys), pointer, private, dimension(:,:) :: & - lake_snl2d=>null(), lake_h2osno2d=>null(), lake_t_grnd2d=>null(), clm_lakedepth=>null(), & - lake_savedtke12d=>null(), lake_dp2dsno=>null(), clm_lake_initialized=>null() - - ! All 3D variables needed for a restart - real(kind_phys), pointer, private, dimension(:,:,:) :: & - lake_z3d=>null(), lake_dz3d=>null(), lake_watsat3d=>null(), & - lake_csol3d=>null(), lake_tkmg3d=>null(), lake_tkdry3d=>null(), & - lake_tksatu3d=>null(), lake_snow_z3d=>null(), lake_snow_dz3d=>null(), & - lake_snow_zi3d=>null(), lake_t_h2osoi_vol3d=>null(), lake_t_h2osoi_liq3d=>null(), & - lake_t_h2osoi_ice3d=>null(), lake_t_soisno3d=>null(), lake_t_lake3d=>null(), & - lake_icefrac3d=>null(), lake_clay3d=>null(), lake_sand3d=>null() - - contains - - ! register_axes calls registers_axis on Sfc_restart for all required axes - procedure, public :: register_axes => clm_lake_register_axes - - ! allocate_data allocates all of the pointers in this object - procedure, public :: allocate_data => clm_lake_allocate_data - - ! fill_with_zero allocates fills the temporary arrays with 0 - procedure, public :: fill_with_zero => clm_lake_fill_with_zero - - ! register_fields calls register_field on Sfc_restart for all CLM Lake model restart variables - procedure, public :: register_fields => clm_lake_register_fields - - ! deallocate_data deallocates all pointers, allowing this object to be used repeatedly. - ! It is safe to call deallocate_data if no data has been allocated. - procedure, public :: deallocate_data => clm_lake_deallocate_data - - ! write_axes writes variables to Sfc_restart, with the name of - ! each axis, containing the appropriate information - procedure, public :: write_axes => clm_lake_write_axes - - ! copy_to_temporaries copies from Sfcprop to internal pointers (declared above) - procedure, public :: copy_to_temporaries => clm_lake_copy_to_temporaries - - ! copy_to_temporaries copies from internal pointers (declared above) to Sfcprop - procedure, public :: copy_from_temporaries => clm_lake_copy_from_temporaries - - ! A fortran 2003 compliant compiler will call clm_lake_final - ! automatically when an object of this type goes out of - ! scope. This will deallocate any arrays via a call to - ! deallocate_data. It is safe to call this routine if no data has - ! been allocated. - final :: clm_lake_final - end type clm_lake_data_type - CONTAINS !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -263,14 +204,6 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) nsfcprop2d = nsfcprop2d + 16 endif -! CLM Lake and Flake - if(Model%lkm > 0) then - nsfcprop2d = nsfcprop2d + 2 - if(Model%iopt_lake==Model%iopt_lake_flake ) then - nsfcprop2d = nsfcprop2d + 8 - endif - endif - allocate (temp2d(isc:iec,jsc:jec,nsfcprop2d+Model%ntot2d+Model%nctp)) allocate (temp3d(isc:iec,jsc:jec,1:lev,14+Model%ntot3d+2*ntr)) allocate (temp3dlevsp1(isc:iec,jsc:jec,1:lev+1,3)) @@ -499,25 +432,8 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) temp2d(i,j,idx_opt+13) = GFS_Data(nb)%Sfcprop%ifd(ix) temp2d(i,j,idx_opt+14) = GFS_Data(nb)%Sfcprop%dt_cool(ix) temp2d(i,j,idx_opt+15) = GFS_Data(nb)%Sfcprop%qrain(ix) - idx_opt = idx_opt + 15 endif -! CLM Lake / Flake - if (Model%lkm > 0) then - temp2d(i,j,idx_opt+ 1) = GFS_Data(nb)%Sfcprop%T_snow(ix) - temp2d(i,j,idx_opt+ 2) = GFS_Data(nb)%Sfcprop%T_ice(ix) - if(Model%iopt_lake==Model%iopt_lake_flake ) then - temp2d(i,j,idx_opt+ 3) = GFS_Data(nb)%Sfcprop%h_ML(ix) - temp2d(i,j,idx_opt+ 4) = GFS_Data(nb)%Sfcprop%t_ML(ix) - temp2d(i,j,idx_opt+ 5) = GFS_Data(nb)%Sfcprop%t_mnw(ix) - temp2d(i,j,idx_opt+ 6) = GFS_Data(nb)%Sfcprop%h_talb(ix) - temp2d(i,j,idx_opt+ 7) = GFS_Data(nb)%Sfcprop%t_talb(ix) - temp2d(i,j,idx_opt+ 8) = GFS_Data(nb)%Sfcprop%t_bot1(ix) - temp2d(i,j,idx_opt+ 9) = GFS_Data(nb)%Sfcprop%t_bot2(ix) - temp2d(i,j,idx_opt+ 10) = GFS_Data(nb)%Sfcprop%c_t(ix) - endif - endif - do l = 1,Model%ntot2d temp2d(i,j,nsfcprop2d+l) = GFS_Data(nb)%Tbd%phy_f2d(ix,l) enddo @@ -606,7 +522,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta integer :: isc, iec, jsc, jec, npz, nx, ny integer :: id_restart integer :: nvar_o2, nvar_s2m, nvar_s2o, nvar_s3 - integer :: nvar_s2l integer :: nvar_oro_ls_ss integer :: nvar_s2r, nvar_s2mp, nvar_s3mp, isnow integer :: nvar_emi, nvar_dust12m, nvar_gbbepx @@ -760,10 +675,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%landfrac(ix) = -9999.0 Sfcprop(nb)%lakefrac(ix) = -9999.0 - Sfcprop(nb)%lakedepth(ix) = -9999.0 Sfcprop(nb)%landfrac(ix) = oro_var2(i,j,17) !land frac [0:1] - if (Model%lkm > 0 ) then if(oro_var2(i,j,18)>Model%lakefrac_threshold .and. & oro_var2(i,j,19)>Model%lakedepth_threshold) then @@ -771,6 +684,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%lakedepth(ix) = oro_var2(i,j,19) !lake depth [m] !YWu else Sfcprop(nb)%lakefrac(ix) = 0 + Sfcprop(nb)%lakedepth(ix) = -9999 endif else Sfcprop(nb)%lakefrac(ix) = oro_var2(i,j,18) !lake frac [0:1] @@ -788,20 +702,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (Model%cplwav) then nvar_s2m = nvar_s2m + 1 endif -! CLM Lake and Flake - if (Model%lkm > 0) then - if(Model%iopt_lake==Model%iopt_lake_flake ) then - write(0,*) 'flake iopt_lake=',Model%iopt_lake - nvar_s2l = 10 - else - write(0,*) 'clm_lake iopt_lake=',Model%iopt_lake - nvar_s2l = 2 - endif - else - write(0,*) 'no lake lkm=',Model%lkm - nvar_s2l = 0 - endif - write(0,*) 'nvar_s2l=',nvar_s2l !--- deallocate containers and free restart container deallocate(oro_name2, oro_var2) @@ -1056,9 +956,9 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (.not. allocated(sfc_name2)) then !--- allocate the various containers needed for restarts - allocate(sfc_name2(nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r+nvar_s2l)) + allocate(sfc_name2(nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r)) allocate(sfc_name3(0:nvar_s3+nvar_s3mp)) - allocate(sfc_var2(nx,ny,nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r+nvar_s2l)) + allocate(sfc_var2(nx,ny,nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r)) ! Note that this may cause problems with RUC LSM for coldstart runs from GFS data ! if the initial conditions do contain this variable, because Model%kice is 9 for ! RUC LSM, but tiice in the initial conditions will only have two vertical layers @@ -1165,7 +1065,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(nvar_s2m+16) = 'ifd' sfc_name2(nvar_s2m+17) = 'dt_cool' sfc_name2(nvar_s2m+18) = 'qrain' - nvar_s2me = nvar_s2m+18 ! ! Only needed when Noah MP LSM is used - 29 2D ! @@ -1199,7 +1098,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(nvar_s2m+45) = 'smcwtdxy' sfc_name2(nvar_s2m+46) = 'deeprechxy' sfc_name2(nvar_s2m+47) = 'rechxy' - nvar_s2me = nvar_s2m+47 else if (Model%lsm == Model%lsm_ruc .and. warm_start) then sfc_name2(nvar_s2m+19) = 'wetness' sfc_name2(nvar_s2m+20) = 'clw_surf_land' @@ -1213,31 +1111,12 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(nvar_s2m+28) = 'sfalb_lnd' sfc_name2(nvar_s2m+29) = 'sfalb_lnd_bck' sfc_name2(nvar_s2m+30) = 'sfalb_ice' - nvar_s2me = nvar_s2m+30 if (Model%rdlai) then sfc_name2(nvar_s2m+31) = 'lai' - nvar_s2me = nvar_s2m+31 endif else if (Model%lsm == Model%lsm_ruc .and. Model%rdlai) then sfc_name2(nvar_s2m+19) = 'lai' - nvar_s2me = nvar_s2m+19 endif -!CLM Lake and Flake - if (Model%lkm > 0) then - sfc_name2(nvar_s2me+1) = 'T_snow' - sfc_name2(nvar_s2me+2) = 'T_ice' - if( Model%iopt_lake==Model%iopt_lake_flake ) then - sfc_name2(nvar_s2me+3) = 'h_ML' - sfc_name2(nvar_s2me+4) = 't_ML' - sfc_name2(nvar_s2me+5) = 't_mnw' - sfc_name2(nvar_s2me+6) = 'h_talb' - sfc_name2(nvar_s2me+7) = 't_talb' - sfc_name2(nvar_s2me+8) = 't_bot1' - sfc_name2(nvar_s2me+9) = 't_bot2' - sfc_name2(nvar_s2me+10) = 'c_t' - write(0,*) 'ten sfc_name2' - endif - endif is_lsoil=.false. if ( .not. warm_start ) then @@ -1273,8 +1152,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then call clm_lake%allocate_data(Model) call clm_lake%fill_with_zero(Model, Sfcprop, Atm_block) - call clm_lake%register_axes(Model) - call clm_lake%register_fields + call clm_lake%register_axes(Model, Sfc_restart) + call clm_lake%register_fields(Sfc_restart) endif !--- register the 2D fields @@ -1345,22 +1224,10 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta end if enddo endif ! noahmp -! CLM Lake and Flake - if (Model%lkm > 0) then - mand = .false. - do num = nvar_s2me+1,nvar_s2me+nvar_s2l - var2_p => sfc_var2(:,:,num) - if(is_lsoil) then - call register_restart_field(Sfc_restart, sfc_name2(num),var2_p,dimensions=(/'lat','lon'/), is_optional=.not.mand) - else - call register_restart_field(Sfc_restart, sfc_name2(num),var2_p,dimensions=(/'Time ','yaxis_1','xaxis_1'/), is_optional=.not.mand) - endif - enddo - endif - nullify(var2_p) endif ! if not allocated + if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. (.not.warm_start)) then !--- names of the 3D variables to save sfc_name3(1) = 'stc' @@ -1518,7 +1385,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%zorlwav(ix) = Sfcprop(nb)%zorlw(ix) endif - if (Sfcprop(nb)%stype(ix) == 14 .or. Sfcprop(nb)%stype(ix) <= 0) then Sfcprop(nb)%landfrac(ix) = zero Sfcprop(nb)%stype(ix) = 0 @@ -1527,7 +1393,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta endif endif - if (Model%frac_grid) then if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then Sfcprop(nb)%slmsk(ix) = ceiling(Sfcprop(nb)%landfrac(ix)-1.0e-6) @@ -1573,7 +1438,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta endif endif else ! not a fractional grid - if (Sfcprop(nb)%landfrac(ix) > zero) then + if (Sfcprop(nb)%landfrac(ix) > -999.0_r8) then if (Sfcprop(nb)%lakefrac(ix) > zero) then Sfcprop(nb)%oceanfrac(ix) = zero Sfcprop(nb)%landfrac(ix) = zero @@ -1663,7 +1528,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%ifd(ix) = sfc_var2(i,j,nvar_s2m+16) !--- nsstm ifd Sfcprop(nb)%dt_cool(ix) = sfc_var2(i,j,nvar_s2m+17) !--- nsstm dt_cool Sfcprop(nb)%qrain(ix) = sfc_var2(i,j,nvar_s2m+18) !--- nsstm qrain - nvar_s2me = nvar_s2m+18 endif endif @@ -1681,17 +1545,14 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%sfalb_lnd(ix) = sfc_var2(i,j,nvar_s2m+28) Sfcprop(nb)%sfalb_lnd_bck(ix) = sfc_var2(i,j,nvar_s2m+29) Sfcprop(nb)%sfalb_ice(ix) = sfc_var2(i,j,nvar_s2m+30) - nvar_s2me = nvar_s2m+30 if (Model%rdlai) then Sfcprop(nb)%xlaixy(ix) = sfc_var2(i,j,nvar_s2m+31) - nvar_s2me = nvar_s2m+31 endif else if (Model%lsm == Model%lsm_ruc) then ! Initialize RUC snow cover on ice from snow cover Sfcprop(nb)%sncovr_ice(ix) = Sfcprop(nb)%sncovr(ix) if (Model%rdlai) then Sfcprop(nb)%xlaixy(ix) = sfc_var2(i,j,nvar_s2m+19) - nvar_s2me = nvar_s2m+19 end if elseif (Model%lsm == Model%lsm_noahmp) then !--- Extra Noah MP variables @@ -1724,23 +1585,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%smcwtdxy(ix) = sfc_var2(i,j,nvar_s2m+45) Sfcprop(nb)%deeprechxy(ix) = sfc_var2(i,j,nvar_s2m+46) Sfcprop(nb)%rechxy(ix) = sfc_var2(i,j,nvar_s2m+47) - nvar_s2me = nvar_s2m+47 - endif -!CLM Lake and Flake - if (Model%lkm > 0) then - Sfcprop(nb)%T_snow(ix) = sfc_var2(i,j,nvar_s2me+1) - Sfcprop(nb)%T_ice(ix) = sfc_var2(i,j,nvar_s2me+2) - if(Model%iopt_lake==Model%iopt_lake_flake ) then - Sfcprop(nb)%h_ML(ix) = sfc_var2(i,j,nvar_s2me+3) - Sfcprop(nb)%t_ML(ix) = sfc_var2(i,j,nvar_s2me+4) - Sfcprop(nb)%t_mnw(ix) = sfc_var2(i,j,nvar_s2me+5) - Sfcprop(nb)%h_talb(ix) = sfc_var2(i,j,nvar_s2me+6) - Sfcprop(nb)%t_talb(ix) = sfc_var2(i,j,nvar_s2me+7) - Sfcprop(nb)%t_bot1(ix) = sfc_var2(i,j,nvar_s2me+8) - Sfcprop(nb)%t_bot2(ix) = sfc_var2(i,j,nvar_s2me+9) - Sfcprop(nb)%c_t(ix) = sfc_var2(i,j,nvar_s2me+10) - write(0,*) 'copy ten sfc_name2' - endif endif if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. (.not.warm_start)) then @@ -2022,10 +1866,8 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta integer :: id_restart integer :: nvar2m, nvar2o, nvar3 integer :: nvar2r, nvar2mp, nvar3mp - integer :: nvar2me, nvar2l !for flake logical :: mand character(len=32) :: fn_srf = 'sfc_data.nc' - logical :: must_reallocate ! reallocate module variables if they're the wrong size real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p1 => NULL() @@ -2065,16 +1907,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nvar2mp = 29 nvar3mp = 5 endif -!CLM Lake and Flake - if (Model%lkm > 0) then - if( Model%iopt_lake==Model%iopt_lake_flake ) then - nvar2l = 10 - else - nvar2l = 2 - endif - else - nvar2l = 0 - endif isc = Atm_block%isc iec = Atm_block%iec @@ -2084,6 +1916,21 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nx = (iec - isc + 1) ny = (jec - jsc + 1) + if (Model%lsm == Model%lsm_ruc) then + if (allocated(sfc_name2)) then + ! Re-allocate if one or more of the dimensions don't match + if (size(sfc_name2).ne.nvar2m+nvar2o+nvar2mp+nvar2r .or. & + size(sfc_name3).ne.nvar3+nvar3mp .or. & + size(sfc_var3,dim=3).ne.Model%lsoil_lsm) then + !--- deallocate containers and free restart container + deallocate(sfc_name2) + deallocate(sfc_name3) + deallocate(sfc_var2) + deallocate(sfc_var3) + end if + end if + end if + !--- set filename infile=trim(indir)//'/'//trim(fn_srf) if( present(timestamp) ) infile=trim(indir)//'/'//trim(timestamp)//'.'//trim(fn_srf) @@ -2159,50 +2006,15 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta ! Tell clm_lake to allocate data, register its axes, and call write_data for each axis's variable if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then call clm_lake%allocate_data(Model) - call clm_lake%register_axes(Model) - call clm_lake%write_axes(Model) + call clm_lake%register_axes(Model, Sfc_restart) + call clm_lake%write_axes(Model, Sfc_restart) endif - check_containers: if(allocated(sfc_name2)) then - !--- Check if the containers are the right size. - !--- This must match the allocate block, below. - must_reallocate = .false. - if(size(sfc_name2) /= nvar2m+nvar2o+nvar2mp+nvar2r+nvar2l .or. & - size(sfc_name3) /= nvar3+nvar3mp .or. & - size(sfc_var2,1) /= nx .or. & - size(sfc_var2,2) /= ny .or. & - size(sfc_var2,3) /= nvar2m+nvar2o+nvar2mp+nvar2r+nvar2l) then - must_reallocate = .true. - else - if(Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then - if(size(sfc_var3,1) /= nx .or. size(sfc_var3,2) /= ny .or. & - size(sfc_var3,3) /= Model%lsoil .or. size(sfc_var3,4) /= nvar3) then - must_reallocate = .true. - endif - else if(model%lsm == Model%lsm_ruc) then - if(size(sfc_var3,1) /= nx .or. size(sfc_var3,2) /= ny .or. & - size(sfc_var3,3) /= Model%lsoil_lsm .or. size(sfc_var3,4) /= nvar3) then - must_reallocate = .true. - endif - endif - endif - if(must_reallocate) then - if(allocated(sfc_name2)) deallocate(sfc_name2) - if(allocated(sfc_name3)) deallocate(sfc_name3) - if(allocated(sfc_var2)) deallocate(sfc_var2) - if(allocated(sfc_var3)) deallocate(sfc_var3) - if(allocated(sfc_var3sn)) deallocate(sfc_var3sn) - if(allocated(sfc_var3eq)) deallocate(sfc_var3eq) - if(allocated(sfc_var3zn)) deallocate(sfc_var3zn) - endif - endif check_containers - - allocate_containers: if (.not. allocated(sfc_name2)) then - !--- Allocate the various containers needed for restarts - !--- which must match the reallocate block, above. - allocate(sfc_name2(nvar2m+nvar2o+nvar2mp+nvar2r+nvar2l)) + if (.not. allocated(sfc_name2)) then + !--- allocate the various containers needed for restarts + allocate(sfc_name2(nvar2m+nvar2o+nvar2mp+nvar2r)) allocate(sfc_name3(0:nvar3+nvar3mp)) - allocate(sfc_var2(nx,ny,nvar2m+nvar2o+nvar2mp+nvar2r+nvar2l)) + allocate(sfc_var2(nx,ny,nvar2m+nvar2o+nvar2mp+nvar2r)) if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then allocate(sfc_var3(nx,ny,Model%lsoil,nvar3)) elseif (Model%lsm == Model%lsm_ruc) then @@ -2271,15 +2083,13 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(46) = 'sncovr_ice' sfc_name2(47) = 'snodi' !snowd on ice portion of a cell sfc_name2(48) = 'weasdi'!weasd on ice portion of a cell - nvar2me = 48 + if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then sfc_name2(49) = 'albdirvis_ice' sfc_name2(50) = 'albdifvis_ice' sfc_name2(51) = 'albdirnir_ice' sfc_name2(52) = 'albdifnir_ice' - nvar2me = 52 ! sfc_name2(53) = 'sfalb_ice' -! nvar2me = 53 endif if (Model%cplwav) then @@ -2304,7 +2114,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+16) = 'ifd' sfc_name2(nvar2m+17) = 'dt_cool' sfc_name2(nvar2m+18) = 'qrain' - nvar2me = nvar2m+18 if (Model%lsm == Model%lsm_ruc) then sfc_name2(nvar2m+19) = 'wetness' sfc_name2(nvar2m+20) = 'clw_surf_land' @@ -2318,10 +2127,8 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+28) = 'sfalb_lnd' sfc_name2(nvar2m+29) = 'sfalb_lnd_bck' sfc_name2(nvar2m+30) = 'sfalb_ice' - nvar2me = nvar2m+30 if (Model%rdlai) then sfc_name2(nvar2m+31) = 'lai' - nvar2me = nvar2m+31 endif else if(Model%lsm == Model%lsm_noahmp) then ! Only needed when Noah MP LSM is used - 29 2D @@ -2354,38 +2161,12 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+45) = 'smcwtdxy' sfc_name2(nvar2m+46) = 'deeprechxy' sfc_name2(nvar2m+47) = 'rechxy' - nvar2me = nvar2m+47 endif -!CLM Lake Flake - if(Model%lkm > 0) then - sfc_name2(nvar2me+1) = 'T_snow' - sfc_name2(nvar2me+2) = 'T_ice' - if(Model%iopt_lake==Model%iopt_lake_flake ) then - sfc_name2(nvar2me+3) = 'h_ML' - sfc_name2(nvar2me+4) = 't_ML' - sfc_name2(nvar2me+5) = 't_mnw' - sfc_name2(nvar2me+6) = 'h_talb' - sfc_name2(nvar2me+7) = 't_talb' - sfc_name2(nvar2me+8) = 't_bot1' - sfc_name2(nvar2me+9) = 't_bot2' - sfc_name2(nvar2me+10) = 'c_t' - if(Model%me==0) then - do i=1,nvar2me+10 - print 1048,i,sfc_name2(i) -1048 format("sfc_name2(",I0,') = "',A,'"') - enddo - if(size(sfc_name2)/=nvar2me+10) then -3814 format("ERROR: size mismatch size(sfc_name2)=",I0," /= nvar2me+10=",I0) - write(0,3814) size(sfc_name2),nvar2me+10 - endif - endif - endif - endif - end if allocate_containers + end if ! Tell clm_lake to register all of its fields if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then - call clm_lake%register_fields + call clm_lake%register_fields(Sfc_restart) endif !--- register the 2D fields @@ -2430,16 +2211,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta &is_optional=.not.mand) enddo endif -!CLM Lake and Flake - if(Model%lkm > 0) then - mand = .false. - do num = nvar2me+1,nvar2me+nvar2l - var2_p => sfc_var2(:,:,num) - call register_restart_field(Sfc_restart, sfc_name2(num),var2_p,dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/),& - &is_optional=.not.mand) - enddo - endif - nullify(var2_p) if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then @@ -2573,7 +2344,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta endif if (Model%cplwav) then sfc_var2(i,j,nvar2m) = Sfcprop(nb)%zorlwav(ix) !--- zorlwav (zorl from wav) - nvar2me = nvar2m endif !--- NSSTM variables if (Model%nstf_name(1) > 0) then @@ -2595,7 +2365,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+16) = Sfcprop(nb)%ifd(ix) !--- nsstm ifd sfc_var2(i,j,nvar2m+17) = Sfcprop(nb)%dt_cool(ix)!--- nsstm dt_cool sfc_var2(i,j,nvar2m+18) = Sfcprop(nb)%qrain(ix) !--- nsstm qrain - nvar2me = nvar2m + 18 endif if (Model%lsm == Model%lsm_ruc) then @@ -2612,10 +2381,8 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+28) = Sfcprop(nb)%sfalb_lnd(ix) sfc_var2(i,j,nvar2m+29) = Sfcprop(nb)%sfalb_lnd_bck(ix) sfc_var2(i,j,nvar2m+30) = Sfcprop(nb)%sfalb_ice(ix) - nvar2me = nvar2m + 30 if (Model%rdlai) then sfc_var2(i,j,nvar2m+31) = Sfcprop(nb)%xlaixy(ix) - nvar2me = nvar2m + 31 endif else if (Model%lsm == Model%lsm_noahmp) then !--- Extra Noah MP variables @@ -2648,23 +2415,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+45) = Sfcprop(nb)%smcwtdxy(ix) sfc_var2(i,j,nvar2m+46) = Sfcprop(nb)%deeprechxy(ix) sfc_var2(i,j,nvar2m+47) = Sfcprop(nb)%rechxy(ix) - nvar2me = nvar2m + 47 endif -!CLM Lake and Flake - if(Model%lkm > 0) then - sfc_var2(i,j,nvar2me+1) = Sfcprop(nb)%T_snow(ix) - sfc_var2(i,j,nvar2me+2) = Sfcprop(nb)%T_ice(ix) ! this is never used - if(Model%iopt_lake==Model%iopt_lake_flake ) then - sfc_var2(i,j,nvar2me+3) = Sfcprop(nb)%h_ML(ix) - sfc_var2(i,j,nvar2me+4) = Sfcprop(nb)%t_ML(ix) - sfc_var2(i,j,nvar2me+5) = Sfcprop(nb)%t_mnw(ix) - sfc_var2(i,j,nvar2me+6) = Sfcprop(nb)%h_talb(ix) - sfc_var2(i,j,nvar2me+7) = Sfcprop(nb)%t_talb(ix) - sfc_var2(i,j,nvar2me+8) = Sfcprop(nb)%t_bot1(ix) - sfc_var2(i,j,nvar2me+9) = Sfcprop(nb)%t_bot2(ix) - sfc_var2(i,j,nvar2me+10) = Sfcprop(nb)%c_t(ix) - endif - endif do k = 1,Model%kice sfc_var3ice(i,j,k) = Sfcprop(nb)%tiice(ix,k) !--- internal ice temperature @@ -2717,407 +2468,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta end subroutine sfc_prop_restart_write - subroutine clm_lake_allocate_data(data,Model) - ! Deallocate all data, and reallocate to the size specified in Model - implicit none - class(clm_lake_data_type) :: data - type(GFS_control_type), intent(in) :: Model - - integer :: nx, ny - print *,'clm_lake_allocate_data' - call data%deallocate_data - - nx=Model%nx - ny=Model%ny - - allocate(data%lake_snl2d(nx,ny)) - allocate(data%lake_h2osno2d(nx,ny)) - allocate(data%lake_t_grnd2d(nx,ny)) - allocate(data%lake_savedtke12d(nx,ny)) - allocate(data%lake_dp2dsno(nx,ny)) - allocate(data%clm_lakedepth(nx,ny)) - allocate(data%clm_lake_initialized(nx,ny)) - - allocate(data%lake_z3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_dz3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_watsat3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_csol3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_tkmg3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_tkdry3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_tksatu3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_snow_z3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) - allocate(data%lake_snow_dz3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) - allocate(data%lake_snow_zi3d(nx,ny,Model%nlevsnowsoil_clm_lake)) - allocate(data%lake_t_h2osoi_vol3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) - allocate(data%lake_t_h2osoi_liq3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) - allocate(data%lake_t_h2osoi_ice3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) - allocate(data%lake_t_soisno3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) - allocate(data%lake_t_lake3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_icefrac3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_clay3d(nx,ny,Model%nlevsoil_clm_lake)) - allocate(data%lake_sand3d(nx,ny,Model%nlevsoil_clm_lake)) - end subroutine clm_lake_allocate_data - - subroutine clm_lake_register_axes(data,Model) - ! Register all five axes needed by CLM Lake restart data - implicit none - class(clm_lake_data_type) :: data - type(GFS_control_type), intent(in) :: Model - print *,'clm_lake_register_axes' - call register_axis(Sfc_restart, 'levlake_clm_lake', dimension_length=Model%nlevlake_clm_lake) - - call register_axis(Sfc_restart, 'levsoil_clm_lake', dimension_length=Model%nlevsoil_clm_lake) - - call register_axis(Sfc_restart, 'levsnow_clm_lake', dimension_length=Model%nlevsnow_clm_lake) - - call register_axis(Sfc_restart, 'levsnowsoil_clm_lake', dimension_length=Model%nlevsnowsoil_clm_lake) - - call register_axis(Sfc_restart, 'levsnowsoil1_clm_lake', dimension_length=Model%nlevsnowsoil1_clm_lake) - end subroutine clm_lake_register_axes - - subroutine clm_lake_write_axes(data, Model) - ! Create variables with the name name as each clm_lake axis, and - ! fill the variable with the appropriate indices - implicit none - class(clm_lake_data_type) :: data - type(GFS_control_type), intent(in) :: Model - real(kind_phys) :: levlake_clm_lake(Model%nlevlake_clm_lake) - real(kind_phys) :: levsoil_clm_lake(Model%nlevsoil_clm_lake) - real(kind_phys) :: levsnow_clm_lake(Model%nlevsnow_clm_lake) - real(kind_phys) :: levsnowsoil_clm_lake(Model%nlevsnowsoil_clm_lake) - real(kind_phys) :: levsnowsoil1_clm_lake(Model%nlevsnowsoil1_clm_lake) - integer :: i - print *,'clm_lake_write_axes' - call register_field(Sfc_restart, 'levlake_clm_lake', 'double', (/'levlake_clm_lake'/)) - call register_variable_attribute(Sfc_restart, 'levlake_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - - call register_field(Sfc_restart, 'levsoil_clm_lake', 'double', (/'levsoil_clm_lake'/)) - call register_variable_attribute(Sfc_restart, 'levsoil_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - - call register_field(Sfc_restart, 'levsnow_clm_lake', 'double', (/'levsnow_clm_lake'/)) - call register_variable_attribute(Sfc_restart, 'levsnow_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - - call register_field(Sfc_restart, 'levsnowsoil_clm_lake', 'double', (/'levsnowsoil_clm_lake'/)) - call register_variable_attribute(Sfc_restart, 'levsnowsoil_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - - call register_field(Sfc_restart, 'levsnowsoil1_clm_lake', 'double', (/'levsnowsoil1_clm_lake'/)) - call register_variable_attribute(Sfc_restart, 'levsnowsoil1_clm_lake', 'cartesian_axis' ,'Z', str_len=1) - - do i=1,Model%nlevlake_clm_lake - levlake_clm_lake(i) = i - enddo - do i=1,Model%nlevsoil_clm_lake - levsoil_clm_lake(i) = i - enddo - do i=1,Model%nlevsnow_clm_lake - levsnow_clm_lake(i) = i - enddo - do i=-Model%nlevsnow_clm_lake,Model%nlevsoil_clm_lake - levsnowsoil_clm_lake(i+Model%nlevsnow_clm_lake+1) = i - enddo - do i=-Model%nlevsnow_clm_lake+1,Model%nlevsoil_clm_lake - levsnowsoil1_clm_lake(i+Model%nlevsnow_clm_lake) = i - enddo - - call write_data(Sfc_restart, 'levlake_clm_lake', levlake_clm_lake) - call write_data(Sfc_restart, 'levsoil_clm_lake', levsoil_clm_lake) - call write_data(Sfc_restart, 'levsnow_clm_lake', levsnow_clm_lake) - call write_data(Sfc_restart, 'levsnowsoil_clm_lake', levsnowsoil_clm_lake) - call write_data(Sfc_restart, 'levsnowsoil1_clm_lake', levsnowsoil1_clm_lake) - end subroutine clm_lake_write_axes - - subroutine clm_lake_copy_to_temporaries(data, Model, Sfcprop, Atm_block) - ! Copies from Sfcprop variables to the corresponding data temporary variables. - ! Terrible things will happen if you don't call data%allocate_data first. - implicit none - class(clm_lake_data_type) :: data - type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) - type(GFS_control_type), intent(in) :: Model - type(block_control_type), intent(in) :: Atm_block - - integer :: nb, ix, isc, jsc, i, j - print *,'clm_lake_copy_to_temporaries' - isc = Model%isc - jsc = Model%jsc - - ! Copy data to temporary arrays - -!$omp parallel do default(shared) private(i, j, nb, ix) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - i = Atm_block%index(nb)%ii(ix) - isc + 1 - j = Atm_block%index(nb)%jj(ix) - jsc + 1 - - data%lake_snl2d(i,j) = Sfcprop(nb)%lake_snl2d(ix) - data%lake_h2osno2d(i,j) = Sfcprop(nb)%lake_h2osno2d(ix) - data%lake_t_grnd2d(i,j) = Sfcprop(nb)%lake_t_grnd2d(ix) - data%lake_savedtke12d(i,j) = Sfcprop(nb)%lake_savedtke12d(ix) - data%lake_dp2dsno(i,j) = Sfcprop(nb)%lake_dp2dsno(ix) - data%clm_lakedepth(i,j) = Sfcprop(nb)%clm_lakedepth(ix) - data%clm_lake_initialized(i,j) = Sfcprop(nb)%clm_lake_initialized(ix) - - data%lake_z3d(i,j,:) = Sfcprop(nb)%lake_z3d(ix,:) - data%lake_dz3d(i,j,:) = Sfcprop(nb)%lake_dz3d(ix,:) - data%lake_watsat3d(i,j,:) = Sfcprop(nb)%lake_watsat3d(ix,:) - data%lake_csol3d(i,j,:) = Sfcprop(nb)%lake_csol3d(ix,:) - data%lake_tkmg3d(i,j,:) = Sfcprop(nb)%lake_tkmg3d(ix,:) - data%lake_tkdry3d(i,j,:) = Sfcprop(nb)%lake_tkdry3d(ix,:) - data%lake_tksatu3d(i,j,:) = Sfcprop(nb)%lake_tksatu3d(ix,:) - data%lake_snow_z3d(i,j,:) = Sfcprop(nb)%lake_snow_z3d(ix,:) - data%lake_snow_dz3d(i,j,:) = Sfcprop(nb)%lake_snow_dz3d(ix,:) - data%lake_snow_zi3d(i,j,:) = Sfcprop(nb)%lake_snow_zi3d(ix,:) - data%lake_t_h2osoi_vol3d(i,j,:) = Sfcprop(nb)%lake_t_h2osoi_vol3d(ix,:) - data%lake_t_h2osoi_liq3d(i,j,:) = Sfcprop(nb)%lake_t_h2osoi_liq3d(ix,:) - data%lake_t_h2osoi_ice3d(i,j,:) = Sfcprop(nb)%lake_t_h2osoi_ice3d(ix,:) - data%lake_t_soisno3d(i,j,:) = Sfcprop(nb)%lake_t_soisno3d(ix,:) - data%lake_t_lake3d(i,j,:) = Sfcprop(nb)%lake_t_lake3d(ix,:) - data%lake_icefrac3d(i,j,:) = Sfcprop(nb)%lake_icefrac3d(ix,:) - data%lake_clay3d(i,j,:) = Sfcprop(nb)%lake_clay3d(ix,:) - data%lake_sand3d(i,j,:) = Sfcprop(nb)%lake_sand3d(ix,:) - enddo - enddo - end subroutine clm_lake_copy_to_temporaries - - subroutine clm_lake_fill_with_zero(data, Model, Sfcprop, Atm_block) - ! Fills all temporary variables with 0. - ! Terrible things will happen if you don't call data%allocate_data first. - implicit none - class(clm_lake_data_type) :: data - type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) - type(GFS_control_type), intent(in) :: Model - type(block_control_type), intent(in) :: Atm_block - - integer :: nb, ix, isc, jsc, i, j - print *,'clm_lake_copy_to_temporaries' - isc = Model%isc - jsc = Model%jsc - - ! Copy data to temporary arrays - -!$omp parallel do default(shared) private(i, j, nb, ix) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - i = Atm_block%index(nb)%ii(ix) - isc + 1 - j = Atm_block%index(nb)%jj(ix) - jsc + 1 - - data%lake_snl2d(i,j) = 0 - data%lake_h2osno2d(i,j) = 0 - data%lake_t_grnd2d(i,j) = 0 - data%lake_savedtke12d(i,j) = 0 - data%lake_dp2dsno(i,j) = 0 - data%clm_lakedepth(i,j) = 0 - data%clm_lake_initialized(i,j) = 0 - - data%lake_z3d(i,j,:) = 0 - data%lake_dz3d(i,j,:) = 0 - data%lake_watsat3d(i,j,:) = 0 - data%lake_csol3d(i,j,:) = 0 - data%lake_tkmg3d(i,j,:) = 0 - data%lake_tkdry3d(i,j,:) = 0 - data%lake_tksatu3d(i,j,:) = 0 - data%lake_snow_z3d(i,j,:) = 0 - data%lake_snow_dz3d(i,j,:) = 0 - data%lake_snow_zi3d(i,j,:) = 0 - data%lake_t_h2osoi_vol3d(i,j,:) = 0 - data%lake_t_h2osoi_liq3d(i,j,:) = 0 - data%lake_t_h2osoi_ice3d(i,j,:) = 0 - data%lake_t_soisno3d(i,j,:) = 0 - data%lake_t_lake3d(i,j,:) = 0 - data%lake_icefrac3d(i,j,:) = 0 - data%lake_clay3d(i,j,:) = 0 - data%lake_sand3d(i,j,:) = 0 - enddo - enddo - end subroutine clm_lake_fill_with_zero - - subroutine clm_lake_copy_from_temporaries(data, Model, Sfcprop, Atm_block) - ! Copies from data temporary variables to the corresponding Sfcprop variables. - ! Terrible things will happen if you don't call data%allocate_data first. - implicit none - class(clm_lake_data_type) :: data - type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) - type(GFS_control_type), intent(in) :: Model - type(block_control_type), intent(in) :: Atm_block - - integer :: nb, ix, isc, jsc, i, j - print *,'clm_lake_copy_from_temporaries' - isc = Model%isc - jsc = Model%jsc - - ! Copy data to temporary arrays - -!$omp parallel do default(shared) private(i, j, nb, ix) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - i = Atm_block%index(nb)%ii(ix) - isc + 1 - j = Atm_block%index(nb)%jj(ix) - jsc + 1 - - Sfcprop(nb)%lake_snl2d(ix) = data%lake_snl2d(i,j) - Sfcprop(nb)%lake_h2osno2d(ix) = data%lake_h2osno2d(i,j) - Sfcprop(nb)%lake_t_grnd2d(ix) = data%lake_t_grnd2d(i,j) - Sfcprop(nb)%lake_savedtke12d(ix) = data%lake_savedtke12d(i,j) - Sfcprop(nb)%lake_dp2dsno(ix) = data%lake_dp2dsno(i,j) - Sfcprop(nb)%clm_lakedepth(ix) = data%clm_lakedepth(i,j) - Sfcprop(nb)%clm_lake_initialized(ix) = data%clm_lake_initialized(i,j) - - Sfcprop(nb)%lake_z3d(ix,:) = data%lake_z3d(i,j,:) - Sfcprop(nb)%lake_dz3d(ix,:) = data%lake_dz3d(i,j,:) - Sfcprop(nb)%lake_watsat3d(ix,:) = data%lake_watsat3d(i,j,:) - Sfcprop(nb)%lake_csol3d(ix,:) = data%lake_csol3d(i,j,:) - Sfcprop(nb)%lake_tkmg3d(ix,:) = data%lake_tkmg3d(i,j,:) - Sfcprop(nb)%lake_tkdry3d(ix,:) = data%lake_tkdry3d(i,j,:) - Sfcprop(nb)%lake_tksatu3d(ix,:) = data%lake_tksatu3d(i,j,:) - Sfcprop(nb)%lake_snow_z3d(ix,:) = data%lake_snow_z3d(i,j,:) - Sfcprop(nb)%lake_snow_dz3d(ix,:) = data%lake_snow_dz3d(i,j,:) - Sfcprop(nb)%lake_snow_zi3d(ix,:) = data%lake_snow_zi3d(i,j,:) - Sfcprop(nb)%lake_t_h2osoi_vol3d(ix,:) = data%lake_t_h2osoi_vol3d(i,j,:) - Sfcprop(nb)%lake_t_h2osoi_liq3d(ix,:) = data%lake_t_h2osoi_liq3d(i,j,:) - Sfcprop(nb)%lake_t_h2osoi_ice3d(ix,:) = data%lake_t_h2osoi_ice3d(i,j,:) - Sfcprop(nb)%lake_t_soisno3d(ix,:) = data%lake_t_soisno3d(i,j,:) - Sfcprop(nb)%lake_t_lake3d(ix,:) = data%lake_t_lake3d(i,j,:) - Sfcprop(nb)%lake_icefrac3d(ix,:) = data%lake_icefrac3d(i,j,:) - Sfcprop(nb)%lake_clay3d(ix,:) = data%lake_clay3d(i,j,:) - Sfcprop(nb)%lake_sand3d(ix,:) = data%lake_sand3d(i,j,:) - enddo - enddo - end subroutine clm_lake_copy_from_temporaries - - subroutine clm_lake_register_fields(data) - ! Registers all restart fields needed by the CLM Lake Model. - ! Terrible things will happen if you don't call data%allocate_data - ! and data%register_axes first. - implicit none - class(clm_lake_data_type) :: data - - print *,'clm_lake_register_fields' - - ! Register 2D fields - call register_restart_field(Sfc_restart, 'lake_snl2d', data%lake_snl2d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'lake_h2osno2d', data%lake_h2osno2d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'lake_t_grnd2d', data%lake_t_grnd2d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'lake_savedtke12d', data%lake_savedtke12d, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'lake_dp2dsno', data%lake_dp2dsno, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'clm_lakedepth', data%clm_lakedepth, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'clm_lake_initialized', data%clm_lake_initialized, & - dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - - ! Register 3D fields - call register_restart_field(Sfc_restart, 'lake_z3d', data%lake_z3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'lake_dz3d', data%lake_dz3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_watsat3d', data%lake_watsat3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_csol3d', data%lake_csol3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_tkmg3d', data%lake_tkmg3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_tkdry3d', data%lake_tkdry3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_tksatu3d', data%lake_tksatu3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_snow_z3d', data%lake_snow_z3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_snow_dz3d', data%lake_snow_dz3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_snow_zi3d', data%lake_snow_zi3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_t_h2osoi_vol3d', data%lake_t_h2osoi_vol3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_t_h2osoi_liq3d', data%lake_t_h2osoi_liq3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_t_h2osoi_ice3d', data%lake_t_h2osoi_ice3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_t_soisno3d', data%lake_t_soisno3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_t_lake3d', data%lake_t_lake3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_icefrac3d', data%lake_icefrac3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_clay3d', data%lake_clay3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsoil_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_sand3d', data%lake_sand3d, & - dimensions=(/'xaxis_1 ', 'yaxis_1 ', & - 'levsoil_clm_lake ', 'Time '/), is_optional=.true.) - end subroutine clm_lake_register_fields - - subroutine clm_lake_final(data) - ! Final routine for clm_lake_data_type, called automatically when - ! an object of that type goes out of scope. This is simply a - ! wrapper around data%deallocate_data(). - implicit none - type(clm_lake_data_type) :: data - call clm_lake_deallocate_data(data) - end subroutine clm_lake_final - - subroutine clm_lake_deallocate_data(data) - ! Deallocates all data used, and nullifies the pointers. The data - ! object can safely be used again after this call. This is also - ! the implementation of the clm_lake_data_type final routine. - implicit none - class(clm_lake_data_type) :: data - - ! Deallocate and nullify any associated pointers - - ! This #define reduces code length by a lot -#define IF_ASSOC_DEALLOC_NULL(var) \ - if(associated(data%var)) then ; \ - deallocate(data%var) ; \ - nullify(data%var) ; \ - endif - - IF_ASSOC_DEALLOC_NULL(lake_snl2d) - IF_ASSOC_DEALLOC_NULL(lake_h2osno2d) - IF_ASSOC_DEALLOC_NULL(lake_t_grnd2d) - IF_ASSOC_DEALLOC_NULL(lake_savedtke12d) - IF_ASSOC_DEALLOC_NULL(lake_dp2dsno) - IF_ASSOC_DEALLOC_NULL(clm_lakedepth) - IF_ASSOC_DEALLOC_NULL(clm_lake_initialized) - - IF_ASSOC_DEALLOC_NULL(lake_z3d) - IF_ASSOC_DEALLOC_NULL(lake_dz3d) - IF_ASSOC_DEALLOC_NULL(lake_watsat3d) - IF_ASSOC_DEALLOC_NULL(lake_csol3d) - IF_ASSOC_DEALLOC_NULL(lake_tkmg3d) - IF_ASSOC_DEALLOC_NULL(lake_tkdry3d) - IF_ASSOC_DEALLOC_NULL(lake_tksatu3d) - IF_ASSOC_DEALLOC_NULL(lake_snow_z3d) - IF_ASSOC_DEALLOC_NULL(lake_snow_dz3d) - IF_ASSOC_DEALLOC_NULL(lake_snow_zi3d) - IF_ASSOC_DEALLOC_NULL(lake_t_h2osoi_vol3d) - IF_ASSOC_DEALLOC_NULL(lake_t_h2osoi_liq3d) - IF_ASSOC_DEALLOC_NULL(lake_t_h2osoi_ice3d) - IF_ASSOC_DEALLOC_NULL(lake_t_soisno3d) - IF_ASSOC_DEALLOC_NULL(lake_t_lake3d) - IF_ASSOC_DEALLOC_NULL(lake_icefrac3d) - IF_ASSOC_DEALLOC_NULL(lake_clay3d) - IF_ASSOC_DEALLOC_NULL(lake_sand3d) - -#undef IF_ASSOC_DEALLOC_NULL - end subroutine clm_lake_deallocate_data !---------------------------------------------------------------------- ! phys_restart_read diff --git a/io/clm_lake_io.F90 b/io/clm_lake_io.F90 new file mode 100644 index 000000000..e4f94a744 --- /dev/null +++ b/io/clm_lake_io.F90 @@ -0,0 +1,496 @@ +module clm_lake_io + use GFS_typedefs, only: GFS_sfcprop_type, GFS_control_type, & + GFS_data_type, kind_phys + use GFS_restart, only: GFS_restart_type + use GFS_diagnostics, only: GFS_externaldiag_type + use block_control_mod, only: block_control_type + use fms2_io_mod, only: FmsNetcdfDomainFile_t, unlimited, & + open_file, close_file, & + register_axis, register_restart_field, & + register_variable_attribute, register_field, & + read_restart, write_restart, write_data, & + get_global_io_domain_indices, variable_exists + + implicit none + + type clm_lake_data_type + ! The clm_lake_data_type derived type is a class that stores + ! temporary arrays used to read or write CLM Lake model restart + ! and axis variables. It can safely be declared and unused, but + ! you should only call these routines if the CLM Lake Model was + ! (or will be) used by this execution of the FV3. It is the + ! responsibility of the caller to ensure the necessary data is in + ! Sfc_restart, Sfcprop, and Model. + + ! All 2D variables needed for a restart + real(kind_phys), pointer, private, dimension(:,:) :: & + T_snow=>null(), T_ice=>null(), & + lake_snl2d=>null(), lake_h2osno2d=>null(), lake_t_grnd2d=>null(), clm_lakedepth=>null(), & + lake_savedtke12d=>null(), lake_dp2dsno=>null(), clm_lake_initialized=>null() + + ! All 3D variables needed for a restart + real(kind_phys), pointer, private, dimension(:,:,:) :: & + lake_z3d=>null(), lake_dz3d=>null(), lake_watsat3d=>null(), & + lake_csol3d=>null(), lake_tkmg3d=>null(), lake_tkdry3d=>null(), & + lake_tksatu3d=>null(), lake_snow_z3d=>null(), lake_snow_dz3d=>null(), & + lake_snow_zi3d=>null(), lake_t_h2osoi_vol3d=>null(), lake_t_h2osoi_liq3d=>null(), & + lake_t_h2osoi_ice3d=>null(), lake_t_soisno3d=>null(), lake_t_lake3d=>null(), & + lake_icefrac3d=>null(), lake_clay3d=>null(), lake_sand3d=>null() + + contains + + ! register_axes calls registers_axis on Sfc_restart for all required axes + procedure, public :: register_axes => clm_lake_register_axes + + ! allocate_data allocates all of the pointers in this object + procedure, public :: allocate_data => clm_lake_allocate_data + + ! fill_with_zero allocates fills the temporary arrays with 0 + procedure, public :: fill_with_zero => clm_lake_fill_with_zero + + ! register_fields calls register_field on Sfc_restart for all CLM Lake model restart variables + procedure, public :: register_fields => clm_lake_register_fields + + ! deallocate_data deallocates all pointers, allowing this object to be used repeatedly. + ! It is safe to call deallocate_data if no data has been allocated. + procedure, public :: deallocate_data => clm_lake_deallocate_data + + ! write_axes writes variables to Sfc_restart, with the name of + ! each axis, containing the appropriate information + procedure, public :: write_axes => clm_lake_write_axes + + ! copy_to_temporaries copies from Sfcprop to internal pointers (declared above) + procedure, public :: copy_to_temporaries => clm_lake_copy_to_temporaries + + ! copy_to_temporaries copies from internal pointers (declared above) to Sfcprop + procedure, public :: copy_from_temporaries => clm_lake_copy_from_temporaries + + ! A fortran 2003 compliant compiler will call clm_lake_final + ! automatically when an object of this type goes out of + ! scope. This will deallocate any arrays via a call to + ! deallocate_data. It is safe to call this routine if no data has + ! been allocated. + final :: clm_lake_final + end type clm_lake_data_type + + CONTAINS + subroutine clm_lake_allocate_data(data,Model) + ! Deallocate all data, and reallocate to the size specified in Model + implicit none + class(clm_lake_data_type) :: data + type(GFS_control_type), intent(in) :: Model + + integer :: nx, ny + print *,'clm_lake_allocate_data' + call data%deallocate_data + + nx=Model%nx + ny=Model%ny + + allocate(data%T_snow(nx,ny)) + allocate(data%T_ice(nx,ny)) + allocate(data%lake_snl2d(nx,ny)) + allocate(data%lake_h2osno2d(nx,ny)) + allocate(data%lake_t_grnd2d(nx,ny)) + allocate(data%lake_savedtke12d(nx,ny)) + allocate(data%lake_dp2dsno(nx,ny)) + allocate(data%clm_lakedepth(nx,ny)) + allocate(data%clm_lake_initialized(nx,ny)) + + allocate(data%lake_z3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_dz3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_watsat3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_csol3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_tkmg3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_tkdry3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_tksatu3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_snow_z3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(data%lake_snow_dz3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(data%lake_snow_zi3d(nx,ny,Model%nlevsnowsoil_clm_lake)) + allocate(data%lake_t_h2osoi_vol3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(data%lake_t_h2osoi_liq3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(data%lake_t_h2osoi_ice3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(data%lake_t_soisno3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(data%lake_t_lake3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_icefrac3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_clay3d(nx,ny,Model%nlevsoil_clm_lake)) + allocate(data%lake_sand3d(nx,ny,Model%nlevsoil_clm_lake)) + end subroutine clm_lake_allocate_data + + subroutine clm_lake_register_axes(data,Model,Sfc_restart) + ! Register all five axes needed by CLM Lake restart data + implicit none + class(clm_lake_data_type) :: data + type(GFS_control_type), intent(in) :: Model + type(FmsNetcdfDomainFile_t) :: Sfc_restart + print *,'clm_lake_register_axes' + call register_axis(Sfc_restart, 'levlake_clm_lake', dimension_length=Model%nlevlake_clm_lake) + + call register_axis(Sfc_restart, 'levsoil_clm_lake', dimension_length=Model%nlevsoil_clm_lake) + + call register_axis(Sfc_restart, 'levsnow_clm_lake', dimension_length=Model%nlevsnow_clm_lake) + + call register_axis(Sfc_restart, 'levsnowsoil_clm_lake', dimension_length=Model%nlevsnowsoil_clm_lake) + + call register_axis(Sfc_restart, 'levsnowsoil1_clm_lake', dimension_length=Model%nlevsnowsoil1_clm_lake) + end subroutine clm_lake_register_axes + + subroutine clm_lake_write_axes(data, Model, Sfc_restart) + ! Create variables with the name name as each clm_lake axis, and + ! fill the variable with the appropriate indices + implicit none + class(clm_lake_data_type) :: data + type(GFS_control_type), intent(in) :: Model + type(FmsNetcdfDomainFile_t) :: Sfc_restart + real(kind_phys) :: levlake_clm_lake(Model%nlevlake_clm_lake) + real(kind_phys) :: levsoil_clm_lake(Model%nlevsoil_clm_lake) + real(kind_phys) :: levsnow_clm_lake(Model%nlevsnow_clm_lake) + real(kind_phys) :: levsnowsoil_clm_lake(Model%nlevsnowsoil_clm_lake) + real(kind_phys) :: levsnowsoil1_clm_lake(Model%nlevsnowsoil1_clm_lake) + integer :: i + print *,'clm_lake_write_axes' + call register_field(Sfc_restart, 'levlake_clm_lake', 'double', (/'levlake_clm_lake'/)) + call register_variable_attribute(Sfc_restart, 'levlake_clm_lake', 'cartesian_axis' ,'Z', str_len=1) + + call register_field(Sfc_restart, 'levsoil_clm_lake', 'double', (/'levsoil_clm_lake'/)) + call register_variable_attribute(Sfc_restart, 'levsoil_clm_lake', 'cartesian_axis' ,'Z', str_len=1) + + call register_field(Sfc_restart, 'levsnow_clm_lake', 'double', (/'levsnow_clm_lake'/)) + call register_variable_attribute(Sfc_restart, 'levsnow_clm_lake', 'cartesian_axis' ,'Z', str_len=1) + + call register_field(Sfc_restart, 'levsnowsoil_clm_lake', 'double', (/'levsnowsoil_clm_lake'/)) + call register_variable_attribute(Sfc_restart, 'levsnowsoil_clm_lake', 'cartesian_axis' ,'Z', str_len=1) + + call register_field(Sfc_restart, 'levsnowsoil1_clm_lake', 'double', (/'levsnowsoil1_clm_lake'/)) + call register_variable_attribute(Sfc_restart, 'levsnowsoil1_clm_lake', 'cartesian_axis' ,'Z', str_len=1) + + do i=1,Model%nlevlake_clm_lake + levlake_clm_lake(i) = i + enddo + do i=1,Model%nlevsoil_clm_lake + levsoil_clm_lake(i) = i + enddo + do i=1,Model%nlevsnow_clm_lake + levsnow_clm_lake(i) = i + enddo + do i=-Model%nlevsnow_clm_lake,Model%nlevsoil_clm_lake + levsnowsoil_clm_lake(i+Model%nlevsnow_clm_lake+1) = i + enddo + do i=-Model%nlevsnow_clm_lake+1,Model%nlevsoil_clm_lake + levsnowsoil1_clm_lake(i+Model%nlevsnow_clm_lake) = i + enddo + + call write_data(Sfc_restart, 'levlake_clm_lake', levlake_clm_lake) + call write_data(Sfc_restart, 'levsoil_clm_lake', levsoil_clm_lake) + call write_data(Sfc_restart, 'levsnow_clm_lake', levsnow_clm_lake) + call write_data(Sfc_restart, 'levsnowsoil_clm_lake', levsnowsoil_clm_lake) + call write_data(Sfc_restart, 'levsnowsoil1_clm_lake', levsnowsoil1_clm_lake) + end subroutine clm_lake_write_axes + + subroutine clm_lake_copy_to_temporaries(data, Model, Sfcprop, Atm_block) + ! Copies from Sfcprop variables to the corresponding data temporary variables. + ! Terrible things will happen if you don't call data%allocate_data first. + implicit none + class(clm_lake_data_type) :: data + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + integer :: nb, ix, isc, jsc, i, j + print *,'clm_lake_copy_to_temporaries' + isc = Model%isc + jsc = Model%jsc + + ! Copy data to temporary arrays + +!$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - isc + 1 + j = Atm_block%index(nb)%jj(ix) - jsc + 1 + + data%T_snow(i,j) = Sfcprop(nb)%T_snow(ix) + data%T_ice(i,j) = Sfcprop(nb)%T_ice(ix) + data%lake_snl2d(i,j) = Sfcprop(nb)%lake_snl2d(ix) + data%lake_h2osno2d(i,j) = Sfcprop(nb)%lake_h2osno2d(ix) + data%lake_t_grnd2d(i,j) = Sfcprop(nb)%lake_t_grnd2d(ix) + data%lake_savedtke12d(i,j) = Sfcprop(nb)%lake_savedtke12d(ix) + data%lake_dp2dsno(i,j) = Sfcprop(nb)%lake_dp2dsno(ix) + data%clm_lakedepth(i,j) = Sfcprop(nb)%clm_lakedepth(ix) + data%clm_lake_initialized(i,j) = Sfcprop(nb)%clm_lake_initialized(ix) + + data%lake_z3d(i,j,:) = Sfcprop(nb)%lake_z3d(ix,:) + data%lake_dz3d(i,j,:) = Sfcprop(nb)%lake_dz3d(ix,:) + data%lake_watsat3d(i,j,:) = Sfcprop(nb)%lake_watsat3d(ix,:) + data%lake_csol3d(i,j,:) = Sfcprop(nb)%lake_csol3d(ix,:) + data%lake_tkmg3d(i,j,:) = Sfcprop(nb)%lake_tkmg3d(ix,:) + data%lake_tkdry3d(i,j,:) = Sfcprop(nb)%lake_tkdry3d(ix,:) + data%lake_tksatu3d(i,j,:) = Sfcprop(nb)%lake_tksatu3d(ix,:) + data%lake_snow_z3d(i,j,:) = Sfcprop(nb)%lake_snow_z3d(ix,:) + data%lake_snow_dz3d(i,j,:) = Sfcprop(nb)%lake_snow_dz3d(ix,:) + data%lake_snow_zi3d(i,j,:) = Sfcprop(nb)%lake_snow_zi3d(ix,:) + data%lake_t_h2osoi_vol3d(i,j,:) = Sfcprop(nb)%lake_t_h2osoi_vol3d(ix,:) + data%lake_t_h2osoi_liq3d(i,j,:) = Sfcprop(nb)%lake_t_h2osoi_liq3d(ix,:) + data%lake_t_h2osoi_ice3d(i,j,:) = Sfcprop(nb)%lake_t_h2osoi_ice3d(ix,:) + data%lake_t_soisno3d(i,j,:) = Sfcprop(nb)%lake_t_soisno3d(ix,:) + data%lake_t_lake3d(i,j,:) = Sfcprop(nb)%lake_t_lake3d(ix,:) + data%lake_icefrac3d(i,j,:) = Sfcprop(nb)%lake_icefrac3d(ix,:) + data%lake_clay3d(i,j,:) = Sfcprop(nb)%lake_clay3d(ix,:) + data%lake_sand3d(i,j,:) = Sfcprop(nb)%lake_sand3d(ix,:) + enddo + enddo + end subroutine clm_lake_copy_to_temporaries + + subroutine clm_lake_fill_with_zero(data, Model, Sfcprop, Atm_block) + ! Fills all temporary variables with 0. + ! Terrible things will happen if you don't call data%allocate_data first. + implicit none + class(clm_lake_data_type) :: data + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + integer :: nb, ix, isc, jsc, i, j + print *,'clm_lake_copy_to_temporaries' + isc = Model%isc + jsc = Model%jsc + + ! Copy data to temporary arrays + +!$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - isc + 1 + j = Atm_block%index(nb)%jj(ix) - jsc + 1 + + data%T_snow(i,j) = 0 + data%T_ice(i,j) = 0 + data%lake_snl2d(i,j) = 0 + data%lake_h2osno2d(i,j) = 0 + data%lake_t_grnd2d(i,j) = 0 + data%lake_savedtke12d(i,j) = 0 + data%lake_dp2dsno(i,j) = 0 + data%clm_lakedepth(i,j) = 0 + data%clm_lake_initialized(i,j) = 0 + + data%lake_z3d(i,j,:) = 0 + data%lake_dz3d(i,j,:) = 0 + data%lake_watsat3d(i,j,:) = 0 + data%lake_csol3d(i,j,:) = 0 + data%lake_tkmg3d(i,j,:) = 0 + data%lake_tkdry3d(i,j,:) = 0 + data%lake_tksatu3d(i,j,:) = 0 + data%lake_snow_z3d(i,j,:) = 0 + data%lake_snow_dz3d(i,j,:) = 0 + data%lake_snow_zi3d(i,j,:) = 0 + data%lake_t_h2osoi_vol3d(i,j,:) = 0 + data%lake_t_h2osoi_liq3d(i,j,:) = 0 + data%lake_t_h2osoi_ice3d(i,j,:) = 0 + data%lake_t_soisno3d(i,j,:) = 0 + data%lake_t_lake3d(i,j,:) = 0 + data%lake_icefrac3d(i,j,:) = 0 + data%lake_clay3d(i,j,:) = 0 + data%lake_sand3d(i,j,:) = 0 + enddo + enddo + end subroutine clm_lake_fill_with_zero + + subroutine clm_lake_copy_from_temporaries(data, Model, Sfcprop, Atm_block) + ! Copies from data temporary variables to the corresponding Sfcprop variables. + ! Terrible things will happen if you don't call data%allocate_data first. + implicit none + class(clm_lake_data_type) :: data + type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) + type(GFS_control_type), intent(in) :: Model + type(block_control_type), intent(in) :: Atm_block + + integer :: nb, ix, isc, jsc, i, j + print *,'clm_lake_copy_from_temporaries' + isc = Model%isc + jsc = Model%jsc + + ! Copy data to temporary arrays + +!$omp parallel do default(shared) private(i, j, nb, ix) + do nb = 1, Atm_block%nblks + do ix = 1, Atm_block%blksz(nb) + i = Atm_block%index(nb)%ii(ix) - isc + 1 + j = Atm_block%index(nb)%jj(ix) - jsc + 1 + + Sfcprop(nb)%T_snow(ix) = data%T_snow(i,j) + Sfcprop(nb)%T_ice(ix) = data%T_ice(i,j) + Sfcprop(nb)%lake_snl2d(ix) = data%lake_snl2d(i,j) + Sfcprop(nb)%lake_h2osno2d(ix) = data%lake_h2osno2d(i,j) + Sfcprop(nb)%lake_t_grnd2d(ix) = data%lake_t_grnd2d(i,j) + Sfcprop(nb)%lake_savedtke12d(ix) = data%lake_savedtke12d(i,j) + Sfcprop(nb)%lake_dp2dsno(ix) = data%lake_dp2dsno(i,j) + Sfcprop(nb)%clm_lakedepth(ix) = data%clm_lakedepth(i,j) + Sfcprop(nb)%clm_lake_initialized(ix) = data%clm_lake_initialized(i,j) + + Sfcprop(nb)%lake_z3d(ix,:) = data%lake_z3d(i,j,:) + Sfcprop(nb)%lake_dz3d(ix,:) = data%lake_dz3d(i,j,:) + Sfcprop(nb)%lake_watsat3d(ix,:) = data%lake_watsat3d(i,j,:) + Sfcprop(nb)%lake_csol3d(ix,:) = data%lake_csol3d(i,j,:) + Sfcprop(nb)%lake_tkmg3d(ix,:) = data%lake_tkmg3d(i,j,:) + Sfcprop(nb)%lake_tkdry3d(ix,:) = data%lake_tkdry3d(i,j,:) + Sfcprop(nb)%lake_tksatu3d(ix,:) = data%lake_tksatu3d(i,j,:) + Sfcprop(nb)%lake_snow_z3d(ix,:) = data%lake_snow_z3d(i,j,:) + Sfcprop(nb)%lake_snow_dz3d(ix,:) = data%lake_snow_dz3d(i,j,:) + Sfcprop(nb)%lake_snow_zi3d(ix,:) = data%lake_snow_zi3d(i,j,:) + Sfcprop(nb)%lake_t_h2osoi_vol3d(ix,:) = data%lake_t_h2osoi_vol3d(i,j,:) + Sfcprop(nb)%lake_t_h2osoi_liq3d(ix,:) = data%lake_t_h2osoi_liq3d(i,j,:) + Sfcprop(nb)%lake_t_h2osoi_ice3d(ix,:) = data%lake_t_h2osoi_ice3d(i,j,:) + Sfcprop(nb)%lake_t_soisno3d(ix,:) = data%lake_t_soisno3d(i,j,:) + Sfcprop(nb)%lake_t_lake3d(ix,:) = data%lake_t_lake3d(i,j,:) + Sfcprop(nb)%lake_icefrac3d(ix,:) = data%lake_icefrac3d(i,j,:) + Sfcprop(nb)%lake_clay3d(ix,:) = data%lake_clay3d(i,j,:) + Sfcprop(nb)%lake_sand3d(ix,:) = data%lake_sand3d(i,j,:) + enddo + enddo + end subroutine clm_lake_copy_from_temporaries + + subroutine clm_lake_register_fields(data, Sfc_restart) + ! Registers all restart fields needed by the CLM Lake Model. + ! Terrible things will happen if you don't call data%allocate_data + ! and data%register_axes first. + implicit none + class(clm_lake_data_type) :: data + type(FmsNetcdfDomainFile_t) :: Sfc_restart + + print *,'clm_lake_register_fields' + + ! Register 2D fields + call register_restart_field(Sfc_restart, 'T_snow', data%T_snow, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'T_ice', data%T_ice, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_snl2d', data%lake_snl2d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_h2osno2d', data%lake_h2osno2d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_t_grnd2d', data%lake_t_grnd2d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_savedtke12d', data%lake_savedtke12d, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_dp2dsno', data%lake_dp2dsno, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'clm_lakedepth', data%clm_lakedepth, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'clm_lake_initialized', data%clm_lake_initialized, & + dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) + + ! Register 3D fields + call register_restart_field(Sfc_restart, 'lake_z3d', data%lake_z3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart, 'lake_dz3d', data%lake_dz3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_watsat3d', data%lake_watsat3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_csol3d', data%lake_csol3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_tkmg3d', data%lake_tkmg3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_tkdry3d', data%lake_tkdry3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_tksatu3d', data%lake_tksatu3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_snow_z3d', data%lake_snow_z3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_snow_dz3d', data%lake_snow_dz3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_snow_zi3d', data%lake_snow_zi3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_t_h2osoi_vol3d', data%lake_t_h2osoi_vol3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_t_h2osoi_liq3d', data%lake_t_h2osoi_liq3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_t_h2osoi_ice3d', data%lake_t_h2osoi_ice3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_t_soisno3d', data%lake_t_soisno3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_t_lake3d', data%lake_t_lake3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_icefrac3d', data%lake_icefrac3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levlake_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_clay3d', data%lake_clay3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsoil_clm_lake ', 'Time '/), is_optional=.true.) + call register_restart_field(Sfc_restart,'lake_sand3d', data%lake_sand3d, & + dimensions=(/'xaxis_1 ', 'yaxis_1 ', & + 'levsoil_clm_lake ', 'Time '/), is_optional=.true.) + end subroutine clm_lake_register_fields + + subroutine clm_lake_final(data) + ! Final routine for clm_lake_data_type, called automatically when + ! an object of that type goes out of scope. This is simply a + ! wrapper around data%deallocate_data(). + implicit none + type(clm_lake_data_type) :: data + call clm_lake_deallocate_data(data) + end subroutine clm_lake_final + + subroutine clm_lake_deallocate_data(data) + ! Deallocates all data used, and nullifies the pointers. The data + ! object can safely be used again after this call. This is also + ! the implementation of the clm_lake_data_type final routine. + implicit none + class(clm_lake_data_type) :: data + + ! Deallocate and nullify any associated pointers + + ! This #define reduces code length by a lot +#define IF_ASSOC_DEALLOC_NULL(var) \ + if(associated(data%var)) then ; \ + deallocate(data%var) ; \ + nullify(data%var) ; \ + endif + + IF_ASSOC_DEALLOC_NULL(T_snow) + IF_ASSOC_DEALLOC_NULL(T_ice) + IF_ASSOC_DEALLOC_NULL(lake_snl2d) + IF_ASSOC_DEALLOC_NULL(lake_h2osno2d) + IF_ASSOC_DEALLOC_NULL(lake_t_grnd2d) + IF_ASSOC_DEALLOC_NULL(lake_savedtke12d) + IF_ASSOC_DEALLOC_NULL(lake_dp2dsno) + IF_ASSOC_DEALLOC_NULL(clm_lakedepth) + IF_ASSOC_DEALLOC_NULL(clm_lake_initialized) + + IF_ASSOC_DEALLOC_NULL(lake_z3d) + IF_ASSOC_DEALLOC_NULL(lake_dz3d) + IF_ASSOC_DEALLOC_NULL(lake_watsat3d) + IF_ASSOC_DEALLOC_NULL(lake_csol3d) + IF_ASSOC_DEALLOC_NULL(lake_tkmg3d) + IF_ASSOC_DEALLOC_NULL(lake_tkdry3d) + IF_ASSOC_DEALLOC_NULL(lake_tksatu3d) + IF_ASSOC_DEALLOC_NULL(lake_snow_z3d) + IF_ASSOC_DEALLOC_NULL(lake_snow_dz3d) + IF_ASSOC_DEALLOC_NULL(lake_snow_zi3d) + IF_ASSOC_DEALLOC_NULL(lake_t_h2osoi_vol3d) + IF_ASSOC_DEALLOC_NULL(lake_t_h2osoi_liq3d) + IF_ASSOC_DEALLOC_NULL(lake_t_h2osoi_ice3d) + IF_ASSOC_DEALLOC_NULL(lake_t_soisno3d) + IF_ASSOC_DEALLOC_NULL(lake_t_lake3d) + IF_ASSOC_DEALLOC_NULL(lake_icefrac3d) + IF_ASSOC_DEALLOC_NULL(lake_clay3d) + IF_ASSOC_DEALLOC_NULL(lake_sand3d) + +#undef IF_ASSOC_DEALLOC_NULL + end subroutine clm_lake_deallocate_data + +end module clm_lake_io From 53e145b76924794167791c361231a5075f7884f1 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 29 Nov 2022 22:33:08 +0000 Subject: [PATCH 34/74] put some changes back in --- .gitmodules | 2 +- ccpp/data/GFS_typedefs.F90 | 9 ++++++++- ccpp/data/GFS_typedefs.meta | 6 ++++++ ccpp/physics | 2 +- 4 files changed, 16 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index 9bfbb3a44..d5c872050 100644 --- a/.gitmodules +++ b/.gitmodules @@ -9,7 +9,7 @@ [submodule "ccpp/physics"] path = ccpp/physics url = https://github.com/SamuelTrahanNOAA/ccpp-physics - branch = flake + branch = clm_lake_revert.v9 [submodule "upp"] path = upp url = https://github.com/NOAA-EMC/UPP diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 032ba98f7..d490a43ab 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -1006,6 +1006,7 @@ module GFS_typedefs integer :: iopt_lake_clm = 2 real(kind_phys) :: lakedepth_threshold !< lakedepth must be GREATER than this value to enable a lake model real(kind_phys) :: lakefrac_threshold !< lakefrac must be GREATER than this value to enable a lake model + logical :: use_lake2m !< use 2m T & Q calculated by the lake model !--- clm lake model parameters integer :: nlevlake_clm_lake !< Number of lake levels for clm lake model @@ -3304,6 +3305,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & integer :: iopt_lake = 1 !< =1 flake, =2 clm lake real(kind_phys) :: lakedepth_threshold = 1.0 !< lakedepth must be GREATER than this value to enable a lake model real(kind_phys) :: lakefrac_threshold = 0.0 !< lakefrac must be GREATER than this value to enable a lake model + logical :: use_lake2m = .false. !< use 2m T & Q from clm lake model !--- tuning parameters for physical parameterizations logical :: ras = .false. !< flag for ras convection scheme @@ -3675,7 +3677,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- lake model control lkm, iopt_lake, lakedepth_threshold, lakefrac_threshold, & clm_lake_depth_default, clm_lake_use_lakedepth, & - clm_lake_debug, & + clm_lake_debug, use_lake2m, & !--- physical parameterizations ras, trans_trac, old_monin, cnvgwd, mstrat, moist_adj, & cscnv, cal_pre, do_aw, do_shoc, shocaftcnv, shoc_cld, & @@ -4315,6 +4317,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- lake model parameters Model%lkm = lkm Model%iopt_lake = iopt_lake + Model%use_lake2m = use_lake2m Model%lakedepth_threshold = lakedepth_threshold Model%lakefrac_threshold = lakefrac_threshold @@ -5269,6 +5272,10 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & print *, ' lake model selection : ', Model%iopt_lake if(Model%iopt_lake==Model%iopt_lake_clm) then print *,' CLM Lake model configuration' + print *,' use_lake2m = ',Model%use_lake2m + print *,' clm_lake_use_lakedepth = ',Model%clm_lake_use_lakedepth + print *,' clm_lake_depth_default = ',Model%clm_lake_depth_default + print *,' clm_lake_debug = ',Model%clm_lake_debug print *,' nlevlake_clm_lake = ',Model%nlevlake_clm_lake print *,' nlevsoil_clm_lake = ',Model%nlevsoil_clm_lake print *,' nlevsnow_clm_lake = ',Model%nlevsnow_clm_lake diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 7bfdd1e67..a44b14518 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -4679,6 +4679,12 @@ units = 1 dimensions = () type = integer +[use_lake2m] + standard_name = use_2m_diagnostics_calculated_by_lake_model + long_name = model 2m diagnostics use the temperature and humidity calculated by the lake model + units = flag + dimensions = () + type = integer [lkm] standard_name = control_for_lake_model_execution_method long_name = control for lake model execution: 0=no lake, 1=lake, 2=lake+nsst diff --git a/ccpp/physics b/ccpp/physics index 405fc8518..c4980ce8c 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 405fc8518a54b4527c0bda30c4efc6c5c9c3a20c +Subproject commit c4980ce8c17a66d76fdaac3404458091ec5a9116 From 5693728bbec61b82f66ca5c7e7f5cf6a2f498e26 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 30 Nov 2022 00:42:41 +0000 Subject: [PATCH 35/74] put new flake back in --- ccpp/data/GFS_typedefs.F90 | 30 +++++++- ccpp/data/GFS_typedefs.meta | 68 ++++++++++++++++- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 148 +++++++++++++++++++++++++++++++++--- 4 files changed, 234 insertions(+), 14 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index d490a43ab..e1da33b38 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -217,6 +217,14 @@ module GFS_typedefs real (kind=kind_phys), pointer :: lake_t2m (:) => null() !< 2 meter temperature from CLM Lake model real (kind=kind_phys), pointer :: lake_q2m (:) => null() !< 2 meter humidity from CLM Lake model + real (kind=kind_phys), pointer :: h_ML(:) => null() !Mixed Layer depth of lakes [m] + real (kind=kind_phys), pointer :: t_ML(:) => null() !Mixing layer temperature in K + real (kind=kind_phys), pointer :: t_mnw(:) => null() !Mean temperature of the water column [K] + real (kind=kind_phys), pointer :: h_talb(:) => null() !the thermally active layer depth of the bottom sediments [m] + real (kind=kind_phys), pointer :: t_talb(:) => null() !Temperature at the bottom of the sediment upper layer [K] + real (kind=kind_phys), pointer :: t_bot1(:) => null() !Temperature at the water-bottom sediment interface [K] + real (kind=kind_phys), pointer :: t_bot2(:) => null() !Temperature for bottom layer of water [K] + real (kind=kind_phys), pointer :: c_t(:) => null() !Shape factor of water temperature vertical profile real (kind=kind_phys), pointer :: T_snow(:) => null() !temperature of snow on a lake [K] real (kind=kind_phys), pointer :: T_ice(:) => null() !temperature of ice on a lake [K] @@ -2128,8 +2136,17 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate (Sfcprop%use_lake_model(IM)) if(Model%lkm > 0) then - if(Model%iopt_lake==Model%iopt_lake_clm ) then + if(Model%iopt_lake==Model%iopt_lake_clm) then allocate (Sfcprop%clm_lakedepth(IM)) + else if(Model%iopt_lake==Model%iopt_lake_flake) then + allocate (Sfcprop%h_ML (IM)) + allocate (Sfcprop%t_ML (IM)) + allocate (Sfcprop%t_mnw (IM)) + allocate (Sfcprop%h_talb (IM)) + allocate (Sfcprop%t_talb (IM)) + allocate (Sfcprop%t_bot1 (IM)) + allocate (Sfcprop%t_bot2 (IM)) + allocate (Sfcprop%c_t (IM)) endif allocate (Sfcprop%T_snow (IM)) allocate (Sfcprop%T_ice (IM)) @@ -2171,8 +2188,17 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%use_lake_model = zero if(Model%lkm > 0) then - if(Model%iopt_lake==Model%iopt_lake_clm ) then + if(Model%iopt_lake==Model%iopt_lake_clm) then Sfcprop%clm_lakedepth = clear_val + else if(Model%iopt_lake==Model%iopt_lake_flake) then + Sfcprop%h_ML = clear_val + Sfcprop%t_ML = clear_val + Sfcprop%t_mnw = clear_val + Sfcprop%h_talb = clear_val + Sfcprop%t_talb = clear_val + Sfcprop%t_bot1 = clear_val + Sfcprop%t_bot2 = clear_val + Sfcprop%c_t = clear_val endif Sfcprop%T_snow = clear_val Sfcprop%T_ice = clear_val diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index a44b14518..c28f6eac0 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -639,7 +639,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_execution_method > 0) [lake_q2m] standard_name = specific_humidity_at_2m_from_clm_lake long_name = specific humidity at 2m from clm lake @@ -647,7 +647,71 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_execution_method > 0) +[h_ML] + standard_name = mixed_layer_depth_of_lakes + long_name = depth of lake mixing layer + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 1 .and. control_for_lake_model_execution_method > 0) +[t_ML] + standard_name = lake_mixed_layer_temperature + long_name = temperature of lake mixing layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 1 .and. control_for_lake_model_execution_method > 0) +[t_mnw] + standard_name = mean_temperature_of_the_water_column + long_name = thee mean temperature of the water column + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 1 .and. control_for_lake_model_execution_method > 0) +[h_talb] + standard_name = the_thermally_active_layer_depth_of_the_bottom_sediment + long_name = the depth of the thermally active layer of the bottom sediment + units = m + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 1 .and. control_for_lake_model_execution_method > 0) +[t_talb] + standard_name = temperature_at_the_bottom_of_the_sediment_upper_layer + long_name = the temperature at the bottom of the sediment upper layer + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 1 .and. control_for_lake_model_execution_method > 0) +[t_bot1] + standard_name = lake_bottom_temperature + long_name = the temperature at the water-bottom sediment interface + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 1 .and. control_for_lake_model_execution_method > 0) +[t_bot2] + standard_name = temperature_for_bottom_layer_of_water + long_name = the temperature at the lake bottom layer water + units = K + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 1 .and. control_for_lake_model_execution_method > 0) +[c_t] + standard_name = shape_factor_of_water_temperature_vertical_profile + long_name = the shape factor of water temperature vertical profile + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + active = (control_for_lake_model_selection == 1 .and. control_for_lake_model_execution_method > 0) [T_snow] standard_name = temperature_of_snow_on_lake long_name = temperature of snow on a lake diff --git a/ccpp/physics b/ccpp/physics index c4980ce8c..e41e718d6 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit c4980ce8c17a66d76fdaac3404458091ec5a9116 +Subproject commit e41e718d63dfddff8851e26aefd52648e0f967a2 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 1c0d30c46..d68ec99bd 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -204,6 +204,10 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) nsfcprop2d = nsfcprop2d + 16 endif + if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_flake) then + nsfcprop2d = nsfcprop2d + 10 + endif + allocate (temp2d(isc:iec,jsc:jec,nsfcprop2d+Model%ntot2d+Model%nctp)) allocate (temp3d(isc:iec,jsc:jec,1:lev,14+Model%ntot3d+2*ntr)) allocate (temp3dlevsp1(isc:iec,jsc:jec,1:lev+1,3)) @@ -432,8 +436,23 @@ subroutine FV3GFS_GFS_checksum (Model, GFS_Data, Atm_block) temp2d(i,j,idx_opt+13) = GFS_Data(nb)%Sfcprop%ifd(ix) temp2d(i,j,idx_opt+14) = GFS_Data(nb)%Sfcprop%dt_cool(ix) temp2d(i,j,idx_opt+15) = GFS_Data(nb)%Sfcprop%qrain(ix) + idx_opt = idx_opt+15 endif +! Flake + if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then + temp2d(i,j,idx_opt+ 1) = GFS_Data(nb)%Sfcprop%T_snow(ix) + temp2d(i,j,idx_opt+ 2) = GFS_Data(nb)%Sfcprop%T_ice(ix) + temp2d(i,j,idx_opt+ 3) = GFS_Data(nb)%Sfcprop%h_ML(ix) + temp2d(i,j,idx_opt+ 4) = GFS_Data(nb)%Sfcprop%t_ML(ix) + temp2d(i,j,idx_opt+ 5) = GFS_Data(nb)%Sfcprop%t_mnw(ix) + temp2d(i,j,idx_opt+ 6) = GFS_Data(nb)%Sfcprop%h_talb(ix) + temp2d(i,j,idx_opt+ 7) = GFS_Data(nb)%Sfcprop%t_talb(ix) + temp2d(i,j,idx_opt+ 8) = GFS_Data(nb)%Sfcprop%t_bot1(ix) + temp2d(i,j,idx_opt+ 9) = GFS_Data(nb)%Sfcprop%t_bot2(ix) + temp2d(i,j,idx_opt+ 10) = GFS_Data(nb)%Sfcprop%c_t(ix) + endif + do l = 1,Model%ntot2d temp2d(i,j,nsfcprop2d+l) = GFS_Data(nb)%Tbd%phy_f2d(ix,l) enddo @@ -524,7 +543,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta integer :: nvar_o2, nvar_s2m, nvar_s2o, nvar_s3 integer :: nvar_oro_ls_ss integer :: nvar_s2r, nvar_s2mp, nvar_s3mp, isnow - integer :: nvar_emi, nvar_dust12m, nvar_gbbepx + integer :: nvar_emi, nvar_dust12m, nvar_gbbepx, nvar_s2me, nvar_s2l real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p1 => NULL() @@ -702,6 +721,12 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (Model%cplwav) then nvar_s2m = nvar_s2m + 1 endif +! CLM Lake and Flake + if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake ) then + nvar_s2l = 10 + else + nvar_s2l = 0 + endif !--- deallocate containers and free restart container deallocate(oro_name2, oro_var2) @@ -956,9 +981,9 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta if (.not. allocated(sfc_name2)) then !--- allocate the various containers needed for restarts - allocate(sfc_name2(nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r)) + allocate(sfc_name2(nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r+nvar_s2l)) allocate(sfc_name3(0:nvar_s3+nvar_s3mp)) - allocate(sfc_var2(nx,ny,nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r)) + allocate(sfc_var2(nx,ny,nvar_s2m+nvar_s2o+nvar_s2mp+nvar_s2r+nvar_s2l)) ! Note that this may cause problems with RUC LSM for coldstart runs from GFS data ! if the initial conditions do contain this variable, because Model%kice is 9 for ! RUC LSM, but tiice in the initial conditions will only have two vertical layers @@ -1065,6 +1090,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(nvar_s2m+16) = 'ifd' sfc_name2(nvar_s2m+17) = 'dt_cool' sfc_name2(nvar_s2m+18) = 'qrain' + nvar_s2me = nvar_s2m+18 ! ! Only needed when Noah MP LSM is used - 29 2D ! @@ -1098,6 +1124,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(nvar_s2m+45) = 'smcwtdxy' sfc_name2(nvar_s2m+46) = 'deeprechxy' sfc_name2(nvar_s2m+47) = 'rechxy' + nvar_s2me = nvar_s2m+47 else if (Model%lsm == Model%lsm_ruc .and. warm_start) then sfc_name2(nvar_s2m+19) = 'wetness' sfc_name2(nvar_s2m+20) = 'clw_surf_land' @@ -1111,11 +1138,27 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_name2(nvar_s2m+28) = 'sfalb_lnd' sfc_name2(nvar_s2m+29) = 'sfalb_lnd_bck' sfc_name2(nvar_s2m+30) = 'sfalb_ice' + nvar_s2me = nvar_s2m+30 if (Model%rdlai) then sfc_name2(nvar_s2m+31) = 'lai' + nvar_s2me = nvar_s2m+31 endif else if (Model%lsm == Model%lsm_ruc .and. Model%rdlai) then sfc_name2(nvar_s2m+19) = 'lai' + nvar_s2me = nvar_s2m+19 + endif +!CLM Lake and Flake + if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then + sfc_name2(nvar_s2me+1) = 'T_snow' + sfc_name2(nvar_s2me+2) = 'T_ice' + sfc_name2(nvar_s2me+3) = 'h_ML' + sfc_name2(nvar_s2me+4) = 't_ML' + sfc_name2(nvar_s2me+5) = 't_mnw' + sfc_name2(nvar_s2me+6) = 'h_talb' + sfc_name2(nvar_s2me+7) = 't_talb' + sfc_name2(nvar_s2me+8) = 't_bot1' + sfc_name2(nvar_s2me+9) = 't_bot2' + sfc_name2(nvar_s2me+10) = 'c_t' endif is_lsoil=.false. @@ -1224,6 +1267,20 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta end if enddo endif ! noahmp + +! Flake + if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then + mand = .false. + do num = nvar_s2me+1,nvar_s2me+nvar_s2l + var2_p => sfc_var2(:,:,num) + if(is_lsoil) then + call register_restart_field(Sfc_restart, sfc_name2(num),var2_p,dimensions=(/'lat','lon'/), is_optional=.not.mand) + else + call register_restart_field(Sfc_restart, sfc_name2(num),var2_p,dimensions=(/'Time ','yaxis_1','xaxis_1'/), is_optional=.not.mand) + endif + enddo + endif + nullify(var2_p) endif ! if not allocated @@ -1509,6 +1566,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%ifd(ix) = zero Sfcprop(nb)%dt_cool(ix) = zero Sfcprop(nb)%qrain(ix) = zero + nvar_s2me = nvar_s2m elseif (Model%nstf_name(2) == 0) then ! nsst restart Sfcprop(nb)%tref(ix) = sfc_var2(i,j,nvar_s2m+1) !--- nsstm tref Sfcprop(nb)%z_c(ix) = sfc_var2(i,j,nvar_s2m+2) !--- nsstm z_c @@ -1528,6 +1586,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%ifd(ix) = sfc_var2(i,j,nvar_s2m+16) !--- nsstm ifd Sfcprop(nb)%dt_cool(ix) = sfc_var2(i,j,nvar_s2m+17) !--- nsstm dt_cool Sfcprop(nb)%qrain(ix) = sfc_var2(i,j,nvar_s2m+18) !--- nsstm qrain + nvar_s2me = nvar_s2m+18 endif endif @@ -1545,14 +1604,18 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%sfalb_lnd(ix) = sfc_var2(i,j,nvar_s2m+28) Sfcprop(nb)%sfalb_lnd_bck(ix) = sfc_var2(i,j,nvar_s2m+29) Sfcprop(nb)%sfalb_ice(ix) = sfc_var2(i,j,nvar_s2m+30) + nvar_s2me = nvar_s2m+30 if (Model%rdlai) then Sfcprop(nb)%xlaixy(ix) = sfc_var2(i,j,nvar_s2m+31) + nvar_s2me = nvar_s2m+31 endif else if (Model%lsm == Model%lsm_ruc) then ! Initialize RUC snow cover on ice from snow cover Sfcprop(nb)%sncovr_ice(ix) = Sfcprop(nb)%sncovr(ix) + nvar_s2me = nvar_s2m+18 if (Model%rdlai) then Sfcprop(nb)%xlaixy(ix) = sfc_var2(i,j,nvar_s2m+19) + nvar_s2me = nvar_s2m+19 end if elseif (Model%lsm == Model%lsm_noahmp) then !--- Extra Noah MP variables @@ -1585,8 +1648,21 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta Sfcprop(nb)%smcwtdxy(ix) = sfc_var2(i,j,nvar_s2m+45) Sfcprop(nb)%deeprechxy(ix) = sfc_var2(i,j,nvar_s2m+46) Sfcprop(nb)%rechxy(ix) = sfc_var2(i,j,nvar_s2m+47) + nvar_s2me = nvar_s2m+47 + endif +! Flake + if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then + Sfcprop(nb)%T_snow(ix) = sfc_var2(i,j,nvar_s2me+1) + Sfcprop(nb)%T_ice(ix) = sfc_var2(i,j,nvar_s2me+2) + Sfcprop(nb)%h_ML(ix) = sfc_var2(i,j,nvar_s2me+3) + Sfcprop(nb)%t_ML(ix) = sfc_var2(i,j,nvar_s2me+4) + Sfcprop(nb)%t_mnw(ix) = sfc_var2(i,j,nvar_s2me+5) + Sfcprop(nb)%h_talb(ix) = sfc_var2(i,j,nvar_s2me+6) + Sfcprop(nb)%t_talb(ix) = sfc_var2(i,j,nvar_s2me+7) + Sfcprop(nb)%t_bot1(ix) = sfc_var2(i,j,nvar_s2me+8) + Sfcprop(nb)%t_bot2(ix) = sfc_var2(i,j,nvar_s2me+9) + Sfcprop(nb)%c_t(ix) = sfc_var2(i,j,nvar_s2me+10) endif - if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp .or. (.not.warm_start)) then !--- 3D variables do lsoil = 1,Model%lsoil @@ -1865,7 +1941,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta integer :: isc, iec, jsc, jec, npz, nx, ny integer :: id_restart integer :: nvar2m, nvar2o, nvar3 - integer :: nvar2r, nvar2mp, nvar3mp + integer :: nvar2r, nvar2mp, nvar3mp, nvar2me, nvar2l logical :: mand character(len=32) :: fn_srf = 'sfc_data.nc' real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() @@ -1907,6 +1983,12 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nvar2mp = 29 nvar3mp = 5 endif +!CLM Lake and Flake + if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then + nvar2l = 10 + else + nvar2l = 0 + endif isc = Atm_block%isc iec = Atm_block%iec @@ -2083,13 +2165,16 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(46) = 'sncovr_ice' sfc_name2(47) = 'snodi' !snowd on ice portion of a cell sfc_name2(48) = 'weasdi'!weasd on ice portion of a cell + nvar2me = 48 if (Model%use_cice_alb .or. Model%lsm == Model%lsm_ruc) then sfc_name2(49) = 'albdirvis_ice' sfc_name2(50) = 'albdifvis_ice' sfc_name2(51) = 'albdirnir_ice' sfc_name2(52) = 'albdifnir_ice' + nvar2me = 52 ! sfc_name2(53) = 'sfalb_ice' +! nvar2me = 53 endif if (Model%cplwav) then @@ -2114,6 +2199,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+16) = 'ifd' sfc_name2(nvar2m+17) = 'dt_cool' sfc_name2(nvar2m+18) = 'qrain' + nvar2me = nvar2m+18 if (Model%lsm == Model%lsm_ruc) then sfc_name2(nvar2m+19) = 'wetness' sfc_name2(nvar2m+20) = 'clw_surf_land' @@ -2127,8 +2213,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+28) = 'sfalb_lnd' sfc_name2(nvar2m+29) = 'sfalb_lnd_bck' sfc_name2(nvar2m+30) = 'sfalb_ice' + nvar2me = nvar2m+30 if (Model%rdlai) then sfc_name2(nvar2m+31) = 'lai' + nvar2me = nvar2m+31 endif else if(Model%lsm == Model%lsm_noahmp) then ! Only needed when Noah MP LSM is used - 29 2D @@ -2161,13 +2249,37 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2m+45) = 'smcwtdxy' sfc_name2(nvar2m+46) = 'deeprechxy' sfc_name2(nvar2m+47) = 'rechxy' + nvar2me = nvar2m+47 endif end if - ! Tell clm_lake to register all of its fields - if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then - call clm_lake%register_fields(Sfc_restart) - endif + if(Model%lkm>0) then + if(Model%iopt_lake==Model%iopt_lake_flake ) then + sfc_name2(nvar2me+1) = 'T_snow' + sfc_name2(nvar2me+2) = 'T_ice' + sfc_name2(nvar2me+3) = 'h_ML' + sfc_name2(nvar2me+4) = 't_ML' + sfc_name2(nvar2me+5) = 't_mnw' + sfc_name2(nvar2me+6) = 'h_talb' + sfc_name2(nvar2me+7) = 't_talb' + sfc_name2(nvar2me+8) = 't_bot1' + sfc_name2(nvar2me+9) = 't_bot2' + sfc_name2(nvar2me+10) = 'c_t' + if(Model%me==0) then + do i=1,nvar2me+10 + print 1048,i,sfc_name2(i) +1048 format("sfc_name2(",I0,') = "',A,'"') + enddo + if(size(sfc_name2)/=nvar2me+10) then +3814 format("ERROR: size mismatch size(sfc_name2)=",I0," /= nvar2me+10=",I0) + write(0,3814) size(sfc_name2),nvar2me+10 + endif + endif + else if(Model%iopt_lake==Model%iopt_lake_clm) then + ! Tell clm_lake to register all of its fields + call clm_lake%register_fields(Sfc_restart) + endif + endif !--- register the 2D fields do num = 1,nvar2m @@ -2344,6 +2456,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta endif if (Model%cplwav) then sfc_var2(i,j,nvar2m) = Sfcprop(nb)%zorlwav(ix) !--- zorlwav (zorl from wav) + nvar2me = nvar2m endif !--- NSSTM variables if (Model%nstf_name(1) > 0) then @@ -2365,6 +2478,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+16) = Sfcprop(nb)%ifd(ix) !--- nsstm ifd sfc_var2(i,j,nvar2m+17) = Sfcprop(nb)%dt_cool(ix)!--- nsstm dt_cool sfc_var2(i,j,nvar2m+18) = Sfcprop(nb)%qrain(ix) !--- nsstm qrain + nvar2me = nvar2m + 18 endif if (Model%lsm == Model%lsm_ruc) then @@ -2381,8 +2495,10 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+28) = Sfcprop(nb)%sfalb_lnd(ix) sfc_var2(i,j,nvar2m+29) = Sfcprop(nb)%sfalb_lnd_bck(ix) sfc_var2(i,j,nvar2m+30) = Sfcprop(nb)%sfalb_ice(ix) + nvar2me = nvar2m + 30 if (Model%rdlai) then sfc_var2(i,j,nvar2m+31) = Sfcprop(nb)%xlaixy(ix) + nvar2me = nvar2m + 31 endif else if (Model%lsm == Model%lsm_noahmp) then !--- Extra Noah MP variables @@ -2415,6 +2531,20 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var2(i,j,nvar2m+45) = Sfcprop(nb)%smcwtdxy(ix) sfc_var2(i,j,nvar2m+46) = Sfcprop(nb)%deeprechxy(ix) sfc_var2(i,j,nvar2m+47) = Sfcprop(nb)%rechxy(ix) + nvar2me = nvar2m + 47 + endif +! Flake + if(Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then + sfc_var2(i,j,nvar2me+1) = Sfcprop(nb)%T_snow(ix) + sfc_var2(i,j,nvar2me+2) = Sfcprop(nb)%T_ice(ix) + sfc_var2(i,j,nvar2me+3) = Sfcprop(nb)%h_ML(ix) + sfc_var2(i,j,nvar2me+4) = Sfcprop(nb)%t_ML(ix) + sfc_var2(i,j,nvar2me+5) = Sfcprop(nb)%t_mnw(ix) + sfc_var2(i,j,nvar2me+6) = Sfcprop(nb)%h_talb(ix) + sfc_var2(i,j,nvar2me+7) = Sfcprop(nb)%t_talb(ix) + sfc_var2(i,j,nvar2me+8) = Sfcprop(nb)%t_bot1(ix) + sfc_var2(i,j,nvar2me+9) = Sfcprop(nb)%t_bot2(ix) + sfc_var2(i,j,nvar2me+10) = Sfcprop(nb)%c_t(ix) endif do k = 1,Model%kice From 98630dad3b374167e687c3ab1a36ed0c0dcc4044 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 30 Nov 2022 18:22:06 +0000 Subject: [PATCH 36/74] Need larger DIAG_SIZE for clm lake model --- io/FV3GFS_io.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index d68ec99bd..15d9023a2 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -99,7 +99,7 @@ module FV3GFS_io_mod real(kind=kind_phys),dimension(:,:,:),allocatable:: uwork3d logical :: uwork_set = .false. character(128) :: uwindname - integer, parameter, public :: DIAG_SIZE = 500 + integer, parameter, public :: DIAG_SIZE = 800 real, parameter :: missing_value = 9.99e20_r8 real, parameter:: stndrd_atmos_ps = 101325.0_r8 real, parameter:: stndrd_atmos_lapse = 0.0065_r8 From 8ab7e21197121cfa5fa2f6c0fea3584a9429b319 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 1 Dec 2022 03:49:57 +0000 Subject: [PATCH 37/74] renamed variables --- ccpp/data/GFS_typedefs.F90 | 54 ++++++------- ccpp/data/GFS_typedefs.meta | 26 +++---- ccpp/driver/GFS_diagnostics.F90 | 22 +++--- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 24 +++--- io/clm_lake_io.F90 | 130 +++++++++++++++----------------- 6 files changed, 123 insertions(+), 135 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index e1da33b38..618333371 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -423,21 +423,21 @@ module GFS_typedefs real (kind=kind_phys), pointer :: lake_albedo(:) => null() ! real (kind=kind_phys), pointer :: lake_z3d(:,:) => null() ! real (kind=kind_phys), pointer :: lake_dz3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_watsat3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_soil_watsat3d(:,:) => null() ! real (kind=kind_phys), pointer :: lake_csol3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_tkmg3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_tkdry3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_tksatu3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_soil_tkmg3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_soil_tkdry3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_soil_tksatu3d(:,:) => null() ! real (kind=kind_phys), pointer :: lake_h2osno2d(:) => null() ! - real (kind=kind_phys), pointer :: lake_dp2dsno(:) => null() ! + real (kind=kind_phys), pointer :: lake_sndpth2d(:) => null() ! real (kind=kind_phys), pointer :: lake_snl2d(:) => null() ! real (kind=kind_phys), pointer :: lake_snow_z3d(:,:) => null() ! real (kind=kind_phys), pointer :: lake_snow_dz3d(:,:) => null() ! real (kind=kind_phys), pointer :: lake_snow_zi3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_t_h2osoi_vol3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_t_h2osoi_liq3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_t_h2osoi_ice3d(:,:) => null() ! - real (kind=kind_phys), pointer :: lake_t_grnd2d(:) => null() ! + real (kind=kind_phys), pointer :: lake_h2osoi_vol3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_h2osoi_liq3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_h2osoi_ice3d(:,:) => null() ! + real (kind=kind_phys), pointer :: lake_tsfc(:) => null() ! real (kind=kind_phys), pointer :: lake_t_soisno3d(:,:) => null() ! real (kind=kind_phys), pointer :: lake_t_lake3d(:,:) => null() ! real (kind=kind_phys), pointer :: lake_savedtke12d(:)=> null() ! @@ -2582,21 +2582,21 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate(Sfcprop%lake_albedo(IM)) allocate(Sfcprop%lake_z3d(IM,Model%nlevlake_clm_lake)) allocate(Sfcprop%lake_dz3d(IM,Model%nlevlake_clm_lake)) - allocate(Sfcprop%lake_watsat3d(IM,Model%nlevlake_clm_lake)) + allocate(Sfcprop%lake_soil_watsat3d(IM,Model%nlevlake_clm_lake)) allocate(Sfcprop%lake_csol3d(IM,Model%nlevlake_clm_lake)) - allocate(Sfcprop%lake_tkmg3d(IM,Model%nlevlake_clm_lake)) - allocate(Sfcprop%lake_tkdry3d(IM,Model%nlevlake_clm_lake)) - allocate(Sfcprop%lake_tksatu3d(IM,Model%nlevlake_clm_lake)) + allocate(Sfcprop%lake_soil_tkmg3d(IM,Model%nlevlake_clm_lake)) + allocate(Sfcprop%lake_soil_tkdry3d(IM,Model%nlevlake_clm_lake)) + allocate(Sfcprop%lake_soil_tksatu3d(IM,Model%nlevlake_clm_lake)) allocate(Sfcprop%lake_h2osno2d(IM)) - allocate(Sfcprop%lake_dp2dsno(IM)) + allocate(Sfcprop%lake_sndpth2d(IM)) allocate(Sfcprop%lake_snl2d(IM)) allocate(Sfcprop%lake_snow_z3d(IM,Model%nlevsnowsoil1_clm_lake)) allocate(Sfcprop%lake_snow_dz3d(IM,Model%nlevsnowsoil1_clm_lake)) allocate(Sfcprop%lake_snow_zi3d(IM,Model%nlevsnowsoil_clm_lake)) - allocate(Sfcprop%lake_t_h2osoi_vol3d(IM,Model%nlevsnowsoil1_clm_lake)) - allocate(Sfcprop%lake_t_h2osoi_liq3d(IM,Model%nlevsnowsoil1_clm_lake)) - allocate(Sfcprop%lake_t_h2osoi_ice3d(IM,Model%nlevsnowsoil1_clm_lake)) - allocate(Sfcprop%lake_t_grnd2d(IM)) + allocate(Sfcprop%lake_h2osoi_vol3d(IM,Model%nlevsnowsoil1_clm_lake)) + allocate(Sfcprop%lake_h2osoi_liq3d(IM,Model%nlevsnowsoil1_clm_lake)) + allocate(Sfcprop%lake_h2osoi_ice3d(IM,Model%nlevsnowsoil1_clm_lake)) + allocate(Sfcprop%lake_tsfc(IM)) allocate(Sfcprop%lake_t_soisno3d(IM,Model%nlevsnowsoil1_clm_lake)) allocate(Sfcprop%lake_t_lake3d(IM,Model%nlevlake_clm_lake)) allocate(Sfcprop%lake_savedtke12d(IM)) @@ -2613,21 +2613,21 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%lake_albedo = clear_val Sfcprop%lake_z3d = clear_val Sfcprop%lake_dz3d = clear_val - Sfcprop%lake_watsat3d = clear_val + Sfcprop%lake_soil_watsat3d = clear_val Sfcprop%lake_csol3d = clear_val - Sfcprop%lake_tkmg3d = clear_val - Sfcprop%lake_tkdry3d = clear_val - Sfcprop%lake_tksatu3d = clear_val + Sfcprop%lake_soil_tkmg3d = clear_val + Sfcprop%lake_soil_tkdry3d = clear_val + Sfcprop%lake_soil_tksatu3d = clear_val Sfcprop%lake_h2osno2d = clear_val - Sfcprop%lake_dp2dsno = clear_val + Sfcprop%lake_sndpth2d = clear_val Sfcprop%lake_snl2d = clear_val Sfcprop%lake_snow_z3d = clear_val Sfcprop%lake_snow_dz3d = clear_val Sfcprop%lake_snow_zi3d = clear_val - Sfcprop%lake_t_h2osoi_vol3d = clear_val - Sfcprop%lake_t_h2osoi_liq3d = clear_val - Sfcprop%lake_t_h2osoi_ice3d = clear_val - Sfcprop%lake_t_grnd2d = clear_val + Sfcprop%lake_h2osoi_vol3d = clear_val + Sfcprop%lake_h2osoi_liq3d = clear_val + Sfcprop%lake_h2osoi_ice3d = clear_val + Sfcprop%lake_tsfc = clear_val Sfcprop%lake_t_soisno3d = clear_val Sfcprop%lake_t_lake3d = clear_val Sfcprop%lake_savedtke12d = clear_val diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index c28f6eac0..8ed1a7cbd 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -639,7 +639,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_lake_model_execution_method > 0) + active = (control_for_lake_model_execution_method > 0 .and. control_for_lake_model_selection == 2) [lake_q2m] standard_name = specific_humidity_at_2m_from_clm_lake long_name = specific humidity at 2m from clm lake @@ -647,7 +647,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_lake_model_execution_method > 0) + active = (control_for_lake_model_execution_method > 0 .and. control_for_lake_model_selection == 2) [h_ML] standard_name = mixed_layer_depth_of_lakes long_name = depth of lake mixing layer @@ -1992,7 +1992,7 @@ type = real kind = kind_phys active = (control_for_lake_model_selection == 2) -[lake_watsat3d] +[lake_soil_watsat3d] standard_name = saturated_volumetric_soil_water_in_lake_model long_name = saturated volumetric soil water in lake model units = m @@ -2008,7 +2008,7 @@ type = real kind = kind_phys active = (control_for_lake_model_selection == 2) -[lake_tkmg3d] +[lake_soil_tkmg3d] standard_name = soil_mineral_thermal_conductivity_in_lake_model long_name = soil mineral thermal conductivity in lake model units = m @@ -2016,7 +2016,7 @@ type = real kind = kind_phys active = (control_for_lake_model_selection == 2) -[lake_tkdry3d] +[lake_soil_tkdry3d] standard_name = dry_soil_thermal_conductivity_in_lake_model long_name = dry soil thermal conductivity in lake model units = m @@ -2024,7 +2024,7 @@ type = real kind = kind_phys active = (control_for_lake_model_selection == 2) -[lake_tksatu3d] +[lake_soil_tksatu3d] standard_name = saturated_soil_thermal_conductivity_in_lake_model long_name = saturated soil thermal conductivity in lake model units = m @@ -2040,7 +2040,7 @@ type = real kind = kind_phys active = (control_for_lake_model_selection == 2) -[lake_dp2dsno] +[lake_sndpth2d] standard_name = actual_snow_depth_in_clm_lake_model long_name = actual acc snow depth over lake in clm lake model units = m @@ -2080,7 +2080,7 @@ type = real kind = kind_phys active = (control_for_lake_model_selection == 2) -[lake_t_h2osoi_vol3d] +[lake_h2osoi_vol3d] standard_name = volumetric_soil_water_in_clm_lake_model long_name = volumetric soil water in clm lake model units = m3 m-3 @@ -2088,7 +2088,7 @@ type = real kind = kind_phys active = (control_for_lake_model_selection == 2) -[lake_t_h2osoi_liq3d] +[lake_h2osoi_liq3d] standard_name = soil_liquid_water_content_in_clm_lake_model long_name = soil liquid water content in clm lake model units = kg m-3 @@ -2096,7 +2096,7 @@ type = real kind = kind_phys active = (control_for_lake_model_selection == 2) -[lake_t_h2osoi_ice3d] +[lake_h2osoi_ice3d] standard_name = soil_ice_water_content_in_clm_lake_model long_name = soil ice water content in clm lake model units = kg m-3 @@ -2104,9 +2104,9 @@ type = real kind = kind_phys active = (control_for_lake_model_selection == 2) -[lake_t_grnd2d] - standard_name = skin_temperature_from_clm_lake_model - long_name = skin temperature from clm lake model +[lake_tsfc] + standard_name = skin_temperature_from_lake_model + long_name = skin temperature from lake model units = K dimensions = (horizontal_loop_extent) type = real diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index 323248c86..6419ad121 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -2601,14 +2601,14 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop idx = idx + 1 ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'lake_dp2dsno' + ExtDiag(idx)%name = 'lake_sndpth2d' ExtDiag(idx)%desc = 'actual acc snow depth over lake in clm lake model' ExtDiag(idx)%unit = 'm' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lake_dp2dsno(:) + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lake_sndpth2d(:) enddo idx = idx + 1 @@ -2625,14 +2625,14 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop idx = idx + 1 ExtDiag(idx)%axes = 2 - ExtDiag(idx)%name = 'lake_t_grnd2d' + ExtDiag(idx)%name = 'lake_tsfc' ExtDiag(idx)%desc = 'skin temperature from clm lake model' ExtDiag(idx)%unit = 'K' ExtDiag(idx)%mod_name = 'gfs_sfc' ExtDiag(idx)%intpl_method = 'nearest_stod' allocate (ExtDiag(idx)%data(nblks)) do nb = 1,nblks - ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lake_t_grnd2d(:) + ExtDiag(idx)%data(nb)%var2 => Sfcprop(nb)%lake_tsfc(:) enddo idx = idx + 1 @@ -4341,7 +4341,7 @@ subroutine clm_lake_externaldiag_populate(ExtDiag, Model, Sfcprop, idx, cn_one, enddo do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_watsat3d, 'lake_watsat3d', 'saturated volumetric soil water', 'm3 m-3') + call link_all_levels(Sfcprop(iblk)%lake_soil_watsat3d, 'lake_soil_watsat3d', 'saturated volumetric soil water', 'm3 m-3') enddo do iblk=1,nblks @@ -4349,15 +4349,15 @@ subroutine clm_lake_externaldiag_populate(ExtDiag, Model, Sfcprop, idx, cn_one, enddo do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_tkmg3d, 'lake_tkmg3d', 'soil thermal conductivity, minerals', 'W m-1 K-1') + call link_all_levels(Sfcprop(iblk)%lake_soil_tkmg3d, 'lake_soil_tkmg3d', 'soil thermal conductivity, minerals', 'W m-1 K-1') enddo do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_tkdry3d, 'lake_tkdry3d', 'soil thermal conductivity, dry soil', 'W m-1 K-1') + call link_all_levels(Sfcprop(iblk)%lake_soil_tkdry3d, 'lake_soil_tkdry3d', 'soil thermal conductivity, dry soil', 'W m-1 K-1') enddo do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_tksatu3d, 'lake_tksatu3d', 'soil thermal conductivity, saturated soil', 'W m-1 K-1') + call link_all_levels(Sfcprop(iblk)%lake_soil_tksatu3d, 'lake_soil_tksatu3d', 'soil thermal conductivity, saturated soil', 'W m-1 K-1') enddo do iblk=1,nblks @@ -4373,15 +4373,15 @@ subroutine clm_lake_externaldiag_populate(ExtDiag, Model, Sfcprop, idx, cn_one, enddo do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_t_h2osoi_vol3d, 'lake_t_h2osoi_vol3d', 'volumetric soil water', 'm3 m-3') + call link_all_levels(Sfcprop(iblk)%lake_h2osoi_vol3d, 'lake_h2osoi_vol3d', 'volumetric soil water', 'm3 m-3') enddo do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_t_h2osoi_liq3d, 'lake_t_h2osoi_liq3d', 'soil liquid water content', 'kg m-2') + call link_all_levels(Sfcprop(iblk)%lake_h2osoi_liq3d, 'lake_h2osoi_liq3d', 'soil liquid water content', 'kg m-2') enddo do iblk=1,nblks - call link_all_levels(Sfcprop(iblk)%lake_t_h2osoi_ice3d, 'lake_t_h2osoi_ice3d', 'soil ice water content', 'kg m-2') + call link_all_levels(Sfcprop(iblk)%lake_h2osoi_ice3d, 'lake_h2osoi_ice3d', 'soil ice water content', 'kg m-2') enddo do iblk=1,nblks diff --git a/ccpp/physics b/ccpp/physics index e41e718d6..f44c410d7 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit e41e718d63dfddff8851e26aefd52648e0f967a2 +Subproject commit f44c410d78b2444cdafdc1852f0f75c0b6fe12f5 diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 15d9023a2..36b61c9f9 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -2001,8 +2001,8 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta if (Model%lsm == Model%lsm_ruc) then if (allocated(sfc_name2)) then ! Re-allocate if one or more of the dimensions don't match - if (size(sfc_name2).ne.nvar2m+nvar2o+nvar2mp+nvar2r .or. & - size(sfc_name3).ne.nvar3+nvar3mp .or. & + if (size(sfc_name2).ne.nvar2m+nvar2o+nvar2mp+nvar2r+nvar2l .or. & + size(sfc_name3).ne.nvar3+nvar3mp .or. & size(sfc_var3,dim=3).ne.Model%lsoil_lsm) then !--- deallocate containers and free restart container deallocate(sfc_name2) @@ -2094,9 +2094,9 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta if (.not. allocated(sfc_name2)) then !--- allocate the various containers needed for restarts - allocate(sfc_name2(nvar2m+nvar2o+nvar2mp+nvar2r)) + allocate(sfc_name2(nvar2m+nvar2o+nvar2mp+nvar2r+nvar2l)) allocate(sfc_name3(0:nvar3+nvar3mp)) - allocate(sfc_var2(nx,ny,nvar2m+nvar2o+nvar2mp+nvar2r)) + allocate(sfc_var2(nx,ny,nvar2m+nvar2o+nvar2mp+nvar2r+nvar2l)) if (Model%lsm == Model%lsm_noah .or. Model%lsm == Model%lsm_noahmp) then allocate(sfc_var3(nx,ny,Model%lsoil,nvar3)) elseif (Model%lsm == Model%lsm_ruc) then @@ -2255,6 +2255,12 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta if(Model%lkm>0) then if(Model%iopt_lake==Model%iopt_lake_flake ) then + if(Model%me==0) then + if(size(sfc_name2)/=nvar2me+10) then +3814 format("ERROR: size mismatch size(sfc_name2)=",I0," /= nvar2me+10=",I0) + write(0,3814) size(sfc_name2),nvar2me+10 + endif + endif sfc_name2(nvar2me+1) = 'T_snow' sfc_name2(nvar2me+2) = 'T_ice' sfc_name2(nvar2me+3) = 'h_ML' @@ -2265,16 +2271,6 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_name2(nvar2me+8) = 't_bot1' sfc_name2(nvar2me+9) = 't_bot2' sfc_name2(nvar2me+10) = 'c_t' - if(Model%me==0) then - do i=1,nvar2me+10 - print 1048,i,sfc_name2(i) -1048 format("sfc_name2(",I0,') = "',A,'"') - enddo - if(size(sfc_name2)/=nvar2me+10) then -3814 format("ERROR: size mismatch size(sfc_name2)=",I0," /= nvar2me+10=",I0) - write(0,3814) size(sfc_name2),nvar2me+10 - endif - endif else if(Model%iopt_lake==Model%iopt_lake_clm) then ! Tell clm_lake to register all of its fields call clm_lake%register_fields(Sfc_restart) diff --git a/io/clm_lake_io.F90 b/io/clm_lake_io.F90 index e4f94a744..3b606415f 100644 --- a/io/clm_lake_io.F90 +++ b/io/clm_lake_io.F90 @@ -25,16 +25,16 @@ module clm_lake_io ! All 2D variables needed for a restart real(kind_phys), pointer, private, dimension(:,:) :: & T_snow=>null(), T_ice=>null(), & - lake_snl2d=>null(), lake_h2osno2d=>null(), lake_t_grnd2d=>null(), clm_lakedepth=>null(), & - lake_savedtke12d=>null(), lake_dp2dsno=>null(), clm_lake_initialized=>null() + lake_snl2d=>null(), lake_h2osno2d=>null(), lake_tsfc=>null(), clm_lakedepth=>null(), & + lake_savedtke12d=>null(), lake_sndpth2d=>null(), clm_lake_initialized=>null() ! All 3D variables needed for a restart real(kind_phys), pointer, private, dimension(:,:,:) :: & - lake_z3d=>null(), lake_dz3d=>null(), lake_watsat3d=>null(), & - lake_csol3d=>null(), lake_tkmg3d=>null(), lake_tkdry3d=>null(), & - lake_tksatu3d=>null(), lake_snow_z3d=>null(), lake_snow_dz3d=>null(), & - lake_snow_zi3d=>null(), lake_t_h2osoi_vol3d=>null(), lake_t_h2osoi_liq3d=>null(), & - lake_t_h2osoi_ice3d=>null(), lake_t_soisno3d=>null(), lake_t_lake3d=>null(), & + lake_z3d=>null(), lake_dz3d=>null(), lake_soil_watsat3d=>null(), & + lake_csol3d=>null(), lake_soil_tkmg3d=>null(), lake_soil_tkdry3d=>null(), & + lake_soil_tksatu3d=>null(), lake_snow_z3d=>null(), lake_snow_dz3d=>null(), & + lake_snow_zi3d=>null(), lake_h2osoi_vol3d=>null(), lake_h2osoi_liq3d=>null(), & + lake_h2osoi_ice3d=>null(), lake_t_soisno3d=>null(), lake_t_lake3d=>null(), & lake_icefrac3d=>null(), lake_clay3d=>null(), lake_sand3d=>null() contains @@ -81,7 +81,6 @@ subroutine clm_lake_allocate_data(data,Model) type(GFS_control_type), intent(in) :: Model integer :: nx, ny - print *,'clm_lake_allocate_data' call data%deallocate_data nx=Model%nx @@ -91,25 +90,25 @@ subroutine clm_lake_allocate_data(data,Model) allocate(data%T_ice(nx,ny)) allocate(data%lake_snl2d(nx,ny)) allocate(data%lake_h2osno2d(nx,ny)) - allocate(data%lake_t_grnd2d(nx,ny)) + allocate(data%lake_tsfc(nx,ny)) allocate(data%lake_savedtke12d(nx,ny)) - allocate(data%lake_dp2dsno(nx,ny)) + allocate(data%lake_sndpth2d(nx,ny)) allocate(data%clm_lakedepth(nx,ny)) allocate(data%clm_lake_initialized(nx,ny)) allocate(data%lake_z3d(nx,ny,Model%nlevlake_clm_lake)) allocate(data%lake_dz3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_watsat3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_soil_watsat3d(nx,ny,Model%nlevlake_clm_lake)) allocate(data%lake_csol3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_tkmg3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_tkdry3d(nx,ny,Model%nlevlake_clm_lake)) - allocate(data%lake_tksatu3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_soil_tkmg3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_soil_tkdry3d(nx,ny,Model%nlevlake_clm_lake)) + allocate(data%lake_soil_tksatu3d(nx,ny,Model%nlevlake_clm_lake)) allocate(data%lake_snow_z3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) allocate(data%lake_snow_dz3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) allocate(data%lake_snow_zi3d(nx,ny,Model%nlevsnowsoil_clm_lake)) - allocate(data%lake_t_h2osoi_vol3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) - allocate(data%lake_t_h2osoi_liq3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) - allocate(data%lake_t_h2osoi_ice3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(data%lake_h2osoi_vol3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(data%lake_h2osoi_liq3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) + allocate(data%lake_h2osoi_ice3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) allocate(data%lake_t_soisno3d(nx,ny,Model%nlevsnowsoil1_clm_lake)) allocate(data%lake_t_lake3d(nx,ny,Model%nlevlake_clm_lake)) allocate(data%lake_icefrac3d(nx,ny,Model%nlevlake_clm_lake)) @@ -123,7 +122,6 @@ subroutine clm_lake_register_axes(data,Model,Sfc_restart) class(clm_lake_data_type) :: data type(GFS_control_type), intent(in) :: Model type(FmsNetcdfDomainFile_t) :: Sfc_restart - print *,'clm_lake_register_axes' call register_axis(Sfc_restart, 'levlake_clm_lake', dimension_length=Model%nlevlake_clm_lake) call register_axis(Sfc_restart, 'levsoil_clm_lake', dimension_length=Model%nlevsoil_clm_lake) @@ -148,7 +146,6 @@ subroutine clm_lake_write_axes(data, Model, Sfc_restart) real(kind_phys) :: levsnowsoil_clm_lake(Model%nlevsnowsoil_clm_lake) real(kind_phys) :: levsnowsoil1_clm_lake(Model%nlevsnowsoil1_clm_lake) integer :: i - print *,'clm_lake_write_axes' call register_field(Sfc_restart, 'levlake_clm_lake', 'double', (/'levlake_clm_lake'/)) call register_variable_attribute(Sfc_restart, 'levlake_clm_lake', 'cartesian_axis' ,'Z', str_len=1) @@ -197,7 +194,6 @@ subroutine clm_lake_copy_to_temporaries(data, Model, Sfcprop, Atm_block) type(block_control_type), intent(in) :: Atm_block integer :: nb, ix, isc, jsc, i, j - print *,'clm_lake_copy_to_temporaries' isc = Model%isc jsc = Model%jsc @@ -213,25 +209,25 @@ subroutine clm_lake_copy_to_temporaries(data, Model, Sfcprop, Atm_block) data%T_ice(i,j) = Sfcprop(nb)%T_ice(ix) data%lake_snl2d(i,j) = Sfcprop(nb)%lake_snl2d(ix) data%lake_h2osno2d(i,j) = Sfcprop(nb)%lake_h2osno2d(ix) - data%lake_t_grnd2d(i,j) = Sfcprop(nb)%lake_t_grnd2d(ix) + data%lake_tsfc(i,j) = Sfcprop(nb)%lake_tsfc(ix) data%lake_savedtke12d(i,j) = Sfcprop(nb)%lake_savedtke12d(ix) - data%lake_dp2dsno(i,j) = Sfcprop(nb)%lake_dp2dsno(ix) + data%lake_sndpth2d(i,j) = Sfcprop(nb)%lake_sndpth2d(ix) data%clm_lakedepth(i,j) = Sfcprop(nb)%clm_lakedepth(ix) data%clm_lake_initialized(i,j) = Sfcprop(nb)%clm_lake_initialized(ix) data%lake_z3d(i,j,:) = Sfcprop(nb)%lake_z3d(ix,:) data%lake_dz3d(i,j,:) = Sfcprop(nb)%lake_dz3d(ix,:) - data%lake_watsat3d(i,j,:) = Sfcprop(nb)%lake_watsat3d(ix,:) + data%lake_soil_watsat3d(i,j,:) = Sfcprop(nb)%lake_soil_watsat3d(ix,:) data%lake_csol3d(i,j,:) = Sfcprop(nb)%lake_csol3d(ix,:) - data%lake_tkmg3d(i,j,:) = Sfcprop(nb)%lake_tkmg3d(ix,:) - data%lake_tkdry3d(i,j,:) = Sfcprop(nb)%lake_tkdry3d(ix,:) - data%lake_tksatu3d(i,j,:) = Sfcprop(nb)%lake_tksatu3d(ix,:) + data%lake_soil_tkmg3d(i,j,:) = Sfcprop(nb)%lake_soil_tkmg3d(ix,:) + data%lake_soil_tkdry3d(i,j,:) = Sfcprop(nb)%lake_soil_tkdry3d(ix,:) + data%lake_soil_tksatu3d(i,j,:) = Sfcprop(nb)%lake_soil_tksatu3d(ix,:) data%lake_snow_z3d(i,j,:) = Sfcprop(nb)%lake_snow_z3d(ix,:) data%lake_snow_dz3d(i,j,:) = Sfcprop(nb)%lake_snow_dz3d(ix,:) data%lake_snow_zi3d(i,j,:) = Sfcprop(nb)%lake_snow_zi3d(ix,:) - data%lake_t_h2osoi_vol3d(i,j,:) = Sfcprop(nb)%lake_t_h2osoi_vol3d(ix,:) - data%lake_t_h2osoi_liq3d(i,j,:) = Sfcprop(nb)%lake_t_h2osoi_liq3d(ix,:) - data%lake_t_h2osoi_ice3d(i,j,:) = Sfcprop(nb)%lake_t_h2osoi_ice3d(ix,:) + data%lake_h2osoi_vol3d(i,j,:) = Sfcprop(nb)%lake_h2osoi_vol3d(ix,:) + data%lake_h2osoi_liq3d(i,j,:) = Sfcprop(nb)%lake_h2osoi_liq3d(ix,:) + data%lake_h2osoi_ice3d(i,j,:) = Sfcprop(nb)%lake_h2osoi_ice3d(ix,:) data%lake_t_soisno3d(i,j,:) = Sfcprop(nb)%lake_t_soisno3d(ix,:) data%lake_t_lake3d(i,j,:) = Sfcprop(nb)%lake_t_lake3d(ix,:) data%lake_icefrac3d(i,j,:) = Sfcprop(nb)%lake_icefrac3d(ix,:) @@ -251,7 +247,6 @@ subroutine clm_lake_fill_with_zero(data, Model, Sfcprop, Atm_block) type(block_control_type), intent(in) :: Atm_block integer :: nb, ix, isc, jsc, i, j - print *,'clm_lake_copy_to_temporaries' isc = Model%isc jsc = Model%jsc @@ -267,25 +262,25 @@ subroutine clm_lake_fill_with_zero(data, Model, Sfcprop, Atm_block) data%T_ice(i,j) = 0 data%lake_snl2d(i,j) = 0 data%lake_h2osno2d(i,j) = 0 - data%lake_t_grnd2d(i,j) = 0 + data%lake_tsfc(i,j) = 0 data%lake_savedtke12d(i,j) = 0 - data%lake_dp2dsno(i,j) = 0 + data%lake_sndpth2d(i,j) = 0 data%clm_lakedepth(i,j) = 0 data%clm_lake_initialized(i,j) = 0 data%lake_z3d(i,j,:) = 0 data%lake_dz3d(i,j,:) = 0 - data%lake_watsat3d(i,j,:) = 0 + data%lake_soil_watsat3d(i,j,:) = 0 data%lake_csol3d(i,j,:) = 0 - data%lake_tkmg3d(i,j,:) = 0 - data%lake_tkdry3d(i,j,:) = 0 - data%lake_tksatu3d(i,j,:) = 0 + data%lake_soil_tkmg3d(i,j,:) = 0 + data%lake_soil_tkdry3d(i,j,:) = 0 + data%lake_soil_tksatu3d(i,j,:) = 0 data%lake_snow_z3d(i,j,:) = 0 data%lake_snow_dz3d(i,j,:) = 0 data%lake_snow_zi3d(i,j,:) = 0 - data%lake_t_h2osoi_vol3d(i,j,:) = 0 - data%lake_t_h2osoi_liq3d(i,j,:) = 0 - data%lake_t_h2osoi_ice3d(i,j,:) = 0 + data%lake_h2osoi_vol3d(i,j,:) = 0 + data%lake_h2osoi_liq3d(i,j,:) = 0 + data%lake_h2osoi_ice3d(i,j,:) = 0 data%lake_t_soisno3d(i,j,:) = 0 data%lake_t_lake3d(i,j,:) = 0 data%lake_icefrac3d(i,j,:) = 0 @@ -305,7 +300,6 @@ subroutine clm_lake_copy_from_temporaries(data, Model, Sfcprop, Atm_block) type(block_control_type), intent(in) :: Atm_block integer :: nb, ix, isc, jsc, i, j - print *,'clm_lake_copy_from_temporaries' isc = Model%isc jsc = Model%jsc @@ -321,25 +315,25 @@ subroutine clm_lake_copy_from_temporaries(data, Model, Sfcprop, Atm_block) Sfcprop(nb)%T_ice(ix) = data%T_ice(i,j) Sfcprop(nb)%lake_snl2d(ix) = data%lake_snl2d(i,j) Sfcprop(nb)%lake_h2osno2d(ix) = data%lake_h2osno2d(i,j) - Sfcprop(nb)%lake_t_grnd2d(ix) = data%lake_t_grnd2d(i,j) + Sfcprop(nb)%lake_tsfc(ix) = data%lake_tsfc(i,j) Sfcprop(nb)%lake_savedtke12d(ix) = data%lake_savedtke12d(i,j) - Sfcprop(nb)%lake_dp2dsno(ix) = data%lake_dp2dsno(i,j) + Sfcprop(nb)%lake_sndpth2d(ix) = data%lake_sndpth2d(i,j) Sfcprop(nb)%clm_lakedepth(ix) = data%clm_lakedepth(i,j) Sfcprop(nb)%clm_lake_initialized(ix) = data%clm_lake_initialized(i,j) Sfcprop(nb)%lake_z3d(ix,:) = data%lake_z3d(i,j,:) Sfcprop(nb)%lake_dz3d(ix,:) = data%lake_dz3d(i,j,:) - Sfcprop(nb)%lake_watsat3d(ix,:) = data%lake_watsat3d(i,j,:) + Sfcprop(nb)%lake_soil_watsat3d(ix,:) = data%lake_soil_watsat3d(i,j,:) Sfcprop(nb)%lake_csol3d(ix,:) = data%lake_csol3d(i,j,:) - Sfcprop(nb)%lake_tkmg3d(ix,:) = data%lake_tkmg3d(i,j,:) - Sfcprop(nb)%lake_tkdry3d(ix,:) = data%lake_tkdry3d(i,j,:) - Sfcprop(nb)%lake_tksatu3d(ix,:) = data%lake_tksatu3d(i,j,:) + Sfcprop(nb)%lake_soil_tkmg3d(ix,:) = data%lake_soil_tkmg3d(i,j,:) + Sfcprop(nb)%lake_soil_tkdry3d(ix,:) = data%lake_soil_tkdry3d(i,j,:) + Sfcprop(nb)%lake_soil_tksatu3d(ix,:) = data%lake_soil_tksatu3d(i,j,:) Sfcprop(nb)%lake_snow_z3d(ix,:) = data%lake_snow_z3d(i,j,:) Sfcprop(nb)%lake_snow_dz3d(ix,:) = data%lake_snow_dz3d(i,j,:) Sfcprop(nb)%lake_snow_zi3d(ix,:) = data%lake_snow_zi3d(i,j,:) - Sfcprop(nb)%lake_t_h2osoi_vol3d(ix,:) = data%lake_t_h2osoi_vol3d(i,j,:) - Sfcprop(nb)%lake_t_h2osoi_liq3d(ix,:) = data%lake_t_h2osoi_liq3d(i,j,:) - Sfcprop(nb)%lake_t_h2osoi_ice3d(ix,:) = data%lake_t_h2osoi_ice3d(i,j,:) + Sfcprop(nb)%lake_h2osoi_vol3d(ix,:) = data%lake_h2osoi_vol3d(i,j,:) + Sfcprop(nb)%lake_h2osoi_liq3d(ix,:) = data%lake_h2osoi_liq3d(i,j,:) + Sfcprop(nb)%lake_h2osoi_ice3d(ix,:) = data%lake_h2osoi_ice3d(i,j,:) Sfcprop(nb)%lake_t_soisno3d(ix,:) = data%lake_t_soisno3d(i,j,:) Sfcprop(nb)%lake_t_lake3d(ix,:) = data%lake_t_lake3d(i,j,:) Sfcprop(nb)%lake_icefrac3d(ix,:) = data%lake_icefrac3d(i,j,:) @@ -357,8 +351,6 @@ subroutine clm_lake_register_fields(data, Sfc_restart) class(clm_lake_data_type) :: data type(FmsNetcdfDomainFile_t) :: Sfc_restart - print *,'clm_lake_register_fields' - ! Register 2D fields call register_restart_field(Sfc_restart, 'T_snow', data%T_snow, & dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) @@ -368,11 +360,11 @@ subroutine clm_lake_register_fields(data, Sfc_restart) dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart, 'lake_h2osno2d', data%lake_h2osno2d, & dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'lake_t_grnd2d', data%lake_t_grnd2d, & + call register_restart_field(Sfc_restart, 'lake_tsfc', data%lake_tsfc, & dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart, 'lake_savedtke12d', data%lake_savedtke12d, & dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart, 'lake_dp2dsno', data%lake_dp2dsno, & + call register_restart_field(Sfc_restart, 'lake_sndpth2d', data%lake_sndpth2d, & dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart, 'clm_lakedepth', data%clm_lakedepth, & dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/), is_optional=.true.) @@ -386,19 +378,19 @@ subroutine clm_lake_register_fields(data, Sfc_restart) call register_restart_field(Sfc_restart, 'lake_dz3d', data%lake_dz3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_watsat3d', data%lake_watsat3d, & + call register_restart_field(Sfc_restart,'lake_soil_watsat3d', data%lake_soil_watsat3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & 'levlake_clm_lake ', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_csol3d', data%lake_csol3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_tkmg3d', data%lake_tkmg3d, & + call register_restart_field(Sfc_restart,'lake_soil_tkmg3d', data%lake_soil_tkmg3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_tkdry3d', data%lake_tkdry3d, & + call register_restart_field(Sfc_restart,'lake_soil_tkdry3d', data%lake_soil_tkdry3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & 'levlake_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_tksatu3d', data%lake_tksatu3d, & + call register_restart_field(Sfc_restart,'lake_soil_tksatu3d', data%lake_soil_tksatu3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & 'levlake_clm_lake ', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_snow_z3d', data%lake_snow_z3d, & @@ -410,13 +402,13 @@ subroutine clm_lake_register_fields(data, Sfc_restart) call register_restart_field(Sfc_restart,'lake_snow_zi3d', data%lake_snow_zi3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & 'levsnowsoil_clm_lake ', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_t_h2osoi_vol3d', data%lake_t_h2osoi_vol3d, & + call register_restart_field(Sfc_restart,'lake_h2osoi_vol3d', data%lake_h2osoi_vol3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_t_h2osoi_liq3d', data%lake_t_h2osoi_liq3d, & + call register_restart_field(Sfc_restart,'lake_h2osoi_liq3d', data%lake_h2osoi_liq3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) - call register_restart_field(Sfc_restart,'lake_t_h2osoi_ice3d', data%lake_t_h2osoi_ice3d, & + call register_restart_field(Sfc_restart,'lake_h2osoi_ice3d', data%lake_h2osoi_ice3d, & dimensions=(/'xaxis_1 ', 'yaxis_1 ', & 'levsnowsoil1_clm_lake', 'Time '/), is_optional=.true.) call register_restart_field(Sfc_restart,'lake_t_soisno3d', data%lake_t_soisno3d, & @@ -465,25 +457,25 @@ subroutine clm_lake_deallocate_data(data) IF_ASSOC_DEALLOC_NULL(T_ice) IF_ASSOC_DEALLOC_NULL(lake_snl2d) IF_ASSOC_DEALLOC_NULL(lake_h2osno2d) - IF_ASSOC_DEALLOC_NULL(lake_t_grnd2d) + IF_ASSOC_DEALLOC_NULL(lake_tsfc) IF_ASSOC_DEALLOC_NULL(lake_savedtke12d) - IF_ASSOC_DEALLOC_NULL(lake_dp2dsno) + IF_ASSOC_DEALLOC_NULL(lake_sndpth2d) IF_ASSOC_DEALLOC_NULL(clm_lakedepth) IF_ASSOC_DEALLOC_NULL(clm_lake_initialized) IF_ASSOC_DEALLOC_NULL(lake_z3d) IF_ASSOC_DEALLOC_NULL(lake_dz3d) - IF_ASSOC_DEALLOC_NULL(lake_watsat3d) + IF_ASSOC_DEALLOC_NULL(lake_soil_watsat3d) IF_ASSOC_DEALLOC_NULL(lake_csol3d) - IF_ASSOC_DEALLOC_NULL(lake_tkmg3d) - IF_ASSOC_DEALLOC_NULL(lake_tkdry3d) - IF_ASSOC_DEALLOC_NULL(lake_tksatu3d) + IF_ASSOC_DEALLOC_NULL(lake_soil_tkmg3d) + IF_ASSOC_DEALLOC_NULL(lake_soil_tkdry3d) + IF_ASSOC_DEALLOC_NULL(lake_soil_tksatu3d) IF_ASSOC_DEALLOC_NULL(lake_snow_z3d) IF_ASSOC_DEALLOC_NULL(lake_snow_dz3d) IF_ASSOC_DEALLOC_NULL(lake_snow_zi3d) - IF_ASSOC_DEALLOC_NULL(lake_t_h2osoi_vol3d) - IF_ASSOC_DEALLOC_NULL(lake_t_h2osoi_liq3d) - IF_ASSOC_DEALLOC_NULL(lake_t_h2osoi_ice3d) + IF_ASSOC_DEALLOC_NULL(lake_h2osoi_vol3d) + IF_ASSOC_DEALLOC_NULL(lake_h2osoi_liq3d) + IF_ASSOC_DEALLOC_NULL(lake_h2osoi_ice3d) IF_ASSOC_DEALLOC_NULL(lake_t_soisno3d) IF_ASSOC_DEALLOC_NULL(lake_t_lake3d) IF_ASSOC_DEALLOC_NULL(lake_icefrac3d) From aed44899ba4b1bb7a363501f2f336418f5532314 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 1 Mar 2023 20:29:15 +0000 Subject: [PATCH 38/74] bug fix: fill restart input with prior values --- io/FV3GFS_io.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 36b61c9f9..116d76b17 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1194,7 +1194,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta ! Tell CLM Lake to allocate data, and register its axes and fields if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then call clm_lake%allocate_data(Model) - call clm_lake%fill_with_zero(Model, Sfcprop, Atm_block) + call clm_lake%copy_to_temporaries(Model,Sfcprop,Atm_block) call clm_lake%register_axes(Model, Sfc_restart) call clm_lake%register_fields(Sfc_restart) endif From b907a592a4d3bcb95dce66a3b89340c07669c27a Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 1 Mar 2023 21:31:12 +0000 Subject: [PATCH 39/74] correction to a comment in clm_lake.f90 --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 7c9a217d1..b214ab49d 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 7c9a217d12d96e199e8d3a06e6a2600e0f993c50 +Subproject commit b214ab49d5cff293d9658c4a8ddce44210d06f91 From c205d9463c3d54f0c3582aa5b8972f0490a955ea Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 2 Mar 2023 14:02:23 +0000 Subject: [PATCH 40/74] restart works with FV3_HRRR suite --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index b214ab49d..05e87ec99 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit b214ab49d5cff293d9658c4a8ddce44210d06f91 +Subproject commit 05e87ec99198dfd727a95f5878adb3f83a249f45 From c3b980706b3c676bee037043917e8ae32cf05f35 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 2 Mar 2023 15:20:52 +0000 Subject: [PATCH 41/74] do not freeze great salt lakes --- ccpp/data/GFS_typedefs.F90 | 3 +++ ccpp/data/GFS_typedefs.meta | 7 +++++++ ccpp/driver/GFS_diagnostics.F90 | 11 +++++++++++ ccpp/physics | 2 +- 4 files changed, 22 insertions(+), 1 deletion(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 6219f3ba7..68b6e0fac 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -447,6 +447,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: lake_clay3d(:,:) => null() real (kind=kind_phys), pointer :: lake_sand3d(:,:) => null() integer, pointer :: lake_is_salty(:) => null() + integer, pointer :: lake_cannot_freeze(:) => null() real (kind=kind_phys), pointer :: clm_lake_initialized(:) => null() !< lakeini was called contains @@ -2607,6 +2608,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate(Sfcprop%lake_clay3d(IM,Model%nlevsoil_clm_lake)) allocate(Sfcprop%lake_sand3d(IM,Model%nlevsoil_clm_lake)) allocate(Sfcprop%lake_is_salty(IM)) + allocate(Sfcprop%lake_cannot_freeze(IM)) allocate(Sfcprop%clm_lake_initialized(IM)) Sfcprop%lake_t2m = clear_val @@ -2638,6 +2640,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%lake_clay3d = clear_val Sfcprop%lake_sand3d = clear_val Sfcprop%lake_is_salty = zero + Sfcprop%lake_cannot_freeze = zero Sfcprop%clm_lake_initialized = zero endif end subroutine sfcprop_create diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 139a125e1..31f5d983e 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -2181,6 +2181,13 @@ dimensions = (horizontal_loop_extent) type = integer active = (control_for_lake_model_selection == 2) +[lake_cannot_freeze] + standard_name = clm_lake_cannot_freeze + long_name = lake at this point is so salty it cannot freeze + units = 1 + dimensions = (horizontal_loop_extent) + type = integer + active = (control_for_lake_model_selection == 2) ######################################################################## [ccpp-table-properties] diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index 6419ad121..88a253650 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -2550,6 +2550,17 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop do nb = 1,nblks ExtDiag(idx)%data(nb)%int2 => Sfcprop(nb)%lake_is_salty(:) enddo + + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'lake_cannot_freeze' + ExtDiag(idx)%desc = 'clm lake model considers the point to be so salty it cannot freeze' + ExtDiag(idx)%unit = '1' + ExtDiag(idx)%mod_name = 'gfs_sfc' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%int2 => Sfcprop(nb)%lake_cannot_freeze(:) + enddo idx = idx + 1 ExtDiag(idx)%axes = 2 diff --git a/ccpp/physics b/ccpp/physics index 05e87ec99..aa57582bf 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 05e87ec99198dfd727a95f5878adb3f83a249f45 +Subproject commit aa57582bfd7cadcefbac63d364f4050ea7cf3c25 From 14b16b6de1dbd2bc43b982b96ffd823ca7662b2e Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 2 Mar 2023 16:31:15 +0000 Subject: [PATCH 42/74] address reviewer comments --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index aa57582bf..b3a058645 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit aa57582bfd7cadcefbac63d364f4050ea7cf3c25 +Subproject commit b3a058645427ce6c5894672d9de33ca2519cfa7c From d00e98b4cf2e53c7b0352f44a361f7434773188a Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 2 Mar 2023 16:41:45 +0000 Subject: [PATCH 43/74] comment in clm_lake.f90 to resolve reviewer confusion --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index b3a058645..ce8643f84 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit b3a058645427ce6c5894672d9de33ca2519cfa7c +Subproject commit ce8643f84cd1f06e62c35f2b72d9cf0b61ad88b0 From cdf86538b5b6543d60d5b3a735b98e576008ccc6 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 2 Mar 2023 17:40:55 +0000 Subject: [PATCH 44/74] change missed in merge --- io/FV3GFS_io.F90 | 16 +++------------- 1 file changed, 3 insertions(+), 13 deletions(-) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 9d367602e..cb8d4743f 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -2335,21 +2335,11 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta if(Model%lkm>0) then if(Model%iopt_lake==Model%iopt_lake_flake ) then if(Model%me==0) then - if(size(sfc_name2)/=nvar2me+10) then -3814 format("ERROR: size mismatch size(sfc_name2)=",I0," /= nvar2me+10=",I0) - write(0,3814) size(sfc_name2),nvar2me+10 + if(size(sfc_name2)/=nvar_before_lake+10) then +3814 format("ERROR: size mismatch size(sfc_name2)=",I0," /= nvar_before_lake+10=",I0) + write(0,3814) size(sfc_name2),nvar_before_lake+10 endif endif - sfc_name2(nvar2me+1) = 'T_snow' - sfc_name2(nvar2me+2) = 'T_ice' - sfc_name2(nvar2me+3) = 'h_ML' - sfc_name2(nvar2me+4) = 't_ML' - sfc_name2(nvar2me+5) = 't_mnw' - sfc_name2(nvar2me+6) = 'h_talb' - sfc_name2(nvar2me+7) = 't_talb' - sfc_name2(nvar2me+8) = 't_bot1' - sfc_name2(nvar2me+9) = 't_bot2' - sfc_name2(nvar2me+10) = 'c_t' else if(Model%iopt_lake==Model%iopt_lake_clm) then ! Tell clm_lake to register all of its fields call clm_lake%register_fields(Sfc_restart) From ed6f862159812027279d9111119926fe006d250b Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 2 Mar 2023 17:41:06 +0000 Subject: [PATCH 45/74] CLM Lake is the default --- ccpp/data/GFS_typedefs.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index 4e60b981a..29232f05a 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -3353,7 +3353,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- flake model parameters integer :: lkm = 0 !< =1 run lake, =2 run lake&nsst =0 no lake - integer :: iopt_lake = 1 !< =1 flake, =2 clm lake + integer :: iopt_lake = 2 !< =1 flake, =2 clm lake (default) real(kind_phys) :: lakedepth_threshold = 1.0 !< lakedepth must be GREATER than this value to enable a lake model real(kind_phys) :: lakefrac_threshold = 0.0 !< lakefrac must be GREATER than this value to enable a lake model logical :: use_lake2m = .false. !< use 2m T & Q from clm lake model From a74281eea8eb481ce07a7fda2899dbf0ea16a114 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 2 Mar 2023 18:38:13 +0000 Subject: [PATCH 46/74] incorrect active= for two variables --- ccpp/data/GFS_typedefs.meta | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 468e53c8b..6d1ce2a80 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -1859,7 +1859,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .or. control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme .or. control_for_lake_model_selection == 2) + active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .or. control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme .or. ( control_for_lake_model_execution_method > 0 .and. control_for_lake_model_selection == 2) ) [rainncprv] standard_name = lwe_thickness_of_explicit_precipitation_amount_on_previous_timestep long_name = explicit rainfall from previous timestep @@ -1867,7 +1867,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .or. control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme .or. control_for_lake_model_selection == 2) + active = (control_for_land_surface_scheme == identifier_for_ruc_land_surface_scheme .or. control_for_land_surface_scheme == identifier_for_noahmp_land_surface_scheme .or. ( control_for_lake_model_execution_method > 0 .and. control_for_lake_model_selection == 2) ) [iceprv] standard_name = lwe_thickness_of_ice_precipitation_amount_on_previous_timestep long_name = ice amount from previous timestep From 37f09da8bd2aff514ca446ffcc801c45caeeccb5 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Thu, 2 Mar 2023 20:31:30 +0000 Subject: [PATCH 47/74] remove clm_lake_fill_with_zero --- io/clm_lake_io.F90 | 56 ---------------------------------------------- 1 file changed, 56 deletions(-) diff --git a/io/clm_lake_io.F90 b/io/clm_lake_io.F90 index 3b606415f..6a47f3ab6 100644 --- a/io/clm_lake_io.F90 +++ b/io/clm_lake_io.F90 @@ -45,9 +45,6 @@ module clm_lake_io ! allocate_data allocates all of the pointers in this object procedure, public :: allocate_data => clm_lake_allocate_data - ! fill_with_zero allocates fills the temporary arrays with 0 - procedure, public :: fill_with_zero => clm_lake_fill_with_zero - ! register_fields calls register_field on Sfc_restart for all CLM Lake model restart variables procedure, public :: register_fields => clm_lake_register_fields @@ -237,59 +234,6 @@ subroutine clm_lake_copy_to_temporaries(data, Model, Sfcprop, Atm_block) enddo end subroutine clm_lake_copy_to_temporaries - subroutine clm_lake_fill_with_zero(data, Model, Sfcprop, Atm_block) - ! Fills all temporary variables with 0. - ! Terrible things will happen if you don't call data%allocate_data first. - implicit none - class(clm_lake_data_type) :: data - type(GFS_sfcprop_type), intent(in) :: Sfcprop(:) - type(GFS_control_type), intent(in) :: Model - type(block_control_type), intent(in) :: Atm_block - - integer :: nb, ix, isc, jsc, i, j - isc = Model%isc - jsc = Model%jsc - - ! Copy data to temporary arrays - -!$omp parallel do default(shared) private(i, j, nb, ix) - do nb = 1, Atm_block%nblks - do ix = 1, Atm_block%blksz(nb) - i = Atm_block%index(nb)%ii(ix) - isc + 1 - j = Atm_block%index(nb)%jj(ix) - jsc + 1 - - data%T_snow(i,j) = 0 - data%T_ice(i,j) = 0 - data%lake_snl2d(i,j) = 0 - data%lake_h2osno2d(i,j) = 0 - data%lake_tsfc(i,j) = 0 - data%lake_savedtke12d(i,j) = 0 - data%lake_sndpth2d(i,j) = 0 - data%clm_lakedepth(i,j) = 0 - data%clm_lake_initialized(i,j) = 0 - - data%lake_z3d(i,j,:) = 0 - data%lake_dz3d(i,j,:) = 0 - data%lake_soil_watsat3d(i,j,:) = 0 - data%lake_csol3d(i,j,:) = 0 - data%lake_soil_tkmg3d(i,j,:) = 0 - data%lake_soil_tkdry3d(i,j,:) = 0 - data%lake_soil_tksatu3d(i,j,:) = 0 - data%lake_snow_z3d(i,j,:) = 0 - data%lake_snow_dz3d(i,j,:) = 0 - data%lake_snow_zi3d(i,j,:) = 0 - data%lake_h2osoi_vol3d(i,j,:) = 0 - data%lake_h2osoi_liq3d(i,j,:) = 0 - data%lake_h2osoi_ice3d(i,j,:) = 0 - data%lake_t_soisno3d(i,j,:) = 0 - data%lake_t_lake3d(i,j,:) = 0 - data%lake_icefrac3d(i,j,:) = 0 - data%lake_clay3d(i,j,:) = 0 - data%lake_sand3d(i,j,:) = 0 - enddo - enddo - end subroutine clm_lake_fill_with_zero - subroutine clm_lake_copy_from_temporaries(data, Model, Sfcprop, Atm_block) ! Copies from data temporary variables to the corresponding Sfcprop variables. ! Terrible things will happen if you don't call data%allocate_data first. From 376f63510c84cef7a197f6976fca2110ad631de5 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Thu, 2 Mar 2023 20:31:41 +0000 Subject: [PATCH 48/74] coare changes and bug fixes from tanya --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index ce8643f84..ac3303b12 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit ce8643f84cd1f06e62c35f2b72d9cf0b61ad88b0 +Subproject commit ac3303b12003c05ba5fa845f33ef65fd105587f0 From 45c9a8e715f21d8e9aa6a8b22abefd03b56af809 Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Thu, 2 Mar 2023 21:25:34 +0000 Subject: [PATCH 49/74] further updates from tanya --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index ac3303b12..06d4d9e65 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit ac3303b12003c05ba5fa845f33ef65fd105587f0 +Subproject commit 06d4d9e65ca955ddf73a7642e756b37308d65734 From ec1f18d6317e31683e9e5029303ab5881de6ac0e Mon Sep 17 00:00:00 2001 From: Samuel Trahan Date: Thu, 2 Mar 2023 21:32:43 +0000 Subject: [PATCH 50/74] disable wordy warning without LAKEDEBUG --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 169ff90ba..a029c2808 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 169ff90bae8123b169587a1cf854c27dc1435a37 +Subproject commit a029c2808fa318305ecc99f724bbd70789e61fd4 From 363625ec941113ba48ee1a33cc9ae8b6741af8ca Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 2 Mar 2023 22:53:54 +0000 Subject: [PATCH 51/74] FV3_HRRR uses clm lake; new FV3_HRRR_flake for flake --- ccpp/suites/suite_FV3_HRRR.xml | 2 +- .../{suite_FV3_HRRR_clm_lake.xml => suite_FV3_HRRR_flake.xml} | 4 ++-- ccpp/suites/suite_FV3_HRRR_smoke.xml | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) rename ccpp/suites/{suite_FV3_HRRR_clm_lake.xml => suite_FV3_HRRR_flake.xml} (97%) diff --git a/ccpp/suites/suite_FV3_HRRR.xml b/ccpp/suites/suite_FV3_HRRR.xml index a4c5b7dbc..898ad7182 100644 --- a/ccpp/suites/suite_FV3_HRRR.xml +++ b/ccpp/suites/suite_FV3_HRRR.xml @@ -43,7 +43,7 @@ mynnsfc_wrapper GFS_surface_loop_control_part1 lsm_ruc - flake_driver + clm_lake GFS_surface_loop_control_part2 diff --git a/ccpp/suites/suite_FV3_HRRR_clm_lake.xml b/ccpp/suites/suite_FV3_HRRR_flake.xml similarity index 97% rename from ccpp/suites/suite_FV3_HRRR_clm_lake.xml rename to ccpp/suites/suite_FV3_HRRR_flake.xml index f7873d68a..01184d7bc 100644 --- a/ccpp/suites/suite_FV3_HRRR_clm_lake.xml +++ b/ccpp/suites/suite_FV3_HRRR_flake.xml @@ -1,6 +1,6 @@ - + @@ -43,7 +43,7 @@ mynnsfc_wrapper GFS_surface_loop_control_part1 lsm_ruc - clm_lake + flake_driver GFS_surface_loop_control_part2 diff --git a/ccpp/suites/suite_FV3_HRRR_smoke.xml b/ccpp/suites/suite_FV3_HRRR_smoke.xml index e3f51c14d..2000c7d3b 100644 --- a/ccpp/suites/suite_FV3_HRRR_smoke.xml +++ b/ccpp/suites/suite_FV3_HRRR_smoke.xml @@ -43,7 +43,7 @@ mynnsfc_wrapper GFS_surface_loop_control_part1 lsm_ruc - flake_driver + clm_lake GFS_surface_loop_control_part2 From 14d06257f6aed89212c6233a55d86b6e8f741a15 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 2 Mar 2023 23:08:37 +0000 Subject: [PATCH 52/74] FV3_RAP_clm_lake suite --- ccpp/suites/suite_FV3_RAP_clm_lake.xml | 91 ++++++++++++++++++++++++++ 1 file changed, 91 insertions(+) create mode 100644 ccpp/suites/suite_FV3_RAP_clm_lake.xml diff --git a/ccpp/suites/suite_FV3_RAP_clm_lake.xml b/ccpp/suites/suite_FV3_RAP_clm_lake.xml new file mode 100644 index 000000000..2c10d49a6 --- /dev/null +++ b/ccpp/suites/suite_FV3_RAP_clm_lake.xml @@ -0,0 +1,91 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + 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 + + + + mynnsfc_wrapper + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + lsm_ruc + clm_lake_driver + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + mynnedmf_wrapper + GFS_GWD_generic_pre + drag_suite + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + cu_gf_driver_pre + cu_gf_driver + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_thompson_pre + mp_thompson + mp_thompson_post + GFS_MP_generic_post + cu_gf_driver_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + From 14897ecc3ccce3b9b9ae88542b5a68c47c3c0e62 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 2 Mar 2023 23:09:24 +0000 Subject: [PATCH 53/74] FV3_RAP_clm_lake suite --- ccpp/suites/suite_FV3_RAP_clm_lake.xml | 88 ++++++++++++++++++++++++++ 1 file changed, 88 insertions(+) create mode 100644 ccpp/suites/suite_FV3_RAP_clm_lake.xml diff --git a/ccpp/suites/suite_FV3_RAP_clm_lake.xml b/ccpp/suites/suite_FV3_RAP_clm_lake.xml new file mode 100644 index 000000000..4aa0b9e61 --- /dev/null +++ b/ccpp/suites/suite_FV3_RAP_clm_lake.xml @@ -0,0 +1,88 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + sgscloud_radpre + GFS_rrtmg_pre + GFS_radiation_surface + rad_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + sgscloud_radpost + 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 + + + + mynnsfc_wrapper + GFS_surface_loop_control_part1 + lsm_ruc + clm_lake + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + mynnedmf_wrapper + GFS_GWD_generic_pre + drag_suite + GFS_GWD_generic_post + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + cu_gf_driver_pre + cu_gf_driver + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + mp_thompson_pre + mp_thompson + mp_thompson_post + GFS_MP_generic_post + cu_gf_driver_post + maximum_hourly_diagnostics + phys_tend + + + + + GFS_stochastics + + + + From 6bf5138232964b98a8bbd55fd6a941925ce51aad Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 3 Mar 2023 05:01:44 +0000 Subject: [PATCH 54/74] use 64 bits for lake and disable broken coare code --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 9031ba488..078bf74eb 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 9031ba48850adba4a6d202a2ddc958dcc2ed8cd8 +Subproject commit 078bf74ebd7bdd452f3b40e959d10a8c4cb4c78e From d57b67a80e36070dfafde5bb9415d0191667a47e Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 3 Mar 2023 17:49:35 +0000 Subject: [PATCH 55/74] Eliminate an out-of-bounds access in MDLFLD.f in UPP. This UPP bug is triggered by one of the new regression tests. --- .gitmodules | 4 ++-- upp | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index d5c872050..463b7b5a0 100644 --- a/.gitmodules +++ b/.gitmodules @@ -12,5 +12,5 @@ branch = clm_lake_revert.v9 [submodule "upp"] path = upp - url = https://github.com/NOAA-EMC/UPP - branch = develop + url = https://github.com/SamuelTrahan-NOAA/UPP + branch = uv10-exch-errors diff --git a/upp b/upp index b37f8ab7b..e83776081 160000 --- a/upp +++ b/upp @@ -1 +1 @@ -Subproject commit b37f8ab7b0f298346d79a37e0c5d4a64037fd4d4 +Subproject commit e83776081ce83b96cd393ba1d8e85f2c1ede1738 From 3e31be3e967e8044949167c1db73c93363a2d043 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 3 Mar 2023 18:09:53 +0000 Subject: [PATCH 56/74] UPP: update author changelog --- upp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/upp b/upp index e83776081..73a178df2 160000 --- a/upp +++ b/upp @@ -1 +1 @@ -Subproject commit e83776081ce83b96cd393ba1d8e85f2c1ede1738 +Subproject commit 73a178df21a634901ed2bd59bf7db19affec6f14 From d9da6fb972a210d1f39ca23d88782197348a1536 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 3 Mar 2023 19:47:38 +0000 Subject: [PATCH 57/74] point to upp develop now that bug is fixed --- .gitmodules | 4 ++-- upp | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index 463b7b5a0..d5c872050 100644 --- a/.gitmodules +++ b/.gitmodules @@ -12,5 +12,5 @@ branch = clm_lake_revert.v9 [submodule "upp"] path = upp - url = https://github.com/SamuelTrahan-NOAA/UPP - branch = uv10-exch-errors + url = https://github.com/NOAA-EMC/UPP + branch = develop diff --git a/upp b/upp index 73a178df2..7ef356495 160000 --- a/upp +++ b/upp @@ -1 +1 @@ -Subproject commit 73a178df21a634901ed2bd59bf7db19affec6f14 +Subproject commit 7ef356495d5cc329f1b79510119cf9f5ec6bd584 From 51d315a1ed5a061f8528931ecaf312eea9d55319 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 9 Mar 2023 00:59:47 +0000 Subject: [PATCH 58/74] clm lake bug fixes in ccpp/physics --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 4eb73a58c..a97690a25 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 4eb73a58c4b3cfa3e3545da85c9aaf24efe9f035 +Subproject commit a97690a2563a96576a4cb9adfb44f1ef89fc1d8f From 70e8cc6494ca77ff35ed3f0e871908e1da1ce790 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 9 Mar 2023 01:00:34 +0000 Subject: [PATCH 59/74] more diagnostic output to track down threading issue --- ccpp/driver/GFS_diagnostics.F90 | 53 +++++++++++++++++++++++++++++++++ 1 file changed, 53 insertions(+) diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index 9a6b2a05b..c1f082333 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -1863,6 +1863,59 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ! if(mpp_pe()==mpp_root_pe())print *,'in gfdl_diag_register,af totgrp,idx=',idx + if(associated(Coupling(1)%dqdti)) then + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'tsflw' + ExtDiag(idx)%desc = 'tsflw' + ExtDiag(idx)%unit = 'K' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%dqdti(:,:) + enddo + endif + + if(associated(Coupling(1)%sfcdlw)) then + idx = idx + 1 + ExtDiag(idx)%axes = 2 + ExtDiag(idx)%name = 'sfcdlw' + ExtDiag(idx)%desc = 'sfcdlw' + ExtDiag(idx)%unit = 'W m-2' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var2 => Coupling(nb)%sfcdlw(:) + enddo + endif + + if(associated(Coupling(1)%htrlw)) then + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'htrlw' + ExtDiag(idx)%desc = 'htrlw' + ExtDiag(idx)%unit = 'W m-2' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%htrlw(:,:) + enddo + endif + + if(associated(Radtend(1)%lwhc)) then + idx = idx + 1 + ExtDiag(idx)%axes = 3 + ExtDiag(idx)%name = 'lwhc' + ExtDiag(idx)%desc = 'lwhc' + ExtDiag(idx)%unit = 'K s-1' + ExtDiag(idx)%mod_name = 'gfs_phys' + allocate (ExtDiag(idx)%data(nblks)) + do nb = 1,nblks + ExtDiag(idx)%data(nb)%var3 => Radtend(nb)%lwhc(:,:) + enddo + endif + + !--- RRFS Smoke --- if (Model%rrfs_smoke) then idx = idx + 1 From ee377329feaa367bf729e020dd50181a8f082f04 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 9 Mar 2023 01:00:49 +0000 Subject: [PATCH 60/74] flake bug fixes so restart does not crash --- io/FV3GFS_io.F90 | 25 ++++++++++++++++++------- 1 file changed, 18 insertions(+), 7 deletions(-) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index cb8d4743f..62ecca56f 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -689,11 +689,10 @@ pure subroutine copy_to_GFS_Data_3d_int2phys(ii1,jj1,isc,jsc,nt,var3d,var_block) end subroutine copy_to_GFS_Data_3d_int2phys - pure subroutine fill_Sfcprop_names(Model,sfc_name2,sfc_name3,nvar_s2m,nvar_before_lake,warm_start) + pure subroutine fill_Sfcprop_names(Model,sfc_name2,sfc_name3,nvar_s2m,warm_start) implicit none type(GFS_control_type), intent(in) :: Model integer, intent(in) :: nvar_s2m - integer, intent(out) :: nvar_before_lake character(len=32),intent(out) :: sfc_name2(:), sfc_name3(:) logical, intent(in) :: warm_start integer :: nt @@ -836,8 +835,6 @@ pure subroutine fill_Sfcprop_names(Model,sfc_name2,sfc_name3,nvar_s2m,nvar_befor nt=nt+1 ; sfc_name2(nt) = 'lai' endif - nvar_before_lake = nt - if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then nt=nt+1 ; sfc_name2(nt) = 'T_snow' nt=nt+1 ; sfc_name2(nt) = 'T_ice' @@ -1066,6 +1063,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta nvar_s2l = 0 endif + nvar_before_lake=nvar_s2m+nvar_s2o+nvar_s2r+nvar_s2mp + !--- deallocate containers and free restart container deallocate(oro_name2, oro_var2) @@ -1346,7 +1345,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta sfc_var3zn = -9999.0_r8 end if - call fill_Sfcprop_names(Model,sfc_name2,sfc_name3,nvar_s2m,nvar_before_lake,warm_start) + call fill_Sfcprop_names(Model,sfc_name2,sfc_name3,nvar_s2m,warm_start) is_lsoil=.false. if ( .not. warm_start ) then @@ -2214,6 +2213,8 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nx = (iec - isc + 1) ny = (jec - jsc + 1) + nvar_before_lake=nvar2m+nvar2o+nvar2r+nvar2mp + if (Model%lsm == Model%lsm_ruc) then if (allocated(sfc_name2)) then ! Re-allocate if one or more of the dimensions don't match @@ -2300,7 +2301,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta else call mpp_error(FATAL, 'Error in opening file'//trim(infile) ) end if if_amiopen - + ! Tell clm_lake to allocate data, register its axes, and call write_data for each axis's variable if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then call clm_lake%allocate_data(Model) @@ -2329,7 +2330,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta sfc_var3eq = -9999.0_r8 sfc_var3zn = -9999.0_r8 endif - call fill_Sfcprop_names(Model,sfc_name2,sfc_name3,nvar2m,nvar_before_lake,.true.) + call fill_Sfcprop_names(Model,sfc_name2,sfc_name3,nvar2m,.true.) end if if(Model%lkm>0) then @@ -2453,6 +2454,16 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta nullify(var3_p3) endif ! lsm = lsm_noahmp + !Flake + if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then + mand = .false. + do num = nvar_before_lake+1,nvar_before_lake+nvar2l + var2_p => sfc_var2(:,:,num) + call register_restart_field(Sfc_restart, sfc_name2(num),var2_p,dimensions=(/'xaxis_1', 'yaxis_1', 'Time '/),& + &is_optional=.not.mand) + enddo + endif + ! Tell clm_lake to copy Sfcprop data to its internal temporary arrays. if(Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm) then call clm_lake%copy_to_temporaries(Model,Sfcprop,Atm_block) From 1fd14279a4c7c7d481116e2ebf248df2a4e09d2c Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Thu, 9 Mar 2023 17:21:01 +0000 Subject: [PATCH 61/74] missing active= lines --- ccpp/data/GFS_typedefs.meta | 58 +++++++++++++++++++------------------ 1 file changed, 30 insertions(+), 28 deletions(-) diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 6d1ce2a80..ced910dca 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -626,6 +626,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (control_for_lake_model_execution_method > 0 .and. control_for_lake_model_selection == 2) [use_lake_model] standard_name = flag_for_using_lake_model long_name = flag indicating lake points using a lake model @@ -719,6 +720,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys + active = (control_for_lake_model_execution_method > 0) [tsfc] standard_name = surface_skin_temperature long_name = surface skin temperature @@ -1967,7 +1969,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_z3d] standard_name = depth_of_lake_interface_layers long_name = depth of lake interface layers @@ -1975,7 +1977,7 @@ dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_dz3d] standard_name = thickness_of_lake_layers long_name = thickness of lake layers @@ -1983,7 +1985,7 @@ dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_soil_watsat3d] standard_name = saturated_volumetric_soil_water_in_lake_model long_name = saturated volumetric soil water in lake model @@ -1991,7 +1993,7 @@ dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_csol3d] standard_name = soil_heat_capacity_in_lake_model long_name = soil heat capacity in lake model @@ -1999,7 +2001,7 @@ dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_soil_tkmg3d] standard_name = soil_mineral_thermal_conductivity_in_lake_model long_name = soil mineral thermal conductivity in lake model @@ -2007,7 +2009,7 @@ dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_soil_tkdry3d] standard_name = dry_soil_thermal_conductivity_in_lake_model long_name = dry soil thermal conductivity in lake model @@ -2015,7 +2017,7 @@ dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_soil_tksatu3d] standard_name = saturated_soil_thermal_conductivity_in_lake_model long_name = saturated soil thermal conductivity in lake model @@ -2023,7 +2025,7 @@ dimensions = (horizontal_loop_extent, lake_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_h2osno2d] standard_name = water_equivalent_accumulated_snow_depth_in_clm_lake_model long_name = water equiv of acc snow depth over lake in clm lake model @@ -2031,7 +2033,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_sndpth2d] standard_name = actual_snow_depth_in_clm_lake_model long_name = actual acc snow depth over lake in clm lake model @@ -2039,7 +2041,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_snl2d] standard_name = snow_layers_in_clm_lake_model long_name = snow layers in clm lake model (treated as integer) @@ -2047,7 +2049,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_snow_z3d] standard_name = snow_level_depth_in_clm_lake_model long_name = snow level depth in clm lake model @@ -2055,7 +2057,7 @@ dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_snow_dz3d] standard_name = snow_level_thickness_in_clm_lake_model long_name = snow level thickness in clm lake model @@ -2063,7 +2065,7 @@ dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_snow_zi3d] standard_name = snow_interface_depth_in_clm_lake_model long_name = snow interface_depth in clm lake model @@ -2071,7 +2073,7 @@ dimensions = (horizontal_loop_extent,snow_plus_soil_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_h2osoi_vol3d] standard_name = volumetric_soil_water_in_clm_lake_model long_name = volumetric soil water in clm lake model @@ -2079,7 +2081,7 @@ dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_h2osoi_liq3d] standard_name = soil_liquid_water_content_in_clm_lake_model long_name = soil liquid water content in clm lake model @@ -2087,7 +2089,7 @@ dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_h2osoi_ice3d] standard_name = soil_ice_water_content_in_clm_lake_model long_name = soil ice water content in clm lake model @@ -2095,7 +2097,7 @@ dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_tsfc] standard_name = skin_temperature_from_lake_model long_name = skin temperature from lake model @@ -2103,7 +2105,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_t_soisno3d] standard_name = soil_or_snow_layer_temperature_from_clm_lake_model long_name = soil or snow layer temperature from clm lake model @@ -2111,7 +2113,7 @@ dimensions = (horizontal_loop_extent,snow_plus_soil_minus_one_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_t_lake3d] standard_name = lake_layer_temperature_from_clm_lake_model long_name = lake layer temperature from clm lake model @@ -2119,7 +2121,7 @@ dimensions = (horizontal_loop_extent,lake_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_savedtke12d] standard_name = top_level_eddy_conductivity_from_previous_timestep_in_clm_lake_model long_name = top level eddy conductivity from previous timestep in clm lake model @@ -2127,7 +2129,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_icefrac3d] standard_name = lake_fractional_ice_cover_on_clm_lake_levels long_name = lake fractional ice cover on clm lake levels @@ -2135,7 +2137,7 @@ dimensions = (horizontal_loop_extent,lake_vertical_dimension_for_clm_lake_model) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_ht] standard_name = test_lake_ht long_name = test_lake_ht @@ -2143,7 +2145,7 @@ units = unitless type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [clm_lake_initialized] standard_name = flag_for_clm_lake_initialization long_name = set to true in clm_lake_run after likeini is called for that gridpoint @@ -2151,35 +2153,35 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_clay3d] standard_name = clm_lake_percent_clay long_name = percent clay in clm lake model units = percent dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) type = integer - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_sand3d] standard_name = clm_lake_percent_sand long_name = percent sand in clm lake model units = percent dimensions = (horizontal_loop_extent,soil_vertical_dimension_for_clm_lake_model) type = integer - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_is_salty] standard_name = clm_lake_is_salty long_name = lake at this point is salty (1) or not (0) units = 1 dimensions = (horizontal_loop_extent) type = integer - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [lake_cannot_freeze] standard_name = clm_lake_cannot_freeze long_name = lake at this point is so salty it cannot freeze units = 1 dimensions = (horizontal_loop_extent) type = integer - active = (control_for_lake_model_selection == 2) + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) ######################################################################## [ccpp-table-properties] From 3c6d491dc2e55c237cdaded29fb21aaef3d6cfbd Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 17 Mar 2023 01:04:16 +0000 Subject: [PATCH 62/74] bug fix from @tanyasmirnova for rrfs crashes during restart --- io/FV3GFS_io.F90 | 65 +++++++++++++++++++++++++++--------------------- 1 file changed, 36 insertions(+), 29 deletions(-) diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 6ee558fcb..1350ce485 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -736,34 +736,33 @@ pure subroutine fill_Sfcprop_names(Model,sfc_name2,sfc_name3,nvar_s2m,warm_start nt=nt+1 ; sfc_name2(nt) = 'albdifvis_ice' nt=nt+1 ; sfc_name2(nt) = 'albdirnir_ice' nt=nt+1 ; sfc_name2(nt) = 'albdifnir_ice' -! nt=nt+1 ; sfc_name2(nt) = 'sfalb_ice' endif if(Model%cplwav) then - sfc_name2(nvar_s2m) = 'zorlwav' !zorl from wave component + nt=nt+1 ; sfc_name2(nvar_s2m) = 'zorlwav' !zorl from wave component endif - nt = nvar_s2m ! next variable will be at nvar_s2m - + if (Model%nstf_name(1) > 0) then !--- NSSTM inputs only needed when (nstf_name(1) > 0) .and. (nstf_name(2)) == 0) - nt=nt+1 ; sfc_name2(nt) = 'tref' - nt=nt+1 ; sfc_name2(nt) = 'z_c' - nt=nt+1 ; sfc_name2(nt) = 'c_0' - nt=nt+1 ; sfc_name2(nt) = 'c_d' - nt=nt+1 ; sfc_name2(nt) = 'w_0' - nt=nt+1 ; sfc_name2(nt) = 'w_d' - nt=nt+1 ; sfc_name2(nt) = 'xt' - nt=nt+1 ; sfc_name2(nt) = 'xs' - nt=nt+1 ; sfc_name2(nt) = 'xu' - nt=nt+1 ; sfc_name2(nt) = 'xv' - nt=nt+1 ; sfc_name2(nt) = 'xz' - nt=nt+1 ; sfc_name2(nt) = 'zm' - nt=nt+1 ; sfc_name2(nt) = 'xtts' - nt=nt+1 ; sfc_name2(nt) = 'xzts' - nt=nt+1 ; sfc_name2(nt) = 'd_conv' - nt=nt+1 ; sfc_name2(nt) = 'ifd' - nt=nt+1 ; sfc_name2(nt) = 'dt_cool' - nt=nt+1 ; sfc_name2(nt) = 'qrain' + nt=nt+1 ; sfc_name2(nt) = 'tref' + nt=nt+1 ; sfc_name2(nt) = 'z_c' + nt=nt+1 ; sfc_name2(nt) = 'c_0' + nt=nt+1 ; sfc_name2(nt) = 'c_d' + nt=nt+1 ; sfc_name2(nt) = 'w_0' + nt=nt+1 ; sfc_name2(nt) = 'w_d' + nt=nt+1 ; sfc_name2(nt) = 'xt' + nt=nt+1 ; sfc_name2(nt) = 'xs' + nt=nt+1 ; sfc_name2(nt) = 'xu' + nt=nt+1 ; sfc_name2(nt) = 'xv' + nt=nt+1 ; sfc_name2(nt) = 'xz' + nt=nt+1 ; sfc_name2(nt) = 'zm' + nt=nt+1 ; sfc_name2(nt) = 'xtts' + nt=nt+1 ; sfc_name2(nt) = 'xzts' + nt=nt+1 ; sfc_name2(nt) = 'd_conv' + nt=nt+1 ; sfc_name2(nt) = 'ifd' + nt=nt+1 ; sfc_name2(nt) = 'dt_cool' + nt=nt+1 ; sfc_name2(nt) = 'qrain' + endif ! ! Only needed when Noah MP LSM is used - 29 2D ! @@ -866,7 +865,11 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta nvar_o2 = 19 nvar_oro_ls_ss = 10 - nvar_s2o = 18 + if (Model%nstf_name(1) > 0) then + nvar_s2o = 18 + else + nvar_s2o = 0 + endif if(Model%rrfs_smoke) then nvar_dust12m = 5 nvar_gbbepx = 3 @@ -1548,7 +1551,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta ! call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sfalb_ice) endif if(Model%cplwav) then - nt = nvar_s2m-1 ! Next item will be at nvar_s2m + !tgs - the following line is a bug. It should be nt = nt + !nt = nvar_s2m-1 ! Next item will be at nvar_s2m call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%zorlwav) !--- (zorl from wave model) else Sfcprop(nb)%zorlwav = Sfcprop(nb)%zorlw @@ -1661,7 +1665,8 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta ! !--- NSSTM variables - nt = nvar_s2m + !tgs - the following line is a bug that will show if(Model%cplwav) = true + !nt = nvar_s2m if (Model%nstf_name(1) > 0) then if (Model%nstf_name(2) == 1) then ! nsst spinup !--- nsstm tref @@ -1704,8 +1709,6 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%dt_cool) !--- nsstm dt_cool call copy_to_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%qrain) !--- nsstm qrain endif - else - nt = nt + 18 endif if (Model%lsm == Model%lsm_ruc .and. warm_start) then @@ -2088,7 +2091,11 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta ! nvar2m = nvar2m + 5 endif if (Model%cplwav) nvar2m = nvar2m + 1 - nvar2o = 18 + if (Model%nstf_name(1) > 0) then + nvar2o = 18 + else + nvar2o = 0 + endif if (Model%lsm == Model%lsm_ruc) then if (Model%rdlai) then nvar2r = 13 @@ -2440,7 +2447,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%sfalb_ice) if (Model%rdlai) then call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%xlaixy) - endif + endif else if (Model%lsm == Model%lsm_noahmp) then !--- Extra Noah MP variables call copy_from_GFS_Data(ii1,jj1,isc,jsc,nt,sfc_var2,Sfcprop(nb)%snowxy) From bfc7f1b913298b0a33aef4074cc2c99f9736ee1d Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Mon, 3 Apr 2023 21:19:08 +0000 Subject: [PATCH 63/74] merge ufs/dev into ccpp/physics --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 74d84613d..e036ea0c7 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 74d84613d721b08343854c858ccbbab7088ee7db +Subproject commit e036ea0c79f79b3f77c403472e3318eb888a8e3c From efd5926fba0440135deb97c5406bc98467454502 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 4 Apr 2023 00:40:05 +0000 Subject: [PATCH 64/74] clm lake is HRRR default, alternative suite with flake --- ccpp/suites/suite_FV3_HRRR.xml | 2 +- ...suite_FV3_HRRR_clm_lake.xml => suite_FV3_HRRR_flake.xml} | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) rename ccpp/suites/{suite_FV3_HRRR_clm_lake.xml => suite_FV3_HRRR_flake.xml} (94%) diff --git a/ccpp/suites/suite_FV3_HRRR.xml b/ccpp/suites/suite_FV3_HRRR.xml index 01c493d5a..6ac35db14 100644 --- a/ccpp/suites/suite_FV3_HRRR.xml +++ b/ccpp/suites/suite_FV3_HRRR.xml @@ -43,7 +43,7 @@ mynnsfc_wrapper GFS_surface_loop_control_part1 lsm_ruc - flake_driver + clm_lake GFS_surface_loop_control_part2 diff --git a/ccpp/suites/suite_FV3_HRRR_clm_lake.xml b/ccpp/suites/suite_FV3_HRRR_flake.xml similarity index 94% rename from ccpp/suites/suite_FV3_HRRR_clm_lake.xml rename to ccpp/suites/suite_FV3_HRRR_flake.xml index f7873d68a..01c493d5a 100644 --- a/ccpp/suites/suite_FV3_HRRR_clm_lake.xml +++ b/ccpp/suites/suite_FV3_HRRR_flake.xml @@ -1,6 +1,6 @@ - + @@ -43,7 +43,7 @@ mynnsfc_wrapper GFS_surface_loop_control_part1 lsm_ruc - clm_lake + flake_driver GFS_surface_loop_control_part2 @@ -52,7 +52,9 @@ sfc_diag sfc_diag_post GFS_surface_generic_post + rrfs_smoke_wrapper mynnedmf_wrapper + rrfs_smoke_postpbl GFS_GWD_generic_pre drag_suite GFS_GWD_generic_post From 8f2b0e90c87e79df772d0820d05989c149210133 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 4 Apr 2023 00:40:33 +0000 Subject: [PATCH 65/74] update ccpp-physics hash --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 3de0f937b..e036ea0c7 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 3de0f937bb7141e68715c2d57b7fe5ad462c6c75 +Subproject commit e036ea0c79f79b3f77c403472e3318eb888a8e3c From a2d5a9a1bcf54bcd421e1e8546c1507c7e090b9e Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 4 Apr 2023 01:50:49 +0000 Subject: [PATCH 66/74] many errors in merge --- ccpp/data/GFS_typedefs.F90 | 5 ++++- ccpp/data/GFS_typedefs.meta | 7 +++++++ ccpp/physics | 2 +- ccpp/suites/suite_FV3_HRRR_flake.xml | 2 +- io/FV3GFS_io.F90 | 4 ++-- 5 files changed, 15 insertions(+), 5 deletions(-) diff --git a/ccpp/data/GFS_typedefs.F90 b/ccpp/data/GFS_typedefs.F90 index b2187e5f4..da60e56c1 100644 --- a/ccpp/data/GFS_typedefs.F90 +++ b/ccpp/data/GFS_typedefs.F90 @@ -454,6 +454,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: lake_clay3d(:,:) => null() real (kind=kind_phys), pointer :: lake_sand3d(:,:) => null() integer, pointer :: lake_is_salty(:) => null() + integer, pointer :: lake_cannot_freeze(:) => null() real (kind=kind_phys), pointer :: clm_lake_initialized(:) => null() !< lakeini was called !--- aerosol surface emissions for Thompson microphysics & smoke dust real (kind=kind_phys), pointer :: emdust (:) => null() !< instantaneous dust emission @@ -2721,6 +2722,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) allocate(Sfcprop%lake_clay3d(IM,Model%nlevsoil_clm_lake)) allocate(Sfcprop%lake_sand3d(IM,Model%nlevsoil_clm_lake)) allocate(Sfcprop%lake_is_salty(IM)) + allocate(Sfcprop%lake_cannot_freeze(IM)) allocate(Sfcprop%clm_lake_initialized(IM)) Sfcprop%lake_t2m = clear_val @@ -2752,6 +2754,7 @@ subroutine sfcprop_create (Sfcprop, IM, Model) Sfcprop%lake_clay3d = clear_val Sfcprop%lake_sand3d = clear_val Sfcprop%lake_is_salty = zero + Sfcprop%lake_cannot_freeze = zero Sfcprop%clm_lake_initialized = zero endif @@ -3500,7 +3503,7 @@ subroutine control_initialize (Model, nlunit, fn_nml, me, master, & !--- flake model parameters integer :: lkm = 0 !< =1 run lake, =2 run lake&nsst =0 no lake - integer :: iopt_lake = 1 !< =1 flake, =2 clm lake + integer :: iopt_lake = 2 !< =1 flake, =2 clm lake real(kind_phys) :: lakedepth_threshold = 1.0 !< lakedepth must be GREATER than this value to enable a lake model real(kind_phys) :: lakefrac_threshold = 0.0 !< lakefrac must be GREATER than this value to enable a lake model logical :: use_lake2m = .false. !< use 2m T & Q from clm lake model diff --git a/ccpp/data/GFS_typedefs.meta b/ccpp/data/GFS_typedefs.meta index 7dee47055..c9410b591 100644 --- a/ccpp/data/GFS_typedefs.meta +++ b/ccpp/data/GFS_typedefs.meta @@ -2217,6 +2217,13 @@ dimensions = (horizontal_loop_extent) type = integer active = (control_for_lake_model_selection == 2) +[lake_cannot_freeze] + standard_name = clm_lake_cannot_freeze + long_name = lake at this point is so salty it cannot freeze + units = 1 + dimensions = (horizontal_loop_extent) + type = integer + active = (control_for_lake_model_selection == 2 .and. control_for_lake_model_execution_method > 0) [emdust] standard_name = emission_of_dust_for_smoke long_name = emission of dust for smoke diff --git a/ccpp/physics b/ccpp/physics index e036ea0c7..fe1d5845d 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit e036ea0c79f79b3f77c403472e3318eb888a8e3c +Subproject commit fe1d5845d6a965f6b93e4214c6fa02300e02b4af diff --git a/ccpp/suites/suite_FV3_HRRR_flake.xml b/ccpp/suites/suite_FV3_HRRR_flake.xml index 01c493d5a..3adea1069 100644 --- a/ccpp/suites/suite_FV3_HRRR_flake.xml +++ b/ccpp/suites/suite_FV3_HRRR_flake.xml @@ -1,6 +1,6 @@ - + diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 0bd82c29b..ca2fd643a 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -1528,7 +1528,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta ! Flake if (Model%lkm > 0 .and. Model%iopt_lake==Model%iopt_lake_flake) then mand = .false. - do num = nvar_s2me+1,nvar_s2me+nvar_s2l + do num = nvar_before_lake+1,nvar_before_lake+nvar_s2l var2_p => sfc_var2(:,:,num) if(is_lsoil) then call register_restart_field(Sfc_restart, sfc_name2(num),var2_p,dimensions=(/'lat','lon'/), is_optional=.not.mand) @@ -2233,7 +2233,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta !--- fms2_io file open logic logical :: amiopen !--- variables used for fms2_io register axis - integer :: is, ie + integer :: is, ie, nvar_before_lake integer, allocatable, dimension(:) :: buffer type(clm_lake_data_type), target :: clm_lake !--- temporary variables for storing rrfs_sd fields From 5f46d40f10282a0d68327d8a50d1041d068c14de Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 4 Apr 2023 05:07:38 +0000 Subject: [PATCH 67/74] get it to compile and run --- ccpp/driver/GFS_diagnostics.F90 | 13 ------------- ccpp/physics | 2 +- io/FV3GFS_io.F90 | 4 ++-- 3 files changed, 3 insertions(+), 16 deletions(-) diff --git a/ccpp/driver/GFS_diagnostics.F90 b/ccpp/driver/GFS_diagnostics.F90 index 3df9f7b75..c1598a28c 100644 --- a/ccpp/driver/GFS_diagnostics.F90 +++ b/ccpp/driver/GFS_diagnostics.F90 @@ -1874,19 +1874,6 @@ subroutine GFS_externaldiag_populate (ExtDiag, Model, Statein, Stateout, Sfcprop ! if(mpp_pe()==mpp_root_pe())print *,'in gfdl_diag_register,af totgrp,idx=',idx - if(associated(Coupling(1)%dqdti)) then - idx = idx + 1 - ExtDiag(idx)%axes = 3 - ExtDiag(idx)%name = 'tsflw' - ExtDiag(idx)%desc = 'tsflw' - ExtDiag(idx)%unit = 'K' - ExtDiag(idx)%mod_name = 'gfs_phys' - allocate (ExtDiag(idx)%data(nblks)) - do nb = 1,nblks - ExtDiag(idx)%data(nb)%var3 => Coupling(nb)%dqdti(:,:) - enddo - endif - if(associated(Coupling(1)%sfcdlw)) then idx = idx + 1 ExtDiag(idx)%axes = 2 diff --git a/ccpp/physics b/ccpp/physics index fe1d5845d..b7cb04a7d 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit fe1d5845d6a965f6b93e4214c6fa02300e02b4af +Subproject commit b7cb04a7d9b7ecc7c3b4fa74b5f1b58f6a3e14ee diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90 index 10e2f1d28..876248d16 100644 --- a/io/FV3GFS_io.F90 +++ b/io/FV3GFS_io.F90 @@ -899,7 +899,7 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain, warm_sta integer :: nvar_oro_ls_ss integer :: nvar_vegfr, nvar_soilfr integer :: nvar_s2r, nvar_s2mp, nvar_s3mp, isnow - integer :: nvar_emi, nvar_dust12m, nvar_gbbepx, nvar_before_lake, nvar_s2l + integer :: nvar_emi, nvar_dust12m, nvar_gbbepx, nvar_before_lake, nvar_s2l, nvar_rrfssd integer, allocatable :: ii1(:), jj1(:) real(kind=kind_phys), pointer, dimension(:,:) :: var2_p => NULL() real(kind=kind_phys), pointer, dimension(:,:,:) :: var3_p => NULL() @@ -2247,7 +2247,7 @@ subroutine sfc_prop_restart_write (Sfcprop, Atm_block, Model, fv_domain, timesta !--- fms2_io file open logic logical :: amiopen !--- variables used for fms2_io register axis - integer :: is, ie, nvar_before_lake + integer :: is, ie integer, allocatable, dimension(:) :: buffer type(clm_lake_data_type), target :: clm_lake !--- temporary variables for storing rrfs_sd fields From ab1c36e476e805793e404ef84646925511aab5fb Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Tue, 11 Apr 2023 14:17:11 +0000 Subject: [PATCH 68/74] bug fix for 2threads support in conus13km tests --- ccpp/driver/GFS_restart.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/ccpp/driver/GFS_restart.F90 b/ccpp/driver/GFS_restart.F90 index 2d6e00f4e..3b1a2959d 100644 --- a/ccpp/driver/GFS_restart.F90 +++ b/ccpp/driver/GFS_restart.F90 @@ -134,7 +134,6 @@ subroutine GFS_restart_populate (Restart, Model, Statein, Stateout, Sfcprop, & ! MYNN SFC if (Model%do_mynnsfclay) then Restart%num2d = Restart%num2d + 13 - surface_layer_saves_rainprev = .false. endif ! Save rain prev for lake if surface layer doesn't. if (Model%lkm>0 .and. Model%iopt_lake==Model%iopt_lake_clm .and. & From cf2c7b97c50eda81ddee4d2208a8c83da86dcc83 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 14 Apr 2023 19:57:58 +0000 Subject: [PATCH 69/74] update ccpp-physics hash --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 2daa88ded..9b19c5339 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 2daa88ded299362ad21fd12f9d3488d2972f3807 +Subproject commit 9b19c53391b3e08019e07eaaf05589be21cfc648 From 994d37302067cd709237b3ac0c0c40acff4d115b Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Fri, 14 Apr 2023 21:53:41 +0000 Subject: [PATCH 70/74] remove test code from clm_lake.f90 --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 9b19c5339..cf604b5d9 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 9b19c53391b3e08019e07eaaf05589be21cfc648 +Subproject commit cf604b5d9b1206c2c2e9497bedd2e8fc881823f9 From d6322109e2d553c091e37ad6f535ddd4147c9f59 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 19 Apr 2023 18:25:55 +0000 Subject: [PATCH 71/74] remove redundant .not.have_2m in sfc_diag.f --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 07a375e7e..3929f9fe3 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 07a375e7e25e269e1bbdd0b11d26c698fe36f864 +Subproject commit 3929f9fe32d74e427a400041d1347466442177b5 From b82a38b168db4c2efb283839d19c042219d246ac Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 19 Apr 2023 18:29:26 +0000 Subject: [PATCH 72/74] explain why kind_lake exists --- ccpp/physics | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ccpp/physics b/ccpp/physics index 3929f9fe3..37dd7a570 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 3929f9fe32d74e427a400041d1347466442177b5 +Subproject commit 37dd7a570178904dd0032a655ae20ec23dadb361 From 9a48191ad714fc6ee912923c7c3b022aa133ef85 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 26 Apr 2023 14:12:12 +0000 Subject: [PATCH 73/74] point ccpp/physics to upstream ufs/dev --- .gitmodules | 4 ++-- ccpp/physics | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index d5c872050..22c723ac1 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,8 +8,8 @@ branch = main [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/SamuelTrahanNOAA/ccpp-physics - branch = clm_lake_revert.v9 + url = https://github.com/ufs-community/ccpp-physics + branch = ufs/dev [submodule "upp"] path = upp url = https://github.com/NOAA-EMC/UPP diff --git a/ccpp/physics b/ccpp/physics index d474c27b9..eda81a58a 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit d474c27b97360a5c6c21aa8ab19d5df87e3eba04 +Subproject commit eda81a58a1e3dd87c945f0d9cc43d53a1c858d65 From 04dfd91116942e7cfa353363206f31d58747bfc5 Mon Sep 17 00:00:00 2001 From: "samuel.trahan" Date: Wed, 26 Apr 2023 14:45:18 +0000 Subject: [PATCH 74/74] remove unintentional blank line --- ccpp/config/ccpp_prebuild_config.py | 1 - 1 file changed, 1 deletion(-) diff --git a/ccpp/config/ccpp_prebuild_config.py b/ccpp/config/ccpp_prebuild_config.py index 65d9c4084..aaf540bcc 100755 --- a/ccpp/config/ccpp_prebuild_config.py +++ b/ccpp/config/ccpp_prebuild_config.py @@ -1,4 +1,3 @@ - #!/usr/bin/env python # CCPP prebuild config for GFDL Finite-Volume Cubed-Sphere Model (FV3)