SUBROUTINE MA_SEC3 ( marrpt, ipt, iret ) C************************************************************************ C* MA_SEC3 * C* * C* This subroutine calls the routines to decode the groups in section 3 * C* of the FM13 ship, fixed buoy, or CMAN bulletin report. This section * C* begins with the 333 group. The number of groups in the section * C* will vary. * C* * C* MA_SEC3 ( MARRPT, IPT, IRET ) * C* * C* Input parameters: * C* MARRPT CHAR* Report array * C* LSEC3 INTEGER Length of section 3 in report * C* ISEC3 INTEGER Pointer to start of section 3 * C* RIVALS(IRNCL0) REAL Number of section 1 cloud layers* C* * C* Input and Output parameters: * C* IPT INTEGER Pointer to groups in report * C* * C* Output parameters: * C* RIVALS(IRNCL0) REAL Number of layers of cloud data * C* IRET INTEGER Return code * C* 0 = Normal return * C* 1 = Problems * C** * C* Log: * C* R. Hollern/NCEP 4/96 * C* D. Kidwell/NCEP 4/97 Changed interface, reorganized * C* header and comments * C* D. Kidwell/NCEP 10/97 Changed interface, cleaned up * C* R. Hollern/NCEP 11/99 Changed cloud data interface * C* and wind gust logic * C* C. Caruso Magee/NCEP 01/02 Changed name of s/r MA_CLDS to * C* MA_CLD3 to match that in dclsfc * C* C. Caruso Magee/NCEP 01/04 Remove refs to XDTFVM and * C* rivals(irdtvm) (wind gust * C* period), removed refs to XCLDS * C* rivals(irgums) - now obsolete * C* C. Caruso Magee/NCEP 01/04 Cleaned up docblock declarations* C* C. Caruso Magee/NCEP 04/07 Break out of do while loop if a second * C* field is found of type which was * C* already decoded (may indicate bad * C* spacing or missing section delimeter). * C* C. Caruso Magee/NCEP 4/07 Print log msg if repeat field found. * C************************************************************************ INCLUDE 'macmn.cmn' C* CHARACTER*(*) marrpt C* INTEGER jflg(8) C------------------------------------------------------------------------ iret = 0 C C* Determine where to store section 3 cloud data in interface C* arrays. C xly = rivals ( irnclo ) C IF ( xly .gt. 0.0 .and. xly .lt. 4.0 ) THEN lvl = xly + .5 ELSE lvl = 0 END IF C C* A group should only appear once in a section (exceptions are noted C* below). This array will C* be used to flag those groups that are decoded in the section. C DO i = 1, 8 jflg ( i ) = 0 END DO C iend = isec3 + lsec3 - 1 C DO WHILE ( ipt .lt. iend ) C ipt = ipt + 1 C IF ( marrpt ( ipt:ipt+1 ) .eq. ' 1' ) THEN IF ( jflg ( 1 ) .eq. 0 ) THEN C C* Decode the maximum temperature group. C ipt = ipt + 2 iparam = 5 CALL MA_TEMP ( marrpt, iparam, ipt, jret ) jflg ( 1 ) = 1 ELSE logmsg = "repeat field 1 found in Sec. 3" CALL DC_WLOG (2, 'DC', 2, logmsg(1:35), ier) ipt = iend END IF ELSE IF ( marrpt ( ipt:ipt+1 ) .eq. ' 2' ) THEN IF ( jflg ( 2 ) .eq. 0 ) THEN C C* Decode the minimum temperature group. C ipt = ipt + 2 iparam = 6 CALL MA_TEMP ( marrpt, iparam, ipt, jret ) jflg ( 2 ) = 1 ELSE logmsg = "repeat field 2 found in Sec. 3" CALL DC_WLOG (2, 'DC', 2, logmsg(1:35), ier) ipt = iend END IF ELSE IF ( ( marrpt ( ipt:ipt+2 ) .eq. ' 58' .or. + marrpt ( ipt:ipt+2 ) .eq. ' 59' ) ) THEN IF ( jflg ( 3 ) .eq. 0 ) THEN C C* Decode the 24 hour pressure change group. C ipt = ipt + 2 CALL MA_PR24 ( marrpt, ipt, jret ) jflg ( 3 ) = 1 ELSE logmsg = "repeat field 58 or 59 found in Sec. 3" CALL DC_WLOG (2, 'DC', 2, logmsg(1:40), ier) ipt = iend END IF ELSE IF ( ( marrpt ( ipt:ipt+5 ) .eq. ' 55407' ) + .or. ( marrpt ( ipt:ipt+5 ) .eq. ' 55408' ) + .or. ( marrpt ( ipt:ipt+5 ) .eq. ' 55507' ) + .or. ( marrpt ( ipt:ipt+5 ) .eq. ' 55508' ) ) THEN C C* Skip 5-group and the supplementary group which C* follows. Do this to avoid problems. C ipt = ipt + 8 ELSE IF ( marrpt ( ipt:ipt+1 ) .eq. ' 6' ) THEN IF ( jflg ( 4 ) .eq. 0 ) THEN C C* Decode the precipitation group. C ipt = ipt + 2 iparam = 0 CALL MA_PREC ( marrpt, iparam, ipt, jret ) jflg ( 4 ) = 1 ELSE logmsg = "repeat field 6 found in Sec. 3" CALL DC_WLOG (2, 'DC', 2, logmsg(1:35), ier) ipt = iend END IF ELSE IF ( marrpt ( ipt:ipt+1 ) .eq. ' 7' ) THEN IF ( jflg ( 5 ) .eq. 0 ) THEN C C* Decode the 24-hour precipitation group. C ipt = ipt + 2 iparam = 1 CALL MA_PREC ( marrpt, iparam, ipt, jret ) jflg ( 5 ) = 1 ELSE logmsg = "repeat field 7 found in Sec. 3" CALL DC_WLOG (2, 'DC', 2, logmsg(1:35), ier) ipt = iend END IF ELSE IF ( marrpt ( ipt:ipt+5 ) .eq. ' 80000' ) THEN C C* Don't decode the additional data in regional code form. C RETURN ELSE IF ( marrpt ( ipt:ipt+1 ) .eq. ' 8' ) THEN C C* Decode the cloud groups. NOTE: there may be as many as C* three of these! C ipt = ipt + 2 lvl = lvl + 1 IF ( lvl .lt. 8 ) THEN CALL MA_CLD3 ( marrpt, lvl, ipt, jret ) ELSE ipt = ipt + 3 END IF ELSE IF ( marrpt ( ipt:ipt+3 ) .eq. ' 907' ) THEN C C* Decode the time duration of following phenomena group. C ipt = ipt + 4 CALL MA_TDUR ( marrpt, ipt, jret ) ELSE IF ( marrpt ( ipt:ipt+3 ) .eq. ' 904' ) THEN C C* This group and the following group it refers to are not C* currently decoded. C ipt = ipt + 8 ELSE IF ( marrpt ( ipt:ipt+3 ) .eq. ' 910' ) THEN IF ( jflg ( 6 ) .eq. 0 ) THEN C C* Decode the wind gust from 910ff group. C ipt = ipt + 4 iparam = 1 CALL MA_WSPD ( marrpt, iparam, ipt, jret ) jflg ( 6 ) = 1 ELSE logmsg = "repeat field 910 found in Sec. 3" CALL DC_WLOG (2, 'DC', 2, logmsg(1:35), ier) ipt = iend END IF ELSE IF ( marrpt ( ipt:ipt+3 ) .eq. ' 911' ) THEN IF ( jflg ( 8 ) .eq. 0 ) THEN C C* Decode the wind gust from 911ff group. C ipt = ipt + 4 iparam = 5 CALL MA_WSPD ( marrpt, iparam, ipt, jret ) jflg ( 8 ) = 1 ELSE logmsg = "repeat field 911 found in Sec. 3" CALL DC_WLOG (2, 'DC', 2, logmsg(1:35), ier) ipt = iend END IF ELSE IF ( marrpt ( ipt:ipt+3 ) .eq. ' 912' ) THEN IF ( jflg ( 7 ) .eq. 0 ) THEN C C* Decode the highest mean wind speed from 912ff group. C ipt = ipt + 4 iparam = 2 CALL MA_WSPD ( marrpt, iparam, ipt, jret ) jflg ( 7 ) = 1 ELSE logmsg = "repeat field 912 found in Sec. 3" CALL DC_WLOG (2, 'DC', 2, logmsg(1:35), ier) ipt = iend END IF END IF END DO C* RETURN END