C Copyright(c) 1997, Space Science and Engineering Center, UW-Madison
C Refer to "McIDAS Software Acquisition and Distribution Policies"
C in the file  mcidas/data/license.txt

C *** $Id: mclatvap.f,v 1.3 1997/10/10 20:18:10 dglo Exp $ ***

*$ Name:
*$	mclatvap - Compute the latent heat of vaporization
*$
*$ Interface:
*$	double precision function
*$	mclatvap(double precision temperature)
*$
*$ Input:
*$	temperature - temperature (Kelvin) of parcel
*$
*$ Input and Output:
*$	none
*$
*$ Output:
*$	none
*$
*$ Return values:
*$	 >0     - success, computed saturation vapor pressure;  units of
*$                   J per K per kg.
*$
*$ Remarks:
*$	This program performs a linear interpolation on values of
*$      latent heats of vaporization as a function of Temperature as in
*$      Smithsonian Meteorological Tables, p. 343.  The values should
*$      NOT be used to compute derivatives of latent heat of vaporization.
*$
*$      If the requested temperature is outside the bounds of the table,
*$      a latent heat is extrapolated from the end points...use these values
*$      with care!!
*$
*$ Categories:
*$	met/science

      double precision function
     &     mclatvap( temperature )

      implicit none

      double precision temperature	! temperature, Kelvin

C---symbolic constants and shared data

      integer          NUMT		! number of smithsonian data points
      parameter       (NUMT=18)

C---local variables

      integer          i		! loop bound
      double precision rc		! return code
      double precision tc		! temperature, degrees C
      double precision t_smith(NUMT)    ! temperatures
      double precision lv_smith(NUMT)   ! latent heats

C---Smithsonian Meteorological Tables data, Lv as a function of temperature

      data t_smith/-50.D0,-40.D0,-30.D0,-20.D0,-10.D0,0.D0,5.D0,10.D0,
     &  15.D0,20.D0,25.D0,30.D0,35.D0,40.D0,45.D0,50.D0,55.D0,60.D0/
      data lv_smith/629.3,621.7,615.,608.9,603.,597.31,594.5,591.7,
     &  588.9,586.0,583.2,580.4,577.6,574.7,571.9,569.,566.1,563.2/

      tc = temperature - 273.15

C---If the temperature is outside the bounds of the Smitty tables, return
C	a value that has been extrapolated from the ends

      if (tc .lt. t_smith(1)) then
	  rc = lv_smith(1) + ( (lv_smith(1) - lv_smith(2)) /
     &			       (t_smith(1) - t_smith(2)) )*(tc-t_smith(1))
	  goto 2000
      endif
      if (tc .gt. t_smith(NUMT)) then
	  rc = lv_smith(NUMT) + ( (lv_smith(NUMT) - lv_smith(NUMT-1)) /
     &			       (t_smith(NUMT) - t_smith(NUMT-1)) )*
     &				(tc-t_smith(NUMT))
	  goto 2000
      endif

      do 100 i = 1,NUMT-1

          if (tc .ge. t_smith(i) .and.
     &			tc .le. t_smith(i+1))   then

	      rc = lv_smith(i) + (lv_smith(i+1) - lv_smith(i))*
     &           (tc - t_smith(i))/(t_smith(i+1) - t_smith(i))
	      goto 2000
          endif

 100  continue

C---the smithsonian tables are given as ITcal per g...convert this to
C	J per K per kg, the mks value for Lv

 2000 continue

      rc = rc*1000*4.18684
      mclatvap = rc

      return
      end
