SUBROUTINE UA_SDGE ( stid, iret ) C************************************************************************ C* UA_SDGE * C* * C* This subroutine retrieves data for ship STID from the ship station * C* table and then stores it in the interface arrays. * C* * C* UA_SDGE ( STID, IRET ) * C* * C* Input parameters: * C* STID CHAR* Ship ID * C* * C* Output parameters: * C* CIVALS (ICCOUN) CHAR* Country ID * C* RIVALS (IRSELV) REAL Elevation in meters * C* RIVALS (IRWMOR) REAL Region number * C* RIVALS (IRITPD) REAL Instrument type * C* IRET INTEGER Return code: * C* 0 = Normal return * C* -1 = STID not in table * C** * C* Log: * C* J. Ator/NCEP 03/96 * C* J. Ator/NCEP 08/96 Use UT_BSRC to locate STID in table * C* J. Ator/NCEP 12/97 New interface format, style changes * C* J. Ator/NCEP 03/98 Include 'uacmn_stntbl.cmn' * C* J. Ator/NCEP 10/99 Clean up function declarations * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'uacmn.cmn' INCLUDE 'uacmn_stntbl.cmn' C* CHARACTER*(*) stid C------------------------------------------------------------------------ iret = 0 C C* Locate ship STID within the ship station table. C CALL DC_BSRC ( stid, sdstid, nsde, ii, iersrc ) IF ( ii .eq. 0 ) THEN iret = -1 RETURN END IF C C* Store the country ID. C civals ( iccoun ) = sdcoun ( ii ) C C* Store the elevation. C rivals ( irselv ) = sdselv ( ii ) C C* Store the region number. C C* This value is stored in the interface format C* as a code figure from WMO BUFR Table 0 01 003. C rivals ( irwmor ) = FLOAT ( sdregn ( ii ) ) C C* Store the station table instrument type. C C* This value is stored in the interface format C* as a code figure from WMO Code Table 3685. C rivals ( iritpd ) = FLOAT ( sdinst ( ii ) ) C* RETURN END