SUBROUTINE SF_INTF ( kyr, kmo, kda, khr, kmi, + iyr, imo, ida, ihr, imi, + id, parcod, idur, valu, iqual, irev ) C************************************************************************ C* SF_INTF * C* * C* This subroutine creates interface output from observational data * C* output by SHEFLIB. It attempts to accumulate as many SHEFLIB data * C* items as possible into a single interface report by checking whether * C* the station ID and date-time for the latest observation are the same * C* as for the current interface report. If so, then the new SHEFLIB * C* data item is simply appended to the current interface report. * C* Otherwise, the existing interface report is converted into BUFR and * C* flushed from the decoder, and then the interface arrays are * C* re-initialized in order to hold the new SHEFLIB data item. * C* * C* SF_INTF ( KYR, KMO, KDY, KHR, KMI, * C* IYR, IMO, IDY, IHR, IMI, * C* ID, PARCOD, IDUR, VALU, IQUAL, IREV ) * C* * C* Input parameters: * C* (Forecast generation time) * C* KYR INTEGER Year * C* KMO INTEGER Month * C* KDY INTEGER Day * C* KHR INTEGER Hour * C* KMI INTEGER Minute * C* (Observation or Forecast time) * C* IYR INTEGER Year * C* IMO INTEGER Month * C* IDY INTEGER Day * C* IHR INTEGER Hour * C* IMI INTEGER Minute * C* ID CHAR* Station ID * C* PARCOD CHAR* SHEF parameter code array * C* IDUR INTEGER SHEF duration code * C* VALU DOUBLE Observational data value * C* IQUAL CHAR* SHEF quality code pertaining * C* to VALU * C* IREV INTEGER SHEF revision code pertaining * C* to VALU * C** * C* Log: * C* J. Ator/NCEP 04/05 * C* J. Ator/NCEP 07/06 Include shstyp in /INTF/ output. * C* J. Ator/NCEP 02/14 Added forecast generation time arguments* C* J. Ator/NCEP 08/14 Allow 'HGIFE' and 'HGIFZ' * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'BRIDGE.PRM' INCLUDE 'sfcmn.cmn' C* CHARACTER id*8, parcod*8, iqual, cimn*8, ctdu*2, curdtp C* DOUBLE PRECISION valu C* INCLUDE 'ERMISS.FNC' C----------------------------------------------------------------------- C C* Is this a type of data that we need to decode? C IF ( ( parcod(4:5) .eq. 'FF' ) .or. + ( parcod(1:5) .eq. 'HGIFE' ) .or. + ( parcod(1:5) .eq. 'HGIFZ' ) ) THEN curdtp = 'F' ELSE IF ( parcod(4:4) .eq. 'R' ) THEN curdtp = 'O' ELSE logmsg = ' skipped data of type ' // + parcod(4:5) // ' with element code ' // + parcod(1:2) // ' for ID ' // id CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg ) RETURN END IF C C* Ignore any data that is "missing". C rvalu = valu IF ( ERMISS ( rvalu ) ) THEN RETURN END IF C IF ( curdtp .eq. 'F' ) THEN C C* Use the fcst generation date-time as the nominal date-time. C nyr = kyr nmo = kmo nda = kda nhr = khr nmi = kmi ELSE C C* Use the observation date-time as the nominal date-time. C nyr = iyr nmo = imo nda = ida nhr = ihr nmi = imi END IF C C* Are the ID, data type and nominal date-time the same as for the C* data that were stored during the previous call to this subroutine? C IF ( ( civals (1) .ne. id ) .or. + ( dattyp .ne. curdtp ) .or. + ( rivals (1) .ne. nyr ) .or. + ( rivals (2) .ne. nmo ) .or. + ( rivals (3) .ne. nda ) .or. + ( rivals (4) .ne. nhr ) .or. + ( rivals (5) .ne. nmi ) ) THEN C C* NO, so convert all accumulated interface data for the C* previous ID and nominal date-time into BUFR and then C* re-initialize the interface arrays to hold the current data. C IF ( nimn .gt. 8 ) THEN CALL SF_IFPT ( 3, ierifp ) CALL SF_BUFR ( ierbfr ) END IF CALL SF_IFIV ( ierifi ) C C* Search for this new ID in the station table in order to C* determine its location information. C CALL DC_BSRC ( id, shstid, nste, ii, iersrh ) IF ( ii .eq. 0 ) THEN logmsg = id // ' not found in SHEF station table' CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg) RETURN END IF C C* Store the new ID, data type, nominal date-time and location C* information into the interface arrays. C cimnem (1) = 'STID' civals (1) = id cimnem (2) = 'STYP' civals (2) = shstyp (ii) C dattyp = curdtp C rimnem (1) = 'YEAR' rivals (1) = nyr rimnem (2) = 'MNTH' rivals (2) = nmo rimnem (3) = 'DAYS' rivals (3) = nda rimnem (4) = 'HOUR' rivals (4) = nhr rimnem (5) = 'MINU' rivals (5) = nmi C rimnem (6) = 'SLAT' rivals (6) = shslat (ii) rimnem (7) = 'SLON' rivals (7) = shslon (ii) rimnem (8) = 'SELV' rivals (8) = shselv (ii) C nimn = 8 END IF C C* Determine the time duration and interface mnemonic C* pertaining to the current data. C CALL SF_TDIM ( idur, parcod(6:6), parcod(1:2), + parcod(4:5), cimn, td, ctdu, ierdth ) IF ( ierdth .ne. 0 ) THEN RETURN END IF C C* Store the current data into the interface arrays. C rimnem (nimn+1) = 'IDUR' // ctdu rivals (nimn+1) = td rimnem (nimn+2) = cimn rivals (nimn+2) = rvalu cimnem (nimn+2) = 'IQUAL' civals (nimn+2) = iqual rimnem (nimn+3) = 'IREV' rivals (nimn+3) = irev IF ( curdtp .ne. 'F' ) THEN nimn_new = 3 ELSE rimnem (nimn+4) = 'FCYR' rivals (nimn+4) = iyr rimnem (nimn+5) = 'FCMN' rivals (nimn+5) = imo rimnem (nimn+6) = 'FCDY' rivals (nimn+6) = ida rimnem (nimn+7) = 'FCHR' rivals (nimn+7) = ihr rimnem (nimn+8) = 'FCMI' rivals (nimn+8) = imi nimn_new = 8 END IF nimn = nimn + nimn_new C C* Is there enough room in the interface arrays for any more data? C IF ( ( nimn + nimn_new ) .gt. MXIMN ) THEN C C* NO, so go ahead now and convert all existing interface C* output into BUFR, then re-initialize the interface arrays C* in advance of the next call to this subroutine. C logmsg = ' No more room in interface arrays,' // + ' so will flush BUFR output now and reset.' CALL DC_WLOG ( 2, 'DC', 2, logmsg, ierwlg) CALL SF_IFPT ( 3, ierifp ) CALL SF_BUFR ( ierbfr ) CALL SF_IFIV ( ierifi ) END IF C* RETURN END