SUBROUTINE UA_MELV ( report, lenr, irptr, iret ) C************************************************************************ C* UA_MELV * C* * C* This subroutine decodes the elevation group within mobil parts. * C* * C* UA_MELV ( REPORT, LENR, IRPTR, IRET ) * C* * C* Input parameters: * C* REPORT CHAR* Report * C* LENR INTEGER Length of REPORT * C* * C* Input and output parameters: * C* IRPTR INTEGER Pointer within REPORT * C* * C* Output parameters: * C* RIVALS (IRSELV) REAL Elevation in meters * C* RIVALS (IRQCVR) REAL Elevation quality flag * C* IRET INTEGER Return code: * C* 0 = normal return * C* -1 = critical error in REPORT * C* or reached end of REPORT * C** * C* Log: * C* J. Ator/NCEP 03/96 * C* J. Ator/NCEP 05/96 Decode QCEVR into range [1,8] * C* J. Ator/NCEP 10/96 Removed ERRRPT * C* J. Ator/NCEP 12/97 New interface format, style changes * C* J. Ator/NCEP 10/99 Clean up function declarations * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'uacmn.cmn' C* CHARACTER*(*) report C* CHARACTER field*(MXLENF) C------------------------------------------------------------------------ iret = -1 C C* Get the elevation group. C CALL UA_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN RETURN ELSE IF ( lenf .ne. 5 ) THEN logmsg = 'elevation group ' // field (1:lenf) CALL DC_WLOG ( 2, 'UA', -1, logmsg, ierwlg ) RETURN END IF C C* Decode the elevation. C CALL ST_INTG ( field (1:4), iselv, ier ) IF ( ier .ne. 0 ) THEN logmsg = 'elevation ' // field (1:4) CALL DC_WLOG ( 2, 'UA', -1, logmsg, ierwlg ) RETURN END IF selv = FLOAT ( iselv ) C C* Decode the elevation quality flag. C CALL ST_INTG ( field (5:5), iim, ier ) IF ( ier .ne. 0 ) THEN logmsg = 'elevation quality flag ' // field (5:5) CALL DC_WLOG ( 2, 'UA', -1, logmsg, ierwlg ) RETURN END IF IF ( ( iim .ge. 1 ) .and. ( iim .le. 4 ) ) THEN ELSE IF ( ( iim .ge. 5 ) .and. ( iim .le. 8 ) ) THEN selv = PR_HGFM ( selv ) ELSE logmsg = 'elevation quality flag ' // field (5:5) CALL DC_WLOG ( 2, 'UA', -1, logmsg, ierwlg ) RETURN END IF C C* Store the elevation. C rivals ( irselv ) = selv C C* Store the elevation quality flag. C C* This value is stored in the interface format as C* a code figure from WMO Code Table 1845. C rivals ( irqcvr ) = FLOAT ( iim ) C iret = 0 C* RETURN END