SUBROUTINE UA_PRHT ( field, pres, z, iret ) C************************************************************************ C* UA_PRHT * C* * C* This subroutine decodes a pressure/height group of the form PPHHH. * C* * C* UA_PRHT ( FIELD, PRES, Z, IRET ) * C* * C* Input parameters: * C* FIELD CHAR* Pressure/height group * C* * C* Output parameters: * C* PRES REAL Pressure * C* Z REAL Height * C* IRET INTEGER Return code: * C* 0 = normal return * C** * C* Log: * C* J. Ator/NCEP 03/96 * C* J. Ator/NCEP 12/97 New interface format, style changes * C* J. Ator/NCEP 10/99 Clean up function declarations * C* J. Ator/NCEP 01/02 Change height range for 700mb * C************************************************************************ INCLUDE 'GEMPRM.PRM' INCLUDE 'uacmn.cmn' C* CHARACTER*(*) field C------------------------------------------------------------------------ C C* Initialize output variables. C iret = 0 pres = RMISSD z = RMISSD C C* Decode the pressure. C CALL UA_PRS2 ( field (1:2), pres, ier ) IF ( ier .ne. 0 ) THEN RETURN END IF C C* Using the decoded pressure as a guide, decode the height. C ipres = INT ( pres ) CALL ST_INTG ( field (3:5), iz, ier ) IF ( ier .eq. 0 ) THEN z = FLOAT ( iz ) IF ( ( prttyp .eq. AA ) .or. ( prttyp .eq. BB ) ) THEN C C* Decode the height below 100mb. C IF ( ( ipres .eq. 1000 ) .and. ( z .gt. 500 ) ) THEN z = 500 - z ELSE IF ( ( ipres .eq. 850 ) .and. ( z .lt. 900 ) ) THEN z = z + 1000 ELSE IF ( ( ipres .eq. 700 ) .and. ( z .lt. 350 ) ) THEN z = z + 3000 ELSE IF ( ipres .eq. 700 ) THEN z = z + 2000 ELSE IF ( ipres .le. 500 ) THEN z = z * 10 IF ( ( ipres .eq. 300 ) .and. ( z .lt. 3000 ) ) THEN z = z + 10000 ELSE IF ( ( ipres .eq. 250 ) .and. + ( z .lt. 5000 ) ) THEN z = z + 10000 ELSE IF ( ( ipres .eq. 200 ) .and. + ( z .lt. 7000 ) ) THEN z = z + 10000 ELSE IF ( ipres .le. 150 ) THEN z = z + 10000 END IF END IF ELSE C C* Decode the height above 100mb. C z = z * 10 IF ( ipres .eq. 70 ) THEN z = z + 10000 ELSE IF ( ( ipres .eq. 50 ) .and. ( z .gt. 8000 ) ) THEN z = z + 10000 ELSE IF ( ipres .eq. 50 ) THEN z = z + 20000 ELSE IF ( ipres .ge. 20 ) THEN z = z + 20000 ELSE IF ( ( ipres .eq. 10 ) .and. ( z .gt. 8000 ) ) THEN z = z + 20000 ELSE IF ( ipres .eq. 10 ) THEN z = z + 30000 ELSE IF ( ipres .ge. 3 ) THEN z = z + 30000 ELSE IF ( ( ipres .eq. 2 ) .and. ( z .gt. 8000 ) ) THEN z = z + 30000 ELSE z = z + 40000 END IF END IF END IF C* RETURN END