Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

MPAS applications: fixes for absolute vorticity and surface latent-heat flux #1069

Merged
merged 9 commits into from
Oct 22, 2024
23 changes: 10 additions & 13 deletions sorc/ncep_post.fd/INITPOST_MPAS.F
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,7 @@
!> 2024-08-30 | Jaymes Kenyon| Add processing for lat-lon projection
!> 2024-08-30 | Jaymes Kenyon| Add temporary hard coding of SLLEVEL (for RUC LSM) and PREC_ACC_DT
!> 2024-09-09 | Eric James | Add checks for missing values before entering some computations
!> 2024-10-16 | Jaymes Kenyon| Missing-value checks for wind interp, fix to LH flux
!>
!> @author Jaymes Kenyon (GSL) @date 2024-08-14

Expand Down Expand Up @@ -287,7 +288,11 @@ SUBROUTINE INITPOST_MPAS
! fill up UH which is U at P-points including 2 row halo
do j = jsta_2l, jend_2u
do i = 1, im
UH (I,J,L) = (dum3d(I,J,L)+dum3d(I+1,J,L))*0.5
if (dum3d(I,J,L) < SPVAL .AND. dum3d(I+1,J,L) < SPVAL) then
UH (I,J,L) = (dum3d(I,J,L)+dum3d(I+1,J,L))*0.5
else
UH (I,J,L) = SPVAL
endif
end do
end do
end do
Expand All @@ -304,7 +309,11 @@ SUBROUTINE INITPOST_MPAS
! fill up VH which is V at P-points including 2 row halo
do j = jsta_2l, jend_2u
do i = 1, im
if (dum3d(I,J,L) < SPVAL .AND. dum3d(I,J+1,L) < SPVAL) then
VH(I,J,L) = (dum3d(I,J,L)+dum3d(I,J+1,L))*0.5
else
VH(I,J,L) = SPVAL
endif
end do
end do
end do
Expand Down Expand Up @@ -2624,26 +2633,14 @@ SUBROUTINE INITPOST_MPAS
end do

! latent heat flux
IF(iSF_SURFACE_PHYSICS/=3) then
VarName='LH'
call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, &
IM,1,JM,1,IM,JS,JE,1)
do j = jsta_2l, jend_2u
do i = 1, im
QWBS(I,J) = dummy ( i, j )
! SFCLHX ( i, j ) = dummy ( i, j )
end do
end do
else
VarName='QFX'
call getVariable(fileName,DateStr,DataHandle,VarName,DUMMY, &
IM,1,JM,1,IM,JS,JE,1)
do j = jsta_2l, jend_2u
do i = 1, im
QWBS(I,J) = dummy ( i, j ) * LHEAT
end do
end do
ENDIF

! ground heat fluxes
VarName='GRDFLX'
Expand Down
18 changes: 5 additions & 13 deletions sorc/ncep_post.fd/UPP_PHYSICS.f
Original file line number Diff line number Diff line change
Expand Up @@ -1737,6 +1737,7 @@ end function TVIRTUAL
!> 2019-10-17 | Y Mao | Skip calculation when U/V is SPVAL
!> 2020-11-06 | J Meng | Use UPP_MATH Module
!> 2022-05-26 | H Chuang | Use GSL approach for FV3R
!> 2024-10-16 | J Kenyon | In CALVOR, initialize ABSV as SPVAL, regardless of "modelname"
!>
!> @author Russ Treadon W/NP2 @date 1992-12-22

Expand Down Expand Up @@ -1773,21 +1774,12 @@ SUBROUTINE CALVOR(UWND,VWND,ABSV)
!
! LOOP TO COMPUTE ABSOLUTE VORTICITY FROM WINDS.
!
IF(MODELNAME == 'RAPR') then
WenMeng-NOAA marked this conversation as resolved.
Show resolved Hide resolved
!$omp parallel do private(i,j)
DO J=JSTA_2L,JEND_2U
DO I=ISTA_2L,IEND_2U
ABSV(I,J) = D00
ENDDO
DO J=JSTA_2L,JEND_2U
DO I=ISTA_2L,IEND_2U
ABSV(I,J) = SPVAL
ENDDO
else
!$omp parallel do private(i,j)
DO J=JSTA_2L,JEND_2U
DO I=ISTA_2L,IEND_2U
ABSV(I,J) = SPVAL
ENDDO
ENDDO
endif
ENDDO

CALL EXCH(UWND)
CALL EXCH(VWND)
Expand Down
Loading