SUBROUTINE LS_SEC1 ( lszrpt, lsfrpt, ipt, iret ) C************************************************************************ C* LS_SEC1 * C* * C* This subroutine decodes the groups in section 1 of the WMO FM12 * C* bulletin report. If the i(r)i(x)hVV or Nddff groups are missing * C* or garbled, then the report is considered invalid. These two groups * C* need to be included in the report, but the other section 1 groups * C* may or may not be included. * C* * C* LS_SEC1 ( LSZRPT, LSFRPT, IPT, IRET ) * C* * C* Input parameters: * C* LSZRPT INTEGER Report size * C* LSFRPT CHAR* Report array * C* LSEC1 INTEGER Length of section 1 in report * C* ISEC1 INTEGER Pointer to start of section 1 * C* * C* Output parameters: * C* IRET INTEGER Return code * C* 0 = normal return * C* 1 = problems * C* * C** * C* Log: * C* R. Hollern/NCEP 4/96 * C* R. Hollern/NCEP 11/96 Added the CALL to LS_GEOP * C* R. Hollern/NCEP 1/98 Changed interface and cleaned up code * C* A. Hardy/GSC 1/98 Reordered calling sequence, added GEMINC * C* R. Hollern/NCEP 2/98 Renamed subr from LS_SC1B to LS_SEC1 * C* S. Jacobs/NCEP 4/98 Fixed typo in the a3 DATA statement * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'lscmn.cmn' C* CHARACTER*(*) lsfrpt C* INTEGER jflg(10) LOGICAL mslp, more CHARACTER a3(5)*1, isurf*1 C* DATA a3 / '1', '2', '5', '7', '8' / C------------------------------------------------------------------------ iret = 0 C C* A group should only appear once in a section. This array will C* be used to flag those groups that are decoded in the section. C DO i = 1,10 jflg ( i ) = 0 END DO C C* Decode i(r)i(x)hVV group. C CALL LS_IIHV ( lsfrpt, ipt, iret ) C IF ( iret .eq. 1 ) RETURN C C* Decode the Nddff group. C CALL LS_NDDF ( lsfrpt, ipt, iret ) C IF ( iret .eq. 1 ) RETURN C iend = isec1 + lsec1 - 1 ist = ipt + 1 C DO WHILE ( ipt .lt. iend ) C ipt = ipt + 1 C IF ( lsfrpt ( ipt:ipt+1 ) .eq. ' 1' .and. + jflg ( 1 ) .eq. 0 ) THEN C C* Decode air temperature group. C ipt = ipt + 2 iparam = 1 CALL LS_TEMP ( lsfrpt, iparam, ipt, jret ) jflg ( 1 ) = 1 ELSE IF ( lsfrpt ( ipt:ipt+2 ) .eq. ' 29' .and. + jflg ( 2 ) .eq. 0 ) THEN C C* Decode relative humidity group. C ipt = ipt + 3 CALL LS_RELH ( lsfrpt, ipt, jret ) jflg ( 2 ) = 1 ELSE IF ( lsfrpt ( ipt:ipt+1 ) .eq. ' 2' .and. + jflg ( 3 ) .eq. 0 ) THEN C C* Decode dew point temperature group. C ipt = ipt + 2 iparam = 2 CALL LS_TEMP ( lsfrpt, iparam, ipt, jret ) jflg ( 3 ) = 1 ELSE IF ( lsfrpt ( ipt:ipt+1 ) .eq. ' 3' .and. + jflg ( 4 ) .eq. 0 ) THEN C C* Decode the station pressure group. C iparam = 0 ipt = ipt + 2 CALL LS_PRES ( lsfrpt, iparam, ipt, jret ) jflg (4) = 1 ELSE IF ( lsfrpt ( ipt:ipt+1 ) .eq. ' 4' .and. + jflg ( 5 ) .eq. 0 ) THEN C mslp = .true. more = .true. C C* Check if this is a geopotential height C* of an agreed standard isobaric surface. C i = 0 DO WHILE ( more ) i = i + 1 IF ( i .eq. 5 ) more = .false. C IF ( lsfrpt ( ipt+2:ipt+2 ) .eq. a3 ( i ) ) THEN mslp = .false. more = .false. isurf = a3(i) ipt = ipt + 2 CALL LS_GEOP ( lsfrpt, isurf, ipt, jret ) END IF END DO C IF ( mslp ) THEN C C* Decode the mean sea level pressure group. C iparam = 1 ipt = ipt + 2 CALL LS_PRES ( lsfrpt, iparam, ipt, jret ) END IF C jflg (5) = 1 ELSE IF ( lsfrpt ( ipt:ipt+1 ) .eq. ' 5' .and. + jflg ( 6 ) .eq. 0 ) THEN C C* Decode the station 3 hourly pressure change. C ipt = ipt + 2 CALL LS_PRS3 ( lsfrpt, ipt, jret ) jflg ( 6 ) = 1 ELSE IF ( lsfrpt ( ipt:ipt+1 ) .eq. ' 6' .and. + jflg ( 7 ) .eq. 0 ) THEN C C* Decode the precipitation group. C ipt = ipt + 2 iparam = 0 CALL LS_PREC ( lsfrpt, iparam, ipt, jret ) jflg ( 7 ) = 1 ELSE IF ( lsfrpt ( ipt:ipt+1 ) .eq. ' 7' .and. + jflg ( 8 ) .eq. 0 ) THEN C C* Decode the present and past weather group. C ipt = ipt + 2 CALL LS_MAWX ( lsfrpt, ipt, jret ) jflg ( 8 ) = 1 ELSE IF ( lsfrpt ( ipt:ipt+1 ) .eq. ' 8' .and. + jflg ( 9 ) .eq. 0 ) THEN C C* Decode the cloud group. C ipt = ipt + 2 CALL LS_CLD1 ( lsfrpt, ipt, jret ) jflg ( 9 ) = 1 ELSE IF ( lsfrpt ( ipt:ipt+1 ) .eq. ' 9' .and. + jflg (10) .eq. 0 ) THEN C C* Decode the obs time group. C ipt = ipt + 2 CALL LS_OBST ( lsfrpt, ipt, jret ) jflg ( 10 ) = 1 END IF END DO C* RETURN END