SUBROUTINE SY_WIND ( iubfma, iubfmn ) C************************************************************************ C* SY_WIND * C* * C* This routine gets and stores the wind data. * C* * C* SY_WIND ( IUBFMA, IUBFMN ) * C* * C* Input parameters: * C* IUBFMA INTEGER Logical unit number of messages * C* file for BUFR input stream * C* IUBFMN INTEGER Logical unit number of messages * C* file for BUFR output stream * C** * C* Log: * C* J. Ator/NCEP 09/12 * C* J. Ator/NCEP 05/17 Handle case when MXGD and MXGS are part * C* of WINDDATA sequence * C* J. Ator/NCEP 11/19 Handle additional data in NC001104 * C* J. Ator/NCEP 06/23 Process 3-07-092 messages * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'sycmn.cmn' C* REAL*8 r8wnd1 (8), r8wnd2 (3,3), GETVALNB C* CHARACTER tagwn1*10, tagwn2*10 C*----------------------------------------------------------------------- C C* Get and store the BSYWND1 data. C CALL UFBINT ( iubfma, r8wnd1, 2, 1, nlv, 'WDIR WSPD' ) r8wnd1 (6) = r8wnd1 (1) r8wnd1 (7) = r8wnd1 (2) C r8wnd1 (1) = GETVALNB ( iubfma, 'WDIR', 1, 'HSALG', -1 ) IF ( gots96 .or. gots91 ) THEN r8wnd1 (2) = GETVALNB ( iubfma, 'WDIR', 1, 'HSAWS', -1 ) r8wnd1 (3) = r8bfms ELSE r8wnd1 (2) = r8bfms r8wnd1 (3) = GETVALNB ( iubfma, 'WDIR', 1, 'TIWM', -1 ) END IF r8wnd1 (4) = GETVALNB ( iubfma, 'WDIR', 1, 'TSIG', -1 ) r8wnd1 (5) = GETVALNB ( iubfma, 'WDIR', 1, 'TPMI', -1 ) r8wnd1 (8) = r8bfms CALL UFBSEQ ( iubfmn, r8wnd1, 8, 1, nlv, 'BSYWND1' ) C C* Get and store the BSYWND2 data. C CALL GETTAGPR ( iubfma, 'MXGD', 1, tagwn1, ierwt1 ) IF ( ierwt1 .eq. 0 ) THEN CALL UFBSEQ ( iubfma, r8wk, MXMN, MXLV, nlv, tagwn1 ) IF ( tagwn1 (1:8) .eq. 'WINDDATA' ) THEN kk = 1 r8wnd2 (1,kk) = r8bfms r8wnd2 (2,kk) = r8wk (5,1) r8wnd2 (3,kk) = r8wk (6,1) ELSE IF ( gots92 ) THEN kk = 1 r8wnd2 (1,kk) = r8wk (3,1) r8wnd2 (2,kk) = r8wk (12,1) r8wnd2 (3,kk) = r8wk (14,1) ELSE kk = 0 DO jj = 1, nlv IF ( ( IBFMS ( r8wk (2,jj) ) .eq. 0 ) .or. + ( IBFMS ( r8wk (3,jj) ) .eq. 0 ) ) THEN kk = kk + 1 DO ii = 1, 3 r8wnd2 (ii,kk) = r8wk (ii,jj) END DO END IF END DO IF ( subtyp .eq. 'NC001104' ) THEN CALL GETTAGPR ( iubfma, 'MXGD', 3, tagwn2, ierwt2 ) IF ( ierwt2 .eq. 0 ) THEN CALL UFBSEQ ( iubfma, r8wk, MXMN, MXLV, nlv, + tagwn2 ) IF ( ( IBFMS ( r8wk (2,1) ) .eq. 0 ) .or. + ( IBFMS ( r8wk (3,1) ) .eq. 0 ) ) THEN kk = kk + 1 DO ii = 1, 3 r8wnd2 (ii,kk) = r8wk (ii,1) END DO END IF END IF END IF END IF IF ( kk .gt. 0 ) THEN CALL DRFINI ( iubfmn, kk, 1, '{BSYWND2}' ) CALL UFBSEQ ( iubfmn, r8wnd2, 3, kk, nlv2, 'BSYWND2' ) END IF END IF C* IF ( subtyp .eq. 'NC001104' ) THEN C C* Get and store the BCMWNDC data. C kk = 0 CALL GETTAGPR ( iubfma, 'WDIR', 3, tagwn1, ierwt1 ) IF ( ierwt1 .eq. 0 ) THEN CALL UFBSEQ ( iubfma, r8in, MXMN, MXLV, nlv, tagwn1 ) DO jj = 1, nlv IF ( ( IBFMS ( r8in (1,jj) ) .eq. 0 ) .or. + ( IBFMS ( r8in (2,jj) ) .eq. 0 ) ) THEN kk = kk + 1 DO ii = 1, 4 r8wk (ii,kk) = r8in (ii,jj) END DO END IF END DO END IF IF ( kk .gt. 0 ) THEN CALL DRFINI ( iubfmn, kk, 1, '{BCMWNDC}' ) CALL UFBSEQ ( iubfmn, r8wk, MXMN, kk, nlv2, 'BCMWNDC' ) END IF END IF C* RETURN END