w3fa03v.f

Go to the documentation of this file.

C> @file
C> @brief Compute standard height, temp, and pot temp.
C> @author James McDonell @date 1974-06-01
C>
C> 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> - James McDonell 1974-06-01
C> - Ralph Jones 1984-06-01 Change to ibm vs fortran.
C> - Dennis Keyser 1992-06-29 Convert to cray cft77 fortran.
C> - Ralph Jones 1994-09-13 Vectorized version to do array instead of one word.
C>
C> @param[in] PRESS Pressure array in millibars.
C> @param[out] HEIGHT Height array in meters.
C> @param[out] TEMP Temperature array in degrees kelvin.
C> @param[out] THETA Potential temperature array in degrees kelvin.
C> @param[out] N Number of points in array press.
C>
C> @note Not valid for pressures less than 8.68 millibars, declare
C> all parameters as type real.
C>
C> @note Height, temp, theta are now all arrays, you must
C> have arrays of size n or you will wipe out memory.
C>
C> @author James McDonell @date 1974-06-01
      SUBROUTINE w3fa03v(PRESS,HEIGHT,TEMP,THETA,N)
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