SUBROUTINE UA_MXWD ( report, lenr, irptr, iret ) C************************************************************************ C* UA_MXWD * C* * C* This subroutine decodes data for all maximum wind levels from * C* temp AA, temp CC, pilot AA, and pilot CC reports. * C* * C* UA_MXWD ( 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 03/00 Allow UA_SDID exit iff temp, * C* use COMMON /WSPDU/ for wind shear units * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'uacmn.cmn' C* CHARACTER*(*) report C* CHARACTER field*(MXLENF) C* LOGICAL UA_EGRP, UA_MHID, UA_MPID, + UA_SDID, UA_RPID, UA_NPID, + ENDMXW, gotmxw, done C* INCLUDE 'ERMISS.FNC' C* C* Function to check for end of maximum wind data. C* ENDMXW ( field ) = + ( ( ( cftyp .eq. TEMP ) .and. + ( UA_SDID ( field ) ) ) + .or. + ( UA_RPID ( field ) ) + .or. + ( UA_NPID ( field ) ) ) C------------------------------------------------------------------------ C C* Initialize variables. C iret = 0 done = .false. C DO WHILE ( .not. done ) gotmxw = .false. 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 done = .true. ELSE IF ( ENDMXW ( field ) ) THEN irptr = ipt1 done = .true. ELSE IF ( .not. UA_EGRP ( field, lenf ) ) THEN IF ( field (1:5) .eq. '77999' ) THEN done = .true. ELSE IF ( UA_MPID ( field ) ) THEN C C* A maximum wind by pressure has been found. C gotmxw = .true. C C* Initialize all output values for this C* maximum wind by pressure level. C vsig = 8.0 pres = RMISSD hgtm = RMISSD drct = RMISSD sped = RMISSD awsb = RMISSD awsa = RMISSD C C* Compute the pressure. C CALL UA_PRS3 ( field (3:5), pres, ier ) ELSE IF ( ( UA_MHID ( field ) ) .and. + ( cftyp .eq. PILOT ) ) THEN C C* A maximum wind by height has been found. C gotmxw = .true. C C* Initialize all output values for this C* maximum wind by height level. C vsig = 8.0 pres = RMISSD hgtm = RMISSD drct = RMISSD sped = RMISSD awsb = RMISSD awsa = RMISSD C C* Compute the height. C CALL ST_INTG ( field (2:5), ihght, ier ) IF ( ier .eq. 0 ) THEN hgtm = FLOAT ( ihght ) * 10. END IF END IF END IF C IF ( gotmxw ) THEN C C* Get the wind group. C CALL UA_GFLD ( report, lenr, irptr, field, lenf, ier ) IF ( ier .ne. 0 ) THEN iret = -1 done = .true. ELSE IF ( .not. UA_EGRP ( field, lenf ) ) THEN CALL UA_WIND ( field, drct, sped, ier ) END IF C C* Is there a wind shear group present ?? C ipt2 = irptr CALL UA_GFLD ( report, lenr, irptr, field, + lenf, ier ) IF ( ier .ne. 0 ) THEN iret = -1 done = .true. ELSE IF ( .not. UA_EGRP ( field, lenf ) ) THEN IF ( field (1:1) .eq. '4') THEN C C* Compute the wind shear. C CALL ST_INTG ( field (2:3), iawsb, ier ) IF ( ier .eq. 0 ) THEN awsb = UA_WSMS ( FLOAT ( iawsb ) ) END IF CALL ST_INTG ( field (4:5), iawsa, ier ) IF ( ier .eq. 0 ) THEN awsa = UA_WSMS ( FLOAT ( iawsa ) ) END IF ELSE irptr = ipt2 END IF END IF END IF END IF C C* If the pressure or height was present for this C* maximum wind level, then store all output values C* for this level into the interface arrays. C IF ( ( .not. ERMISS ( pres ) ) .or. + ( .not. ERMISS ( hgtm ) ) ) THEN CALL UA_STLV ( vsig, pres, hgtm, RMISSD, RMISSD, + drct, sped, awsb, awsa, ierstv ) IF ( ierstv .lt. 0 ) THEN iret = -1 RETURN END IF END IF END IF END DO C* RETURN END