SUBROUTINE CG_RMKA (fldnoin,fldnoout,presdone,rmksdone,ier) C************************************************************************ C* CG_RMKA * C* * C* This subroutine decodes the character remarks fields in a single * C* report. * C* * C* CG_RMKA ( FLDNOIN, FLDNOOUT, presdone, rmksdone, ier ) * C* * C* Input parameters: * C* FLDNOIN INTEGER Number of field to work on. * C* * C* Input parameters passed via common: * C* fields CHAR*(*) Array of fields found in input * C* string * C* lensf INTEGER Array of lengths of fields * C* RIVALS(IRSELV) REAL station elevation (m) * C* RIVALS(IRTMPF) REAL air temperature (deg F) * C* * C* Output parameters passed via common: * C* RIVALS(IRTERC) REAL tidal elev. relative to local * C* chart (inches) * C* RIVALS(IRHOCB) REAL height of cloud base (meters) * C* RIVALS(IRGUST) REAL max. wind speed (gust) (kts) * C* RIVALS(IRMXWH) REAL maximum wave height (ft) * C* RIVALS(IRCORN) REAL correction indicator * C* * C* Input and Output parameters: * C* presdone LOGICAL if true, pressure field has been* C* decoded. * C* rmksdone LOGICAL if true, remarks fields have * C* been decoded. * C* * C* Output parameters: * C* IER INTEGER Return code * C* 0 = Normal return * C* non-zero = Problem * C** * C* Log: * C* C. Caruso Magee/NCEP 4/00 Original Author * C* C. Caruso Magee/NCEP 6/00 Changing SPWS to GUST (single-level) * C* C. Caruso Magee/NCEP 6/00 Remove NCLO, NSWV * C* C. Caruso Magee/NCEP 8/00 Add decoding of gust format Gxx (xx is * C* wind gust speed in knots) * C* C. Caruso Magee/NCEP 8/00 Add setting of ircorn if report contains* C* COR in remarks. * C* C. Caruso Magee/NCEP 3/01 Correct units for cloud base height. * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'cgcmn.cmn' integer fldnoin, fldnoout logical presdone logical rmksdone character*5 parm integer ier data parm/'SWELL'/ ier = 0 i = fldnoin IF ( lensf(i) .eq. 5 ) THEN IF ( fields(i) .eq. 'GUSTY' ) THEN fldnoout = fldnoin + 1 rmksdone = .true. RETURN ELSEIF ( fields(i) .eq. 'MINUS' ) THEN CALL ST_INTG ( fields(i+1)(1:lensf(i+1)), ist1, ier ) IF ( ier .eq. 0 .and. ist1 .lt. 1000 ) THEN rivals ( irterc ) = FLOAT( -ist1 ) C C* check to see if next field is alpha or numeric. C* if alpha, it's station name, else it's more remarks. C IF ( itypsf(i+2) .eq. NMR ) THEN fldnoin = i + 2 CALL CG_PRTM(fldnoin,fldnoout,presdone,rmksdone,ier) fldnoout = fldnoin + 3 ELSE fldnoout = fldnoin + 2 END IF ELSE WRITE ( UNIT = logmsg, FMT = '( A )' ) * ' Invalid group/format error in char remarks' CALL DC_WLOG ( 2, 'CG', 1, logmsg, ierwlg ) fldnoout = fldnoin + 2 END IF END IF ELSEIF ( lensf(i) .eq. 4 ) THEN IF ( fields(i) .eq. 'CEIL' ) THEN c c ceiling (height of cloud base) c IF ( itypsf(i+1) .eq. ALPHA ) THEN IF ( fields(i+1) .eq. 'UNL' ) THEN fldnoout = fldnoin + 2 ELSE fldnoout = fldnoin + 1 END IF ELSEIF ( itypsf(i+1) .eq. NMR ) THEN IF ( lensf(i+1) .eq. 3 ) THEN c c ceiling is in hundreds of feet, so convert to feet, c then to meters before saving into irhocb. c CALL ST_INTG ( fields(i+1)(1:lensf(i+1)), ist1, ier ) IF ( ier .eq. 0 ) THEN rivals ( irhocb ) = FLOAT( ist1 ) * 100./3.28 fldnoout = fldnoin + 2 END IF ELSE fldnoout = fldnoin + 2 END IF ELSE fldnoout = fldnoin + 2 END IF ELSEIF ( fields(i) .eq. 'GUST' ) THEN IF ( itypsf(i+1) .eq. NMR ) THEN CALL ST_INTG ( fields(i+1)(1:lensf(i+1)), ist1, ier ) IF ( ier .eq. 0 .and. ist1 .lt. 300 ) THEN rivals ( irgust ) = FLOAT ( ist1 ) fldnoout = fldnoin + 2 ELSE fldnoout = fldnoin + 2 END IF ELSE WRITE ( UNIT = logmsg, FMT = '( A )' ) * ' Invalid group/format error in char remarks' CALL DC_WLOG ( 2, 'CG', 1, logmsg, ierwlg ) fldnoout = fldnoin + 1 END IF ELSEIF ( fields(i) .eq. 'PLUS' ) THEN CALL ST_INTG ( fields(i+1)(1:lensf(i+1)), ist1, ier ) IF ( ier .eq. 0 .and. ist1 .lt. 1000 ) THEN rivals ( irterc ) = FLOAT ( ist1 ) C C* check to see if next field is alpha or numeric. C* if alpha, it's station name, else it's more remarks. C IF ( itypsf(i+2) .eq. NMR ) THEN fldnoin = i + 2 CALL CG_PRTM(fldnoin,fldnoout,presdone,rmksdone,ier) fldnoout = fldnoin + 3 ELSE fldnoout = fldnoin + 2 END IF ELSE WRITE ( UNIT = logmsg, FMT = '( A )' ) * ' Invalid group/format error in char remarks' CALL DC_WLOG ( 2, 'CG', 1, logmsg, ierwlg ) fldnoout = fldnoin + 2 END IF END IF rmksdone = .true. RETURN ELSEIF ( lensf(i) .eq. 3 ) THEN IF ( fields(i) .eq. 'SCA' ) THEN fldnoout = fldnoin + 1 rmksdone = .true. RETURN ELSEIF ( fields(i) .eq. 'UNL' ) THEN fldnoout = fldnoin + 1 rmksdone = .true. RETURN ELSEIF ( fields(i) .eq. 'COR' ) THEN rivals ( ircorn ) = 1. fldnoout = fldnoin + 1 ELSEIF ( fields(i) .eq. 'MAX' ) THEN IF ( itypsf(i+1) .eq. NMR ) THEN CALL ST_INTG ( fields(i+1)(1:lensf(i+1)), ist1, ier ) IF ( ier .eq. 0 .and. ist1 .lt. 200 ) THEN rivals ( irmxwh ) = FLOAT ( ist1 ) fldnoout = fldnoin + 3 ELSE fldnoout = fldnoin + 3 END IF ELSE fldnoout = fldnoin + 1 END IF rmksdone = .true. RETURN ELSEIF ( fields(i) .eq. 'SSW' .or. * fields(i) .eq. 'WSW' .or. * fields(i) .eq. 'WNW' .or. * fields(i) .eq. 'NNW' .or. * fields(i) .eq. 'NNE' .or. * fields(i) .eq. 'ENE' .or. * fields(i) .eq. 'ESE' .or. * fields(i) .eq. 'SSE' ) THEN IF ( fields(i+1) .eq. 'SWELL' .or. * fields(i+1) .eq. 'SWL' .or. * fields(i+1) .eq. 'SWEL' ) THEN CALL CG_GTWD ( fields(i), parm, iret ) fldnoout = fldnoin + 2 ELSE fldnoout = fldnoin + 1 END IF rmksdone = .true. RETURN END IF ELSEIF ( lensf(i) .eq. 2 ) THEN IF (fields(i) .eq. 'SE' .or. * fields(i) .eq. 'SW' .or. * fields(i) .eq. 'NW' .or. * fields(i) .eq. 'NE' ) THEN IF ( fields(i+1) .eq. 'SWELL' .or. * fields(i+1) .eq. 'SWL' .or. * fields(i+1) .eq. 'SWEL' ) THEN CALL CG_GTWD ( fields(i), parm, iret ) fldnoout = fldnoin + 2 ELSE fldnoout = fldnoin + 1 END IF ELSEIF ( fields(i) .eq. 'MX' ) THEN IF ( itypsf(i+1) .eq. NMR ) THEN CALL ST_INTG ( fields(i+1)(1:lensf(i+1)), ist1, ier ) IF ( ier .eq. 0 .and. ist1 .lt. 200 ) THEN rivals ( irmxwh ) = FLOAT ( ist1 ) fldnoout = fldnoin + 3 ELSE fldnoout = fldnoin + 3 END IF ELSE fldnoout = fldnoin + 1 END IF END IF rmksdone = .true. RETURN ELSEIF ( lensf(i) .eq. 1 .and. * (fields(i) .eq. 'S' .or. * fields(i) .eq. 'W' .or. * fields(i) .eq. 'N' .or. * fields(i) .eq. 'E' )) THEN IF ( fields(i+1) .eq. 'SWELL' .or. * fields(i+1) .eq. 'SWL' .or. * fields(i+1) .eq. 'SWEL' ) THEN CALL CG_GTWD ( fields(i), parm, iret ) fldnoout = fldnoin + 2 ELSE fldnoout = fldnoin + 1 END IF rmksdone = .true. RETURN ELSEIF ( lensf(i) .eq. 1 .and. * (fields(i) .eq. 'G' )) THEN IF ( itypsf(i+1) .eq. NMR ) THEN CALL ST_INTG ( fields(i+1)(1:lensf(i+1)), ist1, ier ) IF ( ier .eq. 0 .and. ist1 .lt. 300 ) THEN rivals ( irgust ) = FLOAT ( ist1 ) fldnoout = fldnoin + 2 ELSE fldnoout = fldnoin + 2 END IF ELSE fldnoout = fldnoin + 1 END IF END IF C C* If no match in this subroutine, character string is either C* a typo or the station name. C IF ( .not. rmksdone ) THEN fldnoout = fldnoin rmksdone = .true. END IF RETURN END