From 18910aa3f6c5b16b1e8aefe985fb811a1bb83699 Mon Sep 17 00:00:00 2001 From: Philip Pegion Date: Fri, 20 Mar 2020 14:12:54 +0000 Subject: [PATCH 1/9] make rain/snow tendency consistent with accumulated rain/snow --- .gitmodules | 2 +- ccpp/framework | 2 +- ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 21 ++++----------------- 4 files changed, 7 insertions(+), 20 deletions(-) diff --git a/.gitmodules b/.gitmodules index d253f6966..746cbc1b5 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,5 +8,5 @@ branch = master [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/NCAR/ccpp-physics + url = https://github.com/pjpegion/ccpp-physics branch = master diff --git a/ccpp/framework b/ccpp/framework index d32b965b1..e77210986 160000 --- a/ccpp/framework +++ b/ccpp/framework @@ -1 +1 @@ -Subproject commit d32b965b11882a42d9db522dc13823b7720b63aa +Subproject commit e7721098639ee73c2a69ee0e8423e8905549e240 diff --git a/ccpp/physics b/ccpp/physics index 3d45390dc..322f5b17c 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 3d45390dcd118c3cb0c6fb008e2d21608bbf0648 +Subproject commit 322f5b17c13015b23e075463459b9077eb8943e3 diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index c2bf254ac..266672c8d 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -911,10 +911,6 @@ subroutine GFS_physics_driver & ! --- set initial quantities for stochastic physics deltas if (Model%do_sppt) then Tbd%dtdtr = zero - do i=1,im - Tbd%drain_cpl(i) = Coupling%rain_cpl (i) - Tbd%dsnow_cpl(i) = Coupling%snow_cpl (i) - enddo endif ! mg, sfc-perts @@ -5463,10 +5459,10 @@ subroutine GFS_physics_driver & if (Model%cplflx .or. Model%cplchm) then do i = 1, im - Coupling%rain_cpl(i) = Coupling%rain_cpl(i) & - + Diag%rain(i) * (one-Sfcprop%srflag(i)) - Coupling%snow_cpl(i) = Coupling%snow_cpl(i) & - + Diag%rain(i) * Sfcprop%srflag(i) + Coupling%drain_cpl(i)= Diag%rain(i) * (one-Sfcprop%srflag(i)) + Coupling%dsnow_cpl(i)= Diag%rain(i) * Sfcprop%srflag(i) + Coupling%rain_cpl(i) = Coupling%rain_cpl(i) + Coupling%drain_cpl(i) + Coupling%snow_cpl(i) = Coupling%snow_cpl(i) + Coupling%dsnow_cpl(i) enddo endif @@ -5557,15 +5553,6 @@ subroutine GFS_physics_driver & if (Model%do_sppt) then !--- radiation heating rate Tbd%dtdtr(1:im,:) = Tbd%dtdtr(1:im,:) + dtdtc(1:im,:)*dtf - do i = 1, im - if (t850(i) > 273.16) then -!--- change in change in rain precip - Tbd%drain_cpl(i) = Diag%rain(i) - Tbd%drain_cpl(i) - else -!--- change in change in snow precip - Tbd%dsnow_cpl(i) = Diag%rain(i) - Tbd%dsnow_cpl(i) - endif - enddo endif !*## CCPP ## !## CCPP ##* This block is not in the CCPP since it is not needed in the CCPP. From 589ecfdcaaa66d5834e3380d33714a627b77b67b Mon Sep 17 00:00:00 2001 From: Philip Pegion Date: Fri, 20 Mar 2020 15:01:07 +0000 Subject: [PATCH 2/9] put drain_cpl and dsnow_cpl in proper container --- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 266672c8d..fa2403347 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -5459,10 +5459,10 @@ subroutine GFS_physics_driver & if (Model%cplflx .or. Model%cplchm) then do i = 1, im - Coupling%drain_cpl(i)= Diag%rain(i) * (one-Sfcprop%srflag(i)) - Coupling%dsnow_cpl(i)= Diag%rain(i) * Sfcprop%srflag(i) - Coupling%rain_cpl(i) = Coupling%rain_cpl(i) + Coupling%drain_cpl(i) - Coupling%snow_cpl(i) = Coupling%snow_cpl(i) + Coupling%dsnow_cpl(i) + Tbd%drain_cpl(i)= Diag%rain(i) * (one-Sfcprop%srflag(i)) + Tbd%dsnow_cpl(i)= Diag%rain(i) * Sfcprop%srflag(i) + Coupling%rain_cpl(i) = Coupling%rain_cpl(i) + Tbd%drain_cpl(i) + Coupling%snow_cpl(i) = Coupling%snow_cpl(i) + Tbd%dsnow_cpl(i) enddo endif From c436789348cab11d0fe4b571df2d8721d595511c Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 24 Mar 2020 09:37:14 -0600 Subject: [PATCH 3/9] Updates of IPD and CCPP code to regain bit-for-bit identical results for coupled model runs --- .../suite_FV3_GFS_2017_coupled_satmedmf.xml | 87 +++++++++++++++++++ gfsphysics/GFS_layer/GFS_physics_driver.F90 | 43 ++++++--- gfsphysics/GFS_layer/GFS_typedefs.F90 | 14 +-- gfsphysics/physics/GFS_debug.F90 | 24 ++++- gfsphysics/physics/gcycle.F90 | 12 +-- 5 files changed, 154 insertions(+), 26 deletions(-) create mode 100644 ccpp/suites/suite_FV3_GFS_2017_coupled_satmedmf.xml diff --git a/ccpp/suites/suite_FV3_GFS_2017_coupled_satmedmf.xml b/ccpp/suites/suite_FV3_GFS_2017_coupled_satmedmf.xml new file mode 100644 index 000000000..df7a04ca7 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_2017_coupled_satmedmf.xml @@ -0,0 +1,87 @@ + + + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_ocean + lsm_noah + sfc_cice + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdif + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys + GFS_DCNV_generic_pre + get_phi_fv3 + GFS_suite_interstitial_3 + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + zhaocarr_gscond + zhaocarr_precpd + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index c2bf254ac..1977d2776 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -687,6 +687,10 @@ subroutine GFS_physics_driver & !gamt = 0. !gflx = 0. !hflx = 0. + !dusfc_cice = 0. + !dvsfc_cice = 0. + !dtsfc_cice = 0. + !dqsfc_cice = 0. ! !! Strictly speaking, this is not required. But when !! hunting for bit-for-bit differences, doing the same as @@ -1145,9 +1149,8 @@ subroutine GFS_physics_driver & endif endif if (fice(i) < one) then - wet(i)=.true. !some open ocean/lake water exists + wet(i)=.true. ! some open ocean/lake water exists if (.not. Model%cplflx) Sfcprop%tsfco(i) = max(Sfcprop%tsfco(i), Sfcprop%tisfc(i), tgice) - end if else fice(i) = zero @@ -1659,13 +1662,14 @@ subroutine GFS_physics_driver & sbsno(i) = zero snowc(i) = zero snohf(i) = zero + !## CCPP ##* GFS_surface_generic.F90/GFS_surface_generic_pre_run Diag%zlvl(i) = Statein%phil(i,1) * onebg Diag%smcwlt2(i) = zero Diag%smcref2(i) = zero - wind(i) = max(sqrt(Statein%ugrs(i,1)*Statein%ugrs(i,1) + & Statein%vgrs(i,1)*Statein%vgrs(i,1)) & + max(zero, min(Tbd%phy_f2d(i,Model%num_p2d), 30.0)), one) + !*## CCPP ## enddo !*## CCPP ## @@ -1909,6 +1913,30 @@ subroutine GFS_physics_driver & endif !lsm + !! Strictly speaking, this is not required. But when + !! hunting for bit-for-bit differences, updating the + !! subsurface variables in the Sfcprop DDT makes + !! life a lot easier + !if (Model%frac_grid) then + ! do k=1,lsoil + ! do i=1,im + ! if (dry(i)) then + ! Sfcprop%smc(i,k) = smsoil(i,k) + ! Sfcprop%stc(i,k) = stsoil(i,k) + ! Sfcprop%slc(i,k) = slsoil(i,k) + ! endif + ! enddo + ! enddo + !else + ! do k=1,lsoil + ! do i=1,im + ! Sfcprop%smc(i,k) = smsoil(i,k) + ! Sfcprop%stc(i,k) = stsoil(i,k) + ! Sfcprop%slc(i,k) = slsoil(i,k) + ! enddo + ! enddo + !endif + ! if (lprnt) write(0,*)' tseabeficemodel =',Sfcprop%tsfc(ipr),' me=',me & ! &, ' kdt=',kdt,' tsfc32=',tsfc3(ipr,2),' fice=',fice(ipr) & ! &,' stsoil=',stsoil(ipr,:) @@ -2103,15 +2131,11 @@ subroutine GFS_physics_driver & ep1d(i) = ep1d3(i,k) Sfcprop%weasd(i) = weasd3(i,k) Sfcprop%snowd(i) = snowd3(i,k) - evap(i) = evap3(i,k) hflx(i) = hflx3(i,k) qss(i) = qss3(i,k) Sfcprop%tsfc(i) = tsfc3(i,k) - Diag%cmm(i) = cmm3(i,k) - Diag%chh(i) = chh3(i,k) - Sfcprop%zorll(i) = zorl3(i,1) Sfcprop%zorlo(i) = zorl3(i,3) @@ -2120,7 +2144,6 @@ subroutine GFS_physics_driver & txo = one - txi evap(i) = txi * evap3(i,2) + txo * evap3(i,3) hflx(i) = txi * hflx3(i,2) + txo * hflx3(i,3) -! Sfcprop%tsfc(i) = txi * tice(i) + txo * tsfc3(i,3) Sfcprop%tsfc(i) = txi * tsfc3(i,2) + txo * tsfc3(i,3) else ! return updated lake ice thickness & concentration to global array if (islmsk(i) == 2) then @@ -2856,8 +2879,6 @@ subroutine GFS_physics_driver & endif Coupling%dtsfci_cpl(i) = con_cp * rho * hflx3(i,3) ! sensible heat flux over open ocean Coupling%dqsfci_cpl(i) = con_hvap * rho * evap3(i,3) ! latent heat flux over open ocean -! if (lprnt .and. i == ipr) write(0,*)' hflx33=',hflx3(i,3),' evap33=',evap3(i,3), & -! ' con_cp=',con_cp,' rho=',rho,' con_hvap=',con_hvap else ! use results from PBL scheme for 100% open ocean Coupling%dusfci_cpl(i) = dusfc1(i) Coupling%dvsfci_cpl(i) = dvsfc1(i) @@ -5283,7 +5304,7 @@ subroutine GFS_physics_driver & !*## CCPP ## !## CCPP ##* GFS_MP_generic.F90/GFS_MP_generic_post_run Diag%rain(:) = Diag%rainc(:) + frain * rain1(:) ! total rain per timestep - + ! --- get the amount of different precip type for Noah MP ! --- convert from m/dtp to mm/s if (Model%lsm==Model%lsm_noahmp) then diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 8250bea53..1388c09f4 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -284,8 +284,8 @@ module GFS_typedefs #endif real (kind=kind_phys), pointer :: q2m (:) => null() !< 2 meter humidity -! -- In/Out for Noah MP - real (kind=kind_phys), pointer :: snowxy (:) => null() ! +! -- In/Out for Noah MP + real (kind=kind_phys), pointer :: snowxy (:) => null() !< real (kind=kind_phys), pointer :: tvxy (:) => null() !< veg temp real (kind=kind_phys), pointer :: tgxy (:) => null() !< ground temp real (kind=kind_phys), pointer :: canicexy(:) => null() !< @@ -312,7 +312,7 @@ module GFS_typedefs real (kind=kind_phys), pointer :: xlaixy (:) => null() !< real (kind=kind_phys), pointer :: taussxy (:) => null() !< real (kind=kind_phys), pointer :: smcwtdxy(:) => null() !< - real (kind=kind_phys), pointer :: deeprechxy(:) => null() !< + real (kind=kind_phys), pointer :: deeprechxy(:)=> null() !< real (kind=kind_phys), pointer :: rechxy (:) => null() !< real (kind=kind_phys), pointer :: snicexy (:,:) => null() !< @@ -2582,7 +2582,7 @@ subroutine coupling_create (Coupling, IM, Model) Coupling%ca_turb = clear_val Coupling%ca_shal = clear_val Coupling%ca_rad = clear_val - Coupling%ca_micro = clear_val + Coupling%ca_micro = clear_val Coupling%cape = clear_val Coupling%tconvtend = clear_val Coupling%qconvtend = clear_val @@ -4833,6 +4833,8 @@ subroutine tbd_create (Tbd, IM, Model) if ( Model%isubc_lw == 2 .or. Model%isubc_sw == 2 ) then allocate (Tbd%icsdsw (IM)) allocate (Tbd%icsdlw (IM)) + Tbd%icsdsw = zero + Tbd%icsdlw = zero endif !--- ozone and stratosphere h2o needs @@ -5427,8 +5429,8 @@ subroutine diag_phys_zero (Diag, Model, linit, iauwindow_center) Diag%u10max = zero Diag%v10max = zero Diag%spd10max = zero -! Diag%rain = zero -! Diag%rainc = zero + Diag%rain = zero + Diag%rainc = zero Diag%ice = zero Diag%snow = zero Diag%graupel = zero diff --git a/gfsphysics/physics/GFS_debug.F90 b/gfsphysics/physics/GFS_debug.F90 index 75fa97603..c0b24ca97 100644 --- a/gfsphysics/physics/GFS_debug.F90 +++ b/gfsphysics/physics/GFS_debug.F90 @@ -394,7 +394,12 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Coupling%rain_cpl', Coupling%rain_cpl) call print_var(mpirank,omprank, blkno, 'Coupling%snow_cpl', Coupling%snow_cpl) end if + if (Model%cplwav2atm) then + call print_var(mpirank,omprank, blkno, 'Coupling%zorlwav_cpl' , Coupling%zorlwav_cpl ) + end if if (Model%cplflx) then + call print_var(mpirank,omprank, blkno, 'Coupling%oro_cpl' , Coupling%oro_cpl ) + call print_var(mpirank,omprank, blkno, 'Coupling%slmsk_cpl' , Coupling%slmsk_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%slimskin_cpl', Coupling%slimskin_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%dusfcin_cpl ', Coupling%dusfcin_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%dvsfcin_cpl ', Coupling%dvsfcin_cpl ) @@ -458,11 +463,24 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Coupling%shum_wts', Coupling%shum_wts) end if if (Model%do_skeb) then - call print_var(mpirank,omprank, blkno, 'Coupling%skebu_wts', Coupling%skebu_wts) - call print_var(mpirank,omprank, blkno, 'Coupling%skebv_wts', Coupling%skebv_wts) + call print_var(mpirank,omprank, blkno, 'Coupling%skebu_wts', Coupling%skebu_wts ) + call print_var(mpirank,omprank, blkno, 'Coupling%skebv_wts', Coupling%skebv_wts ) end if if (Model%do_sfcperts) then - call print_var(mpirank,omprank, blkno, 'Coupling%sfc_wts', Coupling%sfc_wts) + call print_var(mpirank,omprank, blkno, 'Coupling%sfc_wts' , Coupling%sfc_wts ) + end if + if (Model%do_ca) then + call print_var(mpirank,omprank, blkno, 'Coupling%tconvtend', Coupling%tconvtend ) + call print_var(mpirank,omprank, blkno, 'Coupling%qconvtend', Coupling%qconvtend ) + call print_var(mpirank,omprank, blkno, 'Coupling%uconvtend', Coupling%uconvtend ) + call print_var(mpirank,omprank, blkno, 'Coupling%vconvtend', Coupling%vconvtend ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_out ', Coupling%ca_out ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_deep ', Coupling%ca_deep ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_turb ', Coupling%ca_turb ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_shal ', Coupling%ca_shal ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_rad ', Coupling%ca_rad ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_micro ', Coupling%ca_micro ) + call print_var(mpirank,omprank, blkno, 'Coupling%cape ', Coupling%cape ) end if if(Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then call print_var(mpirank,omprank, blkno, 'Coupling%nwfa2d', Coupling%nwfa2d) diff --git a/gfsphysics/physics/gcycle.F90 b/gfsphysics/physics/gcycle.F90 index e3666c26a..b410aaa9f 100644 --- a/gfsphysics/physics/gcycle.F90 +++ b/gfsphysics/physics/gcycle.F90 @@ -8,7 +8,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) GFS_sfcprop_type, GFS_cldprop_type implicit none - integer :: nblks + integer, intent(in) :: nblks type(GFS_control_type), intent(in) :: Model type(GFS_grid_type), intent(in) :: Grid(nblks) type(GFS_sfcprop_type), intent(inout) :: Sfcprop(nblks) @@ -34,7 +34,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) TG3FCS (Model%nx*Model%ny), & CNPFCS (Model%nx*Model%ny), & AISFCS (Model%nx*Model%ny), & - F10MFCS(Model%nx*Model%ny), & +! F10MFCS(Model%nx*Model%ny), & VEGFCS (Model%nx*Model%ny), & VETFCS (Model%nx*Model%ny), & SOTFCS (Model%nx*Model%ny), & @@ -103,7 +103,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) ZORFCS (len) = Sfcprop(nb)%zorl (ix) TG3FCS (len) = Sfcprop(nb)%tg3 (ix) CNPFCS (len) = Sfcprop(nb)%canopy (ix) - F10MFCS (len) = Sfcprop(nb)%f10m (ix) +! F10MFCS (len) = Sfcprop(nb)%f10m (ix) VEGFCS (len) = Sfcprop(nb)%vfrac (ix) VETFCS (len) = Sfcprop(nb)%vtype (ix) SOTFCS (len) = Sfcprop(nb)%stype (ix) @@ -190,8 +190,8 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) len = len + 1 Sfcprop(nb)%slmsk (ix) = SLIFCS (len) if ( Model%nstf_name(1) > 0 ) then - Sfcprop(nb)%tref(ix) = TSFFCS (len) -! if (Model%nstf_name(2) == 0) then + Sfcprop(nb)%tref(ix) = TSFFCS (len) +! if ( Model%nstf_name(2) == 0 ) then ! dt_warm = (Sfcprop(nb)%xt(ix) + Sfcprop(nb)%xt(ix) ) & ! / Sfcprop(nb)%xz(ix) ! Sfcprop(nb)%tsfco(ix) = Sfcprop(nb)%tref(ix) & @@ -205,7 +205,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) Sfcprop(nb)%zorl (ix) = ZORFCS (len) Sfcprop(nb)%tg3 (ix) = TG3FCS (len) Sfcprop(nb)%canopy (ix) = CNPFCS (len) - Sfcprop(nb)%f10m (ix) = F10MFCS (len) +! Sfcprop(nb)%f10m (ix) = F10MFCS (len) Sfcprop(nb)%vfrac (ix) = VEGFCS (len) Sfcprop(nb)%vtype (ix) = VETFCS (len) Sfcprop(nb)%stype (ix) = SOTFCS (len) From ea84cb5d0fd75eec9eeb96b54aff59dc9487a4e5 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 24 Mar 2020 09:37:38 -0600 Subject: [PATCH 4/9] Update .gitmodules and submodule pointer for ccpp-physics for code review and testing --- .gitmodules | 6 ++++-- ccpp/physics | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/.gitmodules b/.gitmodules index d253f6966..84f5be5ee 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,5 +8,7 @@ branch = master [submodule "ccpp/physics"] path = ccpp/physics - url = https://github.com/NCAR/ccpp-physics - branch = master + #url = https://github.com/NCAR/ccpp-physics + #branch = master + url = https://github.com/climbfuji/ccpp-physics + branch = coupled_model_ipd_ccpp_b4b diff --git a/ccpp/physics b/ccpp/physics index 3d45390dc..f143b81ee 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 3d45390dcd118c3cb0c6fb008e2d21608bbf0648 +Subproject commit f143b81eefed08706757a11b1e11cd085ab8aa75 From fcba0e9e6ff3cd9494c470a7cd3e3438722263eb Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 24 Mar 2020 11:30:31 -0600 Subject: [PATCH 5/9] gfsphysics/GFS_layer/GFS_physics_driver.F90: need to initialize local variables for bit-for-bit identical results --- gfsphysics/GFS_layer/GFS_physics_driver.F90 | 28 ++++++++++----------- 1 file changed, 14 insertions(+), 14 deletions(-) diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 1977d2776..596be0de9 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -678,20 +678,20 @@ subroutine GFS_physics_driver & real :: pshltr,QCQ,rh02 real(kind=kind_phys), allocatable, dimension(:,:) :: den - !! Initialize local variables (mainly for debugging purposes, because the - !! corresponding variables Interstitial(nt)%... are reset to zero every time); - !! these variables are only modified over parts of the entire domain (related - !! to land surface mask etc.) - !snowmt = 0. - !gamq = 0. - !gamt = 0. - !gflx = 0. - !hflx = 0. - !dusfc_cice = 0. - !dvsfc_cice = 0. - !dtsfc_cice = 0. - !dqsfc_cice = 0. - ! + ! Initialize local variables. Some of these are mainly for debugging + ! purposes, because the corresponding variables Interstitial(nt)%... + ! are reset to zero every time. For some, however, it is required + ! because they may be used uninitialized otherwise! + snowmt = 0. + gamq = 0. + gamt = 0. + gflx = 0. + hflx = 0. + dusfc_cice = 0. + dvsfc_cice = 0. + dtsfc_cice = 0. + dqsfc_cice = 0. + !! Strictly speaking, this is not required. But when !! hunting for bit-for-bit differences, doing the same as !! in GFS_suite_stateout_reset makes life a lot easier. From 6f4cb56c6ab1c3401e5033c7c854aa382574288e Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 24 Mar 2020 16:51:36 -0600 Subject: [PATCH 6/9] Bugfix in gfsphysics/GFS_layer/GFS_typedefs.F90, allocate Tbd%drain_cpl and Tbd%dsnow_cpl when cplchm or cplflx is true --- ccpp/physics | 2 +- gfsphysics/GFS_layer/GFS_typedefs.F90 | 12 +++++++----- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/ccpp/physics b/ccpp/physics index 53c10713b..091d47524 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 53c10713bfb99a40c00cd5e6b858242a11cdbefa +Subproject commit 091d47524aedd7e62d5e26afc4da85e7cdd45a1c diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 1388c09f4..6ffc71d1b 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -4879,18 +4879,20 @@ subroutine tbd_create (Tbd, IM, Model) Tbd%acvb = clear_val Tbd%acvt = clear_val + if (Model%cplflx .or. Model%cplchm) then + allocate (Tbd%drain_cpl (IM)) + allocate (Tbd%dsnow_cpl (IM)) + Tbd%drain_cpl = clear_val + Tbd%dsnow_cpl = clear_val + endif + if (Model%do_sppt) then allocate (Tbd%dtdtr (IM,Model%levs)) allocate (Tbd%dtotprcp (IM)) allocate (Tbd%dcnvprcp (IM)) - allocate (Tbd%drain_cpl (IM)) - allocate (Tbd%dsnow_cpl (IM)) - Tbd%dtdtr = clear_val Tbd%dtotprcp = clear_val Tbd%dcnvprcp = clear_val - Tbd%drain_cpl = clear_val - Tbd%dsnow_cpl = clear_val endif allocate (Tbd%phy_f2d (IM,Model%ntot2d)) From bcda8764021e590bde291030cf241c836a30ab98 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 25 Mar 2020 13:17:53 -0600 Subject: [PATCH 7/9] Remove local/interstitial variables for seaice coupling, add suite definition file for S2S benchmark runs --- ccpp/physics | 2 +- ccpp/suites/suite_FV3_GFS_v15p2_coupled.xml | 92 +++++++++++++++++++++ gfsphysics/GFS_layer/GFS_physics_driver.F90 | 45 ++++------ gfsphysics/GFS_layer/GFS_typedefs.F90 | 20 ----- gfsphysics/GFS_layer/GFS_typedefs.meta | 35 -------- 5 files changed, 108 insertions(+), 86 deletions(-) create mode 100644 ccpp/suites/suite_FV3_GFS_v15p2_coupled.xml diff --git a/ccpp/physics b/ccpp/physics index 091d47524..5c134c17d 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 091d47524aedd7e62d5e26afc4da85e7cdd45a1c +Subproject commit 5c134c17d88f9ed008e0e4c0bbab392b2c1f4d13 diff --git a/ccpp/suites/suite_FV3_GFS_v15p2_coupled.xml b/ccpp/suites/suite_FV3_GFS_v15p2_coupled.xml new file mode 100644 index 000000000..71f3665f9 --- /dev/null +++ b/ccpp/suites/suite_FV3_GFS_v15p2_coupled.xml @@ -0,0 +1,92 @@ + + + + + + + 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 + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_ocean + lsm_noah + sfc_cice + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + hedmf + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + GFS_DCNV_generic_pre + get_phi_fv3 + GFS_suite_interstitial_3 + 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 + + + + + GFS_stochastics + + + + diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90 index 65d793dcc..98edf87d1 100644 --- a/gfsphysics/GFS_layer/GFS_physics_driver.F90 +++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90 @@ -544,9 +544,6 @@ subroutine GFS_physics_driver & doms, psautco_l, prautco_l, ocalnirbm_cpl, ocalnirdf_cpl, & ocalvisbm_cpl, ocalvisdf_cpl, dtzm, temrain1, t2mmp, q2mp, & psaur_l, praur_l, & -!--- coupling inputs for physics - dtsfc_cice, dqsfc_cice, dusfc_cice, dvsfc_cice, & -! dtsfc_cice, dqsfc_cice, dusfc_cice, dvsfc_cice, ulwsfc_cice, & !--- for CS-convection wcbmax @@ -678,19 +675,14 @@ subroutine GFS_physics_driver & real :: pshltr,QCQ,rh02 real(kind=kind_phys), allocatable, dimension(:,:) :: den - ! Initialize local variables. Some of these are mainly for debugging - ! purposes, because the corresponding variables Interstitial(nt)%... - ! are reset to zero every time. For some, however, it is required - ! because they may be used uninitialized otherwise! - snowmt = 0. - gamq = 0. - gamt = 0. - gflx = 0. - hflx = 0. - dusfc_cice = 0. - dvsfc_cice = 0. - dtsfc_cice = 0. - dqsfc_cice = 0. + !! Initialize local variables (for debugging purposes only, + !! because the corresponding variables Interstitial(nt)%... + !! are reset to zero every time). + !snowmt = 0. + !gamq = 0. + !gamt = 0. + !gflx = 0. + !hflx = 0. !! Strictly speaking, this is not required. But when !! hunting for bit-for-bit differences, doing the same as @@ -1113,14 +1105,6 @@ subroutine GFS_physics_driver & do i=1,im islmsk_cice(i) = nint(Coupling%slimskin_cpl(i)) flag_cice(i) = (islmsk_cice(i) == 4) - - if (flag_cice(i)) then -! ulwsfc_cice(i) = Coupling%ulwsfcin_cpl(i) - dusfc_cice(i) = Coupling%dusfcin_cpl(i) - dvsfc_cice(i) = Coupling%dvsfcin_cpl(i) - dtsfc_cice(i) = Coupling%dtsfcin_cpl(i) - dqsfc_cice(i) = Coupling%dqsfcin_cpl(i) - endif enddo endif !*## CCPP ## @@ -1955,8 +1939,9 @@ subroutine GFS_physics_driver & (im, Statein%tgrs(:,1), & Statein%qgrs(:,1,1), cd3(:,2), cdq3(:,2), & Statein%prsl(:,1), wind, & - flag_cice, flag_iter, dqsfc_cice, dtsfc_cice, & - dusfc_cice, dvsfc_cice, & + flag_cice, flag_iter, & + Coupling%dqsfcin_cpl, Coupling%dtsfcin_cpl, & + Coupling%dusfcin_cpl, Coupling%dvsfcin_cpl, & ! --- outputs: qss3(:,2), cmm3(:,2), chh3(:,2), evap3(:,2), hflx3(:,2), & stress3(:,2)) @@ -2858,10 +2843,10 @@ subroutine GFS_physics_driver & do i=1,im if (Sfcprop%oceanfrac(i) > zero) then ! Ocean only, NO LAKES if (Sfcprop%fice(i) > one - epsln) then ! no open water, thus use results from CICE - Coupling%dusfci_cpl(i) = dusfc_cice(i) - Coupling%dvsfci_cpl(i) = dvsfc_cice(i) - Coupling%dtsfci_cpl(i) = dtsfc_cice(i) - Coupling%dqsfci_cpl(i) = dqsfc_cice(i) + Coupling%dusfci_cpl(i) = Coupling%dusfcin_cpl(i) + Coupling%dvsfci_cpl(i) = Coupling%dvsfcin_cpl(i) + Coupling%dtsfci_cpl(i) = Coupling%dtsfcin_cpl(i) + Coupling%dqsfci_cpl(i) = Coupling%dqsfcin_cpl(i) elseif (icy(i) .or. dry(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point tem1 = max(Diag%q1(i), 1.e-8) rho = Statein%prsl(i,1) / (con_rd*Diag%t1(i)*(one+con_fvirt*tem1)) diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90 index 6ffc71d1b..00bae3897 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.F90 +++ b/gfsphysics/GFS_layer/GFS_typedefs.F90 @@ -1853,11 +1853,6 @@ module GFS_typedefs real (kind=kind_phys), pointer :: tsurf_land(:) => null() !< real (kind=kind_phys), pointer :: tsurf_ocean(:) => null() !< real (kind=kind_phys), pointer :: ud_mf(:,:) => null() !< - real (kind=kind_phys), pointer :: ulwsfc_cice(:) => null() !< - real (kind=kind_phys), pointer :: dusfc_cice(:) => null() !< - real (kind=kind_phys), pointer :: dvsfc_cice(:) => null() !< - real (kind=kind_phys), pointer :: dqsfc_cice(:) => null() !< - real (kind=kind_phys), pointer :: dtsfc_cice(:) => null() !< real (kind=kind_phys), pointer :: uustar_ice(:) => null() !< real (kind=kind_phys), pointer :: uustar_land(:) => null() !< real (kind=kind_phys), pointer :: uustar_ocean(:) => null() !< @@ -5915,11 +5910,6 @@ subroutine interstitial_create (Interstitial, IM, Model) allocate (Interstitial%tsurf_land (IM)) allocate (Interstitial%tsurf_ocean (IM)) allocate (Interstitial%ud_mf (IM,Model%levs)) - allocate (Interstitial%ulwsfc_cice (IM)) - allocate (Interstitial%dusfc_cice (IM)) - allocate (Interstitial%dvsfc_cice (IM)) - allocate (Interstitial%dtsfc_cice (IM)) - allocate (Interstitial%dqsfc_cice (IM)) allocate (Interstitial%uustar_ice (IM)) allocate (Interstitial%uustar_land (IM)) allocate (Interstitial%uustar_ocean (IM)) @@ -6442,11 +6432,6 @@ subroutine interstitial_phys_reset (Interstitial, Model) Interstitial%tsurf_land = huge Interstitial%tsurf_ocean = huge Interstitial%ud_mf = clear_val - Interstitial%ulwsfc_cice = clear_val - Interstitial%dusfc_cice = clear_val - Interstitial%dvsfc_cice = clear_val - Interstitial%dtsfc_cice = clear_val - Interstitial%dqsfc_cice = clear_val Interstitial%uustar_ice = huge Interstitial%uustar_land = huge Interstitial%uustar_ocean = huge @@ -6787,11 +6772,6 @@ subroutine interstitial_print(Interstitial, Model, mpirank, omprank, blkno) write (0,*) 'sum(Interstitial%tsurf_land ) = ', sum(Interstitial%tsurf_land ) write (0,*) 'sum(Interstitial%tsurf_ocean ) = ', sum(Interstitial%tsurf_ocean ) write (0,*) 'sum(Interstitial%ud_mf ) = ', sum(Interstitial%ud_mf ) - write (0,*) 'sum(Interstitial%ulwsfc_cice ) = ', sum(Interstitial%ulwsfc_cice ) - write (0,*) 'sum(Interstitial%dusfc_cice ) = ', sum(Interstitial%dusfc_cice ) - write (0,*) 'sum(Interstitial%dvsfc_cice ) = ', sum(Interstitial%dvsfc_cice ) - write (0,*) 'sum(Interstitial%dtsfc_cice ) = ', sum(Interstitial%dtsfc_cice ) - write (0,*) 'sum(Interstitial%dqsfc_cice ) = ', sum(Interstitial%dqsfc_cice ) write (0,*) 'sum(Interstitial%uustar_ice ) = ', sum(Interstitial%uustar_ice ) write (0,*) 'sum(Interstitial%uustar_land ) = ', sum(Interstitial%uustar_land ) write (0,*) 'sum(Interstitial%uustar_ocean ) = ', sum(Interstitial%uustar_ocean ) diff --git a/gfsphysics/GFS_layer/GFS_typedefs.meta b/gfsphysics/GFS_layer/GFS_typedefs.meta index adb24a3fc..bc2344250 100644 --- a/gfsphysics/GFS_layer/GFS_typedefs.meta +++ b/gfsphysics/GFS_layer/GFS_typedefs.meta @@ -6579,34 +6579,6 @@ dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) type = real kind = kind_phys -[dusfc_cice] - standard_name = surface_x_momentum_flux_for_coupling_interstitial - long_name = sfc x momentum flux for coupling interstitial - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys -[dvsfc_cice] - standard_name = surface_y_momentum_flux_for_coupling_interstitial - long_name = sfc y momentum flux for coupling interstitial - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys -[dtsfc_cice] - standard_name = surface_upward_sensible_heat_flux_for_coupling_interstitial - long_name = sfc sensible heat flux for coupling interstitial - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys -[dqsfc_cice] - standard_name = surface_upward_latent_heat_flux_for_coupling_interstitial - long_name= surface latent heat flux for coupling interstitial - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys [elvmax] standard_name = maximum_subgrid_orography long_name = maximum of subgrid orography @@ -8038,13 +8010,6 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys -[ulwsfc_cice] - standard_name = surface_upwelling_longwave_flux_for_coupling_interstitial - long_name = surface upwelling longwave flux for coupling_interstitial - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys [uustar_ocean] standard_name = surface_friction_velocity_over_ocean long_name = surface friction velocity over ocean From 1c8ce05c902f5fcfcc16e85afbca5f09861683b8 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 26 Mar 2020 15:48:41 -0600 Subject: [PATCH 8/9] Rename S2S suite suite_FV3_GFS_2017_coupled_satmedmf.xml to suite_FV3_GFS_2017_satmedmf_coupled.xml --- ...led_satmedmf.xml => suite_FV3_GFS_2017_satmedmf_coupled.xml} | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) rename ccpp/suites/{suite_FV3_GFS_2017_coupled_satmedmf.xml => suite_FV3_GFS_2017_satmedmf_coupled.xml} (97%) diff --git a/ccpp/suites/suite_FV3_GFS_2017_coupled_satmedmf.xml b/ccpp/suites/suite_FV3_GFS_2017_satmedmf_coupled.xml similarity index 97% rename from ccpp/suites/suite_FV3_GFS_2017_coupled_satmedmf.xml rename to ccpp/suites/suite_FV3_GFS_2017_satmedmf_coupled.xml index df7a04ca7..42928357d 100644 --- a/ccpp/suites/suite_FV3_GFS_2017_coupled_satmedmf.xml +++ b/ccpp/suites/suite_FV3_GFS_2017_satmedmf_coupled.xml @@ -1,6 +1,6 @@ - + From d4380df851d246cafc50355856cd51f09ef3a0fd Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 27 Mar 2020 13:05:37 -0600 Subject: [PATCH 9/9] Revert change to .gitmodules and update submodule pointer for ccpp-physics --- .gitmodules | 6 ++---- ccpp/physics | 2 +- 2 files changed, 3 insertions(+), 5 deletions(-) diff --git a/.gitmodules b/.gitmodules index 84f5be5ee..d253f6966 100644 --- a/.gitmodules +++ b/.gitmodules @@ -8,7 +8,5 @@ branch = master [submodule "ccpp/physics"] path = ccpp/physics - #url = https://github.com/NCAR/ccpp-physics - #branch = master - url = https://github.com/climbfuji/ccpp-physics - branch = coupled_model_ipd_ccpp_b4b + url = https://github.com/NCAR/ccpp-physics + branch = master diff --git a/ccpp/physics b/ccpp/physics index 5c134c17d..efb68b5b9 160000 --- a/ccpp/physics +++ b/ccpp/physics @@ -1 +1 @@ -Subproject commit 5c134c17d88f9ed008e0e4c0bbab392b2c1f4d13 +Subproject commit efb68b5b948937f256a1a90c2de446b0d9b09e0f