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