SUBROUTINE UA_REGP ( report, lenr, irptr, iret ) C************************************************************************ C* UA_REGP * C* * C* This subroutine decodes 5x5x5 regional practice data. * C* * C* UA_REGP ( 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************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'uacmn.cmn' C* CHARACTER*(*) report C* CHARACTER field*(MXLENF) C* LOGICAL UA_EGRP, UA_RPID, UA_NPID C------------------------------------------------------------------------ iret = 0 C DO WHILE ( .true. ) C C* Look for and decode regional practice data. C ipt1 = irptr CALL UA_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN iret = -1 RETURN ELSE IF ( UA_NPID ( field ) ) THEN irptr = ipt1 RETURN ELSE IF ( .not. UA_EGRP ( field, lenf ) ) THEN IF ( UA_RPID ( field ) ) THEN C C* A regional practice data indicator has been found. C IF ( field (2:2) .eq. '1' ) THEN C C* Decode the '51515' regional practice data. C CALL UA_RPD1 ( report, lenr, irptr, iret ) ELSE logmsg = 'regional' CALL DC_WLOG ( 2, 'UA', 3, logmsg, ierwlg ) END IF END IF END IF END DO C* RETURN END