SUBROUTINE AF_BFWX ( iunbfo, r8pwx, iret ) C************************************************************************ C* AF_BFWX * C* * C* For PIREP and RECCO reports, this subroutine creates present weather * C* BUFR data from present weather interface data and then writes it to * C* the BUFR output stream. * C* * C* AF_BFWX ( IUNBFO, R8PWX, IRET ) * C* * C* Input parameters: * C* IUNBFO INTEGER BUFR output file unit number * C* * C* Output parameters: * C* R8PWX (NCPWX,*) REAL*8 BUFR present weather output data* C* IRET INTEGER Return code * C* 0 = Normal return * C** * C* Log: * C* J. Ator/NP12 10/96 * C* J. Ator/NP12 12/96 Initialize wmco( ) to '' * C* J. Ator/NP12 08/97 New interface format, style changes * C* J. Ator/NCEP 12/97 AF_BFPW -> UT_BFPW * C* J. Ator/NCEP 01/98 Add calls to UT_CIBF and UT_RIBF, * C* remove calls to AF_BFOT * C* J. Ator/NCEP 08/99 /INTF base and top heights now in feet * C* J. Ator/NCEP 11/99 Initialize wcod( ) to ' ' * C* J. Ator/NCEP 06/01 Clean up * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'afcmn.cmn' INCLUDE 'afcmn_bufr.cmn' C* REAL*8 r8pwx ( NCPWX, * ), UT_RIBM C* CHARACTER wcod ( MXWLYR )*9 C* INTEGER iepx ( MXWLYR ), iprwe ( MXPRWE ) C----------------------------------------------------------------------- C C* Initialize variables. C iret = 0 DO jj = 1, MXWLYR wcod ( jj ) = ' ' END DO C C* Retrieve the present weather values from the interface arrays. C nwcod = INT ( rivals ( irnpwx ) ) IF ( nwcod .le. 0 ) THEN RETURN END IF DO jj = 1, nwcod wcod ( jj ) = civals ( icwcod ( jj ) ) END DO C C* Convert each present weather value from interface format C* into BUFR format. A single present weather value in C* interface format may result in more than one present C* weather value in BUFR format. C CALL UT_BFPW ( wcod, 1, iprwe, iepx, ierfpw ) IF ( ierfpw .ne. 0 ) THEN RETURN END IF C C* For each present weather value in BUFR format, copy it along C* with any associated altitude values into the BUFR output array. C IF ( bultyp .eq. PIREP ) THEN nprwe = 0 ispx = 1 DO jj = 1, nwcod IF ( iepx ( jj ) .ge. ispx ) THEN DO ii = ispx, iepx ( jj ) nprwe = nprwe + 1 r8pwx ( LXPRWE, nprwe ) = FLOAT ( iprwe ( ii ) ) r8pwx ( LXHBWX, nprwe ) = + UT_RIBM ( PR_HGFM ( rivals ( irhbwx ( jj ) ) ) ) r8pwx ( LXHTWX, nprwe ) = + UT_RIBM ( PR_HGFM ( rivals ( irhtwx ( jj ) ) ) ) END DO ispx = iepx ( jj ) + 1 END IF END DO CALL UFBINT ( iunbfo, r8pwx, NCPWX, nprwe, ierufb, CPWXST ) ELSE IF ( bultyp .eq. RECCO ) THEN IF ( iepx (1) .gt. 0 ) THEN CALL UT_RIBF ( iunbfo, 'PRWE', FLOAT ( iprwe (1) ), + ierrbf ) END IF END IF C* RETURN END