Skip to content

Commit

Permalink
Merge branch 'develop' into fix_nophys_tendencies_output
Browse files Browse the repository at this point in the history
  • Loading branch information
@grantfirl
grantfirl committed Aug 14, 2020
2 parents b6a244c + 0e83a92 commit 5aaf568
Show file tree
Hide file tree
Showing 29 changed files with 2,971 additions and 2,414 deletions.
139 changes: 86 additions & 53 deletions atmos_model.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -220,9 +220,10 @@ module atmos_model_mod
logical,parameter :: flip_vc = .true.
#endif

real(kind=IPD_kind_phys), parameter :: zero = 0.0_IPD_kind_phys, &
one = 1.0_IPD_kind_phys, &
epsln = 1.0e-10_IPD_kind_phys
real(kind=IPD_kind_phys), parameter :: zero = 0.0_IPD_kind_phys, &
one = 1.0_IPD_kind_phys, &
epsln = 1.0e-10_IPD_kind_phys, &
zorlmin = 1.0e-7_IPD_kind_phys

contains

Expand Down Expand Up @@ -299,13 +300,18 @@ subroutine update_atmos_radiation_physics (Atmos)
call stochastic_physics_wrapper(IPD_Control, IPD_Data, Atm_block)

!--- if coupled, assign coupled fields

if( IPD_Control%cplflx .or. IPD_Control%cplwav ) then
! print *,'in atmos_model,nblks=',Atm_block%nblks
! print *,'in atmos_model,IPD_Data size=',size(IPD_Data)
! print *,'in atmos_model,tsfc(1)=',IPD_Data(1)%sfcprop%tsfc(1)
! print *,'in atmos_model, tsfc size=',size(IPD_Data(1)%sfcprop%tsfc)

! if (mpp_pe() == mpp_root_pe() .and. debug) then
! print *,'in atmos_model,nblks=',Atm_block%nblks
! print *,'in atmos_model,IPD_Data size=',size(IPD_Data)
! print *,'in atmos_model,tsfc(1)=',IPD_Data(1)%sfcprop%tsfc(1)
! print *,'in atmos_model, tsfc size=',size(IPD_Data(1)%sfcprop%tsfc)
! endif

call assign_importdata(rc)
! print *,'in atmos_model, after assign_importdata, rc=',rc

endif

! Calculate total non-physics tendencies by substracting old IPD Stateout
Expand Down Expand Up @@ -881,7 +887,7 @@ subroutine update_atmos_model_state (Atmos)
if (mpp_pe() == mpp_root_pe()) write(6,*) ' gfs diags time since last bucket empty: ',time_int/3600.,'hrs'
call atmosphere_nggps_diag(Atmos%Time)
call FV3GFS_diag_output(Atmos%Time, IPD_DIag, Atm_block, IPD_Control%nx, IPD_Control%ny, &
IPD_Control%levs, 1, 1, 1.d0, time_int, time_intfull, &
IPD_Control%levs, 1, 1, 1.0_IPD_kind_phys, time_int, time_intfull, &
IPD_Control%fhswr, IPD_Control%fhlwr)
if (nint(IPD_Control%fhzero) > 0) then
if (mod(isec,3600*nint(IPD_Control%fhzero)) == 0) diag_time = Atmos%Time
Expand Down Expand Up @@ -1177,6 +1183,9 @@ subroutine update_atmos_chemistry(state, rc)
ntb = size(IPD_Data(1)%IntDiag%duem, dim=2)
nte = size(qu, dim=3)
do it = 1, min(ntb, nte)
!$OMP parallel do default (none) &
!$OMP shared (it, nj, ni, Atm_block, IPD_Data, qu) &
!$OMP private (j, jb, i, ib, nb, ix)
do j = 1, nj
jb = j + Atm_block%jsc - 1
do i = 1, ni
Expand All @@ -1189,17 +1198,22 @@ subroutine update_atmos_chemistry(state, rc)
enddo

nte = nte - ntb
do it = 1, min(size(IPD_Data(1)%IntDiag%ssem, dim=2), nte)
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)
IPD_Data(nb)%IntDiag%ssem(ix,it) = qu(i,j,it+ntb)
if (nte > 0) then
do it = 1, min(size(IPD_Data(1)%IntDiag%ssem, dim=2), nte)
!$OMP parallel do default (none) &
!$OMP shared (it, nj, ni, ntb, Atm_block, IPD_Data, qu) &
!$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)
IPD_Data(nb)%IntDiag%ssem(ix,it) = qu(i,j,it+ntb)
enddo
enddo
enddo
enddo
endif

!--- (c) sedimentation and dry/wet deposition
do it = 1, size(qd, dim=3)
Expand Down Expand Up @@ -1583,8 +1597,9 @@ subroutine assign_importdata(rc)
real(kind=ESMF_KIND_R4), dimension(:,:), pointer :: datar42d
real(kind=ESMF_KIND_R8), dimension(:,:), pointer :: datar82d
real(kind=IPD_kind_phys), dimension(:,:), pointer :: datar8
real(kind=IPD_kind_phys) :: tem
real(kind=IPD_kind_phys) :: tem, ofrac
logical found, isFieldCreated, lcpl_fice
real (kind=IPD_kind_phys), parameter :: z0ice=1.1 ! (in cm)
!
!------------------------------------------------------------------------------
!
Expand All @@ -1607,6 +1622,7 @@ subroutine assign_importdata(rc)

found = .false.


isFieldCreated = ESMF_FieldIsCreated(importFields(n), rc=rc)
if (ESMF_LogFoundError(rcToCheck=rc, msg=ESMF_LOGERR_PASSTHRU, line=__LINE__, file=__FILE__)) return

Expand Down Expand Up @@ -1663,10 +1679,13 @@ subroutine assign_importdata(rc)
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then
tem = 100.0 * max(zero, min(0.1, datar8(i,j)))
IPD_Data(nb)%Coupling%zorlwav_cpl(ix) = tem
if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero .and. datar8(i,j) > zorlmin) then
tem = 100.0_IPD_kind_phys * min(0.1_IPD_kind_phys, datar8(i,j))
! IPD_Data(nb)%Coupling%zorlwav_cpl(ix) = tem
IPD_Data(nb)%Sfcprop%zorlo(ix) = tem
IPD_Data(nb)%Sfcprop%zorlw(ix) = tem
else
IPD_Data(nb)%Sfcprop%zorlw(ix) = -999.0_IPD_kind_phys

endif
enddo
Expand All @@ -1685,8 +1704,9 @@ subroutine assign_importdata(rc)
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then
IPD_Data(nb)%Coupling%tisfcin_cpl(ix) = datar8(i,j)
if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero .and. datar8(i,j) > 150.0) then
! IPD_Data(nb)%Coupling%tisfcin_cpl(ix) = datar8(i,j)
IPD_Data(nb)%Sfcprop%tisfc(ix) = datar8(i,j)
endif
enddo
enddo
Expand All @@ -1698,17 +1718,14 @@ subroutine assign_importdata(rc)
fldname = 'sea_surface_temperature'
if (trim(impfield_name) == trim(fldname)) then
findex = QueryFieldList(ImportFieldsList,fldname)
! if (mpp_pe() == mpp_root_pe() .and. debug) print *,' for sst', &
! ' fldname=',fldname,' findex=',findex,' importFieldsValid=',importFieldsValid(findex)

if (importFieldsValid(findex)) then
!$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)
if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then
IPD_Data(nb)%Coupling%tseain_cpl(ix) = datar8(i,j)
if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero .and. datar8(i,j) > 150.0) then
! IPD_Data(nb)%Coupling%tseain_cpl(ix) = datar8(i,j)
IPD_Data(nb)%Sfcprop%tsfco(ix) = datar8(i,j)
endif
enddo
Expand All @@ -1723,23 +1740,26 @@ subroutine assign_importdata(rc)
if (trim(impfield_name) == trim(fldname)) then
findex = QueryFieldList(ImportFieldsList,fldname)
if (importFieldsValid(findex)) then
lcpl_fice = .true.
!$omp parallel do default(shared) private(i,j,nb,ix)
lcpl_fice = .true.
!$omp parallel do default(shared) private(i,j,nb,ix,ofrac)
do j=jsc,jec
do i=isc,iec
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
IPD_Data(nb)%Coupling%ficein_cpl(ix) = zero

IPD_Data(nb)%Sfcprop%fice(ix) = zero
IPD_Data(nb)%Coupling%slimskin_cpl(ix) = IPD_Data(nb)%Sfcprop%slmsk(ix)
if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then
IPD_Data(nb)%Coupling%ficein_cpl(ix) = max(zero, min(one, datar8(i,j)/IPD_Data(nb)%Sfcprop%oceanfrac(ix))) !LHS: ice frac wrt water area
if (IPD_Data(nb)%Coupling%ficein_cpl(ix) > one-epsln) IPD_Data(nb)%Coupling%ficein_cpl(ix)=one
if (IPD_Data(nb)%Coupling%ficein_cpl(ix) >= IPD_control%min_seaice) then
if (abs(one-IPD_Data(nb)%Sfcprop%oceanfrac(ix)) < epsln) IPD_Data(nb)%Sfcprop%slmsk(ix) = 2. !slmsk=2 crashes in gcycle on partial land points
IPD_Data(nb)%Coupling%slimskin_cpl(ix) = 4.
ofrac = IPD_Data(nb)%Sfcprop%oceanfrac(ix)
if (ofrac > zero) then
IPD_Data(nb)%Sfcprop%fice(ix) = max(zero, min(one, datar8(i,j)/ofrac)) !LHS: ice frac wrt water area
if (IPD_Data(nb)%Sfcprop%fice(ix) >= IPD_control%min_seaice) then
if (IPD_Data(nb)%Sfcprop%fice(ix) > one-epsln) IPD_Data(nb)%Sfcprop%fice(ix) = one
if (abs(one-ofrac) < epsln) IPD_Data(nb)%Sfcprop%slmsk(ix) = 2.0_IPD_kind_phys !slmsk=2 crashes in gcycle on partial land points
! IPD_Data(nb)%Sfcprop%slmsk(ix) = 2.0_IPD_kind_phys
IPD_Data(nb)%Coupling%slimskin_cpl(ix) = 4.0_IPD_kind_phys
else
IPD_Data(nb)%Coupling%ficein_cpl(ix) = zero
if (abs(one-IPD_Data(nb)%Sfcprop%oceanfrac(ix)) < epsln) then
IPD_Data(nb)%Sfcprop%fice(ix) = zero
if (abs(one-ofrac) < epsln) then
IPD_Data(nb)%Sfcprop%slmsk(ix) = zero
IPD_Data(nb)%Coupling%slimskin_cpl(ix) = zero
end if
Expand Down Expand Up @@ -1870,7 +1890,8 @@ subroutine assign_importdata(rc)
nb = Atm_block%blkno(i,j)
ix = Atm_block%ixp(i,j)
if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then
IPD_Data(nb)%Coupling%hicein_cpl(ix) = datar8(i,j)
! IPD_Data(nb)%Coupling%hicein_cpl(ix) = datar8(i,j)
IPD_Data(nb)%Sfcprop%hice(ix) = datar8(i,j)
endif
enddo
enddo
Expand Down Expand Up @@ -1913,25 +1934,36 @@ subroutine assign_importdata(rc)
ix = Atm_block%ixp(i,j)
if (IPD_Data(nb)%Sfcprop%oceanfrac(ix) > zero) then
!if it is ocean or ice get surface temperature from mediator
if(IPD_Data(nb)%Coupling%ficein_cpl(ix) >= IPD_control%min_seaice) then
IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tisfcin_cpl(ix)
IPD_Data(nb)%Sfcprop%fice(ix) = IPD_Data(nb)%Coupling%ficein_cpl(ix)
IPD_Data(nb)%Sfcprop%hice(ix) = IPD_Data(nb)%Coupling%hicein_cpl(ix)
IPD_Data(nb)%Sfcprop%snowd(ix) = IPD_Data(nb)%Coupling%hsnoin_cpl(ix)
if (IPD_Data(nb)%Sfcprop%fice(ix) >= IPD_control%min_seaice) then

! if(IPD_Data(nb)%Coupling%ficein_cpl(ix) >= IPD_control%min_seaice) then
! IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tisfcin_cpl(ix)
! IPD_Data(nb)%Sfcprop%fice(ix) = IPD_Data(nb)%Coupling%ficein_cpl(ix)
! IPD_Data(nb)%Sfcprop%hice(ix) = IPD_Data(nb)%Coupling%hicein_cpl(ix)
! IPD_Data(nb)%Sfcprop%snowd(ix) = IPD_Data(nb)%Coupling%hsnoin_cpl(ix)

IPD_Data(nb)%Coupling%hsnoin_cpl(ix) = IPD_Data(nb)%Coupling%hsnoin_cpl(ix) &
/ max(0.01_IPD_kind_phys, IPD_Data(nb)%Sfcprop%fice(ix))
! / max(0.01_IPD_kind_phys, IPD_Data(nb)%Coupling%ficein_cpl(ix))
IPD_Data(nb)%Sfcprop%zorli(ix) = z0ice
else
IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tseain_cpl(ix)
IPD_Data(nb)%Sfcprop%fice(ix) = zero
IPD_Data(nb)%Sfcprop%hice(ix) = zero
IPD_Data(nb)%Sfcprop%snowd(ix) = zero
! IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Coupling%tseain_cpl(ix)
IPD_Data(nb)%Sfcprop%tisfc(ix) = IPD_Data(nb)%Sfcprop%tsfco(ix)
IPD_Data(nb)%Sfcprop%fice(ix) = zero
IPD_Data(nb)%Sfcprop%hice(ix) = zero
! IPD_Data(nb)%Sfcprop%snowd(ix) = zero
IPD_Data(nb)%Coupling%hsnoin_cpl(ix) = zero
!
IPD_Data(nb)%Coupling%dtsfcin_cpl(ix) = -99999.0 ! over open water - should not be used in ATM
IPD_Data(nb)%Coupling%dqsfcin_cpl(ix) = -99999.0 ! ,,
IPD_Data(nb)%Coupling%dusfcin_cpl(ix) = -99999.0 ! ,,
IPD_Data(nb)%Coupling%dvsfcin_cpl(ix) = -99999.0 ! ,,
IPD_Data(nb)%Coupling%dtsfcin_cpl(ix) = -99999.0 ! ,,
IPD_Data(nb)%Coupling%ulwsfcin_cpl(ix) = -99999.0 ! ,,
if (abs(one-IPD_Data(nb)%Sfcprop%oceanfrac(ix)) < epsln) &
IPD_Data(nb)%Coupling%slimskin_cpl(ix) = zero ! 100% open water
if (abs(one-IPD_Data(nb)%Sfcprop%oceanfrac(ix)) < epsln) then ! 100% open water
IPD_Data(nb)%Coupling%slimskin_cpl(ix) = zero
IPD_Data(nb)%Sfcprop%slmsk(ix) = zero
endif
endif
endif
enddo
Expand All @@ -1947,7 +1979,8 @@ subroutine assign_importdata(rc)
! abs(IPD_Data(nb)%Grid%xlat_d(ix)+58.99) < 0.1) then
! write(0,*)' in assign tisfc=',IPD_Data(nb)%Sfcprop%tisfc(ix), &
! ' oceanfrac=',IPD_Data(nb)%Sfcprop%oceanfrac(ix),' i=',i,' j=',j,&
! ' tisfcin=',IPD_Data(nb)%Coupling%tisfcin_cpl(ix), &
!! ' tisfcin=',IPD_Data(nb)%Coupling%tisfcin_cpl(ix), &
! ' tisfcin=',IPD_Data(nb)%Sfcprop%tisfc(ix), &
! ' fice=',IPD_Data(nb)%Sfcprop%fice(ix)
! endif
! enddo
Expand Down
2 changes: 1 addition & 1 deletion ccpp/physics
Submodule physics updated 42 files
+76 −70 physics/GFS_MP_generic.F90
+21 −19 physics/GFS_PBL_generic.F90
+7 −7 physics/GFS_debug.F90
+6 −6 physics/GFS_rrtmg_post.F90
+74 −82 physics/GFS_rrtmg_pre.F90
+2 −2 physics/GFS_rrtmg_setup.F90
+105 −139 physics/GFS_suite_interstitial.F90
+131 −81 physics/GFS_surface_composites.F90
+28 −2 physics/GFS_surface_composites.meta
+21 −26 physics/GFS_surface_generic.F90
+2 −2 physics/GFS_surface_loop_control.F90
+1 −1 physics/GFS_time_vary_pre.fv3.F90
+3 −3 physics/dcyc2.f
+98 −99 physics/gcm_shoc.F90
+41 −22 physics/gcycle.F90
+4 −3 physics/get_prs_fv3.F90
+308 −305 physics/m_micro.F90
+9 −10 physics/micro_mg3_0.F90
+30 −30 physics/micro_mg_utils.F90
+1 −1 physics/module_nst_model.f90
+41 −50 physics/module_nst_water_prop.f90
+84 −76 physics/moninshoc.f
+226 −216 physics/rascnv.F90
+4 −5 physics/rrtmg_lw_post.F90
+2 −2 physics/rrtmg_lw_pre.F90
+5 −5 physics/rrtmg_sw_post.F90
+3 −3 physics/rrtmg_sw_pre.F90
+25 −9 physics/sfc_cice.f
+36 −0 physics/sfc_cice.meta
+110 −91 physics/sfc_diff.f
+9 −0 physics/sfc_diff.meta
+50 −64 physics/sfc_drv.f
+79 −69 physics/sfc_nst.f
+16 −0 physics/sfc_nst.meta
+20 −31 physics/sfc_ocean.F
+0 −18 physics/sfc_ocean.meta
+84 −67 physics/sfc_sice.f
+33 −31 physics/sfc_sice.meta
+630 −554 physics/sfcsub.F
+27 −23 physics/tridi.f
+89 −82 physics/ugwp_driver_v0.F
+318 −319 physics/wv_saturation.F
90 changes: 90 additions & 0 deletions ccpp/suites/suite_FV3_GFS_cpld_rasmgshocnsst.xml
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,90 @@
<?xml version="1.0" encoding="UTF-8"?>

<suite name="FV3_GFS_cpld_rasmgshocnsst" lib="ccppphys" ver="3">
<!-- <init></init> -->
<group name="time_vary">
<subcycle loop="1">
<scheme>GFS_time_vary_pre</scheme>
<scheme>GFS_rrtmg_setup</scheme>
<scheme>GFS_rad_time_vary</scheme>
<scheme>GFS_phys_time_vary</scheme>
</subcycle>
</group>
<group name="radiation">
<subcycle loop="1">
<scheme>GFS_suite_interstitial_rad_reset</scheme>
<scheme>GFS_rrtmg_pre</scheme>
<scheme>rrtmg_sw_pre</scheme>
<scheme>rrtmg_sw</scheme>
<scheme>rrtmg_sw_post</scheme>
<scheme>rrtmg_lw_pre</scheme>
<scheme>rrtmg_lw</scheme>
<scheme>rrtmg_lw_post</scheme>
<scheme>GFS_rrtmg_post</scheme>
</subcycle>
</group>
<group name="physics">
<subcycle loop="1">
<scheme>GFS_suite_interstitial_phys_reset</scheme>
<scheme>GFS_suite_stateout_reset</scheme>
<scheme>get_prs_fv3</scheme>
<scheme>GFS_suite_interstitial_1</scheme>
<scheme>GFS_surface_generic_pre</scheme>
<scheme>GFS_surface_composites_pre</scheme>
<scheme>dcyc2t3</scheme>
<scheme>GFS_surface_composites_inter</scheme>
<scheme>GFS_suite_interstitial_2</scheme>
</subcycle>
<!-- Surface iteration loop -->
<subcycle loop="2">
<scheme>sfc_diff</scheme>
<scheme>GFS_surface_loop_control_part1</scheme>
<scheme>lsm_noah</scheme>
<scheme>sfc_nst_pre</scheme>
<scheme>sfc_nst</scheme>
<scheme>sfc_nst_post</scheme>
<scheme>sfc_cice</scheme>
<scheme>sfc_sice</scheme>
<scheme>GFS_surface_loop_control_part2</scheme>
</subcycle>
<!-- End of surface iteration loop -->
<subcycle loop="1">
<scheme>GFS_surface_composites_post</scheme>
<scheme>sfc_diag</scheme>
<scheme>sfc_diag_post</scheme>
<scheme>GFS_surface_generic_post</scheme>
<scheme>GFS_PBL_generic_pre</scheme>
<scheme>moninshoc</scheme>
<scheme>GFS_PBL_generic_post</scheme>
<scheme>GFS_GWD_generic_pre</scheme>
<scheme>cires_ugwp</scheme>
<scheme>cires_ugwp_post</scheme>
<scheme>GFS_GWD_generic_post</scheme>
<scheme>rayleigh_damp</scheme>
<scheme>GFS_suite_stateout_update</scheme>
<scheme>ozphys_2015</scheme>
<scheme>h2ophys</scheme>
<scheme>get_phi_fv3</scheme>
<scheme>GFS_suite_interstitial_3</scheme>
<scheme>shoc</scheme>
<scheme>GFS_DCNV_generic_pre</scheme>
<scheme>GFS_suite_interstitial_5</scheme>
<scheme>rascnv</scheme>
<scheme>GFS_DCNV_generic_post</scheme>
<scheme>GFS_suite_interstitial_4</scheme>
<scheme>cnvc90</scheme>
<scheme>GFS_MP_generic_pre</scheme>
<scheme>m_micro_pre</scheme>
<scheme>m_micro</scheme>
<scheme>m_micro_post</scheme>
<scheme>GFS_MP_generic_post</scheme>
<scheme>maximum_hourly_diagnostics</scheme>
</subcycle>
</group>
<group name="stochastics">
<subcycle loop="1">
<scheme>GFS_stochastics</scheme>
</subcycle>
</group>
<!-- <finalize></finalize> -->
</suite>
Loading

0 comments on commit 5aaf568

Please sign in to comment.