SUBROUTINE UA_MLWD ( report, lenr, irptr, iret ) C************************************************************************ C* UA_MLWD * C* * C* This subroutine decodes 10194 mean layer wind data. * C* * C* UA_MLWD ( 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* RIVALS (IRMWDL) REAL Mean wind direction, in degrees,* C* for surface-1500m level * C* RIVALS (IRMWSL) REAL Mean wind speed, in m/s, * C* for surface-1500m level * C* RIVALS (IRMWDH) REAL Mean wind direction, in degrees,* C* for 1500m-3000m level * C* RIVALS (IRMWSH) REAL Mean wind speed, in m/s * C* for 1500m-3000m level * 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/99 Clean up function declarations * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'uacmn.cmn' C* CHARACTER*(*) report C* CHARACTER field*(MXLENF) C* LOGICAL UA_EGRP C* REAL mlwdat ( 4 ) C------------------------------------------------------------------------ C C* Initialize variables. C iret = 0 DO ii = 1, 4 mlwdat (ii) = RMISSD END DO C C* Get and decode the mean layer wind data. C DO ii = 1, 2 CALL UA_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN iret = -1 RETURN END IF idir = ( 2 * ii ) - 1 ispd = ( 2 * ii ) IF ( .not. UA_EGRP ( field, lenf ) ) THEN CALL UA_WIND ( field, mlwdat ( idir ), + mlwdat ( ispd ), ier ) END IF END DO C C* Store the mean layer wind data. C rivals ( irmwdl ) = mlwdat (1) rivals ( irmwsl ) = mlwdat (2) rivals ( irmwdh ) = mlwdat (3) rivals ( irmwsh ) = mlwdat (4) C* RETURN END