SUBROUTINE TG_SC2A ( kray, mxrpt, mxrptsz, mxdatv, expdesc, + nmrpts, lenrpts, nmdatval, dataval, nr, + iret ) C************************************************************************ C* TG_SC2A * C* * C* This subroutine gets the station report ID and the report * C* observational GMT time from the arrays holding the decoded Section 2 * C* data and stores these data into the interface arrays. * C* * C* TG_SC2A ( KRAY, MXRPT, MXRPTSZ, MXDATV, EXPDESC, NMRPTS, LENRPTS, * C* NMDATVAL, DATAVAL, NR, IRET ) * C* * C* INPUT PARAMETERS: * C* KRAY ( MXDATV) INTGEGER Array locations indicate which * C* descriptors in expdesc have * C* already been processed * C* MXRPT INTEGER Maximum number of reports * C* expected in message * C* MXRPTSZ INTEGER Maximum report size expected * C* MXDATV REAL Maximum number of data values * C* expected in report * C* EXPDESC (MXDATV) * C* CHAR* List of descriptors which are * C* close to a one-to-one * C* correspondece with the data * C* values in dataval array * C* * C* NMRPTS INTEGER Number of reports in CREX msg * C* * C* LENRPTS (NMRPTS) * C* INTEGER Array to store the length of * C* each report * C* * C* NMDATVAL INTEGER Number of data values in * C* Section 2 of CREX message * C* * C* DATAVAL (MXRPT,MXDATV) * C* INTEGER Array to hold the Section 2 * C* decoded data values * C* NR INTEGER Pointer to where to get the data* C* in arrays for current report * C* * C* OUTPUT PARAMETERS: * C* CIVALS(ICSTID) CHAR* Report ID * 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(IRTOST) REAL Type of station -- automatic * C* IRET INTEGER Return code * C* 0 = Normal return * C* 1 = Problems * C* * C** * C* Log: * C* R. Hollern/NCEP 8/00 * C* J. Ator/NCEP 8/13 Use report lat/long if available * C************************************************************************ INCLUDE 'tgcmn.cmn' C* REAL*8 dataval ( mxrpt, mxdatv ) C* INTEGER lenrpts ( mxrpt ) INTEGER kray ( mxdatv ) C* CHARACTER expdesc ( mxdatv )*6 C* REAL rval INTEGER ival CHARACTER cval*8, misng*8 CHARACTER mdescr*6 C* DATA misng / '////////' / C------------------------------------------------------------------------ iret = 0 loglvl = 2 irepflg = 0 C C* Get tide station ID. C mdescr = 'B01075' C C* Table B units for station ID is character. C idatty = 1 C CALL TG_GETV( kray, irepflg, mdescr, nr, loglvl, mxrpt, + mxrptsz, mxdatv, nmrpts, expdesc, nmdatval, + dataval, idatty, rval, cval, iret ) C IF ( iret .eq. 0 ) THEN C C* Save report ID. C civals ( icstid ) = cval ELSE CALL DC_WLOG ( loglvl, 'DCTIDG', 5, ' ', ierwlg ) iret = 1 RETURN END IF C C* Get the station table data for this station ID. C CALL TG_STBD ( iretbd ) C C* Table B units for lat/long and date/time data are numeric. C idatty = 0 C C* Check if the report contained a latitude and longitude. C* If so, use these instead of the values from the station table. C mdescr = 'B05001' CALL TG_GETV( kray, irepflg, mdescr, nr, loglvl, mxrpt, + mxrptsz, mxdatv, nmrpts, expdesc, nmdatval, + dataval, idatty, rvallt, cval, iretlt ) mdescr = 'B06001' CALL TG_GETV( kray, irepflg, mdescr, nr, loglvl, mxrpt, + mxrptsz, mxdatv, nmrpts, expdesc, nmdatval, + dataval, idatty, rvalln, cval, iretln ) IF ( ( iretlt .eq. 0 ) .and. ( iretln .eq. 0 ) ) THEN rivals ( irslat ) = rvallt rivals ( irslon ) = rvalln ELSE IF ( iretbd .eq. 1 ) THEN iret = 1 RETURN END IF C C* Get the report date/time data. C mdescr = 'B04001' C CALL TG_GETV( kray, irepflg, mdescr, nr, loglvl, mxrpt, + mxrptsz, mxdatv, nmrpts, expdesc, nmdatval, + dataval, idatty, rval, cval, iret ) C IF ( iret .eq. 0 .and. cval .ne. misng ) THEN rivals(iryear) = rval irptdt(1) = NINT ( rval ) ELSE CALL DC_WLOG ( loglvl, 'DCTIDG', 8, ' ', ierwlg ) iret = 1 RETURN END IF C mdescr = 'B04002' C CALL TG_GETV( kray, irepflg, mdescr, nr, loglvl, mxrpt, + mxrptsz, mxdatv, nmrpts, expdesc, nmdatval, + dataval, idatty, rval, cval, iret ) C IF ( iret .eq. 0 .AND. cval .ne. misng ) THEN ival = NINT ( rval ) IF ( ival .ge. 1 .and. ival .le. 12 ) THEN irptdt(2) = ival rivals(irmnth) = rval ELSE CALL DC_WLOG ( loglvl, 'DCTIDG', 8, ' ', ierwlg ) iret = 1 RETURN END IF ELSE CALL DC_WLOG ( loglvl, 'DCTIDG', 8, ' ', ierwlg ) iret = 1 RETURN END IF C C* Get day of month of observation. C mdescr = 'B04003' C CALL TG_GETV( kray, irepflg, mdescr, nr, loglvl, mxrpt, + mxrptsz, mxdatv, nmrpts, expdesc, nmdatval, + dataval, idatty, rval, cval, iret ) C IF ( iret .eq. 0 .AND. cval .ne. misng ) THEN ival = NINT ( rval ) IF ( ival .ge. 1 .and. ival .le. 31 ) THEN imnday = ival irptdt(3) = ival rivals(irdays) = rval ELSE CALL DC_WLOG ( loglvl, 'DCTIDG', 8, ' ', ierwlg ) iret = 1 RETURN END IF ELSE CALL DC_WLOG ( loglvl, 'DCTIDG', 8, ' ', ierwlg ) iret = 1 RETURN END IF C C* Get hour of observation. C mdescr = 'B04004' C CALL TG_GETV( kray, irepflg, mdescr, nr, loglvl, mxrpt, + mxrptsz, mxdatv, nmrpts, expdesc, nmdatval, + dataval, idatty, rval, cval, iret ) C IF ( iret .eq. 0 .AND. cval .ne. misng ) THEN ival = NINT ( rval ) IF ( ival .ge. 0 .and. ival .le. 23 ) THEN irptdt(4) = ival rivals(irhour) = rval ELSE CALL DC_WLOG ( loglvl, 'DCTIDG', 8, ' ', ierwlg ) iret = 1 RETURN END IF ELSE CALL DC_WLOG ( loglvl, 'DCTIDG', 8, ' ', ierwlg ) iret = 1 RETURN END IF C C* Get the minutes part of the observation hour. C mdescr = 'B04005' C CALL TG_GETV( kray, irepflg, mdescr, nr, loglvl, mxrpt, + mxrptsz, mxdatv, nmrpts, expdesc, nmdatval, + dataval, idatty, rval, cval, iret ) C IF ( iret .eq. 0 .AND. cval .ne. misng ) THEN ival = NINT ( rval ) IF ( ival .ge. 0 .and. ival .le. 59 ) THEN irptdt(5) = ival rivals(irminu) = rval ELSE CALL DC_WLOG ( loglvl, 'DCTIDG', 8, ' ', ierwlg ) iret = 1 RETURN END IF ELSE CALL DC_WLOG ( loglvl, 'DCTIDG', 8, ' ', ierwlg ) iret = 1 RETURN END IF C C* Set type of station to automatic. C rivals ( irtost ) = 0.0 C* RETURN END