SUBROUTINE UA_STNM ( report, lenr, irptr, iret ) C************************************************************************ C* UA_STNM * C* * C* This subroutine decodes and stores the land station number. * C* * C* UA_STNM ( 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 (IRSTNM) REAL Land station number * 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 10/96 Removed ERRRPT * C* J. Ator/NCEP 12/97 New interface format, style changes * C* J. Ator/NCEP 03/98 Removed call to UA_LDGE * 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 land station number group. C CALL UA_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN RETURN ELSE IF ( lenf .ne. 5 ) THEN logmsg = 'land STNM group ' // field (1:lenf) CALL DC_WLOG ( 2, 'UA', -1, logmsg, ierwlg ) RETURN END IF C C* Decode the land station number. C CALL ST_INTG ( field (1:5), istnm, ier ) IF ( ier .ne. 0 ) THEN logmsg = 'land STNM group ' // field (1:lenf) CALL DC_WLOG ( 2, 'UA', -1, logmsg, ierwlg ) RETURN END IF C C* Store the land station number. C rivals ( irstnm ) = FLOAT ( istnm ) C iret = 0 C* RETURN END