source: trunk/LMDZ.PLUTO.old/libf/phypluto/tpindex.F @ 3436

      subroutine tpindex(pw,tw,qvar,pref,tref,wrefvar,LCOEF,MT,MP,
     &     NVAR,wratio)

!==================================================================
!     
!     Purpose
!     -------
!     Interpolate K-coefficients to the given P,T and Qvar values.
!
!     Notes
!     -----
!     The interpolation is the usual one in two dimensions given
!     in "Numerical Recipes", where the "X" are P, the "Y" are
!     T, and the F(X,Y) are the CO2 K-coefficients.
!
!     The interpolating box is:
!
!           (PL,TU)                        (PR,TU)
!
!                          (TW,PW)
!
!           
!           (PL,TL)                        (PR,TL)
!
!      PL  - Pressure left
!      PR  - Pressure right
!      TL  - Temperature lower
!      TU  - Temperature upper
!      PW  - Pressure wanted
!      TW  - Temperature wanted
!
!     Inputs
!     ------
!     PW                 - The pressure to interpolate to
!     TW                 - The temperature to interpolate to
!     Pref(NP)           - The pressure grid array
!     Tref(NT)           - The temperature grid array
!   
!     Outputs
!     -------
!     TI                 - Interpolation term (pressure)
!     UI                 - Interpolation term (temperature)
!     MT                 - Temperature index (bottom left temperature)
!                          of bounding box
!     MP                 - Pressure index (bottom left pressure)
!                          of bounding box
!
!     Authors
!     -------
!     Adapted from the NASA Ames code by R. Wordsworth (2009)
!     
!==================================================================

      use radinc_h

      implicit none

      real*8 Tref(L_NTREF)
      real*8 pref(L_PINT)
      real*8 wrefvar(L_REFVAR)

      integer MT, MP, N, M, NP, NVAR
      real*8  PW, TW, Qvar, wratio
      real*8  PWL, LCOEF(4), T, U

C======================================================================C
 
!     Get the upper and lower temperature grid indicies that bound the
!     requested temperature. If the requested temperature is outside
!     the T-grid, set up to extrapolate from the appropriate end.
!     TW : temperature to be interpolated
!     TREF : grid array
!     MT : index of TREF for bounding new temperature
!     U : new temperature interpolated

      IF(TW.LE.TREF(1)) THEN
        MT = 1
      ELSE
        do n=1,L_NTREF-1
          if(tw.gt.Tref(n) .and. TW.LE.TREF(N+1)) then
            MT = n
            goto 10
          end if
        end do

        MT = L_NTREF-1
      
   10   continue
      END IF

      !TB: case low temp : MT=1: fixed TW right above tref(1)
      IF (MT.eq.1) THEN
         TW=tref(1)*1.01
!         write(*,*) 'Caution! Pressure of upper levels lower than
!     $        ref pressure for k-coef: k-coeff fixed for upper levels'
      ENDIF

      U = (TW-TREF(MT))/(TREF(MT+1)-TREF(MT))

!     Get the upper and lower pressure grid indicies that bound the
!     requested pressure. If the requested pressure is outside
!     the P-grid, set up to extrapolate from the appropriate end.

      pwl = log10(pw)

      do n=2,L_PINT-1
        if(pwl.le.Pref(n)) then
          MP = n-1
          goto 20
        end if
      end do

      MP = L_PINT-1

   20 continue
      
      !TB: case low pressure : n=2 : fixed pwl, right above pref(1)
      IF (MP.eq.1) THEN
         PWL=Pref(1)*1.01
!         write(*,*) 'Caution! Pressure of upper levels lower than
!     $        ref pressure for k-coef: k-coeff fixed for upper levels'
      ENDIF

!     interpolated pressure
      T = (PWL-PREF(MP))/(PREF(MP+1)-PREF(MP))

!  Fill in the interpolation coefficients
      LCOEF(1) = (1.0-T)*(1.0-U)
      LCOEF(2) = T*(1.0-U)
      LCOEF(3) = T*U
      LCOEF(4) = (1.0-T)*U

!  Get the indicies for abundance of the varying species. There are 10 sets of 
!  k-coefficients with differing amounts of variable vs. constant gas.

      IF(QVAR.le.WREFVAR(1)) then
        NVAR   = 1
        WRATIO = 0.0D0
      ELSEIF(QVAR.ge.WREFVAR(L_REFVAR)) then
        NVAR   = L_REFVAR-1
        WRATIO = 0.99D0
      ELSE
        DO N=2,L_REFVAR
          IF(QVAR.GE.WREFVAR(N-1) .and. QVAR.lt.WREFVAR(N)) then
            NVAR   = N-1
            WRATIO = (QVAR - WREFVAR(N-1))/(WREFVAR(N) - WREFVAR(N-1))
            GOTO 30
          END IF
        END DO
      END IF

   30 CONTINUE

      return
      end