SUBROUTINE UA_101G ( report, lenr, irptr, iret ) C************************************************************************ C* UA_101G * C* * C* This subroutine decodes data from 101AA "additional data" groups. * C* * C* UA_101G ( REPORT, LENR, IRPTR, IRET ) * C* * C* Input parameters: * C* REPORT CHAR* Report * C* LENR INTEGER Length of REPORT * C* * C* Input and output parameters: * C* IRPTR INTEGER Pointer within REPORT * C* * C* Output parameters: * C* IRET INTEGER Return code: * C* 0 = normal return * C* -1 = critical error in REPORT * C* or reached end of REPORT * C** * C* Log: * C* J. Ator/NCEP 03/96 * C* J. Ator/NCEP 10/96 ERRGRP -> UA_EGRP, removed ERRRPT * C* J. Ator/NCEP 12/97 New interface format, style changes * C* J. Ator/NCEP 10/98 REGPID -> UA_RPID, NATPID -> UA_NPID * C* J. Ator/NCEP 10/99 Clean up function declarations * C* J. Ator/NCEP 10/01 Comment out call to UA_HYCK * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'uacmn.cmn' C* CHARACTER*(*) report C* CHARACTER field*(MXLENF) C* LOGICAL UA_EGRP, UA_RPID, UA_NPID, + END101 C* C* Function to check for end of 101AA "additional data". C* END101 ( field ) = + ( ( UA_RPID ( field ) ) .or. + ( UA_NPID ( field ) ) ) C------------------------------------------------------------------------ iret = 0 C DO WHILE ( .true. ) C C* Get the next group in the report. C ipt1 = irptr CALL UA_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN iret = -1 RETURN ELSE IF ( END101 ( field ) ) THEN irptr = ipt1 RETURN ELSE IF ( .not. UA_EGRP ( field, lenf ) ) THEN IF ( field (1:3) .eq. '101' ) THEN CALL ST_INTG ( field (4:5), iadf, ier ) IF ( ier .eq. 0 ) THEN C IF ( ( iadf .ge. 40 ) .and. + ( iadf .le. 59 ) ) THEN C C* This is a group indicating the reason for C* no report or for an incomplete report. C CALL UA_RDCS ( iadf, ierrdc ) C ELSE IF ( iadf .eq. 64 ) THEN C C* This is a group indicating that stability C* index data follows. C CALL UA_STAB ( report, lenr, irptr, iret ) C ELSE IF ( ( iadf .ge. 80 ) .and. + ( iadf .le. 82 ) ) THEN C C* This is a group indicating that the report C* contains corrected data. C CALL UA_RDCS ( iadf, ierrdc ) C ELSE IF ( iadf .eq. 90 ) THEN C C* This is a group indicating that extrapolated C* mandatory level data follows. C CALL UA_XMLD ( report, lenr, irptr, iret ) C ELSE IF ( iadf .eq. 94 ) THEN C C* This is a group indicating that mean layer C* wind data follows. C CALL UA_MLWD ( report, lenr, irptr, iret ) C ELSE IF ( ( iadf .eq. 96 ) .and. + ( prttyp .eq. BB ) ) THEN C C* This is a group indicating that mandatory C* level data from 925mb, 850mb, 700mb, and C* 500mb follows. C CALL UA_TMLV ( report, lenr, irptr, iret ) C* CALL UA_HYCK ( ierhyk ) C ELSE C C* This is an unknown indicator group. C logmsg = 'regional' CALL DC_WLOG ( 2, 'UA', 3, logmsg, ierwlg ) END IF C END IF END IF C C* Stop if a critical error or the end of the report was C* encountered during processing of the most recent data. C IF ( iret .lt. 0 ) THEN RETURN END IF END IF END DO C* RETURN END