SUBROUTINE UA_STID ( report, lenr, irptr, iret ) C************************************************************************ C* UA_STID * C* * C* This subroutine decodes and stores the ship or mobil land station ID.* C* * C* UA_STID ( 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* CIVALS (ICSTID) CHAR* Station ID * 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_SDGE * C* J. Ator/NCEP 10/99 Clean up function declarations * C* J. Ator/NCEP 09/02 Allow up to 8 characters in station ID * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'uacmn.cmn' C* CHARACTER*(*) report C* CHARACTER field*(MXLENF) C------------------------------------------------------------------------ iret = -1 C C* Get the ship or mobil land station ID group. C CALL UA_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN RETURN ELSE IF ( ( lenf .lt. 3 ) .or. ( lenf .gt. 8 ) ) THEN logmsg = 'ship/mobil STID group ' // field (1:lenf) CALL DC_WLOG ( 2, 'UA', -1, logmsg, ierwlg ) RETURN END IF C C* Store the ship or mobil land station ID. C civals ( icstid ) = field ( 1 : lenf ) C iret = 0 C* RETURN END