Skip to content

Commit

Permalink
Merge pull request #822 from climbfuji/mynnsfc_restart
Browse files Browse the repository at this point in the history 
MYNN sfclay restart reproducibility
  • Loading branch information
@climbfuji
climbfuji authored Jan 6, 2022
2 parents a5dcdce + cd92c4c commit 9880f44
Show file tree
Hide file tree
Showing 3 changed files with 45 additions and 23 deletions.
3 changes: 1 addition & 2 deletions physics/GFS_surface_composites.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -410,8 +410,7 @@ subroutine GFS_surface_composites_post_run (
cmm, cmm_wat, cmm_lnd, cmm_ice, chh, chh_wat, chh_lnd, chh_ice, gflx, gflx_wat, gflx_lnd, gflx_ice, ep1d, ep1d_wat, &
ep1d_lnd, ep1d_ice, weasd, weasd_lnd, weasd_ice, snowd, snowd_lnd, snowd_ice, tprcp, tprcp_wat, &
tprcp_lnd, tprcp_ice, evap, evap_wat, evap_lnd, evap_ice, hflx, hflx_wat, hflx_lnd, hflx_ice, qss, qss_wat, qss_lnd, &
qss_ice, tsfc, tsfco, tsfcl, tsfc_wat, tisfc, hice, cice, tiice, &
! qss_ice, tsfc, tsfco, tsfcl, tsfc_wat, tisfc, hice, cice, min_seaice, tiice, &
qss_ice, tsfc, tsfco, tsfcl, tsfc_wat, tisfc, hice, cice, tiice, &
sigmaf, zvfun, lheatstrg, h0facu, h0facs, hflxq, hffac, stc, &
grav, prsik1, prslk1, prslki, z1, ztmax_wat, ztmax_lnd, ztmax_ice, huge, errmsg, errflg)

Expand Down
15 changes: 11 additions & 4 deletions physics/module_MYNNSFC_wrapper.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -201,7 +201,7 @@ SUBROUTINE mynnsfc_wrapper_run( &
& CHS2, CQS2, rmol, zol, mol, ch, &
& lh, wstar
!LOCAL
real, dimension(im) :: &
real(kind=kind_phys), dimension(im) :: &
& hfx, znt, psim, psih, &
& chs, ck, cd, mavail, xland, GZ1OZ0, &
& cpm, qgh, qfx, snowh_wat
Expand All @@ -228,13 +228,19 @@ SUBROUTINE mynnsfc_wrapper_run( &
! endif

! prep MYNN-only variables
pattern_spp_pbl(:,:) = 0
dz(:,:) = 0
th(:,:) = 0
qv(:,:) = 0
hfx(:) = 0
qfx(:) = 0
rmol(:) = 0
do k=1,2 !levs
do i=1,im
dz(i,k)=(phii(i,k+1) - phii(i,k))*g_inv
th(i,k)=t3d(i,k)/exner(i,k)
!qc(i,k)=MAX(qgrs(i,k,ntcw),0.0)
qv(i,k)=qvsh(i,k)/(1.0 - qvsh(i,k))
pattern_spp_pbl(i,k)=0.0
enddo
enddo
do i=1,im
Expand Down Expand Up @@ -333,8 +339,9 @@ SUBROUTINE mynnsfc_wrapper_run( &
spp_pbl=spp_pbl,pattern_spp_pbl=pattern_spp_pbl, &
ids=1,ide=im, jds=1,jde=1, kds=1,kde=levs, &
ims=1,ime=im, jms=1,jme=1, kms=1,kme=levs, &
its=1,ite=im, jts=1,jte=1, kts=1,kte=levs )

its=1,ite=im, jts=1,jte=1, kts=1,kte=levs, &
errmsg=errmsg, errflg=errflg )
if (errflg/=0) return

!! POST MYNN SURFACE LAYER (INTERSTITIAL) WORK:
!do i = 1, im
Expand Down
50 changes: 33 additions & 17 deletions physics/module_sf_mynn.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -164,7 +164,8 @@ SUBROUTINE SFCLAY_mynn( &
spp_pbl,pattern_spp_pbl, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte )
its,ite, jts,jte, kts,kte, &
errmsg, errflg )
!-------------------------------------------------------------------
IMPLICIT NONE
!-------------------------------------------------------------------
Expand Down Expand Up @@ -258,6 +259,8 @@ SUBROUTINE SFCLAY_mynn( &
!-- jte end index for j in tile
!-- kts start index for k in tile
!-- kte end index for k in tile
!-- errmsg CCPP error message
!-- errflg CCPP error code
!=================================================================
! SCALARS
!===================================
Expand Down Expand Up @@ -352,9 +355,13 @@ SUBROUTINE SFCLAY_mynn( &
& QFLX_wat, QFLX_lnd, QFLX_ice, &
& qsfc_wat, qsfc_lnd, qsfc_ice

! CCPP error handling
character(len=*), intent(inout) :: errmsg
integer, intent(inout) :: errflg

!ADDITIONAL OUTPUT
!JOE-begin
REAL, DIMENSION( ims:ime ) :: qstar
REAL, DIMENSION( ims:ime ) :: qstar
!JOE-end
!===================================
! 1D LOCAL ARRAYS
Expand Down Expand Up @@ -401,6 +408,7 @@ SUBROUTINE SFCLAY_mynn( &
else
rstoch1D(i)=0.0
endif
qstar(i)=0.0
ENDDO

IF (itimestep==1 .AND. iter==1) THEN
Expand All @@ -410,9 +418,6 @@ SUBROUTINE SFCLAY_mynn( &
UST_LND(i)=MAX(0.04*SQRT(U1D(i)*U1D(i) + V1D(i)*V1D(i)),0.001)
UST_ICE(i)=MAX(0.04*SQRT(U1D(i)*U1D(i) + V1D(i)*V1D(i)),0.001)
MOL(i)=0.0
qstar(i)=0.0
QFX(i)=0.
HFX(i)=0.
QFLX(i)=0.
HFLX(i)=0.
if ( LSM == LSM_RUC ) then
Expand Down Expand Up @@ -461,12 +466,12 @@ SUBROUTINE SFCLAY_mynn( &
PSIM,PSIH, &
HFLX,HFX,QFLX,QFX,LH,FLHC,FLQC, &
QGH,QSFC,U10,V10,TH2,T2,Q2, &
GZ1OZ0,WSPD,wstar, &
GZ1OZ0,WSPD,wstar,qstar, &
spp_pbl,rstoch1D, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte &
)
its,ite, jts,jte, kts,kte, &
errmsg, errflg )

END SUBROUTINE SFCLAY_MYNN

Expand Down Expand Up @@ -509,12 +514,12 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, &
HFLX,HFX,QFLX,QFX,LH,FLHC,FLQC, &
QGH,QSFC, &
U10,V10,TH2,T2,Q2, &
GZ1OZ0,WSPD,wstar, &
GZ1OZ0,WSPD,wstar,qstar, &
spp_pbl,rstoch1D, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte &
)
its,ite, jts,jte, kts,kte, &
errmsg, errflg )

!-------------------------------------------------------------------
IMPLICIT NONE
Expand Down Expand Up @@ -563,9 +568,10 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, &
dz8w1d, &
dz2w1d

REAL, DIMENSION( ims:ime ), INTENT(INOUT) :: HFLX,HFX, &
QFLX,QFX,LH, &
MOL,RMOL, &
REAL, DIMENSION( ims:ime ), INTENT(OUT) :: QFX,HFX, &
RMOL
REAL, DIMENSION( ims:ime ), INTENT(INOUT) :: HFLX,QFLX, &
LH,MOL, &
QGH,QSFC, &
ZNT, &
ZOL, &
Expand Down Expand Up @@ -610,8 +616,13 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, &

!--------------------------------------------
!JOE-additinal output
REAL, DIMENSION( ims:ime ) :: wstar,qstar
REAL, DIMENSION( ims:ime ), INTENT(OUT) :: wstar,qstar
!JOE-end

! CCPP error handling
character(len=*), intent(inout) :: errmsg
integer, intent(inout) :: errflg

!----------------------------------------------------------------
! LOCAL VARS
!----------------------------------------------------------------
Expand Down Expand Up @@ -661,8 +672,8 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, &
!-------------------------------------------------------------------
DO I=its,ite

! PSFC ( in cmb) is used later in saturation checks
PSFC(I)=PSFCPA(I)/1000.
! PSFC ( in cmb) is used later in saturation checks
PSFC(I)=PSFCPA(I)/1000.
!tgs - do computations if flag_iter(i) = .true.
if ( flag_iter(i) ) then

Expand Down Expand Up @@ -1224,6 +1235,11 @@ SUBROUTINE SFCLAY1D_mynn(flag_iter, &
CALL zilitinkevich_1995(ZNTstoch_lnd(i),ZT_lnd(i),ZQ_lnd(i),restar,&
UST_lnd(I),KARMAN,1.0,IZ0TLND,spp_pbl,rstoch1D(i))
ELSEIF ( IZ0TLND .EQ. 2 ) THEN
! DH note - at this point, qstar is either not initialized
! or initialized to zero, but certainly not set correctly
errmsg = 'Logic error: qstar is not set correctly when calling Yang_2008'
errflg = 1
return
CALL Yang_2008(ZNTSTOCH_lnd(i),ZT_lnd(i),ZQ_lnd(i),UST_lnd(i),MOL(I),&
qstar(I),restar,visc)
ELSEIF ( IZ0TLND .EQ. 3 ) THEN
Expand Down

0 comments on commit 9880f44

Please sign in to comment.