Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
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
189 changes: 168 additions & 21 deletions io/post_fv3.F90
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