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.

Sign up for GitHub

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

Restrict UPP computation from undefined points #306

Merged
merged 11 commits into from
May 3, 2021
Merged

Restrict UPP computation from undefined points #306

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
11 commits
Select commit Hold shift + click to select a range
6b6e297
20210414 Jesse Meng commit progress for Issue #240 restrict post comp…
JesseMeng-NOAA Apr 14, 2021
1915724
Merge remote-tracking branch 'upstream/develop' into feature/post_ref…
JesseMeng-NOAA Apr 14, 2021
1e91749
20210416 Jesse Meng commit progress for "restrict post computation fr…
Apr 16, 2021
e1038d8
Merge remote-tracking branch 'upstream/develop' into HEAD
Apr 16, 2021
2d7888e
20210422 Jesse Meng commit progress for #240 restrict post computatio…
Apr 23, 2021
54bf17b
20210422 Jesse Meng Merge remote-tracking branch 'upstream/develop' i…
Apr 23, 2021
bdf6558
20210423 Jesse Meng fix bug in CALVIS_GSD PR#306
Apr 23, 2021
e45b236
20210426 Jesse Meng Merge remote-tracking branch 'upstream/develop' i…
Apr 26, 2021
6ae0de9
20210427 Jesse Meng commit EMC_post issue #240 restrict post computat…
Apr 27, 2021
7dd1428
20210429 Jesse Meng fix instantaneous surface SW in CLDRAD.f
Apr 29, 2021
9d5a1ee
20210430 Jesse Meng Merge remote-tracking branch 'upstream/develop' i…
Apr 30, 2021
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
100 changes: 91 additions & 9 deletions sorc/ncep_post.fd/AVIATION.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@
!! SUBPROGRAM: CALLLWS COMPUTES Low Level Wind Shear (0-2000feet)
!! PRGRMMR: Binbin Zhou /NCEP/EMC DATE: 2005-08-16
!! 19-10-30 Bo CUI - REMOVE "GOTO" STATEMENT
!! 21-04-01 Jesse Meng - computation on defined points only
!!
!! ABSTRACT:
!! This program computes the low level wind shear(LLWS) over 0-2000 feet (0-609.5m)
Expand Down Expand Up @@ -83,7 +84,7 @@ SUBROUTINE CALLLWS(U,V,H,LLWS)
!
USE vrbls2d, only: fis, u10, v10
use params_mod, only: gi
use ctlblk_mod, only: jsta, jend, im, jm, lsm
use ctlblk_mod, only: jsta, jend, im, jm, lsm, spval
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
Expand Down Expand Up @@ -137,9 +138,10 @@ SUBROUTINE CALLLWS(U,V,H,LLWS)
END IF

!computer vector difference
610 LLWS(I,J)=SQRT((U2-U10(I,J))**2+(V2-V10(I,J))**2)/ &
LLWS(I,J) = spval
if(U10(I,J)<spval.and.V10(I,J)<spval) &
LLWS(I,J)=SQRT((U2-U10(I,J))**2+(V2-V10(I,J))**2)/ &
609.6 * 1.943*609.6 !unit: knot/2000ft

ENDDO

100 CONTINUE
Expand Down Expand Up @@ -194,7 +196,7 @@ SUBROUTINE CALICING (T1,RH,OMGA, ICING)
! MACHINE : BLUE AT NCEP
!$$$
!
use ctlblk_mod, only: jsta, jend, im
use ctlblk_mod, only: jsta, jend, im, spval
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
Expand All @@ -208,7 +210,7 @@ SUBROUTINE CALICING (T1,RH,OMGA, ICING)
!
DO J=JSTA,JEND
DO I=1,IM

IF(OMGA(I,J)<SPVAL.AND.T1(I,J)<SPVAL.AND.RH(I,J)<SPVAL) THEN
IF(OMGA(I,J) < 0.0 .AND. &
(T1(I,J) <= 273.0 .AND. T1(I,J) >= 251.0) &
.AND. RH(I,J) >= 70.0) THEN
WenMeng-NOAA marked this conversation as resolved.
Show resolved Hide resolved
Expand All @@ -217,6 +219,9 @@ SUBROUTINE CALICING (T1,RH,OMGA, ICING)
ELSE
ICING(I,J) = 0.0
END IF
ELSE
ICING(I,J) = SPVAL
ENDIF
ENDDO
ENDDO

Expand Down Expand Up @@ -335,6 +340,8 @@ SUBROUTINE CALCAT(U,V,H,U_OLD,V_OLD,H_OLD,CAT)
DO I=ISTART,ISTOP
!
IF(GRIDTYPE=='B')THEN
IF(U(I,J)<spval.and.U(I,J-1)<spval.and.U(I-1,J)<spval.and.U(I-1,J-1)<spval.and.&
V(I,J)<spval.and.V(I,J-1)<spval.and.V(I-1,J)<spval.and.V(I-1,J-1)<spval)THEN
!dsh=dv/dx+du/dy
DSH=(0.5*(V(I,J)+V(I,J-1))-0.5*(V(I-1,J)+V(I-1,J-1)))*10000./DX(I,J) &
+(0.5*(U(I,J)+U(I-1,J))-0.5*(U(I,J-1)+U(I-1,J-1)))*10000./DY(I,J)
Expand All @@ -346,7 +353,13 @@ SUBROUTINE CALCAT(U,V,H,U_OLD,V_OLD,H_OLD,CAT)
!cvg=-(du/dx+dv/dy)
CVG = -((0.5*(U(I,J)+U(I,J-1))-0.5*(U(I-1,J)+U(I-1,J-1)))*10000./DX(I,J) &
+(0.5*(V(I,J)+V(I-1,J))-0.5*(V(I,J-1)+V(I-1,J-1)))*10000./DY(I,J))
ELSE
DEF = SPVAL
WenMeng-NOAA marked this conversation as resolved.
Show resolved Hide resolved
CVG = SPVAL
ENDIF
ELSE
IF(U(I,J+1)<spval.and.U(I,J-1)<spval.and.U(I+IHE(J),J)<spval.and.U(I+IHW(J),J)<spval.and.&
V(I,J+1)<spval.and.V(I,J-1)<spval.and.V(I+IHE(J),J)<spval.and.V(I+IHW(J),J)<spval)THEN
!dsh=dv/dx+du/dy
DSH = (V(I+IHE(J),J) - V(I+IHW(J),J))*10000./(2*DX(I,J)) &
+ (U(I,J+1) - U(I,J-1))*10000./(2*DY(I,J))
Expand All @@ -360,42 +373,106 @@ SUBROUTINE CALCAT(U,V,H,U_OLD,V_OLD,H_OLD,CAT)
!cvg=-(du/dx+dv/dy)
CVG = -( (U(I+IHE(J),J) - U(I+IHW(J),J))*10000./(2*DX(I,J)) &
+(V(I,J+1) - V(I,J-1))*10000./(2*DY(I,J)) )
ELSE
DEF = SPVAL
WenMeng-NOAA marked this conversation as resolved.
Show resolved Hide resolved
CVG = SPVAL
ENDIF
END IF

IF(GRIDTYPE == 'A')THEN
!vws=d|U|/dz
IF(U_OLD(I,J)<spval.and.U(I,J)<spval.and.&
V_OLD(I,J)<spval.and.V(I,J)<spval.and.&
H_OLD(I,J)<spval.and.H(I,J)<spval)THEN
VWS = ( SQRT(U_OLD(I,J)**2+V_OLD(I,J)**2 ) - &
SQRT(U(I,J)**2+V(I,J)**2 ) ) * &
1000.0/(H_OLD(I,J) - H(I,J))
ELSE
VWS = SPVAL
ENDIF
else IF(GRIDTYPE == 'E')THEN
!vws=d|U|/dz
IF(U_OLD(I+IHE(J),J)<spval.and.U(I+IHE(J),J)<spval.and.&
V_OLD(I+IHE(J),J)<spval.and.V(I+IHE(J),J)<spval)THEN

VWS1 = ( SQRT(U_OLD(I+IHE(J),J)**2+V_OLD(I+IHE(J),J)**2 ) -&
SQRT(U(I+IHE(J),J)**2+V(I+IHE(J),J)**2 ) )
ELSE
VWS1 = SPVAL
ENDIF
!vws=d|U|/dz
IF(U_OLD(I+IHW(J),J)<spval.and.U(I+IHW(J),J)<spval.and.&
V_OLD(I+IHW(J),J)<spval.and.V(I+IHW(J),J)<spval)THEN
VWS2 = ( SQRT(U_OLD(I+IHW(J),J)**2+V_OLD(I+IHW(J),J)**2 ) -&
SQRT(U(I+IHW(J),J)**2+V(I+IHW(J),J)**2 ) )
ELSE
VWS2 = SPVAL
ENDIF
!vws=d|U|/dz
IF(U_OLD(I,J-1)<spval.and.U(I,J-1)<spval.and.&
V_OLD(I,J-1)<spval.and.V(I,J-1)<spval)THEN
VWS3 = ( SQRT(U_OLD(I,J-1)**2+V_OLD(I,J-1)**2 ) - &
SQRT(U(I,J-1)**2+V(I,J-1)**2 ) )
ELSE
VWS3 = SPVAL
ENDIF
!vws=d|U|/dz
IF(U_OLD(I,J+1)<spval.and.U(I,J+1)<spval.and.&
V_OLD(I,J+1)<spval.and.V(I,J+1)<spval)THEN
VWS4 = ( SQRT(U_OLD(I,J+1)**2+V_OLD(I,J+1)**2 ) - &
SQRT(U(I,J+1)**2+V(I,J+1)**2 ) )
ELSE
VWS4 = SPVAL
ENDIF

IF(VWS1<spval.and.VWS2<spval.and.VWS3<spval.and.VWS4<spval.and.&
H_OLD(I,J)<spval.and.H(I,J)<spval)THEN
VWS=1000.0*(VWS1+VWS2+VWS3+VWS4)/4.0/(H_OLD(I,J) - H(I,J))
ELSE
VWS = SPVAL
ENDIF
ELSE IF(GRIDTYPE == 'B')THEN
IF(U_OLD(I+IHE(J),J)<spval.and.U(I+IHE(J),J)<spval.and.&
V_OLD(I+IHE(J),J)<spval.and.V(I+IHE(J),J)<spval)THEN
VWS1 = ( SQRT(U_OLD(I+IHE(J),J)**2+V_OLD(I+IHE(J),J)**2 ) -&
SQRT(U(I+IHE(J),J)**2+V(I+IHE(J),J)**2 ) )
ELSE
VWS1 = SPVAL
ENDIF
!vws=d|U|/dz
IF(U_OLD(I+IHW(J),J)<spval.and.U(I+IHW(J),J)<spval.and.&
V_OLD(I+IHW(J),J)<spval.and.V(I+IHW(J),J)<spval)THEN
VWS2 = ( SQRT(U_OLD(I+IHW(J),J)**2+V_OLD(I+IHW(J),J)**2 ) -&
SQRT(U(I+IHW(J),J)**2+V(I+IHW(J),J)**2 ) )
ELSE
VWS2 = SPVAL
ENDIF
!vws=d|U|/dz
IF(U_OLD(I,J-1)<spval.and.U(I,J-1)<spval.and.&
V_OLD(I,J-1)<spval.and.V(I,J-1)<spval)THEN
VWS3 = ( SQRT(U_OLD(I,J-1)**2+V_OLD(I,J-1)**2 ) - &
SQRT(U(I,J-1)**2+V(I,J-1)**2 ) )
ELSE
VWS3 = SPVAL
ENDIF
!vws=d|U|/dz
IF(U_OLD(I-1,J-1)<spval.and.U(I-1,J-1)<spval.and.&
V_OLD(I-1,J-1)<spval.and.V(I-1,J-1)<spval)THEN
VWS4 = ( SQRT(U_OLD(I-1,J-1)**2+V_OLD(I-1,J-1)**2 ) - &
SQRT(U(I-1,J-1)**2+V(I-1,J-1)**2 ) )
ELSE
VWS4 = SPVAL
ENDIF

IF(VWS1<spval.and.VWS2<spval.and.VWS3<spval.and.VWS4<spval.and.&
H_OLD(I,J)<spval.and.H(I,J)<spval)THEN
VWS=1000.0*(VWS1+VWS2+VWS3+VWS4)/4.0/(H_OLD(I,J) - H(I,J))
ELSE
VWS=SPVAL
ENDIF
END IF


IF(VWS<spval.and.DEF<spval.and.CVG<spval)THEN
TRBINDX = ABS(VWS)*(DEF + ABS(CVG))

IF(TRBINDX<=4.) THEN
Expand All @@ -407,7 +484,9 @@ SUBROUTINE CALCAT(U,V,H,U_OLD,V_OLD,H_OLD,CAT)
ELSE
CAT(I,J)=3.0
END IF

ELSE
CAT(I,J)=SPVAL
ENDIF
ENDDO

100 CONTINUE
Expand Down Expand Up @@ -526,7 +605,7 @@ SUBROUTINE CALFLTCND (CEILING,FLTCND)
!$$$
!
use vrbls2d, only: vis
use ctlblk_mod, only: jsta, jend, im
use ctlblk_mod, only: jsta, jend, im, spval
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
!
Expand All @@ -543,6 +622,7 @@ SUBROUTINE CALFLTCND (CEILING,FLTCND)
DO J=JSTA,JEND
DO I=1,IM

IF(CEILING(I,J)<spval.and.VIS(I,J)<spval)THEN
CEIL = CEILING(I,J) * 3.2808 !from m -> feet
VISI = VIS(I,J) / 1609.0 !from m -> miles

Expand All @@ -561,7 +641,9 @@ SUBROUTINE CALFLTCND (CEILING,FLTCND)
FLTCND(I,J) = 4.0

END IF

ELSE
FLTCND(I,J) = SPVAL
ENDIF
ENDDO
ENDDO

Expand Down
31 changes: 31 additions & 0 deletions sorc/ncep_post.fd/BNDLYR.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -31,6 +31,7 @@
!! 00-01-04 JIM TUCCILLO - MPI VERSION
!! 02-01-15 MIKE BALDWIN - WRF VERSION
!! 20-11-10 JESSE MENG - USE UPP_PHYSICS MODULE
!! 21-04-01 JESSE MENG - COMPUTATION ON DEFINED POINTS ONLY
!!
!! USAGE: CALL BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND,
!! WBND,OMGBND,PWTBND,QCNVBND)
Expand Down Expand Up @@ -273,6 +274,8 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
DO J=JSTA,JEND
DO I=1,IM
IF(PSUM(I,J,LBND)/=0.)THEN
IF(T(I,J,LBND)<spval.and.Q(I,J,LBND)<spval.and.&
UH(I,J,LBND)<spval.and.VH(I,J,LBND)<spval) THEN
RPSUM = 1./PSUM(I,J,LBND)
LVLBND(I,J,LBND)= LVLBND(I,J,LBND)/NSUM(I,J,LBND)
PBND(I,J,LBND) = (PBINT(I,J,LBND)+PBINT(I,J,LBND+1))*0.5
Expand All @@ -286,6 +289,17 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
END IF
WBND(I,J,LBND) = WBND(I,J,LBND)*RPSUM
QCNVBND(I,J,LBND) = QCNVBND(I,J,LBND)*RPSUM
WenMeng-NOAA marked this conversation as resolved.
Show resolved Hide resolved
ELSE
LVLBND(I,J,LBND)= spval
PBND(I,J,LBND) = spval
TBND(I,J,LBND) = spval
QBND(I,J,LBND) = spval
OMGBND(I,J,LBND)= spval
UBND(I,J,LBND) = spval
VBND(I,J,LBND) = spval
WBND(I,J,LBND) = spval
QCNVBND(I,J,LBND)= spval
ENDIF
ENDIF
ENDDO
ENDDO
Expand All @@ -294,9 +308,14 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
DO J=JSTA_M,JEND_M
DO I=2,IM-1
IF(PVSUM(I,J,LBND)/=0.)THEN
IF(UBND(I,J,LBND)<spval.and.VBND(I,J,LBND)<spval.and.PVSUM(I,J,LBND)<spval)THEN
RPVSUM = 1./PVSUM(I,J,LBND)
UBND(I,J,LBND) = UBND(I,J,LBND)*RPVSUM
VBND(I,J,LBND) = VBND(I,J,LBND)*RPVSUM
WenMeng-NOAA marked this conversation as resolved.
Show resolved Hide resolved
ELSE
UBND(I,J,LBND) = spval
VBND(I,J,LBND) = spval
ENDIF
ENDIF
ENDDO
ENDDO
Expand Down Expand Up @@ -336,6 +355,7 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
VBND(I,J,LBND) = VH(I,J,L)
END IF
WBND(I,J,LBND) = WH(I,J,L)
IF(T(I,J,LBND)<spval.and.Q(I,J,LBND)<spval)THEN
QCNVBND(I,J,LBND) = QCNVG(I,J,L)
IF(MODELNAME == 'GFS' .OR. MODELNAME == 'FV3R')THEN
ES = FPVSNEW(T(I,J,L))
Expand All @@ -347,10 +367,17 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
QSBND(I,J,LBND) = QSAT
OMGBND(I,J,LBND) = OMGA(I,J,L)
PWTBND(I,J,LBND) = (Q(I,J,L)+CWM(I,J,L))*DP*GI
ELSE
QCNVBND(I,J,LBND)= spval
QSBND(I,J,LBND) = spval
OMGBND(I,J,LBND) = spval
PWTBND(I,J,LBND) = spval
ENDIF
ENDIF
!
! RH, BOUNDS CHECK
!
IF(T(I,J,LBND)<spval.and.Q(I,J,LBND)<spval)THEN
RHBND(I,J,LBND) = QBND(I,J,LBND)/QSBND(I,J,LBND)
IF (RHBND(I,J,LBND)>1.0) THEN
RHBND(I,J,LBND) = 1.0
Expand All @@ -360,6 +387,10 @@ SUBROUTINE BNDLYR(PBND,TBND,QBND,RHBND,UBND,VBND, &
RHBND(I,J,LBND) = 0.01
QBND(I,J,LBND) = RHBND(I,J,LBND)*QSBND(I,J,LBND)
ENDIF
ELSE
RHBND(I,J,LBND) = spval
QBND(I,J,LBND) = spval
ENDIF
ENDDO
ENDDO
!
Expand Down
6 changes: 5 additions & 1 deletion sorc/ncep_post.fd/CALHEL.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -84,7 +84,7 @@ SUBROUTINE CALHEL(DEPTH,UST,VST,HELI,USHR1,VSHR1,USHR6,VSHR6)
use params_mod, only: g
use lookup_mod, only: ITB,JTB,ITBQ,JTBQ
use ctlblk_mod, only: jsta, jend, jsta_m, jend_m, jsta_2l, jend_2u, &
lm, im, jm, me
lm, im, jm, me, spval
use gridspec_mod, only: gridtype
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
Expand Down Expand Up @@ -444,6 +444,10 @@ SUBROUTINE CALHEL(DEPTH,UST,VST,HELI,USHR1,VSHR1,USHR6,VSHR6)
DU2 = UH(I,J,L)-UH(I,J,L-1)
DV1 = VH(I,J,L+1)-VH(I,J,L)
DV2 = VH(I,J,L)-VH(I,J,L-1)
IF( VH(I,J,L) <spval.and.UH(I,J,L) <spval.and. &
VH(I,J,L+1)<spval.and.UH(I,J,L+1)<spval.and. &
VH(I,J,L-1)<spval.and.UH(I,J,L-1)<spval.and. &
VST(I,J) <spval.and.UST(I,J) <spval) &
HELI(I,J,N) = ((VH(I,J,L)-VST(I,J))* &
(DZ2*(DU1/DZ1)+DZ1*(DU2/DZ2)) &
- (UH(I,J,L)-UST(I,J))* &
Expand Down
11 changes: 10 additions & 1 deletion sorc/ncep_post.fd/CALHEL2.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -88,7 +88,7 @@ SUBROUTINE CALHEL2(LLOW,LUPP,DEPTH,UST,VST,HELI,CANGLE)
use params_mod, only: g
use lookup_mod, only: ITB,JTB,ITBQ,JTBQ
use ctlblk_mod, only: jsta, jend, jsta_m, jend_m, jsta_2l, jend_2u, &
lm, im, jm, me
lm, im, jm, me, spval
use gridspec_mod, only: gridtype
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
Expand Down Expand Up @@ -461,6 +461,10 @@ SUBROUTINE CALHEL2(LLOW,LUPP,DEPTH,UST,VST,HELI,CANGLE)
DV1 = VH(I,J,L+1)-VH(I,J,L)
DV2 = VH(I,J,L)-VH(I,J,L-1)
IF( L >= LUPP(I,J) .AND. L <= LLOW(I,J) ) THEN
IF( VH(I,J,L) <spval.and.UH(I,J,L) <spval.and. &
VH(I,J,L+1)<spval.and.UH(I,J,L+1)<spval.and. &
VH(I,J,L-1)<spval.and.UH(I,J,L-1)<spval.and. &
VST(I,J) <spval.and.UST(I,J) <spval) &
HELI(I,J,N) = ((VH(I,J,L)-VST(I,J))* &
(DZ2*(DU1/DZ1)+DZ1*(DU2/DZ2)) &
- (UH(I,J,L)-UST(I,J))* &
Expand All @@ -484,11 +488,16 @@ SUBROUTINE CALHEL2(LLOW,LUPP,DEPTH,UST,VST,HELI,CANGLE)

DO J=JSTART,JSTOP
DO I=ISTART,ISTOP
IF(VSHR05(I,J)<spval.and.USHR05(I,J)<spval.and. &
VST(I,J)<spval.and.UST(I,J)<spval) THEN
CANGLE(I,J)=ATAN2(VSHR05(I,J),USHR05(I,J))-ATAN2(VST(I,J),UST(I,J))
CANGLE(I,J)=(CANGLE(I,J)/PI)*180.
IF(CANGLE(I,J) > 180.) CANGLE(I,J)=360.-CANGLE(I,J)
IF(CANGLE(I,J) < 0. .AND. CANGLE(I,J) >= -180.) CANGLE(I,J)=-CANGLE(I,J)
IF(CANGLE(I,J) < -180.) CANGLE(I,J)=360.+CANGLE(I,J)
ELSE
CANGLE(I,J)=spval
ENDIF
ENDDO
ENDDO
!
Expand Down
6 changes: 5 additions & 1 deletion sorc/ncep_post.fd/CALHEL3.f
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -86,7 +86,7 @@ SUBROUTINE CALHEL3(LLOW,LUPP,UST,VST,HELI)
use params_mod, only: g
use lookup_mod, only: ITB,JTB,ITBQ,JTBQ
use ctlblk_mod, only: jsta, jend, jsta_m, jend_m, jsta_2l, jend_2u, &
lm, im, jm, me
lm, im, jm, me, spval
use gridspec_mod, only: gridtype
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
implicit none
Expand Down Expand Up @@ -458,6 +458,10 @@ SUBROUTINE CALHEL3(LLOW,LUPP,UST,VST,HELI)
DV1 = VH(I,J,L+1)-VH(I,J,L)
DV2 = VH(I,J,L)-VH(I,J,L-1)
IF( L >= LUPP(I,J) .AND. L <= LLOW(I,J) ) THEN
IF( VH(I,J,L) <spval.and.UH(I,J,L) <spval.and. &
VH(I,J,L+1)<spval.and.UH(I,J,L+1)<spval.and. &
VH(I,J,L-1)<spval.and.UH(I,J,L-1)<spval.and. &
VST(I,J) <spval.and.UST(I,J) <spval) &
HELI(I,J) = ((VH(I,J,L)-VST(I,J))* &
(DZ2*(DU1/DZ1)+DZ1*(DU2/DZ2)) &
- (UH(I,J,L)-UST(I,J))* &
Expand Down
Loading