SUBROUTINE MA_CST0 ( marrpt, istarr, icmand, ipt, iret) C************************************************************************ C* MA_CST0 * C* * C* This subroutine gets the (1) CMAN station report ID, (2) the report * C* GMT observational time, (3) the indicator for the source and units * C* of wind speed, (4) the latitude of CMAN station, (5) the longitude * C* of the CMAN station, (6) the quadrant of the globe where the * C* station is located, and (7) the elevation of the station in meters. * C* The elevation, the latitude, and the longitude data are not part of * C* the report, but are gotten from a station table data file. * C* The routine also stores the receipt time of the report in the * C* interface array. * C* * C* MA_CST0 ( MARRPT, ISTARR, ICMAND, IPT, IRET ) * C* * C* Input parameters: * C* MARRPT CHAR* Report array * C* ISTARR (*) INTEGER System time - YY,MM,DD,HH,MM * C* ICMAND CHAR* YYGGi(w) group in CMAN bulletn * C* JSTNIDM (*) CHAR* Station IDs - msfc table * C* ELEVM(*) INTEGER Elevations of stations in m * C* from msfc table * C* YLATM(*) REAL Latitude of stations in * C* hundredths of degrees * C* from msfc table * C* YLONGM(*) REAL Longitude of stations in * C* hundredths of degrees * C* from msfc table * C* JSTNIDT (*) CHAR* Station IDs - tidg table * C* ELEVT(*) INTEGER Elevations of stations in m * C* from tidg table * C* YLATT(*) REAL Latitude of stations in * C* hundredths of degrees * C* from tidg table * C* YLONGT(*) REAL Longitude of stations in * C* hundredths of degrees * C* from tidg table * C* RCTIM (*) REAL Receipt date/time of bulletin * C* * C* Output parameters: * C* CIVALS(ICSTID) CHAR* Report ID (CMAN station id) * C* IHOUR INTEGER Hour of observation of report * C* IRPTDT (*) INTEGER Report date-time * C* (YYYY, MM, DD, HH, MM) * C* RIVALS(IRYEAR) REAL Report year - YYYY * C* RIVALS(IRMNTH) REAL Report month - MM * C* RIVALS(IRDAYS) REAL Report day - DD * C* RIVALS(IRHOUR) REAL Report hour - HH * C* RIVALS(IRMINU) REAL Report minute - MM * C* RIVALS(IRSELV) REAL Elevation of station in meters * C* RIVALS(IRSLAT) REAL Latitude in degrees * C* RIVALS(IRSLON) REAL Longitude in degrees * C* RIVALS(IRISWS) REAL Indicator for source and * C* units of wind speed * C* (WMO Code Table 1855) * C* IPT INTEGER Points to start of next group * C* in marrpt * C* IRET INTEGER Return code * C* 0 = Normal return * C* 1 = Problems * C* * C** * C* Log: * C* R. Hollern/NCEP 6/96 * C* R. Hollern/NCEP 9/96 Added RCTS to receipt time data * C* R. Hollern/NCEP 10/96 Added corrected report indicator logic * C* R. Hollern/NCEP 11/96 Changed wording of LOG message * C* D. Kidwell/NCEP 4/97 Changed interface and cleaned up code * C* D. Kidwell/NCEP 10/97 Changed interface , cleaned up code * C* R. Hollern/NCEP 12/97 Replaced call to MA_RTIM with DC_RTIM * C* R. Hollern/NCEP 7/99 Added date/time data to interface array * C* R. Hollern/NCEP 3/00 Removed reprt correction indicator logic* C* J. Ator/NCEP 12/00 Check validity of iuwind * C* J. Ator/NCEP 02/01 SUWS -> ISWS * C* C. Caruso Magee/NCEP 03/05 Adding code to check tidg table too * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'macmn.cmn' C* CHARACTER*(*) marrpt, icmand INTEGER istarr (*) C* CHARACTER stnid*8, fld2*2, fld1*1 LOGICAL more, againm, againt C------------------------------------------------------------------------ iret = 0 more = .true. jp = 0 ip = 0 stnid = ' ' C C* Get CMAN station ID. C C* Ip points to start of ID. Locate next space, the end of ID. C DO WHILE (more) C ip = ip + 1 IF ( marrpt ( ip:ip ) .ne. ' ' ) THEN jp = jp + 1 IF ( jp .lt. 9 ) stnid ( jp:jp ) = marrpt ( ip:ip ) ELSE more = .false. END IF C END DO C C* Save report id (CMAN station id). C civals ( icstid ) = stnid C ipt = ip C C* Get the station elevation, latitude, and longitude C* from the sfc marine or tide gauge station table data. C smcman = .false. tgcman = .false. againm = .true. againt = .true. i = 1 j = 1 C DO WHILE ( againm ) C IF ( stnid ( 1:5 ) .eq. jstnidm (i) ( 1:5 ) ) THEN rivals ( irselv ) = elevm ( i ) rivals ( irslat ) = ylatm ( i ) rivals ( irslon ) = ylongm ( i ) smcman = .true. againm = .false. againt = .false. END IF i = i + 1 C IF ( i .gt. jstnm ) againm = .false. END DO C C* If CMAN station ID is not in sfc marine dictionary, C* then check tide gauge dictionary. C DO WHILE ( againt ) IF ( stnid ( 1:5 ) .eq. jstnidt (j) ( 1:5 ) ) THEN rivals ( irselv ) = elevt ( j ) rivals ( irslat ) = ylatt ( j ) rivals ( irslon ) = ylongt ( j ) tgcman = .true. againt = .false. END IF j = j + 1 C IF ( j .gt. jstnt ) THEN C C* If CMAN station ID is not in tide gauge dictionary, C* skip decoding station data for now. C loglvl = 2 CALL ST_UNPR( marrpt, 80, logmsg, len, iunpr ) CALL DC_WLOG( loglvl, 'MA', 3, stnid(1:5), ierwlg ) logmsg = ' ' iret = 1 RETURN END IF C END DO C C* Get day of month of observation. C fld2 = icmand ( 1:2 ) CALL ST_INTG ( fld2, ival, ier ) IF ( ier .eq. 0 ) THEN IF ( ival .gt. 0 .and. ival .lt. 32 ) THEN imnday = ival ELSE ierrno = 7 CALL MA_ERRS ( ierrno, marrpt, kret ) iret = 1 RETURN END IF ELSE iret = 1 RETURN END IF C C* Get hour of observation. C fld2 = icmand ( 3:4 ) CALL ST_INTG ( fld2, ival, ier ) IF ( ier .eq. 0 ) THEN IF ( ival .ge. 0 .and. ival .lt. 24 ) THEN ihour = ival ELSE ierrno = 8 CALL MA_ERRS ( ierrno, marrpt, kret ) iret = 1 RETURN END IF ELSE iret = 1 RETURN END IF C C* Set minutes of obs hour to zero. C imins = 0 C C* Combine the run times and obs times into a report date-time. C ndays = 10 CALL DC_RTIM ( istarr, imnday, ihour, imins, ndays, irptdt, + jret ) C IF ( jret .ne. 0 ) THEN iret = 1 RETURN END IF C C* Save date/time data in interface array C rivals(iryear) = float ( irptdt(1) ) rivals(irmnth) = float ( irptdt(2) ) rivals(irdays) = float ( irptdt(3) ) rivals(irhour) = float ( irptdt(4) ) rivals(irminu) = float ( irptdt(5) ) C C* Get indicator for source and units of wind speed. C fld1 = icmand ( 5:5 ) CALL ST_INTG ( fld1, iuwind, ier ) IF ( ier .eq. 0 ) THEN ip = ip + 1 IF ( ( iuwind .eq. 0 ) .or. ( iuwind .eq. 1 ) .or. + ( iuwind .eq. 3 ) .or. ( iuwind .eq. 4 ) ) THEN rivals ( irisws ) = FLOAT ( iuwind ) END IF END IF C C* Set quadrant of the globe (not currently used). C iquad = 7 C* RETURN END