SUBROUTINE UA_HYLV ( llyy, llxx, iret )
C************************************************************************
C* UA_HYLV *
C* *
C* This subroutine hydrostatically computes a height value for a *
C* mandatory level (using data at a neighboring level) and then *
C* compares it to the height value that was decoded from the report. *
C* If the height value that was decoded from the report is found to be *
C* erroneous, then it is corrected. *
C* *
C* UA_HYLV ( LLYY, LLXX, IRET ) *
C* *
C* Input parameters: *
C* LLYY INTEGER Index within interface arrays of*
C* mandatory level to be checked *
C* LLXX INTEGER Index within interface arrays of*
C* neighboring level *
C* *
C* Output parameters: *
C* RIVALS (IRHGTM) REAL Height in meters *
C* IRET INTEGER Return code: *
C* 0 = normal return *
C* -1 = not enough data in *
C* neighboring level to do *
C* hydrostatic comparison *
C** *
C* Log: *
C* J. Ator/NCEP 03/96 *
C* J. Ator/NCEP 11/96 Use GPGRAV instead of GRAVTY *
C* J. Ator/NCEP 12/97 New interface format, style changes *
C* J. Ator/NCEP 10/98 Compute height iff TMPC exists at each *
C* level, correct height iff pass MOD test *
C* J. Ator/NCEP 03/99 Update MOD test for AIX compatibility *
C* J. Ator/NCEP 10/99 Clean up function declarations *
C* J. Ator/NCEP 08/01 Check heights of certain neighboring *
C* levels before using in computation *
C************************************************************************
INCLUDE 'GEMPRM.PRM'
INCLUDE 'uacmn.cmn'
C*
INCLUDE 'ERMISS.FNC'
C------------------------------------------------------------------------
iret = -1
C
C* Compute the average temperature (in K) within the layer bounded
C* by the two levels.
C
tmpcyy = rivals ( irtmpc ( llyy ) )
tmpcxx = rivals ( irtmpc ( llxx ) )
IF ( ( ERMISS ( tmpcyy ) ) .or.
+ ( ERMISS ( tmpcxx ) ) ) THEN
RETURN
END IF
tmpcav = ( tmpcyy + tmpcxx ) / 2
tmpkav = PR_TMCK ( tmpcav )
C
C* Get the height of the neighboring level.
C
hgtmxx = rivals ( irhgtm ( llxx ) )
IF ( ERMISS ( hgtmxx ) ) THEN
RETURN
END IF
C
C* Is the height of the neighboring level reasonable?
C
C* If not, then don't use it within a hydrostatic computation.
C
presxx = rivals ( irpres ( llxx ) )
IF ( ( ( INT ( presxx ) .eq. 1000 ) .and.
+ ( ( hgtmxx .lt. -550. ) .or. ( hgtmxx .gt. 550. ) ) )
+ .or.
+ ( ( INT ( presxx ) .eq. 500 ) .and.
+ ( ( hgtmxx .lt. 4600. ) .or. ( hgtmxx .gt. 6000. ) ) )
+ .or.
+ ( ( INT ( presxx ) .eq. 400 ) .and.
+ ( ( hgtmxx .lt. 6200. ) .or. ( hgtmxx .gt. 7800. ) ) ) )
+ THEN
RETURN
END IF
C
C* There is enough data present in the neighboring level to do
C* a hydrostatic comparison. Set the return code accordingly.
C
iret = 0
C
C* Use the hydrostatic equation to compute a height value for the
C* mandatory level to be checked.
C
hgtmcf = ( 287 / GPGRAV ) * tmpkav
presyy = rivals ( irpres ( llyy ) )
IF ( presyy .gt. presxx ) THEN
hgtmhc = hgtmxx + ( hgtmcf * ( LOG ( presxx / presyy ) ) )
ELSE IF ( presyy .lt. presxx ) THEN
hgtmhc = hgtmxx - ( hgtmcf * ( LOG ( presyy / presxx ) ) )
END IF
C
C* Compare the height value computed above with the value that
C* was decoded from the report, and, if necessary, correct the
C* latter value.
C
C* Note that, for mandatory levels with pressure values greater
C* than 500mb, we are checking whether the thousands digit of the
C* height value was correctly decoded from the report; otherwise,
C* we are checking whether the ten-thousands digit of the height
C* value was correctly decoded from the report.
C
IF ( presyy .gt. 500 ) THEN
ihtamt = 1000
ELSE
ihtamt = 10000
END IF
C
hgtmyy = rivals ( irhgtm ( llyy ) )
IF ( ( ABS ( hgtmhc - hgtmyy ) ) .gt. ( ihtamt / 2 ) ) THEN
C
C* Compute the corrected height value.
C
IF ( hgtmhc .gt. hgtmyy ) THEN
hgtmyi = hgtmyy + ihtamt
ELSE
hgtmyi = hgtmyy - ihtamt
END IF
C
C* Make sure that the corrected height value differs from the
C* original value (that was decoded from the report) only in
C* the digit (thousands or ten-thousands) that was to be
C* checked. If so, then go ahead and make the correction
C* to the original value.
C
IF ( ( MOD ( INT ( hgtmyi ), ihtamt ) ) .eq.
+ ( MOD ( INT ( hgtmyy ), ihtamt ) ) ) THEN
C
rivals ( irhgtm ( llyy ) ) = hgtmyi
C
WRITE ( UNIT = logmsg,
+ FMT = '( A, I5, A, I6, A, I6 )' )
+ 'UA_HYLV changed HGTM at ', INT ( presyy ), 'mb: ',
+ INT ( hgtmyy ), ' -> ', INT ( hgtmyi )
CALL DC_WLOG ( 2, 'UA', 1, logmsg, ierwlg )
C
END IF
END IF
C*
RETURN
END