diff --git a/atmos_cubed_sphere b/atmos_cubed_sphere
index 8b59ebc03..32a406a13 160000
--- a/atmos_cubed_sphere
+++ b/atmos_cubed_sphere
@@ -1 +1 @@
-Subproject commit 8b59ebc039dafe1c20ed6dd21cb38ca564852b98
+Subproject commit 32a406a13283337358aeef33685176ad43f9fb01
diff --git a/atmos_model.F90 b/atmos_model.F90
index 0499c3c56..81589c386 100644
--- a/atmos_model.F90
+++ b/atmos_model.F90
@@ -99,13 +99,13 @@ module atmos_model_mod
IPD_interstitial => GFS_interstitial
use IPD_driver, only: IPD_initialize, IPD_initialize_rst
use CCPP_driver, only: CCPP_step, non_uniform_blocks
+
+use stochastic_physics_wrapper_mod, only: stochastic_physics_wrapper
#else
use IPD_driver, only: IPD_initialize, IPD_initialize_rst, IPD_step
use physics_abstraction_layer, only: time_vary_step, radiation_step1, physics_step1, physics_step2
#endif
-use stochastic_physics_wrapper_mod, only: stochastic_physics_wrapper
-
use FV3GFS_io_mod, only: FV3GFS_restart_read, FV3GFS_restart_write, &
FV3GFS_IPD_checksum, &
FV3GFS_diag_register, FV3GFS_diag_output, &
@@ -291,16 +291,16 @@ subroutine update_atmos_radiation_physics (Atmos)
#ifdef CCPP
call CCPP_step (step="time_vary", nblks=Atm_block%nblks, ierr=ierr)
if (ierr/=0) call mpp_error(FATAL, 'Call to CCPP time_vary step failed')
+
+!--- call stochastic physics pattern generation / cellular automata
+ call stochastic_physics_wrapper(IPD_Control, IPD_Data, Atm_block, ierr)
+ if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed')
+
#else
Func1d => time_vary_step
call IPD_step (IPD_Control, IPD_Data(:), IPD_Diag, IPD_Restart, IPD_func1d=Func1d)
#endif
-!--- call stochastic physics pattern generation / cellular automata
- call stochastic_physics_wrapper(IPD_Control, IPD_Data, Atm_block, ierr)
- if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed')
-
-
!--- if coupled, assign coupled fields
if( IPD_Control%cplflx .or. IPD_Control%cplwav ) then
@@ -625,14 +625,15 @@ subroutine atmos_model_init (Atmos, Time_init, Time, Time_step)
#ifdef CCPP
call IPD_initialize (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, &
IPD_Interstitial, commglobal, mpp_npes(), Init_parm)
-#else
- call IPD_initialize (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, Init_parm)
-#endif
!--- Initialize stochastic physics pattern generation / cellular automata for first time step
call stochastic_physics_wrapper(IPD_Control, IPD_Data, Atm_block, ierr)
if (ierr/=0) call mpp_error(FATAL, 'Call to stochastic_physics_wrapper failed')
+#else
+ call IPD_initialize (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart, Init_parm)
+#endif
+
Atmos%Diag => IPD_Diag
Atm(mygrid)%flagstruct%do_skeb = IPD_Control%do_skeb
diff --git a/ccpp/driver/CCPP_driver.F90 b/ccpp/driver/CCPP_driver.F90
index 8e45d9382..89c41672f 100644
--- a/ccpp/driver/CCPP_driver.F90
+++ b/ccpp/driver/CCPP_driver.F90
@@ -93,7 +93,7 @@ subroutine CCPP_step (step, nblks, ierr)
end do
end do
- else if (trim(step)=="physics_init") then
+ else if (trim(step)=="physics_init") then
! Since the physics init steps are independent of the blocking structure,
! we can use cdata_domain here. Since we don't use threading on the outside,
@@ -107,7 +107,7 @@ subroutine CCPP_step (step, nblks, ierr)
return
end if
- else if (trim(step)=="time_vary") then
+ else if (trim(step)=="time_vary") then
! Since the time_vary steps only use data structures for all blocks (except the
! CCPP-internal variables ccpp_error_flag and ccpp_error_message, which are defined
@@ -123,8 +123,8 @@ subroutine CCPP_step (step, nblks, ierr)
return
end if
- ! Radiation and stochastic physics
- else if (trim(step)=="radiation" .or. trim(step)=="physics" .or. trim(step)=="stochastics") then
+ ! Radiation and stochastic physics
+ else if (trim(step)=="radiation" .or. trim(step)=="physics" .or. trim(step)=="stochastics") then
! Set number of threads available to physics schemes to one,
! because threads are used on the outside for blocking
@@ -162,8 +162,8 @@ subroutine CCPP_step (step, nblks, ierr)
!$OMP end parallel
if (ierr/=0) return
- ! Finalize
- else if (trim(step)=="finalize") then
+ ! Finalize
+ else if (trim(step)=="finalize") then
! Loop over blocks, don't use threading on the outside but allowing threading
! inside the finalization, similar to what is done for the initialization
diff --git a/ccpp/physics b/ccpp/physics
index 0808cc2e8..28cf65480 160000
--- a/ccpp/physics
+++ b/ccpp/physics
@@ -1 +1 @@
-Subproject commit 0808cc2e8938ba66003b46746858143a9d75addb
+Subproject commit 28cf654806dd1ec6d8ff88386a80a2e683002f3b
diff --git a/ccpp/suites/suite_FV3_GFS_2017_couplednsst.xml b/ccpp/suites/suite_FV3_GFS_2017_couplednsst.xml
new file mode 100644
index 000000000..1aa7ca484
--- /dev/null
+++ b/ccpp/suites/suite_FV3_GFS_2017_couplednsst.xml
@@ -0,0 +1,89 @@
+
+
+
+
+
+
+ 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
+ lsm_noah
+ sfc_nst_pre
+ sfc_nst
+ sfc_nst_post
+ 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
+ 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
+ zhaocarr_gscond
+ zhaocarr_precpd
+ GFS_MP_generic_post
+ maximum_hourly_diagnostics
+
+
+
+
+ GFS_stochastics
+
+
+
+
diff --git a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml
index 5b3b63528..a08956dfa 100644
--- a/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml
+++ b/ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml
@@ -1,6 +1,6 @@
-
+
diff --git a/gfsphysics/GFS_layer/GFS_physics_driver.F90 b/gfsphysics/GFS_layer/GFS_physics_driver.F90
index 899955f03..62b48b872 100644
--- a/gfsphysics/GFS_layer/GFS_physics_driver.F90
+++ b/gfsphysics/GFS_layer/GFS_physics_driver.F90
@@ -814,8 +814,8 @@ subroutine GFS_physics_driver &
! do i=1,im
! lprnt = Model%me == 23 .and. i == 25
! lprnt = Model%me == 127 .and. i == 11
-! lprnt = kdt >= 20 .and. abs(grid%xlon(i)*rad2dg-102.65) < 0.101 &
-! .and. abs(grid%xlat(i)*rad2dg-0.12) < 0.201
+! lprnt = kdt >= 20 .and. abs(grid%xlon(i)*rad2dg-295.40) < 0.101 &
+! .and. abs(grid%xlat(i)*rad2dg-47.0) < 0.101
! lprnt = kdt >= 20 .and. abs(grid%xlon(i)*rad2dg-184.00) < 0.301 &
! .and. abs(grid%xlat(i)*rad2dg-83.23) < 0.301
! lprnt = kdt >= 7 .and. abs(grid%xlon(i)*rad2dg-216.20) < 0.101 &
@@ -2183,22 +2183,25 @@ subroutine GFS_physics_driver &
endif
if (islmsk(i) == 1) then
k = 1
- Sfcprop%tsfcl(i) = tsfc3(i,1) ! over land
stress(i) = stress3(i,1)
! Sfcprop%tprcp(i) = tprcp3(i,1)
+ Sfcprop%tsfcl(i) = tsfc3(i,1) ! over land
Sfcprop%tsfco(i) = tsfc3(i,1)
Sfcprop%tisfc(i) = tsfc3(i,1)
+ Sfcprop%tsfc(i) = tsfc3(i,1)
elseif (islmsk(i) == 0) then
k = 3
- Sfcprop%tsfco(i) = tsfc3(i,3) ! over lake (and ocean when uncoupled)
stress(i) = stress3(i,3)
! Sfcprop%tprcp(i) = tprcp3(i,3)
+ Sfcprop%tsfco(i) = tsfc3(i,3) ! over lake (and ocean when uncoupled)
Sfcprop%tisfc(i) = tsfc3(i,3)
Sfcprop%tsfcl(i) = tsfc3(i,3)
+ Sfcprop%tsfc(i) = tsfc3(i,3)
else
k = 2
stress(i) = stress3(i,2)
! Sfcprop%tprcp(i) = fice(i)*tprcp3(i,2) + (one-fice(i))*tprcp3(i,3)
+ Sfcprop%tsfc(i) = tsfc3(i,2)
endif
Sfcprop%zorl(i) = zorl3(i,k)
cd(i) = cd3(i,k)
@@ -2219,43 +2222,49 @@ subroutine GFS_physics_driver &
evap(i) = evap3(i,k)
hflx(i) = hflx3(i,k)
qss(i) = qss3(i,k)
- Sfcprop%tsfc(i) = tsfc3(i,k)
+! Sfcprop%tsfc(i) = tsfc3(i,k)
Sfcprop%zorll(i) = zorl3(i,1)
Sfcprop%zorli(i) = zorl3(i,2)
Sfcprop%zorlo(i) = zorl3(i,3)
- if (flag_cice(i)) then
- if (wet(i) .and. fice(i) > Model%min_seaice) then ! this was already done for lake ice in sfc_sice
- txi = fice(i)
- 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 * tsfc3(i,2) + txo * tsfc3(i,3)
- stress(i) = txi *stress3(i,2) + txo * stress3(i,3)
- qss(i) = txi * qss3(i,2) + txo * qss3(i,3)
- ep1d(i) = txi * ep1d3(i,2) + txo * ep1d3(i,3)
- Sfcprop%zorl(i) = txi*zorl3(i,2) + txo*zorl3(i,3)
+ if (k == 2) then
+ if (wet(i)) then
+ Sfcprop%tsfco(i) = tsfc3(i,3)
+ endif
+ if (flag_cice(i)) then
+ if (wet(i) .and. fice(i) > Model%min_seaice) then ! this was already done for lake ice in sfc_sice
+ txi = fice(i)
+ 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 * tsfc3(i,2) + txo * tsfc3(i,3)
+ stress(i) = txi *stress3(i,2) + txo * stress3(i,3)
+ qss(i) = txi * qss3(i,2) + txo * qss3(i,3)
+ ep1d(i) = txi * ep1d3(i,2) + txo * ep1d3(i,3)
+ Sfcprop%zorl(i) = txi * zorl3(i,2) + txo * zorl3(i,3)
+ endif
+ elseif (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array
+ Sfcprop%tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled)
+ Sfcprop%tsfc(i) = tsfc3(i,2)
+ Sfcprop%hice(i) = zice(i)
+ Sfcprop%fice(i) = fice(i) ! fice is fraction of lake area that is frozen
+ Sfcprop%zorl(i) = fice(i)*zorl3(i,2) + (one-fice(i))*zorl3(i,3)
+ else ! this would be over open ocean or land (no ice fraction)
+ Sfcprop%hice(i) = zero
+ Sfcprop%fice(i) = zero
+ Sfcprop%tsfc(i) = Sfcprop%tsfco(i)
+ Sfcprop%tisfc(i) = Sfcprop%tsfc(i)
+ icy(i) = .false.
+ endif
+ Sfcprop%tsfcl(i) = Sfcprop%tsfc(i)
+ if (.not. wet(i)) then
+ Sfcprop%tsfco(i) =Sfcprop%tsfc(i)
endif
- elseif (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array
- Sfcprop%tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled)
- Sfcprop%hice(i) = zice(i)
- Sfcprop%fice(i) = fice(i) ! fice is fraction of lake area that is frozen
- Sfcprop%zorl(i) = fice(i)*zorl3(i,2) + (one-fice(i))*zorl3(i,3)
- else ! this would be over open ocean or land (no ice fraction)
- Sfcprop%hice(i) = zero
- Sfcprop%fice(i) = zero
- Sfcprop%tisfc(i) = Sfcprop%tsfc(i)
- icy(i) = .false.
- endif
- Sfcprop%tsfcl(i) = Sfcprop%tsfc(i)
- if (wet(i)) then
- Sfcprop%tsfco(i) = tsfc3(i,3)
- else
- Sfcprop%tsfco(i) =Sfcprop%tsfc(i)
endif
do k=1,Model%kice ! store tiice in stc to reduce output in the nonfrac grid case
- Sfcprop%stc(i,k) = Sfcprop%tiice(i,k)
+! Sfcprop%stc(i,k) = Sfcprop%tiice(i,k)
+ Sfcprop%stc(i,k) = stsoil(i,k)
enddo
enddo
endif ! if (Model%frac_grid)
@@ -5806,6 +5815,7 @@ subroutine GFS_physics_driver &
! if (lprnt) write(0,*)' end driver sfcprop%tsfcl=',Sfcprop%tsfcl(ipr),' kdt=',kdt
! if (lprnt) write(0,*)' end driver sfcprop%tsfco=',Sfcprop%tsfco(ipr),' kdt=',kdt
! if (lprnt) write(0,*)' end driver sfcprop%tisfc=',Sfcprop%tisfc(ipr),' kdt=',kdt
+! if (lprnt) write(0,*)' end driver sfcprop%tsfc=',Sfcprop%tsfc(ipr),' kdt=',kdt,wet(ipr),icy(ipr),dry(ipr)
! endif
return
diff --git a/gfsphysics/GFS_layer/GFS_typedefs.F90 b/gfsphysics/GFS_layer/GFS_typedefs.F90
index 429170059..2c6166df4 100644
--- a/gfsphysics/GFS_layer/GFS_typedefs.F90
+++ b/gfsphysics/GFS_layer/GFS_typedefs.F90
@@ -1550,9 +1550,9 @@ module GFS_typedefs
#ifdef CCPP
real (kind=kind_phys), pointer :: TRAIN (:,:) => null() !< accumulated stratiform T tendency (K s-1)
#endif
-#ifdef CCPP
+!#ifdef CCPP
real (kind=kind_phys), pointer :: cldfra (:,:) => null() !< instantaneous 3D cloud fraction
-#endif
+!#endif
!--- MP quantities for 3D diagnositics
real (kind=kind_phys), pointer :: refl_10cm(:,:) => null() !< instantaneous refl_10cm
!
diff --git a/io/FV3GFS_io.F90 b/io/FV3GFS_io.F90
index e0898c3f6..458605c96 100644
--- a/io/FV3GFS_io.F90
+++ b/io/FV3GFS_io.F90
@@ -1077,16 +1077,16 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain)
if (Sfcprop(nb)%lakefrac(ix) > zero) then
Sfcprop(nb)%oceanfrac(ix) = zero ! lake & ocean don't coexist in a cell
- if (Sfcprop(nb)%fice(ix) < Model%min_lakeice) then
- Sfcprop(nb)%fice(ix) = zero
- if (Sfcprop(nb)%slmsk(ix) == 2) Sfcprop(nb)%slmsk(ix) = 0
- endif
+! if (Sfcprop(nb)%fice(ix) < Model%min_lakeice) then
+! Sfcprop(nb)%fice(ix) = zero
+! if (Sfcprop(nb)%slmsk(ix) == 2) Sfcprop(nb)%slmsk(ix) = 0
+! endif
else
Sfcprop(nb)%oceanfrac(ix) = one - Sfcprop(nb)%landfrac(ix)
- if (Sfcprop(nb)%fice(ix) < Model%min_seaice) then
- Sfcprop(nb)%fice(ix) = zero
- if (Sfcprop(nb)%slmsk(ix) == 2) Sfcprop(nb)%slmsk(ix) = 0
- endif
+! if (Sfcprop(nb)%fice(ix) < Model%min_seaice) then
+! Sfcprop(nb)%fice(ix) = zero
+! if (Sfcprop(nb)%slmsk(ix) == 2) Sfcprop(nb)%slmsk(ix) = 0
+! endif
endif
!
!--- NSSTM variables
@@ -1357,28 +1357,47 @@ subroutine sfc_prop_restart_read (Sfcprop, Atm_block, Model, fv_domain)
enddo
enddo
else
+ if( Model%phour < 1.e-7) then
!$omp parallel do default(shared) private(nb, ix, tem)
- do nb = 1, Atm_block%nblks
- do ix = 1, Atm_block%blksz(nb)
+ do nb = 1, Atm_block%nblks
+ do ix = 1, Atm_block%blksz(nb)
!--- specify tsfcl/zorll/zorli from existing variable tsfco/zorlo
-! Sfcprop(nb)%tsfcl(ix) = Sfcprop(nb)%tsfco(ix)
-! Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorlo(ix)
-! Sfcprop(nb)%zorli(ix) = Sfcprop(nb)%zorlo(ix)
-! Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorlo(ix)
-! Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfco(ix)
- if (Sfcprop(nb)%slmsk(ix) == 1) then
- Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix)
- Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix)
- else
- tem = one - Sfcprop(nb)%fice(ix)
- Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorli(ix) * Sfcprop(nb)%fice(ix) &
- + Sfcprop(nb)%zorlo(ix) * tem
-
- Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tisfc(ix) * Sfcprop(nb)%fice(ix) &
- + Sfcprop(nb)%tsfco(ix) * tem
- endif
+! Sfcprop(nb)%tsfcl(ix) = Sfcprop(nb)%tsfco(ix)
+! Sfcprop(nb)%zorll(ix) = Sfcprop(nb)%zorlo(ix)
+! Sfcprop(nb)%zorli(ix) = Sfcprop(nb)%zorlo(ix)
+! Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorlo(ix)
+ if (Sfcprop(nb)%slmsk(ix) == 1) then
+ Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix)
+ Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix)
+ else
+ tem = one - Sfcprop(nb)%fice(ix)
+ Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorli(ix) * Sfcprop(nb)%fice(ix) &
+ + Sfcprop(nb)%zorlo(ix) * tem
+ Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tisfc(ix) * Sfcprop(nb)%fice(ix) &
+ + Sfcprop(nb)%tsfco(ix) * tem
+ endif
+ enddo
enddo
- enddo
+ else
+!$omp parallel do default(shared) private(nb, ix, tem)
+ do nb = 1, Atm_block%nblks
+ do ix = 1, Atm_block%blksz(nb)
+ !--- specify tsfcl/zorll/zorli from existing variable tsfco/zorlo
+ Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfco(ix)
+ if (Sfcprop(nb)%slmsk(ix) == 1) then
+ Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorll(ix)
+ Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix)
+ else
+ tem = one - Sfcprop(nb)%fice(ix)
+ Sfcprop(nb)%zorl(ix) = Sfcprop(nb)%zorli(ix) * Sfcprop(nb)%fice(ix) &
+ + Sfcprop(nb)%zorlo(ix) * tem
+ if (Sfcprop(nb)%fice(ix) > min(Model%min_seaice,Model%min_lakeice)) then
+ Sfcprop(nb)%tsfc(ix) = Sfcprop(nb)%tsfcl(ix)
+ endif
+ endif
+ enddo
+ enddo
+ endif
endif ! if (Model%frac_grid)
!#ifdef CCPP