SUBROUTINE W3FA03V(PRESS,HEIGHT,TEMP,THETA,N) C$$$ SUBPROGRAM DOCUMENTATION BLOCK C . . . . C SUBPROGRAM: W3FA03V COMPUTE STANDARD HEIGHT, TEMP, AND POT TEMP C PRGMMR: KEYSER ORG: W/NMC22 DATE: 92-06-29 C C ABSTRACT: COMPUTES THE STANDARD HEIGHT, TEMPERATURE, AND POTENTIAL C TEMPERATURE GIVEN THE PRESSURE IN MILLIBARS ( > 8.68 MB ). FOR C HEIGHT AND TEMPERATURE THE RESULTS DUPLICATE THE VALUES IN THE C U.S. STANDARD ATMOSPHERE (L962), WHICH IS THE ICAO STANDARD C ATMOSPHERE TO 54.7487 MB (20 KM) AND THE PROPOSED EXTENSION TO C 8.68 MB (32 KM). FOR POTENTIAL TEMPERATURE A VALUE OF 2/7 IS C USED FOR RD/CP. C C PROGRAM HISTORY LOG: C 74-06-01 J. MCDONELL W345 -- ORIGINAL AUTHOR C 84-06-01 R.E.JONES W342 -- CHANGE TO IBM VS FORTRAN C 92-06-29 D. A. KEYSER W/NMC22 -- CONVERT TO CRAY CFT77 FORTRAN C 94-09-13 R.E.JONES -- VECTORIZED VERSION TO DO ARRAY C INSTEAD OF ONE WORD C C USAGE: CALL W3FA03V(PRESS,HEIGHT,TEMP,THETA,N) C INPUT ARGUMENT LIST: C PRESS - PRESSURE ARRAY IN MILLIBARS C C OUTPUT ARGUMENT LIST: C HEIGHT - HEIGHT ARRAY IN METERS C TEMP - TEMPERATURE ARRAY IN DEGREES KELVIN C THETA - POTENTIAL TEMPERATURE ARRAY IN DEGREES KELVIN C N - NUMBER OF POINTS IN ARRAY PRESS C C SUBPROGRAMS CALLED: C LIBRARY: C CRAY - ALOG C C REMARKS: NOT VALID FOR PRESSURES LESS THAN 8.68 MILLIBARS, DECLARE C ALL PARAMETERS AS TYPE REAL. C C WARNING: HEIGHT, TEMP, THETA ARE NOW ALL ARRAYS, YOU MUST C HAVE ARRAYS OF SIZE N OR YOU WILL WIPE OUT MEMORY. C C ATTRIBUTES: C LANGUAGE: CRAY CFT77 FORTRAN C MACHINE: CRAY C916/128, Y-MP8/864, Y-MP EL92/256 C C$$$ C REAL M0 REAL HEIGHT(*) REAL PRESS(*) REAL TEMP(*) REAL THETA(*) C SAVE C DATA G/9.80665/,RSTAR/8314.32/,M0/28.9644/,PISO/54.7487/, $ ZISO/20000./,SALP/-.0010/,PZERO/1013.25/,T0/288.15/,ALP/.0065/, $ PTROP/226.321/,TSTR/216.65/ C ROVCP = 2.0/7.0 R = RSTAR/M0 ROVG = R/G FKT = ROVG * TSTR AR = ALP * ROVG PP0 = PZERO**AR AR1 = SALP * ROVG PP01 = PISO**AR1 C DO J = 1,N IF (PRESS(J).LT.PISO) THEN C C COMPUTE LAPSE RATE = -.0010 CASES C HEIGHT(J) = ((TSTR/(PP01 * SALP )) * (PP01-(PRESS(J) ** AR1))) & + ZISO TEMP(J) = TSTR - ((HEIGHT(J) - ZISO) * SALP) C ELSE IF (PRESS(J).GT.PTROP) THEN C HEIGHT(J) = (T0/(PP0 * ALP)) * (PP0 - (PRESS(J) ** AR)) TEMP(J) = T0 - (HEIGHT(J) * ALP) C ELSE C C COMPUTE ISOTHERMAL CASES C HEIGHT(J) = 11000.0 + (FKT * ALOG(PTROP/PRESS(J))) TEMP(J) = TSTR C END IF THETA(J) = TEMP(J) * ((1000./PRESS(J))**ROVCP) END DO C RETURN END