w3fa04.f

Go to the documentation of this file.

C> @file
C> @brief Compute standard pressure, temp, pot temp.
C> @author James McDonell @date 1974-06-01
 
C> Computes the standard pressure, temperature, and poten-
C> tial temperature given the height in meters (<32 km). For
C> the pressure and temperature the results duplicate the values in
C> the U.S. standard atmosphere (1962), 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-07-05 Change to ibm vs fortran.
C> - Ralph Jones 1990-04-27 Change to cray cft77 fortran.
C>
C> @param[in] HEIGHT Height in meters.
C> @param[out] PRESS Standard pressure in millibars.
C> @param[out] TEMP Temperature in degrees kelvin.
C> @param[out] THETA Potential temperature in degrees kelvin.
C>
C> @note Not valid for heights greater than 32 km. declare all parameters
C> as type real*4.
C>
C> @author James McDonell @date 1974-06-01
 
      SUBROUTINE w3fa04(HEIGHT,PRESS,TEMP,THETA)
C
      REAL  M0
C
      DATA
     *g     /9.80665/,
     *rstar /8314.32/,
     *m0    /28.9644/,
     *piso  /54.7487/,
     *ziso  /20000./,
     *salp  /-.0010/,
     *tstr  /216.65/,
     *ptrop /226.321/,
     *alp   /.0065/,
     *t0    /288.15/,
     *pzero /1013.25/
C
      rovcp = 2.0 / 7.0
      r     = rstar/m0
      IF (height.GT.ziso)   GO TO 100
      IF (height.GT.11000.) GO TO 200
C
C     COMPUTE IN TROPOSPHERE
C
      temp = t0 - height * alp
      press = pzero * ((1.0 - ((alp/t0) * height)) ** (g/(alp * r)))
      GO TO 300
C
C     COMPUTE LAPSE RATE = -.0010 CASES
C
 100  CONTINUE
      d     = height - ziso
      press = piso * ((1.-(( salp /tstr) * d  )) ** (g/( salp * r)))
      temp  = tstr - d * salp
      GO TO 300
C
C     COMPUTE ISOTHERMAL CASES
C
 200  CONTINUE
      d     = exp((height - 11000.0) / ((r / g) * tstr))
      press = ptrop / d
      temp  = tstr
C
 300  CONTINUE
      theta = temp * ((1000.0 / press) ** rovcp)
      RETURN
      END