w3fa03.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> 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>
C> @param[in] PRESS Pressure in millibars.
C> @param[out] HEIGHT Height in meters.
C> @param[out] TEMP Temperature in degrees kelvin.
C> @param[out] THETA Potential temperature in degrees kelvin.
C>
C> @note Not valid for pressures less than 8.68 millibars, declare
C> all parameters as type real.
C>
C> @author James McDonell @date 1974-06-01
      SUBROUTINE w3fa03(PRESS,HEIGHT,TEMP,THETA)
C
      REAL  M0
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
      IF(press.LT.piso)   GO TO 100
      IF(press.GT.ptrop)  GO TO 200
C
C     COMPUTE ISOTHERMAL CASES
C
      height = 11000.0 + (fkt * alog(ptrop/press))
      temp = tstr
      GO TO 300
C
C     COMPUTE LAPSE RATE = -.0010 CASES
C
 100  CONTINUE
      ar     = salp * rovg
      pp0    = piso**ar
      height = ((tstr/(pp0 * salp )) * (pp0-(press ** ar))) + ziso
      temp   = tstr - ((height - ziso) * salp)
      GO TO 300
C
 200  CONTINUE
      height = (t0/(pp0 * alp)) * (pp0 - (press ** ar))
      temp   = t0 - (height * alp)
C
 300  CONTINUE
      theta  = temp * ((1000./press)**rovcp)
      RETURN
      END