SUBROUTINE LS_OST0 ( lszrpt, lsfrpt, istarr, ipt, iret ) C************************************************************************ C* LS_OST0 * C* * C* This subroutine decodes the groups in section 0 of the FM 14 mobil * C* land station report. Section 0 contains the station ID, the obs day * C* and hour, the wind speed indicator, the station latitude/longitude * C* postion, the number of the Marsden square in which the station is * C* situated, and the elevation of the mobile land station. * C* * C* LS_OST0 ( LSZRPT, LSFRPT, ISTARR, IPT, IRET ) * C* * C* Input parameters: * C* LSZRPT INTEGER Report size * C* LSFRPT CHAR* Report array * C* ISTARR (*) INTEGER System time - YYYY,MM,DD,HH,MM * C* * C* Output parameters: * C* CIVALS(ICSTID) CHAR* Report ID * C* YYGGI CHAR* YYGGi(w) group in FM 14 MOBIL * C* SYNOP report * C* RIVALS(IRISWS) REAL Indicator for source and * C* units of wind speed * C* (WMO Code Table 1855) * C* RIVALS(IRSELV) REAL Elevation of station in meters * C* RIVALS (IRQCVR) REAL Elevation quality flag * C* RIVALS(IRSLAT) REAL Latitude in degrees * C* RIVALS(IRSLON) REAL Longitude in degrees * C* IHOUR INTEGER Hour of observation of report * C* IRPTDT (*) INTEGER Report date-time * C* (YYYY, MM, DD, HH, MM) * C* IPT INTEGER Pointer to start of next group * C* IRET INTEGER Return code * C* 0 = normal return * C* 1 = problems * C** * C* Log: * C* R. Hollern/NCEP 08/02 * C* J. Ator/NCEP 06/11 Allow up to 8 characters in station ID * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'lscmn.cmn' C* CHARACTER*(*) lsfrpt INTEGER istarr(*) C* CHARACTER stnid*8, yyggi*5 CHARACTER fld4*4, fld3*3, fld1*1 LOGICAL more C------------------------------------------------------------------------ iret = 0 more = .true. jp = 0 ip = 0 stnid = ' ' C C* Get station ID from lsfrpt. Use ip which points to start of ID. C* Locate next space following the end of ID. C DO WHILE ( more ) C ip = ip + 1 IF ( lsfrpt ( ip:ip ) .ne. ' ' ) THEN jp = jp + 1 IF ( jp .lt. 9 ) stnid ( jp:jp ) = lsfrpt ( ip:ip ) ELSE more = .false. END IF C END DO C C* Save report ID. C civals ( icstid ) = stnid C ip = ip + 1 C ipt = ip C C* Get obs day of month, hour, and wind speed indicator. C yyggi = lsfrpt ( ip:ip+4 ) C ip = ip + 5 C CALL LS_YYGG ( yyggi, istarr, nret ) C IF ( nret .ne. 0 ) THEN ierrno = 3 CALL LS_ERRS ( ierrno, lsfrpt, kret ) iret = 1 RETURN END IF C C* Get latitude from next group. C IF ( lsfrpt ( ip:ip+2 ) .ne. ' 99' ) THEN iret = 1 RETURN END IF C ip = ip + 3 fld3 = lsfrpt ( ip:ip+2 ) CALL ST_INTG ( fld3, ival, ier ) rval = FLOAT ( ival ) IF ( ier .eq. 0 .and. rval .le. 900. ) THEN ip = ip + 3 xlat = .1 * rval ELSE iret = 1 RETURN END IF C C* The next character is a space, if not, problems. C IF ( lsfrpt ( ip:ip ) .eq. ' ' ) THEN ip = ip + 1 ELSE iret = 1 END IF C C* Get quadrant of the globe. C fld1 = lsfrpt ( ip:ip ) CALL ST_INTG ( fld1, iquad, ier ) IF ( ier .eq. 0 ) THEN ip = ip + 1 ELSE iret = 1 RETURN END IF C C* Get the longitude. C fld4 = lsfrpt ( ip:ip+3 ) CALL ST_INTG ( fld4, ival, ier ) rval = FLOAT ( ival ) IF ( ier .eq. 0 .and. rval .lt. 1800. ) THEN ipt = ip + 4 xlong = .1 * rval ELSE ipt = ip + 4 iret = 1 RETURN END IF C C* Determine the sign of the lat/long from quadrant of globe. C IF ( iquad .eq. 7 ) THEN C C* North lat, West long (e.g. North America) C xlong = -xlong ELSE IF ( iquad .eq. 5 ) THEN C C* South lat, West long (e.g. South America) C xlat = -xlat xlong = -xlong ELSE IF ( iquad .eq. 3 ) THEN C C* South lat, East long (e.g. Australia, part of Africa) C xlat = -xlat ELSE IF (iquad .ne. 1 ) THEN C C* iquad = 1 is North lat, East long (e.g. Europe, most of Asia), C* so anything at this point other than 1 is an invalid quadrant C* value. C iret = 1 RETURN END IF C rivals ( irslat ) = xlat rivals ( irslon ) = xlong C C* Get the Marsden square in which the station is situated at C* the time of observation. C ip = ip + 5 C fld3 = lsfrpt ( ip:ip+2 ) CALL ST_INTG ( fld3, ival, ier ) IF ( ier .eq. 0 ) THEN rivals ( irmrsq ) = FLOAT ( ival ) END IF C C* At the present time the lat/long units digits C* associated with the Marsden square will not be decoded. C ip = ip + 6 ipt = ip + 5 C C* The elevation of the mobile land station. C fld4 = lsfrpt ( ip:ip+3 ) CALL ST_INTG ( fld4, ival, ier ) IF ( ier .eq. 0 ) Then selv = FLOAT ( ival ) ELSE RETURN END IF C C* Get the indicator for units of elevation and confidence C* factor for accuracy of elevation. (Code Table 1845). C ip = ip + 4 fld1 = lsfrpt ( ip:ip ) CALL ST_INTG ( fld1, ival, ier ) IF ( ier .ne. 0 ) RETURN C IF ( ival .ge. 1 .and. ival .le. 4 ) THEN ELSE IF ( ival .ge. 5 .and. ival .le. 8 ) THEN C C* Convert from feet to meters. C selv = PR_HGFM ( selv ) ELSE RETURN END IF C rivals ( irselv ) = selv rivals ( irqcvr ) = FLOAT ( ival ) C* RETURN END