SUBROUTINE CX_GRPT ( lenmsg, crexmsg, mxrpt, mxrptsz, jpos, + lcxrpt, cxrpt, nmrpts, lenrpts, rawrpt, + iret ) C************************************************************************ C* CX_GRPT * C* * C* This subroutine gets the next subset/report in the message. The * C* length of the report must not exceed the maximum size allowed for * C* this report. If it does, there is a problem and the report and the * C* rest of the CREX message are not decoded. The last report in the * C* section should end with the character string '++'. The raw report is* C* passed to the user in the rawrpt array. * C* * C* CX_GRPT ( LENMSG, CREXMSG, MXRPT, MXRPTSZ, JPOS, LCXRPT, CXRPT, * C* NMRPTS, LENRPTS, RAWRPT, IRET ) * C* * C* Input parameters: * C* LENMSG INTEGER CREX message length * C* CREXMSG CHAR* CREX message * C* MXRPT INTEGER Maximum number of reports * C* expected in message * C* MXRPTSZ INTEGER Maximum report size allowed * C* * C* Input and output parameters: * C* JPOS INTEGER Points to start of report on * C* input; to next report on output * C* * C* Output parameters: * C* LCXRPT INTEGER Report length * C* CXRPT CHAR* Current report * C* NMRPTS INTEGER Array index referring to the * C* current report. * C* * C* LENRPTS (MXRPT) * C* INTEGER Array to store the length of * C* each report in CREX message * C* RAWRPT (MXRPT, MXRPTSZ) * C* CHAR* Array to hold raw reports * C* * C* IRET INTEGER Return code * C* 0 = normal return * C* 1 = reject report and rest of * C* CREX message * C* 2 = no more reports in msg * C* 3 = reached end of message * C* * C** * C* Log: * C* R. Hollern/NCEP 8/03 * C************************************************************************ INCLUDE 'cxcmn.cmn' C* CHARACTER*(*) crexmsg, cxrpt CHARACTER rawrpt ( mxrpt, mxrptsz )*8 CHARACTER blanks*8, eor*8 C* INTEGER lcxrpt, lenrpts ( mxrpt ) C* LOGICAL more C* DATA blanks / ' ' / DATA eor / 'endofrpt' / C----------------------------------------------------------------------- iret = 0 more = .true. cxrpt = ' ' C C* Check if at end of message. C jsize = lenmsg - jpos C IF ( jsize .lt. 7 ) THEN iret = 3 RETURN END IF C DO WHILE ( more ) C C* Remove any spaces before start of report and C* set pointer jpos to start of report. C IF ( crexmsg ( jpos:jpos ) .eq. ' ' ) THEN jpos = jpos + 1 ELSE more = .false. END IF C END DO C lcxrpt = 0 kst = jpos more = .true. C DO WHILE ( more ) C IF ( crexmsg ( jpos:jpos+1 ) .eq. '++' ) THEN C C* Last report in message ends with the characters ++. C jpos = jpos + 2 more = .false. iret = 2 ELSE IF ( crexmsg ( jpos:jpos ) .eq. '+' ) THEN C C* A report ends with the character +. C jpos = jpos + 1 more = .false. ELSE jpos = jpos + 1 lcxrpt = lcxrpt + 1 C C* Check that length of report does not exceed the C* maximum size allowed. C IF ( lcxrpt .gt. mxrptsz ) THEN loglvl = 2 logmsg(1:27) = 'Report length greater than ' logmsg(28:51) = 'the maximum size allowed' CALL DC_WLOG( loglvl, 'CX', 2, logmsg, ierwlg ) logmsg(1:30) = 'Rest of CREX message rejected ' CALL DC_WLOG( loglvl, 'CX', 2, logmsg, ierwlg ) iret = 1 RETURN END IF C IF ( jpos .ge. lenmsg ) THEN C C* Report does not end with '+'. C more = .false. END IF END IF END DO C C* Store report in cxrpt. C cxrpt ( 1:lcxrpt ) = crexmsg ( kst:jpos ) C nmrpts = nmrpts + 1 C C* Store report length in rptlen. C lenrpts (nmrpts) = lcxrpt C C* Store report in character*8 array rawrpt. C nwords = lcxrpt / 8 C irem = MOD ( lcxrpt, 8 ) C IF ( irem .ne. 0 ) nwords = nwords + 1 C n1 = 1 n2 = 8 C DO j = 1, nwords C l = j C IF ( j .lt. nwords ) THEN rawrpt ( nmrpts, j) = cxrpt(n1:n2) ELSE rawrpt ( nmrpts,j ) = blanks mm = lcxrpt - n1 + 1 rawrpt ( nmrpts, j )(1:mm) = cxrpt(n1:lcxrpt) END IF C n1 = n1 + 8 n2 = n2 + 8 C END DO C C* Identifier for the end of the report. C rawrpt ( nmrpts,l+1 ) = eor C* RETURN END