Skip to content
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 6 additions & 2 deletions sorc/ncep_post.fd/INITPOST_NETCDF.f
Original file line number Diff line number Diff line change
Expand Up @@ -114,7 +114,7 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice
use physcons_post, only: grav => con_g, fv => con_fvirt, rgas => con_rd, &
eps => con_eps, epsm1 => con_epsm1
use params_mod, only: erad, dtr, tfrz, h1, d608, rd, p1000, capa,pi
use params_mod, only: erad, dtr, tfrz, h1, d608, rd, p1000, capa,pi, small
use lookup_mod, only: thl, plq, ptbl, ttbl, rdq, rdth, rdp, rdthe, pl, qs0, sqs, sthe, &
ttblq, rdpq, rdtheq, stheq, the0q, the0
use ctlblk_mod, only: me, mpi_comm_comp, icnt, idsp, jsta, jend, ihrst, idat, sdat, ifhr, &
Expand Down Expand Up @@ -1220,9 +1220,13 @@ SUBROUTINE INITPOST_NETCDF(ncid2d,ncid3d)
do i=ista,iend
if(zint(i,j,l+1)/=spval .and. zint(i,j,l)/=spval &
.and. pmid(i,j,l)/=spval)then
zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* &
if (abs(zint(i,j,l+1)-zint(i,j,l)) < small) then
zmid(i,j,l)=zint(i,j,l)
else
zmid(i,j,l)=zint(i,j,l+1)+(zint(i,j,l)-zint(i,j,l+1))* &
(log(pmid(i,j,l))-alpint(i,j,l+1))/ &
(alpint(i,j,l)-alpint(i,j,l+1))
endif
if(zmid(i,j,l)>1.0E6)print*,'bad Hmid ',i,j,l,zmid(i,j,l)
else
zmid(i,j,l)=spval
Expand Down
10 changes: 7 additions & 3 deletions sorc/ncep_post.fd/UPP_PHYSICS.f
Original file line number Diff line number Diff line change
Expand Up @@ -5010,7 +5010,8 @@ subroutine calslr_uutah2(slr)
real,dimension(ista:iend,jsta:jend,nfl) :: tfd,ufd,vfd,pfd,qfd,rhfd
real,dimension(ista:iend,jsta:jend) :: zsfc

real lhl(nfl),dzabh(nfl),swnd(nfl)
integer lhl(nfl)
real dzabh(nfl),swnd(nfl)
real htsfc,htabh,dz,rdz,delt,delu,delv,delp,delq

real, parameter :: s03 = 0.2113589753880838
Expand Down Expand Up @@ -5076,21 +5077,24 @@ subroutine calslr_uutah2(slr)
htsfc = zint(i,j,lm+1)
llmh = nint(lmh(i,j))
ifd = 1
lhl=llmh
do l = llmh,1,-1
if(zmid(i,j,l)<spval) then
htabh = zmid(i,j,l)-htsfc
if(htabh>htfl(ifd)) then
if(htabh>=htfl(ifd)) then
lhl(ifd) = l
dzabh(ifd) = htabh-htfl(ifd)
ifd = ifd + 1
endif
endif
if(ifd > nfl) exit
enddo

! compute t, u, v at fd levels.

do ifd = 1,nfl
l = lhl(ifd)
if (l<lm .and. t(i,j,l)<spval .and. uh(i,j,l)<spval .and. vh(i,j,l)<spval) then
if (l<lm .and. t(i,j,l)<spval .and. uh(i,j,l)<spval .and. vh(i,j,l)<spval .and. zmid(i,j,l)<spval) then
dz = zmid(i,j,l)-zmid(i,j,l+1)
rdz = 1./dz
delt = t(i,j,l)-t(i,j,l+1)
Expand Down