SUBROUTINE UA_TROP ( report, lenr, irptr, iret ) C************************************************************************ C* UA_TROP * C* * C* This subroutine decodes data for all tropopause levels from temp AA * C* and temp CC reports. * C* * C* UA_TROP ( 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 * C* J. Ator/NCEP 08/00 Check wind group for UA_TPID or ENDTRP * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'uacmn.cmn' C* CHARACTER*(*) report C* CHARACTER field*(MXLENF) C* LOGICAL UA_EGRP, UA_TPID, UA_MPID, + UA_SDID, UA_RPID, UA_NPID, + ENDTRP, done C* INCLUDE 'ERMISS.FNC' C* C* Function to check for end of tropopause data. C* ENDTRP ( field ) = + ( ( UA_MPID ( field ) ) .or. + ( 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 ) 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 ( ENDTRP ( field ) ) THEN irptr = ipt1 done = .true. ELSE IF ( .not. UA_EGRP ( field, lenf ) ) THEN IF ( UA_TPID ( field ) ) THEN IF ( field (3:5) .eq. '999' ) THEN done = .true. ELSE C C* Initialize all output values for this C* tropopause level. C vsig = 16.0 pres = RMISSD tmpc = RMISSD dwpc = RMISSD drct = RMISSD sped = RMISSD C C* Compute the pressure. C CALL UA_PRS3 ( field (3:5), pres, ier ) C C* Get the temperature/dewpoint 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_TEMP ( field, tmpc, dwpc, ier ) END IF C C* Get the wind group. C ipt2 = irptr CALL UA_GFLD ( report, lenr, irptr, + field, lenf, ier ) IF ( ier .ne. 0 ) THEN iret = -1 done = .true. ELSE IF ( ( UA_TPID ( field ) ) .or. + ( ENDTRP ( field ) ) ) THEN irptr = ipt2 ELSE IF ( .not. UA_EGRP ( field, lenf ) ) + THEN CALL UA_WIND ( field, drct, sped, ier ) END IF END IF C C* If the pressure was present for this tropopause C* level, then store all output values for this C* level into the interface arrays. C IF ( .not. ERMISS ( pres ) ) THEN CALL UA_STLV ( vsig, pres, RMISSD, + tmpc, dwpc, drct, sped, + RMISSD, RMISSD, ierstv ) IF ( ierstv .lt. 0 ) THEN iret = -1 RETURN END IF END IF END IF END IF END IF END DO C* RETURN END