SUBROUTINE GF_BUFR ( iubfmn, irundt, corn, bfstyp, iret ) C************************************************************************ C* GF_BUFR * C* * C* This subroutine retrieves data from the interface arrays, converts * C* it into BUFR output, and then writes the BUFR output to the BUFR * C* output stream. * C* * C* GF_BUFR ( IUBFMN, IRUNDT, CORN, BFSTYP, IRET ) * C* * C* Input parameters: * C* IUBFMN INTEGER Logical unit number of messages * C* file for BUFR output stream * C* IRUNDT (5) INTEGER Run date-time * C* (YYYY, MM, DD, HH, MM) * C* CORN REAL Corrected report indicator * C* BFSTYP CHARACTER OUTPUT BUFR/SUBTYPE * C* * C* Output parameters: * C* IRET INTEGER Return code: * C* 0 = normal return * C** * C* Log: * C* C. Caruso Magee/NCEP 06/06 * C* C. Caruso Magee/NCEP 07/06 Removing parms that will never be set. * C* L. Sager/NCEP 04/07 Added bufr type/subtype to window * C S. Guan/NCEP 09/09 Adopting new BUFR4 formatted wind/wave. * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'gfcmn.cmn' C* CHARACTER bfstyp*8 C* INTEGER irundt (5) C* INCLUDE 'ERMISS.FNC' C*----------------------------------------------------------------------- iret = 0 C C* Set the BUFR message date-time. C year = rivals ( iryear ) rmth = rivals ( irmnth ) days = rivals ( irdays ) hour = rivals ( irhour ) IF ( ( ERMISS ( year ) ) .or. ( ERMISS ( rmth ) ) .or. + ( ERMISS ( days ) ) .or. ( ERMISS ( hour ) ) ) THEN RETURN END IF C C* If 10 meter wind speed, wave height, and peakiness are all 0 and/or C* missing, don't write this report out to bufr. C IF ( ( ( rivals ( irhowv ) .eq. 0.0 ) .or. + ERMISS ( rivals ( irhowv ) ) ) .and. + ( ( rivals ( irws10 ) .eq. 0.0 ) .or. + ERMISS ( rivals ( irws10 ) ) ) .and. + ( ( rivals ( irpeak ) .eq. 0.0 ) .or. + ERMISS ( rivals ( irpeak ) ) ) ) THEN RETURN END IF ibfdt = ( INT ( year ) * 1000000 ) + ( INT ( rmth ) * 10000 ) + + ( INT ( days ) * 100 ) + INT ( hour ) C C* Open a BUFR message for output. C CALL OPENMB ( iubfmn, bfstyp, ibfdt ) C C* Satellite instrument data used in processing. C CALL UT_RIBF ( iubfmn, 'SAID', rivals ( irsaid ), ierrbf ) C C* Latitude and longitude. C CALL UT_RIBF ( iubfmn, 'CLAT', rivals ( irclat ), ierrbf ) CALL UT_RIBF ( iubfmn, 'CLON', rivals ( irclon ), ierrbf ) C C* Receipt date-time. C CALL UT_RIBF ( iubfmn, 'RCYR', FLOAT ( irundt (1) ), ierrbf ) CALL UT_RIBF ( iubfmn, 'RCMO', FLOAT ( irundt (2) ), ierrbf ) CALL UT_RIBF ( iubfmn, 'RCDY', FLOAT ( irundt (3) ), ierrbf ) CALL UT_RIBF ( iubfmn, 'RCHR', FLOAT ( irundt (4) ), ierrbf ) CALL UT_RIBF ( iubfmn, 'RCMI', FLOAT ( irundt (5) ), ierrbf ) CALL UT_RIBF ( iubfmn, 'RCTS', 0., ierrbf ) C C* Corrected report indicator C CALL UT_RIBF ( iubfmn, 'CORN', corn, ierrbf ) C C* Observation date-time. C CALL UT_RIBF ( iubfmn, 'YEAR', rivals ( iryear ), ierrbf ) CALL UT_RIBF ( iubfmn, 'MNTH', rivals ( irmnth ), ierrbf ) CALL UT_RIBF ( iubfmn, 'DAYS', rivals ( irdays ), ierrbf ) CALL UT_RIBF ( iubfmn, 'HOUR', rivals ( irhour ), ierrbf ) CALL UT_RIBF ( iubfmn, 'MINU', rivals ( irminu ), ierrbf ) CALL UT_RIBF ( iubfmn, 'SECO', rivals ( irseco ), ierrbf ) C C* Total number with respect to accumulation or average. C C CALL UT_RIBF ( iubfmn, 'ACAV', rivals ( iracav ), ierrbf ) C C* Wind speed at 10 meters. C CALL UT_RIBF ( iubfmn, 'WS10', rivals ( irws10 ), ierrbf ) C C* Standard deviation of horizontal wind speed. C C CALL UT_RIBF ( iubfmn, 'SDHS', rivals ( irsdhs ), ierrbf ) C C* Height of waves. C CALL UT_RIBF ( iubfmn, 'HOWV', rivals ( irhowv ), ierrbf ) C C* Standard deviation of significant wave height. C CALL UT_RIBF ( iubfmn, 'SDWH', rivals ( irsdwh ), ierrbf ) C C* Altitude (Platform to Ellipsoid). C CALL UT_RIBF ( iubfmn, 'ALTPE', rivals ( iraltp ), ierrbf ) C C* Peakiness. C CALL UT_RIBF ( iubfmn, 'PEAK', rivals ( irpeak ), ierrbf ) C C* Height of station. C C CALL UT_RIBF ( iubfmn, 'SELV', rivals ( irselv ), ierrbf ) C C* Standard deviation of altitude. C C CALL UT_RIBF ( iubfmn, 'SDAL', rivals ( irsdal ), ierrbf ) C C* Radar altimeter product confidence. C C CALL UT_RIBF ( iubfmn, 'RAPC', rivals ( irrapc ), ierrbf ) C C C* Satellite altimeter calibration status. C C CALL UT_RIBF ( iubfmn, 'SACS', rivals ( irsacs ), ierrbf ) C C* Satellite altimeter instrument mode. C C CALL UT_RIBF ( iubfmn, 'SAIM', rivals ( irsaim ), ierrbf ) C C* Altimeter correction (ionosphere). C CALL UT_RIBF ( iubfmn, 'ACIO', rivals ( iracio ), ierrbf ) C C* Altimeter correction (dry troposphere). C CALL UT_RIBF ( iubfmn, 'ACDT', rivals ( iracdt ), ierrbf ) C C* Altimeter correction (wet troposphere). C CALL UT_RIBF ( iubfmn, 'ACWT', rivals ( iracwt ), ierrbf ) C C* Altimeter correction (calibration constant). C C CALL UT_RIBF ( iubfmn, 'ACCC', rivals ( iraccc ), ierrbf ) C C* Backscatter C CALL UT_RIBF ( iubfmn, 'BKST', rivals ( irbkst ), ierrbf ) C C* Open loop correction (auto gain control). C CALL UT_RIBF ( iubfmn, 'OLCA', rivals ( irolca ), ierrbf ) C CALL UT_WBFR ( iubfmn, 'gfofd', 0, ierwbf ) C* RETURN END