source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/phystd/interpolateH2Ocont_PPC.F90 @ 222

     subroutine interpolateH2Ocont_PPC(wn,temp,presS,presF,abcoef,firstcall)

!==================================================================
!     
!     Purpose
!     -------
!     Calculates the H2O continuum opacity, using the formulae
!     provided in Pierrehumbert, PPC (2010). As this is based on
!     the CKD continuum, it provides a useful check for the 
!     implementation of the more general interpolateH2Ocont_CKD.F90.
!
!     Authors
!     -------
!     R. Wordsworth (2012)
!     
!==================================================================

      use watercommon_h, only: mH2O
      use datafile_mod, only: datadir
      implicit none

      ! input
      double precision wn                 ! wavenumber             (cm^-1)
      double precision temp               ! temperature            (Kelvin)
      double precision presS              ! self-pressure          (Pascals)
      double precision presF              ! foreign (air) pressure (Pascals)

      ! parameters
      double precision, parameter :: T0 = 296.0
      double precision, parameter :: p0 = 1.D+4

      ! variables
      double precision rho_w, x

      ! output
      double precision abcoef             ! absorption coefficient (m^-1)

      logical firstcall

      x = wn - 2500.

      if(firstcall)then ! called by sugas_corrk only
         print*,'----------------------------------------------------'
         print*,'Testing H2O continuum...'

         print*,'interpolateH2Ocont: At wavenumber ',wn,' cm^-1'
         print*,'   temperature ',temp,' K'
         print*,'   H2O pressure ',presS,' Pa'

         rho_w = presS/((8.31446/(mH2O/1000.))*temp)

         if(wn.gt.500 .and. wn.lt.1400)then
            abcoef = exp(12.167 - 0.050898*wn + 8.3207e-5*wn**2 - 7.0748e-8*wn**3 + 2.3261e-11*wn**4)*(T0/temp)**4.25*(presS/p0)
         elseif(wn.gt.2100 .and. wn.lt.3000)then
            abcoef = exp(-6.0055 - 0.0021363*x + 6.4723e-7*x**2 - 1.493e-8*x**3 + 2.5621e-11*x**4 + 7.328e-14*x**5)*(T0/temp)**4.25*(presS/p0)
         else
            abcoef = 0.0
         endif
         abcoef = abcoef*rho_w

         print*,'The self absorption is ',abcoef,' m^-1'
         print*,'And optical depth / km : ',1000.0*abcoef

      else

         rho_w = presS/((8.31446/(mH2O/1000.))*temp)

         if(wn.gt.500 .and. wn.lt.1400)then
            abcoef = exp(12.167 - 0.050898*wn + 8.3207e-5*wn**2 - 7.0748e-8*wn**3 + 2.3261e-11*wn**4)*(T0/temp)**4.25*(presS/p0)
         elseif(wn.gt.2100 .and. wn.lt.3000)then
            abcoef = exp(-6.0055 - 0.0021363*x + 6.4723e-7*x**2 - 1.493e-8*x**3 + 2.5621e-11*x**4 + 7.328e-14*x**5)*(T0/temp)**4.25*(presS/p0)
         else
            abcoef = 0.0
         endif
         abcoef = abcoef*rho_w

         ! unlike for Rayleigh scattering, we do not currently weight by the BB function
         ! however our bands are normally thin, so this is no big deal.

      endif

      return
    end subroutine interpolateH2Ocont_PPC