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