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