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