SUBROUTINE CG_PRTM ( fldnoin, fldnoout, presdone, rmksdone, ier ) C************************************************************************ C* CG_PRTM * C* * C* This subroutine decodes the altimeter or pressure and any numerical * C* remarks fields in a single report. * C* * C* CG_PRTM ( 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* RIVALS(IRMNTH) REAL observation month * C* * C* Output parameters passed via common: * C* RIVALS(IRALTI) REAL altimeter setting (in. Hg) * C* RIVALS(IRPMSL) REAL sea-level pressure (mb) * C* RIVALS(IRPRES) REAL station pressure (mb) * C* RIVALS(IRMXTM) REAL maximum temperature (deg F) * C* RIVALS(IRMITM) REAL minimum temperature (deg F) * 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* FLDNOOUT INTEGER Number of next field to work on * 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 8/00 Fix bug in mon. check (missing rivals())* C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'cgcmn.cmn' integer fldnoin, fldnoout logical presdone, rmksdone integer ier C C* Field is either pressure or max/min temp. in Remarks. C* Check length to see if it's 4 digit altimeter (e.g. 2982), C* 4 digit barometer (e.g. 1018), first 2 digits of 5-digit alti C* (e.g. '29' of 29.82), or 5-digit max/min temp (e.g. 45441, where C* '54' is max temp and '41' is min temp). Also check for max/min C* temperature field encoded as '454//' (min temp missing) or C* '4//41' (max temp missing). C i = fldnoin IF ( lensf(i) .eq. 5 ) THEN IF ( fields(i)(1:1) .eq. '4' ) THEN c c* get maximum temperature. c CALL ST_INTG ( fields(i)(2:3), ist1, ier ) rivals(irmxtm) = FLOAT( ist1 ) IF ( rivals(irmnth) .gt. 3 .and. * rivals(irmnth) .lt. 11 ) THEN c c* check for 100+ temperatures. c IF ( ist1 .lt. 20 ) THEN rivals(irmxtm) = FLOAT( ist1 ) + 100. END IF ELSE c c* check for sub-zero temperatures. c IF ( ist1 .ge. 90 ) THEN rivals(irmxtm) = FLOAT( ist1 ) - 100. END IF END IF c c* get minimum temperature. c CALL ST_INTG ( fields(i)(4:5), ist1, ier ) rivals(irmitm) = FLOAT( ist1 ) IF ( rivals(irmnth) .lt. 5 .or. * rivals(irmnth) .gt. 10 ) THEN c c* check for sub-zero temperatures. c IF ( ist1 .gt. 70 .and. rivals(irtmpf) .lt. ist1 ) THEN rivals(irmitm) = FLOAT( ist1 ) - 100. END IF END IF presdone = .true. rmksdone = .true. fldnoout = fldnoin + 1 ELSE c c* bad group or format error. c WRITE ( UNIT = logmsg, FMT = '( A )' ) * ' Invalid group/format error (len = 5) in numerical rmks.' CALL DC_WLOG ( 2, 'CG', 1, logmsg, ierwlg ) fldnoout = fldnoin + 1 END IF ELSEIF ( lensf(i) .eq. 4) THEN IF ( .not. presdone ) THEN IF ( fields(i)(1:1) .eq. '1' ) THEN c c* Pressure in millibars. Check upper bound before saving and c* copy into pmsl if selv .lt. 7.5 meters. c CALL ST_INTG ( fields(i)(1:4), ist1, ier ) IF ( ist1 .le. 1100 ) THEN rivals(irpres) = FLOAT( ist1 ) IF ( rivals(irselv) .lt. 7.5 ) THEN rivals(irpmsl) = rivals(irpres) END IF END IF ELSEIF ( fields(i)(1:1) .eq. '2' .or. * fields(i)(1:1) .eq. '3' ) THEN c c* Altimeter reading in inches of mercury. Check upper bound c* before saving. c CALL ST_INTG ( fields(i)(1:4), ist1, ier ) IF ( ist1 .le. 3350 ) THEN rivals(iralti) = FLOAT( ist1 ) / 100. END IF ELSE c c* bad group or format error. c WRITE ( UNIT = logmsg, FMT = '( A )' ) * ' Invalid group/format error (len = 4) in numerical rmks.' CALL DC_WLOG ( 2, 'CG', 1, logmsg, ierwlg ) END IF presdone = .true. fldnoout = fldnoin + 1 ELSE c c* bad group or format error. c WRITE ( UNIT = logmsg, FMT = '( A )' ) * ' Invalid group/format error (len = 4) in numerical rmks.' CALL DC_WLOG ( 2, 'CG', 1, logmsg, ierwlg ) END IF ELSEIF ( lensf(i) .eq. 3) THEN IF (fields(i)(1:1) .eq. '4') THEN c c* maximum temperature c CALL ST_INTG ( fields(i)(2:3), ist1, ier ) rivals(irmxtm) = FLOAT( ist1 ) IF ( rivals(irmnth) .gt. 3 .and. * rivals(irmnth) .lt. 11 ) THEN c c* check for 100+ temperatures. c IF ( ist1 .lt. 20 ) THEN rivals(irmxtm) = FLOAT( ist1 ) + 100. END IF ELSE c c* check for sub-zero temperatures. c IF ( ist1 .ge. 90 ) THEN rivals(irmxtm) = FLOAT( ist1 ) - 100. END IF END IF ELSE c c* bad group or format error. c WRITE ( UNIT = logmsg, FMT = '( A )' ) * ' Invalid group/format error (len = 3) in numerical rmks.' CALL DC_WLOG ( 2, 'CG', 1, logmsg, ierwlg ) END IF presdone = .true. rmksdone = .true. fldnoout = fldnoin + 2 ELSEIF ( lensf(i) .eq. 2 ) THEN IF ( .not. presdone ) THEN c c* check to see if it's first 2 digits of altimeter. c CALL ST_INTG ( fields(i)(1:2), ist1, ier) tmp1alti = FLOAT( ist1 ) IF (fields(i+1) .ne. '.') THEN c c* format error (alti not of optional form xx.xx). c WRITE ( UNIT = logmsg, FMT = '( A )' ) * ' Format error in alti/baro.' CALL DC_WLOG ( 2, 'CG', 1, logmsg, ierwlg ) presdone = .true. fldnoout = fldnoin + 1 RETURN ELSE c c* get last 2 digits (10th's and 100th's) of altimeter. c* check upper bound before saving. c CALL ST_INTG ( fields(i+2)(1:2), ist1, ier) tmp2alti = FLOAT( ist1 ) altitmp = tmp1alti + ( tmp2alti / 100. ) IF ( altitmp .le. 33.50 ) THEN rivals(iralti) = altitmp END IF fldnoout = fldnoin + 3 presdone = .true. END IF END IF ELSEIF ( lensf(i) .eq. 1) THEN IF (fields(i)(1:1) .eq. '4') THEN IF ( lensf(i+1) .eq. 2 .and. * fields(i+1) .eq. '//' ) THEN c c* max temp. is missing so get min temp. c CALL ST_INTG ( fields(i+2)(1:2), ist1, ier ) rivals(irmitm) = FLOAT( ist1 ) IF ( rivals(irmnth) .lt. 5 .or. * rivals(irmnth) .gt. 10 ) THEN c c* check for sub-zero temperatures. c IF ( ist1 .gt. 70 .and. irtmpf .lt. ist1 ) THEN rivals(irmitm) = FLOAT( ist1 ) - 100. END IF END IF END IF ELSE c c* bad group or format error. c WRITE ( UNIT = logmsg, FMT = '( A )' ) * ' Invalid group/format error (len = 1) in numerical rmks.' CALL DC_WLOG ( 2, 'CG', 1, logmsg, ierwlg ) END IF presdone = .true. rmksdone = .true. fldnoout = fldnoin + 3 ELSE fldnoout = fldnoin + 1 END IF c c* check to see if both max temp. and min temp were saved. c* if so, and max is less than min, set both to missing. c IF ( rivals(irmxtm) .ne. RMISSD .and. * rivals(irmitm) .ne. RMISSD ) THEN IF ( rivals(irmxtm) .lt. rivals(irmitm) ) THEN WRITE ( UNIT = logmsg, FMT = '( A, 2F6.2 )' ) * ' Max temp lt min temp...mxtm, mitm =', * rivals(irmxtm), rivals(irmitm) CALL DC_WLOG ( 2, 'CG', 1, logmsg, ierwlg ) rivals(irmxtm) = RMISSD rivals(irmitm) = RMISSD END IF END IF RETURN END