SUBROUTINE UA_AWDD ( report, lenr, irptr, iret ) C************************************************************************ C* UA_AWDD * C* * C* This subroutine decodes additional wind data of the form * C* 11PPP DDFFF 22PPP DDFFF 33PPP DDFFF from regional and national * C* practice data sections. * C* * C* UA_AWDD ( 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 12/98 Initialize awdlev via DATA statement * C* J. Ator/NCEP 10/99 Clean up function declarations * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'uacmn.cmn' C* CHARACTER*(*) report C* CHARACTER field*(MXLENF), awdlev ( 3 )*2 C* LOGICAL UA_EGRP C* DATA awdlev + / '11', '22', '33' / C* INCLUDE 'ERMISS.FNC' C------------------------------------------------------------------------ iret = 0 C DO ii = 1, 3 C C* Initialize all output values for this additional wind level. C vsig = 2.0 pres = RMISSD drct = RMISSD sped = RMISSD C CALL UA_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN iret = -1 ELSE IF ( .not. UA_EGRP ( field, lenf ) ) THEN IF ( field (1:2) .eq. awdlev (ii) ) THEN C C* Decode the pressure. C CALL UA_PRS3 ( field (3:5), pres, ier ) END IF C C* Get and decode the wind group. C CALL UA_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN iret = -1 ELSE IF ( .not. UA_EGRP ( field, lenf ) ) THEN CALL UA_WIND ( field, drct, sped, ier ) END IF C C* If the pressure exists for this additional wind level, C* then store all output values for this level into the C* interface arrays. C IF ( .not. ERMISS ( pres ) ) THEN CALL UA_STLV ( vsig, pres, RMISSD, RMISSD, RMISSD, + drct, sped, RMISSD, RMISSD, ierstv ) IF ( ierstv .lt. 0 ) THEN iret = -1 RETURN END IF END IF END IF C C* Stop if the end of the report was encountered during C* decoding of this wind level. C IF ( iret .lt. 0 ) THEN RETURN END IF END DO C* RETURN END