Skip to content

Commit b852361

Browse files
whannah1whannah1
committed
fixes to restor BFB for EAM tests
e
1 parent 5274d20 commit b852361

File tree

3 files changed

+45
-56
lines changed

3 files changed

+45
-56
lines changed

‎components/eam/src/physics/cam/zm_conv.F90‎

Lines changed: 8 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -612,34 +612,21 @@ subroutine zm_convr( pcols, ncol, pver, pverp, is_first_step, delt, &
612612
end do
613613
end do
614614

615+
do i = 1,lengath
616+
jctop(ideep(i)) = jt(i)
617+
jcbot(ideep(i)) = maxg(i)
618+
pflx(ideep(i),pverp) = pflxg(i,pverp)
619+
end do
620+
615621
!----------------------------------------------------------------------------
616-
! Scatter microphysics data (i.e. undo the gathering)
622+
! scatter microphysics data (i.e. undo the gathering)
617623

618-
if (zm_param%zm_microp) then
619-
call zm_microp_st_scatter(loc_microp_st,microp_st,pcols,lengath,pver,ideep)
620-
! we also need to do a few miscellaneous things to the micro variables
621-
do i = 1,ncol
622-
do k = msg + 1,pver
623-
if(k.lt.pver) then
624-
! interpolate from interface to mid-point
625-
microp_st%wu(i,k) = 0.5_r8 * ( microp_st%wu(i,k) + microp_st%wu(i,k+1) )
626-
end if
627-
! convert freezing rate to a heating rate due to freezing => [K/s]
628-
microp_st%frz(i,k) = microp_st%frz(i,k) * zm_const%latice/zm_const%cpair
629-
end do
630-
end do
631-
end if
624+
if (zm_param%zm_microp) call zm_microp_st_scatter(loc_microp_st,microp_st,pcols,lengath,pver,ideep)
632625

633626
#ifdef CPRCRAY
634627
!DIR$ CONCURRENT
635628
#endif
636629

637-
do i = 1,lengath
638-
jctop(ideep(i)) = jt(i)
639-
jcbot(ideep(i)) = maxg(i)
640-
pflx(ideep(i),pverp) = pflxg(i,pverp)
641-
end do
642-
643630
!----------------------------------------------------------------------------
644631
! Compute precip by integrating change in water vapor minus detrained cloud water
645632
do i = 1,ncol

‎components/eam/src/physics/cam/zm_conv_intr.F90‎

Lines changed: 5 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -644,8 +644,6 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, &
644644
call t_stopf ('zm_convr')
645645

646646
if (zm_param%zm_microp) then
647-
! perform some miscellaneous conversions on the ZM microphysics data
648-
call zm_microphysics_history_convert(ncol, microp_st, state%pmid, state%t)
649647
! update ZM micro variables in pbuf
650648
qi (1:ncol,1:pver) = microp_st%qice (1:ncol,1:pver)
651649
dif (1:ncol,1:pver) = microp_st%dif (1:ncol,1:pver)
@@ -655,10 +653,12 @@ subroutine zm_conv_tend(pblh, mcon, cme, tpert, dlftot, pflx, zdu, &
655653
dnsf (1:ncol,1:pver) = microp_st%dnsf (1:ncol,1:pver)
656654
mudpcu (1:ncol,1:pver) = microp_st%mudpcu (1:ncol,1:pver)
657655
lambdadpcu(1:ncol,1:pver) = microp_st%lambdadpcu(1:ncol,1:pver)
656+
! perform some miscellaneous conversions on the ZM microphysics data
657+
call zm_microphysics_history_convert(ncol, microp_st, state%pmid, state%t)
658658
! update other micro variables
659-
rice(1:ncol) = microp_st%rice(1:ncol)
660-
dlftot(1:ncol,1:pver) = dlf(1:ncol,1:pver) + dif(1:ncol,1:pver) + dsf(1:ncol,1:pver)
661-
wuc(1:pcols,1:pver) = microp_st%wu(1:pcols,1:pver)
659+
wuc (1:ncol,1:pver) = microp_st%wu (1:ncol,1:pver)
660+
rice (1:ncol) = microp_st%rice (1:ncol)
661+
dlftot (1:ncol,1:pver) = dlf(1:ncol,1:pver) + dif(1:ncol,1:pver) + dsf(1:ncol,1:pver)
662662
else
663663
dlftot(1:ncol,1:pver) = dlf(1:ncol,1:pver)
664664
end if

‎components/eam/src/physics/cam/zm_microphysics_history.F90‎

Lines changed: 32 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -137,7 +137,7 @@ subroutine zm_microphysics_history_convert( ncol, microp_st, pmid, temperature )
137137
!----------------------------------------------------------------------------
138138
! Purpose: convert ZM microphysics prior to output
139139
!----------------------------------------------------------------------------
140-
use zm_conv, only: zm_const
140+
use zm_conv, only: zm_const, zm_param
141141
!----------------------------------------------------------------------------
142142
! Arguments
143143
integer, intent(in ) :: ncol ! number of columns in chunk
@@ -147,10 +147,13 @@ subroutine zm_microphysics_history_convert( ncol, microp_st, pmid, temperature )
147147
!----------------------------------------------------------------------------
148148
! Local variables
149149
integer :: i,k
150+
integer :: msg ! number of missing moisture levels at the top of model
150151
real(r8) :: rho
151152
!----------------------------------------------------------------------------
153+
msg = zm_param%limcnv - 1 ! set this to match zm_convr()
154+
152155
do i = 1,ncol
153-
do k = 1,pver
156+
do k = msg + 1,pver
154157
! Interpolate variable from interface to mid-layer.
155158
if (k<pver) then
156159
microp_st%qice (i,k) = 0.5_r8*(microp_st%qice (i,k)+microp_st%qice (i,k+1))
@@ -166,36 +169,35 @@ subroutine zm_microphysics_history_convert( ncol, microp_st, pmid, temperature )
166169
microp_st%wu (i,k) = 0.5_r8*(microp_st%wu (i,k)+microp_st%wu (i,k+1))
167170
end if
168171
! for levels at the freezing level move ice upward
169-
if (k>1) then
170-
if ( temperature(i,k).gt.zm_const%tfreez .and. temperature(i,k-1).le.zm_const%tfreez ) then
171-
microp_st%qice (i,k-1) = microp_st%qice (i,k-1) + microp_st%qice (i,k)
172-
microp_st%qni (i,k-1) = microp_st%qni (i,k-1) + microp_st%qni (i,k)
173-
microp_st%qsnow (i,k-1) = microp_st%qsnow (i,k-1) + microp_st%qsnow (i,k)
174-
microp_st%qns (i,k-1) = microp_st%qns (i,k-1) + microp_st%qns (i,k)
175-
microp_st%qgraupel(i,k-1) = microp_st%qgraupel(i,k-1) + microp_st%qgraupel(i,k)
176-
microp_st%qng (i,k-1) = microp_st%qng (i,k-1) + microp_st%qng (i,k)
177-
microp_st%qice (i,k) = 0._r8
178-
microp_st%qni (i,k) = 0._r8
179-
microp_st%qsnow (i,k) = 0._r8
180-
microp_st%qns (i,k) = 0._r8
181-
microp_st%qgraupel(i,k) = 0._r8
182-
microp_st%qng (i,k) = 0._r8
183-
end if
172+
if ( temperature(i,k).gt.zm_const%tfreez .and. temperature(i,k-1).le.zm_const%tfreez ) then
173+
microp_st%qice (i,k-1) = microp_st%qice (i,k-1) + microp_st%qice (i,k)
174+
microp_st%qni (i,k-1) = microp_st%qni (i,k-1) + microp_st%qni (i,k)
175+
microp_st%qsnow (i,k-1) = microp_st%qsnow (i,k-1) + microp_st%qsnow (i,k)
176+
microp_st%qns (i,k-1) = microp_st%qns (i,k-1) + microp_st%qns (i,k)
177+
microp_st%qgraupel(i,k-1) = microp_st%qgraupel(i,k-1) + microp_st%qgraupel(i,k)
178+
microp_st%qng (i,k-1) = microp_st%qng (i,k-1) + microp_st%qng (i,k)
179+
microp_st%qice (i,k) = 0._r8
180+
microp_st%qni (i,k) = 0._r8
181+
microp_st%qsnow (i,k) = 0._r8
182+
microp_st%qns (i,k) = 0._r8
183+
microp_st%qgraupel(i,k) = 0._r8
184+
microp_st%qng (i,k) = 0._r8
184185
end if
185186
end do ! k
186-
! Convert units from "kg/kg" to "g/m3"
187-
do k = 1,pver
188-
rho = pmid(i,k)/(temperature(i,k)*zm_const%rdair)
189-
microp_st%qice (i,k) = microp_st%qice(i,k) * rho *1000._r8
190-
microp_st%qliq (i,k) = microp_st%qliq(i,k) * rho *1000._r8
191-
microp_st%qrain (i,k) = microp_st%qrain(i,k) * rho *1000._r8
192-
microp_st%qsnow (i,k) = microp_st%qsnow(i,k) * rho *1000._r8
193-
microp_st%qgraupel(i,k) = microp_st%qgraupel(i,k) * rho *1000._r8
194-
microp_st%qni (i,k) = microp_st%qni(i,k) * rho
195-
microp_st%qnl (i,k) = microp_st%qnl(i,k) * rho
196-
microp_st%qnr (i,k) = microp_st%qnr(i,k) * rho
197-
microp_st%qns (i,k) = microp_st%qns(i,k) * rho
198-
microp_st%qng (i,k) = microp_st%qng(i,k) * rho
187+
! Convert units
188+
do k = msg + 1,pver
189+
microp_st%qice (i,k) = microp_st%qice(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair *1000._r8
190+
microp_st%qliq (i,k) = microp_st%qliq(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair *1000._r8
191+
microp_st%qrain (i,k) = microp_st%qrain(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair *1000._r8
192+
microp_st%qsnow (i,k) = microp_st%qsnow(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair *1000._r8
193+
microp_st%qgraupel(i,k) = microp_st%qgraupel(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair *1000._r8
194+
microp_st%qni (i,k) = microp_st%qni(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair
195+
microp_st%qnl (i,k) = microp_st%qnl(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair
196+
microp_st%qnr (i,k) = microp_st%qnr(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair
197+
microp_st%qns (i,k) = microp_st%qns(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair
198+
microp_st%qng (i,k) = microp_st%qng(i,k) * pmid(i,k)/temperature(i,k)/zm_const%rdair
199+
! convert freezing rate to a heating rate due to freezing => [K/s]
200+
microp_st%frz (i,k) = microp_st%frz(i,k) * zm_const%latice/zm_const%cpair
199201
end do ! k
200202
end do ! i
201203

0 commit comments

Comments
 (0)