SUBROUTINE CG_WIND ( cgrpt, mszrpt, ipt, iret ) C************************************************************************ C* CG_WIND * C* * C* This subroutine decodes the wind data in one report. It separates * C* the wind direction and wind speed from the input string and calls * C* separate subroutines to decode and store the wind dir. and speed. * C* * C* CG_WIND ( CGRPT, MSZRPT, IPT, IRET ) * C* * C* Input parameters: * C* MSZRPT INTEGER Length of report in bytes * C* CGRPT CHAR* Report array * C* * C* Output parameters passed via common: * C* RIVALS(IRWHGT) REAL wave height * C* RIVALS(IRWPER) REAL wave period * C* RIVALS(IRSKNT) REAL wind speed (kts) * C* RIVALS(IRDRCT) REAL wind direction * C* RIVALS(IRISWS) REAL source units for wind speed * C* RIVALS(IRGUST) REAL max. wind speed (gust) (kts) * C* * C* Input and Output parameters: * C* IPT INTEGER Pointer to start of field. * C* * C* Output parameters: * C* IRET INTEGER Return code * C* 0 = Normal return * C* -1 = No / found in rest of rpt * C* -2 = Bad wind speed * C* -3 = Error rtn from UT_BKGP * C** * C* Log: * C* C. Caruso Magee/NCEP 4/00 Original Author * C* C. Caruso Magee/NCEP 6/00 Change irsped to irsknt * C* C. Caruso Magee/NCEP 9/00 Add code to handle variable wind dir. * C* C. Caruso Magee/NCEP 2/01 Add code to handle gusts in wind col. * C* J. Ator/NCEP 8/01 CG_BKGP -> UT_BKGP * C* C. Caruso Magee/NCEP 2/02 SUWS -> ISWS * C* C. Caruso Magee/NCEP 6/04 Fixed wlog error number. * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'cgcmn.cmn' character*(*) cgrpt character*100 stwind, outst character*100 wdstring, wsstring, guststring character*4 parm logical found integer mszrpt integer length integer islash integer kret, lret, mret data parm/'WIND'/ iret = 0 i = ipt found = .false. C C* look for '/' character. stop looping when the '/' we found is C* the field separator. C DO WHILE ( .not. found ) IF ( i .le. mszrpt ) THEN islash = index(cgrpt(i:i),'/') IF ( islash .eq. 0 ) THEN i = i + 1 ELSE iendwd = i - 1 found = .true. END IF ELSE iret = -1 return END IF END DO C C* wind field lies between ipt and iendwd (inclusive). C* compress blanks out of wind field. C stwind = cgrpt(ipt:iendwd) CALL ST_RMBL ( stwind, outst, length, kret ) IF ( length .gt. 1 ) THEN C C* split wind group into 'like-type'groups to facilitate decoding. C iretbg = 0 CALL UT_BKGP ( outst, iretbg ) IF ( iretbg .ne. 0 ) THEN iret = -3 RETURN END IF IF ( nflds .eq. 1 ) THEN IF ( itypsf(1) .eq. ALPHA ) THEN IF ( fields(1) .eq. 'CALM' ) THEN rivals(irdrct) = 0. rivals(irsknt) = 0. rivals(irisws) = 4. ELSE C C* Field is either wind direction only or is garbage. C WRITE ( UNIT = logmsg, FMT = '( A )' ) * ' Missing wind speed or bad format!' CALL DC_WLOG ( 2, 'CG', 1, logmsg, ierwlg ) ipt = iendwd + 2 RETURN END IF ELSE C C* Wind direction missing, so just skip this field. C WRITE ( UNIT = logmsg, FMT = '( A )' ) * ' Missing wind direction!' CALL DC_WLOG ( 2, 'CG', 1, logmsg, ierwlg ) ipt = iendwd + 2 RETURN END IF ELSEIF ( nflds .eq. 2 .or. nflds .eq. 4 ) THEN C C* decode wind direction. C IF ( itypsf(1) .eq. ALPHA ) THEN wdstring = fields(1) CALL CG_GTWD ( wdstring, parm, lret ) ELSE ipt = iendwd + 2 RETURN END IF C C* decode wind speed if direction was successfully decoded. C IF ( lret .eq. 0 ) THEN wsstring = fields(2) CALL CG_GTWS ( wsstring, lensf(2), mret ) IF ( mret .lt. 0 ) THEN C C* bad wind speed field - probable decode error (code is C* decoding the wrong field due to some format error), so C* stop decoding this entire report and go get the next C* report. C logmsg = 'Bad wind speed of '//wsstring(1:lensf(2)) CALL DC_WLOG ( 2, 'CG', -3, logmsg, ierwlg ) WRITE ( UNIT = logmsg, FMT = '( A )' ) * ' Skip this report!' CALL DC_WLOG ( 2, 'CG', 1, logmsg, ierwlg ) iret = -2 RETURN END IF C C* check to see if wdir was variable but speed is greater than C* 6 kts (2 m/s). If so, set wdir, wspd, and isws to missing. C* NOTE: CG always reports wind speed in kts, so the 2nd C* check for isws = 1 (m/s) and irsknt = 2 m/s can never be! C* Also, nowhere in this decoder is irdrct ever set to -99, C* so that check will always be false unless the actual report C* contains a -99! C IF ( ( rivals(irdrct) .eq. -99. ) .and. * ( ( rivals(irisws) .eq. 4 .and. * rivals(irsknt) .gt. 6. ) .or. * ( rivals(irisws) .eq. 1 .and. * rivals(irsknt) .gt. 2 ) ) ) THEN rivals(irdrct) = RMISSD rivals(irsknt) = RMISSD rivals(irisws) = RMISSD END IF END IF C C* decode gust if present. C IF ( nflds .eq. 4 ) THEN IF ( itypsf(3) .eq. ALPHA .and. fields(3) .eq. 'G' ) THEN IF ( itypsf(4) .eq. NMR ) THEN guststring = fields(4) CALL ST_INTG ( guststring(1:lensf(4)), ist1, ier ) IF ( ier .eq. 0 .and. ist1 .lt. 300 ) THEN rivals ( irgust ) = FLOAT ( ist1 ) END IF ELSE logmsg = 'Invalid (non-numeric) gust field ' // * 'in wind column' CALL DC_WLOG ( 2, 'CG', 3, logmsg, ierwlg ) ipt = iendwd + 2 RETURN END IF ELSE logmsg = 'Invalid fields trailing wind speed' CALL DC_WLOG ( 2, 'CG', 3, logmsg, ierwlg ) ipt = iendwd + 2 RETURN END IF END IF END IF ELSE C C* wind field is blank or missing C ipt = iendwd + 2 RETURN END IF ipt = iendwd + 2 RETURN END