Skip to content

Commit

Permalink
Merge pull request #4 from WenMeng-NOAA/upp_update_wen
Browse files Browse the repository at this point in the history 
Add more upp updates
  • Loading branch information
@SamuelTrahanNOAA
SamuelTrahanNOAA authored Jul 5, 2024
2 parents 5ec9abc + 4a7724e commit 4456e69
Show file tree
Hide file tree
Showing 2 changed files with 169 additions and 22 deletions.
189 changes: 168 additions & 21 deletions io/post_fv3.F90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -507,7 +507,7 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp)
use vrbls4d, only: dust, smoke, fv3dust, coarsepm, SALT, SUSO, SOOT, &
WASO,no3,nh4, PP25, PP10, ebb
use vrbls3d, only: t, q, uh, vh, wh, alpint, dpres, zint, zmid, o3, &
qqr, qqs, cwm, qqi, qqw, qqg, omga, cfr, pmid, &
qqr, qqs, cwm, qqi, qqw, qqg, qqh, omga, cfr, pmid, &
q2, rlwtt, rswtt, tcucn, tcucns, train, el_pbl, &
pint, exch_h, ref_10cm, qqni, qqnr, qqnw, qqnwfa, &
qqnifa, effri, effrl, effrs, aextc55, taod5503d, &
Expand Down Expand Up @@ -546,13 +546,15 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp)
sfcvxi, t10m, t10avg, psfcavg, akhsavg, akmsavg, &
albedo, tg, prate_max, pwat, snow_acm, snow_bkt, &
acgraup, graup_bucket, acfrain, frzrn_bucket, &
ltg1_max, ltg2_max, ltg3_max, hwp, &
ltg1_max, ltg2_max, ltg3_max, hwp, albedo, &
aod550,du_aod550,ss_aod550,su_aod550,oc_aod550, &
bc_aod550,maod, &
dustpm10, dustcb, bccb, occb, sulfcb, sscb, &
dustallcb, ssallcb, dustpm, sspm, pp25cb, pp10cb, &
no3cb, nh4cb, dusmass, ducmass, dusmass25,ducmass25, &
snownc, graupelnc, qrmax, hail_maxhailcast
snownc, graupelnc, qrmax, hail_maxhailcast, &
smoke_ave,dust_ave,coarsepm_ave,swddif,swddni, &
xlaixy
use soil, only: sldpth, sh2o, smc, stc, sllevel
use masks, only: lmv, lmh, htm, vtm, gdlat, gdlon, dx, dy, hbm2, sm, sice
use ctlblk_mod, only: im, jm, lm, lp1, jsta, jend, jsta_2l, jend_2u, jsta_m,jend_m, &
Expand Down Expand Up @@ -608,7 +610,8 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp)
real,dimension(:), allocatable :: slat,qstl
real,external::FPVSNEW
real,dimension(:,:),allocatable :: dummy, p2d, t2d, q2d, qs2d, &
cw2d, cfr2d, snacc_land, snacc_ice
cw2d, cfr2d, snacc_land, snacc_ice, &
acsnom_land, acsnom_ice
real,dimension(:,:,:),allocatable :: ext550
character(len=80) :: fieldname, wrtFBName, flatlon, &
VarName
Expand Down Expand Up @@ -691,15 +694,6 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp)
!Allocate for regional models only
if(modelname=='FV3R') then
allocate(ext550(ista:iend,jsta:jend,lm))
allocate(snacc_ice(ista:iend,jsta:jend))
allocate(snacc_land(ista:iend,jsta:jend))

do j=jsta,jend
do i=ista,iend
snacc_ice(i,j)=spval
snacc_land(i,j)=spval
end do
end do

do l=1,lm
do j=jsta,jend
Expand All @@ -710,6 +704,20 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp)
end do
endif

allocate(snacc_ice(ista:iend,jsta:jend))
allocate(snacc_land(ista:iend,jsta:jend))
allocate(acsnom_ice(ista:iend,jsta:jend))
allocate(acsnom_land(ista:iend,jsta:jend))

do j=jsta,jend
do i=ista,iend
snacc_ice(i,j)=spval
snacc_land(i,j)=spval
acsnom_ice(i,j)=spval
acsnom_land(i,j)=spval
end do
end do

!
! GFS doesn not yet output soil layer thickness, assign SLDPTH to be the same as nam
sldpth(1) = 0.10
Expand Down Expand Up @@ -1007,8 +1015,8 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp)
enddo
endif

! wildfire potential
if(trim(fieldname)=='hwp') then
! hourly wildfire potential
if(trim(fieldname)=='hwp_ave') then
!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,hwp,arrayr42d,fillValue,spval)
do j=jsta,jend
do i=ista, iend
Expand All @@ -1018,6 +1026,39 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp)
enddo
endif

!hourly averaged smoke
if(trim(fieldname)=='smoke_ave') then
!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,smoke_ave,arrayr42d,fillValue,spval)
do j=jsta,jend
do i=ista, iend
smoke_ave(i,j)=arrayr42d(i,j)
if(abs(arrayr42d(i,j)-fillValue) < small) smoke_ave(i,j)=spval
enddo
enddo
endif

!hourly averaged dust
if(trim(fieldname)=='dust_ave') then
!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,dust_ave,arrayr42d,fillValue,spval)
do j=jsta,jend
do i=ista, iend
dust_ave(i,j)=arrayr42d(i,j)
if(abs(arrayr42d(i,j)-fillValue) < small) dust_ave(i,j)=spval
enddo
enddo
endif

!hourly averaged coarsepm
if(trim(fieldname)=='coarsepm_ave') then
!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,coarsepm_ave,arrayr42d,fillValue,spval)
do j=jsta,jend
do i=ista, iend
coarsepm_ave(i,j)=arrayr42d(i,j)
if(abs(arrayr42d(i,j)-fillValue) < small) coarsepm_ave(i,j)=spval
enddo
enddo
endif

! frictional velocity
if(trim(fieldname)=='fricv') then
!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,ustar,arrayr42d,fillValue,spval)
Expand Down Expand Up @@ -1062,6 +1103,17 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp)
enddo
endif

! surface albedo
if(trim(fieldname)=='sfalb') then
!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,albedo,arrayr42d,fillValue,spval)
do j=jsta,jend
do i=ista, iend
albedo(i,j)=arrayr42d(i,j)
if(abs(arrayr42d(i,j)-fillValue) < small) albedo(i,j)=spval
enddo
enddo
endif

! surface potential T
if(trim(fieldname)=='tmpsfc') then
!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,arrayr42d,ths,fillValue,spval)
Expand Down Expand Up @@ -2009,6 +2061,50 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp)
enddo
endif

! inst incoming clear sky sfc shortwave
if(trim(fieldname)=='dswrf_clr') then
!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,rswinc,arrayr42d,fillValue,spval)
do j=jsta,jend
do i=ista, iend
rswinc(i,j) = arrayr42d(i,j)
if( abs(arrayr42d(i,j)-fillValue) < small) rswinc(i,j) = spval
enddo
enddo
endif

! inst incoming direct beam sfc shortwave
if(trim(fieldname)=='visbmdi') then
!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,swddni,arrayr42d,fillValue,spval)
do j=jsta,jend
do i=ista, iend
swddni(i,j) = arrayr42d(i,j)
if( abs(arrayr42d(i,j)-fillValue) < small) swddni(i,j) = spval
enddo
enddo
endif

! inst incoming diffuse sfc shortwave
if(trim(fieldname)=='visdfdi') then
!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,swddif,arrayr42d,fillValue,spval)
do j=jsta,jend
do i=ista, iend
swddif(i,j) = arrayr42d(i,j)
if( abs(arrayr42d(i,j)-fillValue) < small) swddif(i,j) = spval
enddo
enddo
endif

! leaf area index
if(trim(fieldname)=='xlaixy') then
!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,xlaixy,arrayr42d,fillValue,spval)
do j=jsta,jend
do i=ista, iend
xlaixy(i,j) = arrayr42d(i,j)
if( abs(arrayr42d(i,j)-fillValue) < small) xlaixy(i,j) = spval
enddo
enddo
endif

! time averaged incoming sfc uv-b
if(trim(fieldname)=='duvb_ave') then
!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,auvbin,arrayr42d,fillValue,spval)
Expand Down Expand Up @@ -2305,8 +2401,6 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp)
enddo
endif

if(modelname=='FV3R')then

!sndepac
if(trim(fieldname)=='snacc_land') then
!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,snacc_land,arrayr42d,fillvalue,spval)
Expand All @@ -2327,7 +2421,25 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp)
enddo
endif

endif !FV3R
!snom
if(trim(fieldname)=='snom_land') then
!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acsnom_land,arrayr42d,fillvalue,spval)
do j=jsta,jend
do i=ista, iend
acsnom_land(i,j) = arrayr42d(i,j)
if(abs(arrayr42d(i,j)-fillvalue)<small) acsnom_land(i,j) = spval
enddo
enddo
endif
if(trim(fieldname)=='snom_ice') then
!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,acsnom_ice,arrayr42d,fillvalue,spval)
do j=jsta,jend
do i=ista, iend
acsnom_ice(i,j) = arrayr42d(i,j)
if(abs(arrayr42d(i,j)-fillvalue)<small) acsnom_ice(i,j) = spval
enddo
enddo
endif

if(rdaod) then
! MERRA2 aerosols
Expand Down Expand Up @@ -3711,6 +3823,19 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp)
enddo
endif

! model level hail mixing ratio
if(trim(fieldname)=='hail') then
!$omp parallel do default(none) private(i,j,l) shared(lm,jsta,jend,ista,iend,qqh,arrayr43d,fillvalue,spval)
do l=1,lm
do j=jsta,jend
do i=ista, iend
qqh(i,j,l) = arrayr43d(i,j,l)
if(abs(arrayr43d(i,j,l)-fillvalue)<small) qqh(i,j,l) = spval
enddo
enddo
enddo
endif

if(imp_physics == 8) then
! model level rain water number
if(trim(fieldname)=='rain_nc') then
Expand Down Expand Up @@ -4413,12 +4538,15 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp)
enddo
enddo
do l=1,lm
!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qrmax,qqg,qqs,qqr,qqi,qqw,spval)
!$omp parallel do default(none) private(i,j) shared(l,jsta,jend,ista,iend,cwm,qrmax,qqg,qqs,qqr,qqi,qqw,qqh,spval)
do j=jsta,jend
do i=ista,iend
if( qqr(i,j,l) /= spval) then
cwm(i,j,l) = qqg(i,j,l)+qqs(i,j,l)+qqr(i,j,l)+qqi(i,j,l)+qqw(i,j,l)
qrmax(i,j)=max(qrmax(i,j),qqr(i,j,l))
if(qqh(i,j,l) /= spval) then
cwm(i,j,l) = cwm(i,j,l)+qqh(i,j,l)
endif
else
cwm(i,j,l) = spval
endif
Expand Down Expand Up @@ -4488,6 +4616,8 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp)
enddo
enddo
enddo
deallocate(ext550)
endif !end FV3R

!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,snacc_ice,snacc_land,sndepac)
do j=jsta,jend
Expand All @@ -4502,11 +4632,24 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp)
enddo
enddo

deallocate(ext550)
!$omp parallel do default(none) private(i,j) shared(jsta,jend,ista,iend,spval,acsnom_ice,acsnom_land,acsnom)
do j=jsta,jend
do i=ista, iend
if(acsnom_land(i,j)<spval) then
acsnom(i,j) = acsnom_land(i,j)
elseif(acsnom_ice(i,j)<spval) then
acsnom(i,j) = acsnom_ice(i,j)
else
acsnom(i,j) = spval
endif
enddo
enddo

deallocate(snacc_ice)
deallocate(snacc_land)
deallocate(acsnom_ice)
deallocate(acsnom_land)

endif !end FV3R

! chmical field computation
if(gocart_on .or. gccpp_on .or. nasa_on) then
Expand Down Expand Up @@ -4579,6 +4722,10 @@ subroutine set_postvars_fv3(wrt_int_state,grid_id,mype,mpicomp)
no3(i,j,l,3)<spval) then
no3cb(i,j)=no3cb(i,j)+ (no3(i,j,l,1)+no3(i,j,l,2)+ &
no3(i,j,l,3) ) * dpres(i,j,l)/grav
else
no3(i,j,l,1)=0.
no3(i,j,l,2)=0.
no3(i,j,l,3)=0.
endif
if(nh4(i,j,l,1)<spval)then
nh4cb(i,j)=nh4cb(i,j)+ nh4(i,j,l,1)* &
Expand Down
2 changes: 1 addition & 1 deletion upp
Submodule upp updated 10 files
+4 −3 ci/rt.sh
+5 −2 modulefiles/orion.lua
+3 −1 sorc/ncep_post.fd/CALGUST.f
+4 −1 sorc/ncep_post.fd/CALUPDHEL.f
+14 −5 sorc/ncep_post.fd/INITPOST_NETCDF.f
+4 −0 sorc/ncep_post.fd/MDLFLD.f
+4 −3 tests/detect_machine.sh
+56 −56 tests/logs/rt.log.HERA
+56 −56 tests/logs/rt.log.HERCULES
+56 −56 tests/logs/rt.log.ORION

0 comments on commit 4456e69

Please sign in to comment.