SUBROUTINE LS_BUFR( bufrtb, last, lsfrpt, lszrpt, iret) C************************************************************************ C* LS_BUFR * C* * C* This routine creates a BUFR message containing subsets of all the * C* same message type. The data from the current report will be * C* converted to a BUFR subset and added to the BUFR message which * C* contains subsets of the same message type as the report. If there * C* are none, then one will be started. On the first entry into the * C* routine, unit numbers are assigned to the BUFR output files and these* C* files are then opened for use. On the last entry into the routine, * C* the BUFR output files are closed. * C* * C* LS_BUFR ( BUFRTB, LAST, LSFRPT, LSZRPT, IBRTYP, IRET ) * C* * C* Input variables: * C* * C* BUFRTB CHAR* BUFR table file * C* LAST LOGICAL Flag to close BUFR files * C* LSZRPT INTEGER Byte size of report * C* LSZRPT CHAR* Report array * C* IBRTYP INTEGER Bulletin FM code form * C* 1 = FM 12 synoptic land * C* 2 = FM 14 synoptic mobil * C* * C* Output variables: * C* * C* IRET INTEGER Return code * C* 0 = normal return * C* 1 = problems * C* * C** * C* Log: * C* R. Hollern/NCEP 04/96 * C* R. Hollern/NCEP 01/98 New interface format, style changes * C* R. Hollern/NCEP 02/98 Included century in date/time data * C* passed to OPENMB * C* R. Hollern/NCEP 01/99 Renamed INCLUDE block ls.bufr.prm to * C* lsbufr.cmn * C* C. Caruso Magee/NCEP 06/01 Replace calls to WRITSA and * C* DBN_BUFR with new s/r UT_WBFR. * C* J. Ator/NCEP 06/01 Use 'NUL' in call to OPENBF * C* C. Caruso Magee/NCEP 07/01 Make max report length be 500 chars * C* (from 400) and increase r8chr array * C* size to 63 (from 50). Also removed * C* declaration of array chday1*400 (not * C* used). * C* C. Caruso Magee/NCEP 02/02 Change name to lsbufr.f. Change to use * C* UT_RIBF, UT_CIBF, and UT_RIBM for BUFR * C* output instead of lots of separate * C* calls to UFBINT or UFBREP. * C* This s/r replaces lsbufa.f plus all of * C* the subroutines it previously called. * C* R. Hollern/NCEP 06/02 Added INCLUDE 'GEMPRM.PRM' statement * C* to fix precipitation problem * C* J. Ator/NCEP 06/02 Added check for WMO Res. 40 bulletins * C* R. Hollern/NCEP 07/02 Added the NCEP BUFR Code Table 002038 * C* and 002039 definitions for MSST and * C* MWBT, respectively. * C* R. Hollern/NCEP 08/02 Added code to store mobil land station * C* reports in BUFR. Clean up. * C* J. Ator/NCEP 08/02 Add include of BUFR.CMN * C* R. Hollern/NCEP 10/02 Created WMO Res40 NCEP bufr as * C* type/subtype 000/000. Removed istyp. * C* C. Caruso Magee/NCEP 01/03 Change RSRD for WMO Res40 from 256 to * C* 224. * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'lscmn.cmn' INCLUDE 'lscmn_bufr.cmn' C* CHARACTER*(*) bufrtb, lsfrpt LOGICAL first, last, icont REAL*8 r8swv ( NCSWV, MXSLYR ), GETBMISS, + r8cld ( NCCLD, MXCLYR ), UT_RIBM, UT_IWBF REAL xx, risw CHARACTER subset*8, wmobid*2, wmostid*3, cbb*11 C* DATA first / .true. / C SAVE C* INCLUDE 'ERMISS.FNC' C------------------------------------------------------------------------ C iret = 0 C C* Do not create BUFR if the latitude or longitude is missing. C IF ( ( ERMISS ( rivals ( irslat ) ) ) .or. + ( ERMISS ( rivals ( irslon ) ) ) ) THEN iret = 1 RETURN END IF C IF ( first ) THEN first = .false. C C* Allocate unit numbers to the BUFR table and to the BUFR C* output files C CALL FL_GLUN ( lunbtb, kret ) CALL FL_GLUN ( iunbfo, kret ) C C* Open the BUFR table file C OPEN ( UNIT = lunbtb, FILE = bufrtb ) C C* Connect the BUFR output files to the BUFR table C CALL OPENBF ( iunbfo, 'NUL', lunbtb ) r8bfms = GETBMISS() C END IF C IF ( LAST ) then C C* Close BUFR output files C CALL CLOSBF ( lunbtb ) CALL CLOSBF ( iunbfo ) RETURN END IF C ibfdt = ( irptdt (1) * 1000000 ) + + ( irptdt (2) * 10000 ) + ( irptdt (3) * 100 ) + + irptdt (4) C C* Check if this is a WMO Resolution 40 bulletin. C ires40 = 0 cbb = buhd (1:6) // ' ' // cborg (1:4) CALL DC_BSRC ( cbb, cr40b, nr40b, ipos, ierbrc ) IF ( ipos .ne. 0 ) THEN ires40 = 1 END IF C IF ( ires40 .eq. 1 ) THEN C C* WMO Resolution 40 Land synoptic report. C subset = 'NC000000' C ELSE IF ( ibrtyp .eq. 1 ) THEN C C* Land synoptic report. C subset = 'NC000001' C ELSE IF ( ibrtyp .eq. 2 ) THEN C C* Mobil synoptic report. C subset = 'NC000002' ELSE RETURN END IF C C* Open BUFR file for output C CALL OPENMB ( iunbfo, subset, ibfdt ) C C* Initialize BUFR output arrays. C DO jj = 1, MXSLYR DO ii = 1, NCSWV r8swv ( ii, jj ) = r8bfms END DO END DO DO jj = 1, MXCLYR DO ii = 1, NCCLD r8cld ( ii, jj ) = r8bfms END DO END DO C C* Add bulletin header data to BUFR output. C CALL UT_CIBF ( iunbfo, 'SEQNUM', seqnum, 8, iercbf ) CALL UT_CIBF ( iunbfo, 'BUHD', buhd, 8, iercbf ) CALL UT_CIBF ( iunbfo, 'BORG', cborg, 8, iercbf ) CALL UT_CIBF ( iunbfo, 'BULTIM', btime, 8, iercbf ) CALL UT_CIBF ( iunbfo, 'BBB', bbb, 8, iercbf ) C C* Add character ID. C CALL UT_CIBF ( iunbfo, 'RPID', civals(icstid), 8, iercbf ) C C* If this is a WMO Resolution 40 bulletin, set RSRD accordingly. C IF ( ires40 .eq. 1 ) THEN CALL UT_RIBF ( iunbfo, 'RSRD', 224., ierrbf ) END IF C C* Block/station ID C wmobid = civals ( icstid ) (1:2) CALL ST_INTG ( wmobid, ival, ier ) IF ( ier .eq. 0 ) THEN CALL UT_RIBF ( iunbfo, 'WMOB', FLOAT(ival), ierrbf ) END IF C wmostid = civals ( icstid ) (3:5) CALL ST_INTG ( wmostid, ival, ier ) IF ( ier .eq. 0 ) THEN CALL UT_RIBF ( iunbfo, 'WMOS', FLOAT(ival), ierrbf ) END IF C C* Longitude. C CALL UT_RIBF ( iunbfo, 'CLON', rivals ( irslon ), ierrbf ) C C* Latitude. C CALL UT_RIBF ( iunbfo, 'CLAT', rivals ( irslat ), ierrbf ) C C* Station elevation in meters. C CALL UT_RIBF ( iunbfo, 'SELV', rivals ( irselv ), ierrbf ) C IF ( ibrtyp .eq. 2 ) THEN C C* Elevation quality flag. C CALL UT_RIBF ( iunbfo, 'QCEVR', rivals ( irqcvr ), ierrbf ) END IF C C* Get corrected report indicator. C IF ( bbb (1:1) .eq. 'C' ) THEN xx = 1.0 ELSE xx = 0.0 END IF CALL UT_RIBF ( iunbfo, 'CORN', xx, ierrbf ) C C* Report date-time. C CALL UT_RIBF ( iunbfo, 'YEAR', rivals ( iryear ), ierrbf ) CALL UT_RIBF ( iunbfo, 'MNTH', rivals ( irmnth ), ierrbf ) CALL UT_RIBF ( iunbfo, 'DAYS', rivals ( irdays ), ierrbf ) CALL UT_RIBF ( iunbfo, 'HOUR', rivals ( irhour ), ierrbf ) CALL UT_RIBF ( iunbfo, 'MINU', rivals ( irminu ), ierrbf ) C C* Receipt date-time. C CALL UT_RIBF ( iunbfo, 'RCYR', rctim (2), ierrbf ) CALL UT_RIBF ( iunbfo, 'RCMO', rctim (3), ierrbf ) CALL UT_RIBF ( iunbfo, 'RCDY', rctim (4), ierrbf ) CALL UT_RIBF ( iunbfo, 'RCHR', rctim (5), ierrbf ) CALL UT_RIBF ( iunbfo, 'RCMI', rctim (6), ierrbf ) CALL UT_RIBF ( iunbfo, 'RCTS', rctim (1), ierrbf ) C C* Precipitation indicator ( 0 13 194 ) C CALL UT_RIBF ( iunbfo, 'INPC', rivals ( irinpc ), ierrbf ) C C* Station indicator ( 0 02 193 ) C IF ( .not. ERMISS ( rivals ( iritso ) ) ) THEN CALL UT_RIBF ( iunbfo, 'ITSO', + ( rivals ( iritso ) - 1.0 ), ierrbf ) END IF C C* Type of station ( 0 02 001 ) C CALL UT_RIBF ( iunbfo, 'TOST', rivals ( irtost ), ierrbf ) C C* Horizontal visibility in meters C CALL UT_RIBF ( iunbfo, 'HOVI', + PR_HGKM ( rivals ( irvsbk ) ), ierrbf ) C C* Vertical visibility in meters (0 20 002) C CALL UT_RIBF ( iunbfo, 'VTVI', rivals ( irvrtm ), ierrbf ) C C* Indicator for source and units of wind speed C risw = UT_IWBF ( rivals ( irisws ) ) CALL UT_RIBF ( iunbfo, 'TIWM', risw, ierrbf ) C C* Wind direction in degrees. If wind is light and variable C* (direction was reported as '99'), set wind direction to 0. C IF ( INT ( rivals ( irdrct ) ) .eq. 99 .and. + rivals ( irsped ) .gt. 0.0 ) THEN CALL UT_RIBF ( iunbfo, 'WDIR', 0.0, ierrbf ) ELSE CALL UT_RIBF ( iunbfo, 'WDIR', rivals ( irdrct ), ierrbf ) END IF C C* Wind speed in m/sec C CALL UT_RIBF ( iunbfo, 'WSPD', rivals ( irsped ), ierrbf ) C C* Number of supplementary wind types C nwty = NINT ( rivals ( irnspw ) ) IF ( nwty .gt. 0 .and. nwty .le. 3 ) THEN C C* The outer loop corresponds to the NCEP Supplementary Wind C* Type Code Table SPWT values. The 911ff group is given the C* highest priority for determining the wind gust (0 11 041). C icont = .true. C DO k = 0,2 C DO j = 1,nwty C mty = NINT ( rivals ( irspwt ( j ) ) ) C IF ( mty .eq. k .and. icont ) THEN C C* Duration in minutes of wind gust period C IF ( rivals ( irspwp ( j ) ) .ge. 0.0 .and. + rivals ( irspwp ( j ) ) .le. 60.0 ) THEN CALL UT_RIBF ( iunbfo, '.DTMMXGS', + rivals ( irspwp ( j ) ), ierrbf ) icont = .false. END IF C C* Wind gust C CALL UT_RIBF ( iunbfo, 'MXGS', + rivals ( irspws ( j ) ), ierrbf ) icont = .false. END IF END DO END DO END IF C C* Dry bulb temperature in Kelvin ( 0 12 001 ) C CALL UT_RIBF ( iunbfo, 'TMDB', + PR_TMCK ( rivals ( irtmpc ) ), ierrbf ) C C* Dew point temperature in Kelvin ( 0 12 003 ) C CALL UT_RIBF ( iunbfo, 'TMDP', + PR_TMCK ( rivals ( irdwpc ) ), ierrbf ) C C* Method of sea surface temperature ( 0 02 038 ) C C* The NCEP BUFR Code Table 0 02 038 definitions for MSST. C ix = NINT ( rivals ( irmsst ) ) C IF ( ix .eq. 0 .or. ix .eq. 1 ) THEN xx = 0.0 ELSE IF ( ix .eq. 2 .or. ix .eq. 3 ) THEN xx = 1.0 ELSE IF ( ix .eq. 4 .or. ix .eq. 5 ) THEN xx = 2.0 ELSE xx = RMISSD END IF C CALL UT_RIBF ( iunbfo, 'MSST', xx, ierrbf ) C C* Sea surface temperature in Kelvin ( 0 22 042 ) C CALL UT_RIBF ( iunbfo, 'SST1', + PR_TMCK ( rivals ( irsstc ) ), ierrbf ) C C* The NCEP BUFR Code Table 0 02 039 definitions for MWBT. C ix = NINT ( rivals ( irstwc ) ) C IF ( ix .eq. 0 .or. ix .eq. 1 ) THEN xx = 0. ELSE IF ( ix .eq. 2 ) THEN xx = 1. ELSE IF ( ix .eq. 5 .or. ix .eq. 6 ) THEN xx = 2. ELSE IF ( ix .eq. 7 ) THEN xx = 3. ELSE xx = RMISSD END IF C CALL UT_RIBF ( iunbfo, 'MWBT', xx, ierrbf ) C C* Wet bulb temperature in Kelvin ( 0 12 002 ) C CALL UT_RIBF ( iunbfo, 'TMWB', + PR_TMCK ( rivals ( irtmwc ) ), ierrbf ) C C* Relative humidity in per cent ( 0 13 003 ) C CALL UT_RIBF ( iunbfo, 'REHU', rivals ( irrelh ), ierrbf ) C C* Maximum and minimum temperature in Kelvin. The time period c* will be set to missing, although most likely these are 24 hour C* max/min temperatures. ( 0 12 011, 0 12 012 ) C CALL UT_RIBF ( iunbfo, '.DTHMXTM', rivals ( irdtv1 ), ierrbf ) CALL UT_RIBF ( iunbfo, 'MXTM', + PR_TMCK ( rivals ( irmxtm ) ), ierrbf ) CALL UT_RIBF ( iunbfo, '.DTHMITM', rivals ( irdtv2 ), ierrbf ) CALL UT_RIBF ( iunbfo, 'MITM', + PR_TMCK ( rivals ( irmitm ) ), ierrbf ) C C* PRES, PMSL, 3HPC, 24PC, and PRLC are in units of millibars C* within the interface format, but they need to be in units of C* Pascals within the BUFR format. C C* Pressure in Pascals ( 0 10 004) C CALL UT_RIBF ( iunbfo, 'PRES', + PR_M100 ( rivals ( irpres ) ), ierrbf ) C C* Mean sea level pressure in Pascals ( 0 10 051 ) C CALL UT_RIBF ( iunbfo, 'PMSL', + PR_M100 ( rivals ( irpmsl ) ), ierrbf ) C C* Characteristic of pressure change ( 0 10 063 ) C CALL UT_RIBF ( iunbfo, 'CHPT', rivals ( irchpt ), ierrbf ) C C* 3-hour pressure change ( 0 10 061 ) C CALL UT_RIBF ( iunbfo, '3HPC', + PR_M100 ( rivals ( ir3hpc ) ), ierrbf ) C C* Pressure ( 0 07 004 ) C CALL UT_RIBF ( iunbfo, 'PRLC', + PR_M100 ( rivals ( irisob ) ), ierrbf ) C C* Geopotential ( 0 10 008 ) C IF ( .not. ERMISS ( rivals ( irgeop ) ) ) THEN CALL UT_RIBF ( iunbfo, 'GP10', + ( rivals ( irgeop ) * GPGRAV ), ierrbf ) END IF C C* 24-hour pressure change ( 0 10 062 ) C CALL UT_RIBF ( iunbfo, '24PC', + PR_M100 ( rivals ( ir24pc ) ), ierrbf ) C C* Number of precipitation values. C nvals = NINT ( rivals ( irnpcv ) ) IF ( nvals .gt. 0 ) THEN DO i = 1, nvals C C* Determine period of precip C IF ( ERMISS ( rivals ( irpprd ( i ) ) ) ) THEN ipd = 0 ELSE ipd = NINT ( rivals ( irpprd ( i ) ) ) END IF C IF ( .not. ERMISS ( rivals ( irpamt ( i ) ) ) ) THEN C C* Total precip past 6 hours ( 0 13 021 ). C IF ( ipd .eq. 6 ) THEN CALL UT_RIBF ( iunbfo, 'TP06', + rivals ( irpamt ( i ) ), ierrbf ) ELSE IF ( ipd .eq. 24 ) THEN C C* Total precip past 24 hours ( 0 13 023 ). C CALL UT_RIBF ( iunbfo, 'TP24', + rivals ( irpamt ( i ) ), ierrbf ) ELSE IF ( ipd .eq. 1 ) THEN C C* Total precip past 1 hour ( 0 13 019 ). C CALL UT_RIBF ( iunbfo, 'TP01', + rivals ( irpamt ( i ) ), ierrbf ) ELSE IF ( ipd .eq. 3 ) THEN C C* Total precip past 3 hours ( 0 13 020 ). C CALL UT_RIBF ( iunbfo, 'TP03', + rivals ( irpamt ( i ) ), ierrbf ) ELSE IF ( ipd .eq. 12 ) THEN C C* Total precip past 12 hours ( 0 13 022 ). C CALL UT_RIBF ( iunbfo, 'TP12', + rivals ( irpamt ( i ) ), ierrbf ) ELSE IF ( ipd .eq. 2 .or. ipd .eq. 9 .or. + ipd .eq. 15 .or. ipd .eq. 18. or. + ipd .eq. 0 ) THEN C C* Total precip past 2, 9, 15, 18, or 0 hours ( 0 13 011 ). C* Don't store period if ipd = 0. BUFR will default to C* R8BFMS in this case, which is what we want. C CALL UT_RIBF ( iunbfo, 'TOPC', + rivals ( irpamt ( i ) ), ierrbf ) IF ( ipd .ne. 0 ) THEN CALL UT_RIBF ( iunbfo, '.DTHTOPC', + rivals ( irpprd ( i ) ), ierrbf ) END IF END IF END IF END DO END IF C C* Present and past weather. Determine if station is manned (iritso C* = 1), automated (iritso = 7), or automated using Code tables 4677 C* and 4561 ( iritso = 4 ) (which are the same tables used by manned C* stations), so we know which interface mnemonics to use. C IF ( rivals ( iritso ) .eq. 1 .or. + rivals ( iritso ) .eq. 4 ) THEN c C* Present weather ( 0 20 003 ) C CALL UT_RIBF ( iunbfo, 'PRWE', rivals ( irwwmo ), ierrbf ) C C* Past weather 1 ( 0 20 004 ) C CALL UT_RIBF ( iunbfo, 'PSW1', rivals ( irpwwm ), ierrbf ) C C* Past weather 2 ( 0 20 005 ) C CALL UT_RIBF ( iunbfo, 'PSW2', rivals ( irpsw2 ), ierrbf ) C ELSE IF ( rivals ( iritso ) .eq. 7 ) THEN C C* Present weather ( 0 20 003 ) C IF ( .not. ERMISS ( rivals ( irwwma ) ) ) THEN CALL UT_RIBF ( iunbfo, 'PRWE', + ( rivals ( irwwma ) + 100. ), ierrbf ) END IF C C* Past weather 1 ( 0 20 004 ) C IF ( .not. ERMISS ( rivals ( irpwwa ) ) ) THEN CALL UT_RIBF ( iunbfo, 'PSW1', + ( rivals ( irpwwa ) + 10. ), ierrbf ) END IF C C* Past weather 2 ( 0 20 005 ) C IF ( .not. ERMISS ( rivals ( irpwa2 ) ) ) THEN CALL UT_RIBF ( iunbfo, 'PSW2', + ( rivals ( irpwa2 ) + 10. ), ierrbf ) END IF END IF C C* Period and height of waves (instruments) (0 22 011, 0 22 021) C CALL UT_RIBF ( iunbfo, 'POWV', rivals ( irwper ), ierrbf ) CALL UT_RIBF ( iunbfo, 'HOWV', rivals ( irwhgt ), ierrbf ) C C* Period and height of wind waves (0 22 012, 0 22 022) C CALL UT_RIBF ( iunbfo, 'POWW', rivals ( irpoww ), ierrbf ) CALL UT_RIBF ( iunbfo, 'HOWW', rivals ( irhoww ), ierrbf ) C C* Swell data ( 0 22 003, 0 22 013, 0 22 23 ) C C* Number of systems of swell observed C nrep = NINT ( rivals ( irnswv ) ) IF ( nrep .gt. 0 .and. nrep .le. 2 ) THEN DO j = 1, nrep r8swv ( LWDOSW, j ) = + UT_RIBM ( rivals ( irdosw ( j ) ) ) r8swv ( LWPOSW, j ) = + UT_RIBM ( rivals ( irposw ( j ) ) ) r8swv ( LWHOSW, j ) = + UT_RIBM ( rivals ( irhosw ( j ) ) ) END DO CALL UFBINT ( iunbfo, r8swv, NCSWV, nrep, ierufb, + CSWVST ) END IF C C* General cloud information (BBXX section 1 data) C C* % of total cloud cover ( 0 20 010 ) C* Convert to % (100. * (cfrt/8.)) C C* Note that a cfrt value of 9 will generate a corresponding C* TOCC value of 113%, but this is the correct practice C* according to Note (5) of BUFR Table B, Class 20. C IF ( .not. ERMISS ( rivals ( ircfrt ) ) ) THEN CALL UT_RIBF ( iunbfo, 'TOCC', + ( rivals ( ircfrt ) * 12.5 ), ierrbf ) END IF C C* Height of lowest cloud seen (0 20 201) C CALL UT_RIBF ( iunbfo, 'HBLCS', rivals ( irhblc ), ierrbf ) C C* Multi-layer cloud data C C* Sections 1, 3, and 4 cloud layer data C nrep = NINT ( rivals ( irnclo ) ) C IF ( nrep .gt. 0 .and. nrep .le. 9 ) THEN DO i = 1, nrep r8cld ( LCVSSO, i ) = + UT_RIBM ( rivals ( irvsso ( i ) ) ) r8cld ( LCCLAM, i ) = + UT_RIBM ( rivals ( irclam ( i ) ) ) r8cld ( LCCLTP, i ) = + UT_RIBM ( rivals ( ircltp ( i ) ) ) r8cld ( LCHOCB, i ) = + UT_RIBM ( rivals ( irhocb ( i ) ) ) r8cld ( LCCTDS, i ) = + UT_RIBM ( rivals ( irctds ( i ) ) ) r8cld ( LCHOCT, i ) = + UT_RIBM ( rivals ( irhoct ( i ) ) ) END DO CALL UFBINT ( iunbfo, r8cld, NCCLD, nrep, ierufb, + CCLDST ) END IF C C* Duration of period in hours of newly fallen snow C CALL UT_RIBF ( iunbfo, '.DTHDOFS', + rivals ( irdhfs ), ierrbf ) C C* Depth of newly fallen snow ( 0 13 012 ) C CALL UT_RIBF ( iunbfo, 'DOFS', rivals ( irdofs ), ierrbf ) C C* Total depth of snow on the ground ( 0 13 013 ) C IF ( rivals ( irsncm ) .lt. 997. ) THEN C C* Convert from centimeters to meters C CALL UT_RIBF ( iunbfo, 'TOSD', + PR_D100 ( rivals ( irsncm ) ), ierrbf ) ELSE IF ( rivals ( irsncm ) .eq. 997. ) THEN C C* Trace of snow C CALL UT_RIBF ( iunbfo, 'TOSD', -0.01, ierrbf ) ELSE IF ( rivals ( irsncm ) .eq. 998. ) THEN C C* Snow cover, not continuous C CALL UT_RIBF ( iunbfo, 'TOSD', -0.02, ierrbf ) END IF C C* State of the ground code figure ( 0 20 062 ) C C* Without snow or measurable ice cover. C CALL UT_RIBF ( iunbfo, 'SOGR', rivals ( irsgr1 ), ierrbf ) C C* With snow or measurable ice cover. C IF ( .not. ERMISS ( rivals ( irsgr2 ) ) ) THEN CALL UT_RIBF ( iunbfo, 'SOGR', + ( rivals ( irsgr2 ) + 10. ), ierrbf ) END IF C C* Add US city data to BUFR output C IF ( ctyflg ) THEN C C* City temperature ( 0 12 193 ) C CALL UT_RIBF ( iunbfo, 'CTTP', + PR_TMCK ( rivals ( ircttp ) ), ierrbf ) C C* City max temperature ( 0 12 194 ) (already in deg K) C CALL UT_RIBF ( iunbfo, 'CTMX', rivals ( irctmx ), ierrbf ) C C* City min temperature ( 0 12 195 ) (already in deg K) C CALL UT_RIBF ( iunbfo, 'CTMN', rivals ( irctmn ), ierrbf ) END IF C C* Raw report C CALL UT_CIBF ( iunbfo, 'RRSTG', lsfrpt, lszrpt, iercbf ) C C* Write BUFR message to BUFR output file C CALL UT_WBFR ( iunbfo, 'lsfc', 0, ierwbf ) C* RETURN END