SUBROUTINE AP_BFID ( iunbf, irundt, iret ) C************************************************************************ C* AP_BFID * C* * C* This subroutine writes the report ID data to the BUFR output stream. * C* * C* AP_BFID ( IUNBF, IRUNDT, IRET ) * C* * C* Input parameters: * C* IUNBF INTEGER BUFR output file unit number * C* IRUNDT (5) INTEGER Run date-time * C* (YYYY, MM, DD, HH, MM) * C* * C* Output parameters: * C* IRET INTEGER Return code: * C* 0 = normal return * C** * C* Log: * C* J. Ator/NCEP 10/08 * C* J. Ator/NCEP 08/11 Add processing of STATYPE as BUFR A4ME * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'apcmn.cmn' C* INTEGER irundt (5) C* INCLUDE 'ERMISS.FNC' C*----------------------------------------------------------------------- iret = 0 C C* Report date-time. C CALL UT_RIBF ( iunbf, 'YEAR', rivals ( iryear ), ierrbf ) CALL UT_RIBF ( iunbf, 'MNTH', rivals ( irmnth ), ierrbf ) CALL UT_RIBF ( iunbf, 'DAYS', rivals ( irdays ), ierrbf ) CALL UT_RIBF ( iunbf, 'HOUR', rivals ( irhour ), ierrbf ) CALL UT_RIBF ( iunbf, 'MINU', rivals ( irminu ), ierrbf ) C C* Receipt date-time. C CALL UT_RIBF ( iunbf, 'RCYR', FLOAT ( irundt (1) ), ierrbf ) CALL UT_RIBF ( iunbf, 'RCMO', FLOAT ( irundt (2) ), ierrbf ) CALL UT_RIBF ( iunbf, 'RCDY', FLOAT ( irundt (3) ), ierrbf ) CALL UT_RIBF ( iunbf, 'RCHR', FLOAT ( irundt (4) ), ierrbf ) CALL UT_RIBF ( iunbf, 'RCMI', FLOAT ( irundt (5) ), ierrbf ) CALL UT_RIBF ( iunbf, 'RCTS', 0., ierrbf ) C C* Station ID. C CALL UT_CIBF ( iunbf, 'RPID', civals ( icstid ), 8, iercbf ) C C* Latitude. C CALL UT_RIBF ( iunbf, 'CLAT', rivals ( irslat ), ierrbf ) C C* Longitude. C CALL UT_RIBF ( iunbf, 'CLON', rivals ( irslon ), ierrbf ) C C* Station elevation. C CALL UT_RIBF ( iunbf, 'SELV', rivals ( irselv ), ierrbf ) C C* Averaging period in seconds (and associated time significance). C IF ( .not. ERMISS ( rivals ( iravpm ) ) ) THEN CALL UT_RIBF ( iunbf, 'TSIG', 2.0, ierrbf ) CALL UT_RIBF ( iunbf, 'TPSE', + rivals ( iravpm ) * (-60.0), ierrbf ) END IF C C* Type of measuring equipment used. C isttp = NINT ( rivals ( irsttp ) ) IF ( ( isttp .ge. 1 ) .and. ( isttp .le. 4 ) ) THEN IF ( isttp .eq. 4 ) THEN ia4me = 9 ELSE ia4me = 6 END IF CALL UT_RIBF ( iunbf, 'A4ME', FLOAT ( ia4me ), ierrbf ) END IF C* RETURN END