c     Copyright (C)
c     2010-2013 Université Bordeaux 1
c     2010-2013 Ecole des Mines d'Albi
c     2014-2018 - Mesostar
c     
c     This program is free software; you can redistribute it and/or modify
c     it under the terms of the GNU General Public License as published by
c     the Free Software Foundation; either version 2, or (at your option)
c     any later version.

c     This program is distributed in the hope that it will be useful,
c     but WITHOUT ANY WARRANTY; without even the implied warranty of
c     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
c     GNU General Public License for more details.

c     You should have received a copy of the GNU General Public License
c     along with this program; if not, write to the Free Software
c     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
c     USA.
c
      subroutine interpolation_single_column(db,Nt,Nx,Np,Nb,Nq,
     &     T,P,logP,x,w,ka,
     &     Nlev,p_levels,t_levels,x_levels,
     &     ck_1column)
      implicit none
      include 'max.inc'
c
c     Purpose: to interpolate k-distribution for a single atmospheric column
c
c     Input:
c       + Nt: number of temperature levels
c       + Nx: number of concentration levels
c       + Np: number of pressure levels
c       + Nb: number of spectral narrowbands
c       + Nq: quadrature order
c       + T: temperature levels (K)
c       + P: pressure levels (Pa)
c       + logP: levels of log(pressure)
c       + x: concentrations levels for H2O
c       + w: quadrature weights
c       + ka: absorption coefficient data set (cm^2/molecule)
c     
c       + Nlev: number of (P,T) levels where "ka" has to be interpolated
c       + p_levels: array of pressure levels (Pa) for each interpolation level
c       + t_levels: array of temperature levels (K) for each interpolation level
c       + x_levels: array of concentration levels (molar fraction) for each interpolation level
c
c     Output:
c       + ck_1column: (interpolated) array of k-distribution coefficients for the column
c
c     I/O
      integer db
      integer Nt,Nx,Np,Nb,Nq
      double precision T(1:Nt_mx)
      double precision P(1:Np_mx)
      double precision logP(1:Np_mx)
      double precision x(1:Nx_mx)
      double precision w(1:Nq_mx)
      double precision ka(1:Nt_mx,1:Nx_mx,1:Np_mx,1:Nb_mx,1:Nq_mx)
      integer Nlev
      double precision p_levels(1:Nlev_mx)
      double precision t_levels(1:Nlev_mx)
      double precision x_levels(1:Nlev_mx)
      double precision ck_1column(1:Nlev_mx,1:Nb_mx,1:Nq_mx)
c     temp
      integer lev,band,quad
      double precision ck_interp(1:Nb_mx,1:Nq_mx)
      double precision sigma_cst
      logical is_nan,debug
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine interpolation_single_column'

      do lev=1,Nlev
c     Debug
c         if (db.eq.1) then
c            write(*,*) 'p_levels(',lev,')=',p_levels(lev)
c            write(*,*) 't_levels(',lev,')=',t_levels(lev)
c            write(*,*) 'x_levels(',lev,')=',x_levels(lev)
c         endif
c     Debug
c     Debug
c         if ((db.eq.1).and.(lev.eq.1)) then
c            debug=.true.
c         else
c            debug=.false.
c         endif
         debug=.false.
c     Debug
         call interpolation_PTX(debug,Nt,Nx,Np,Nb,Nq,
     &        T,P,logP,x,w,ka,
     &        p_levels(lev),t_levels(lev),x_levels(lev),
     &        ck_interp)
c     Debug
c         stop
c     Debug
         do band=1,Nb
            do quad=1,Nq
               ck_1column(lev,band,quad)=ck_interp(band,quad)
               call test_nan_dble(ck_1column(lev,band,quad),is_nan)
               if (is_nan) then
                  call error(label)
                  write(*,*) 'ck_1column(',lev,',',band,',',
     &                 quad,')=',ck_1column(lev,band,quad)
                  write(*,*) 'ck_interp(',band,',',quad,')=',
     &                 ck_interp(band,quad)
                  stop
               endif
c               if (ck_1column(lev,band,quad).eq.0.0D+0) then
c                  call warning(label)
c                  write(*,*) 'ck_1column(',lev,',',band,',',quad,')=',
c     &                 ck_1column(lev,band,quad)
c                  write(*,*) 'p_levels(',lev,')=',p_levels(lev)
c                  write(*,*) 't_levels(',lev,')=',t_levels(lev)
c                  write(*,*) 'x_levels(',lev,')=',x_levels(lev)
c                  stop
c               endif
c     Debug
c               ck_1column(lev,band,quad)=0.0D+0
c     Debug
            enddo ! quad
         enddo ! band
      enddo ! lev
c     Debug
c      write(*,*) 'In: ',label(1:strlen(label))
c      do lev=1,Nlev
c         write(*,*) 'ck_1column(',lev,')=',ck_1column(lev,1,1)
c      enddo ! lev
c     Debug

      return
      end



      subroutine interpolation_PTX(debug,Nt,Nx,Np,Nb,Nq,
     &     T,P,logP,x,w,ka,
     &     pressure,temperature,molar_fraction,
     &     ck_interp)
      implicit none
      include 'max.inc'
c
c     Purpose: to interpolate a k-distribution data set (for every band, for every quadrature point)
c     for given (P,T,x) conditions
c
c     Input:
c       + Nt: number of temperature levels
c       + Nx: number of concentration levels
c       + Np: number of pressure levels
c       + Nb: number of spectral narrowbands
c       + Nq: quadrature order
c       + T: temperature levels (K)
c       + P: pressure levels
c       + logP: levels of log(pressure)
c       + x: concentrations levels for H2O
c       + w: quadrature weights
c       + ka: absorption coefficient data set (cm^2/molecule)
c     
c       + pressure: pressure level the data has to be interpolated at (Pa)
c       + temperature: temperature level the data has to be interpolated at (K)
c       + molar_fraction: concentration level the data has to be interpolated at (molar fraction)
c
c     Output:
c       + ck_interp: interpolated k-distribution data set
c
c     I/O
      logical debug
      integer Nt,Nx,Np,Nb,Nq
      double precision T(1:Nt_mx)
      double precision P(1:Np_mx)
      double precision logP(1:Np_mx)
      double precision x(1:Nx_mx)
      double precision w(1:Nq_mx)
      double precision ka(1:Nt_mx,1:Nx_mx,1:Np_mx,1:Nb_mx,1:Nq_mx)
      double precision pressure,temperature,molar_fraction
      double precision ck_interp(1:Nb_mx,1:Nq_mx)
c     temp
      integer it,ip,ix,band,quad
      integer ip0,it0,ix0
      logical it0_found,ip0_found,ix0_found
      double precision k1,k2,k3,k4,k5,k6,k7,k8
      double precision k9,k10,k11,k12
      double precision k13,k14
c     Debug
      double precision mink,mint,maxt
      logical is_nan
c     Debug
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine interpolation_PTX'

c     identification of interpolation indexes
      ip0_found=.false.
      it0_found=.false.

c     ------------------------------------------------------------------------------
c     identification of ip0
      if (pressure.lt.P(1)) then
         ip0=2 ! interpolation between P(1) and P(2)
         ip0_found=.true.
         goto 111
      endif
      do ip=1,Np-1
         if ((pressure.ge.P(ip)).and.(pressure.le.P(ip+1))) then
            ip0=ip+1
            ip0_found=.true.
            goto 111
         endif
      enddo
      if (pressure.gt.P(Np)) then
         ip0=Np ! interpolation between P(Np-1) and P(Np)
         ip0_found=.true.
         goto 111
      endif
 111  continue
      if (.not.ip0_found) then
         call error(label)
         write(*,*) 'ip0 index was not found'
         write(*,*) 'pressure=',pressure
         do ip=1,Np
            write(*,*) 'P(',ip,')=',P(ip)
         enddo
         stop
      endif
c     Debug
c      write(*,*) 'P(',ip0-1,')=',P(ip0-1)
c      write(*,*) 'pressure=',pressure
c      write(*,*) 'P(',ip0,')=',P(ip0)
c      stop
      if (debug) then
         write(*,*) 'P(',ip0-1,')=',P(ip0-1)
         write(*,*) 'pressure=',pressure
         write(*,*) 'P(',ip0,')=',P(ip0)
      endif
c     Debug

c     ------------------------------------------------------------------------------
c     identification of it0
      if (temperature.lt.T(1)) then
         it0=2 ! interpolation between T(1) and T(2)
         it0_found=.true.
         goto 112
      endif
      do it=1,Nt-1
         if ((temperature.ge.T(it)).and.(temperature.le.T(it+1))) then
            it0=it+1
            it0_found=.true.
            goto 112
         endif
      enddo
      if (temperature.gt.T(Nt)) then
         it0=Nt ! interpolation between T(Nt-1) and T(Nt)
         it0_found=.true.
         goto 112
      endif
 112  continue
      if (.not.it0_found) then
         call error(label)
         write(*,*) 'it0 index was not found'
         write(*,*) 'temperature=',temperature
         do it=1,Nt
            write(*,*) 'T(',it,')=',T(it)
         enddo
         stop
      endif
c     Debug
      if (debug) then
         write(*,*) 'T(',it0-1,')=',T(it0-1)
         write(*,*) 'temperature=',temperature
         write(*,*) 'T(',it0,')=',T(it0)
      endif
c     Debug

c     ------------------------------------------------------------------------------
c     identification of ix0
      if (molar_fraction.lt.x(1)) then
         ix0=2 ! interpolation between x(1) and x(2)
         ix0_found=.true.
         goto 113
      endif
      do ix=1,Nx-1
         if ((molar_fraction.ge.x(ix)).and.
     &        (molar_fraction.le.x(ix+1))) then
            ix0=ix+1
            ix0_found=.true.
            goto 113
         endif
      enddo
      if (molar_fraction.gt.x(Nx)) then
         ix0=Nx ! interpolation between x(Nx-1) and x(Nx)
         ix0_found=.true.
         goto 113
      endif
 113  continue
      if (.not.ix0_found) then
         call error(label)
         write(*,*) 'ix0 index was not found'
         write(*,*) 'molar_fraction=',molar_fraction
         do ix=1,Nx
            write(*,*) 'x(',ix,')=',x(ix)
         enddo
         stop
      endif
c     Debug
      if (debug) then
         write(*,*) 'x(',ix0-1,')=',x(ix0-1)
         write(*,*) 'molar_fraction=',molar_fraction
         write(*,*) 'x(',ix0,')=',x(ix0)
      endif
c     Debug

c     ------------------------------------------------------------------------------
c     3D interpolation
      do band=1,Nb
         do quad=1,Nq
c     k1 to k4: for ix0-1
            k1=ka(it0-1,ix0-1,ip0-1,band,quad)
            if (k1.lt.0.0D+0) then
               call error(label)
               write(*,*) 'k1=',k1
               stop
            endif
            k2=ka(it0,ix0-1,ip0-1,band,quad)
            if (k2.lt.0.0D+0) then
               call error(label)
               write(*,*) 'k2=',k2
               stop
            endif
            k3=ka(it0-1,ix0-1,ip0,band,quad)
            if (k3.lt.0.0D+0) then
               call error(label)
               write(*,*) 'k3=',k3
               stop
            endif
            k4=ka(it0,ix0-1,ip0,band,quad)
            if (k4.lt.0.0D+0) then
               call error(label)
               write(*,*) 'k4=',k4
               stop
            endif
c     k5 to k8: for ix0
            k5=ka(it0-1,ix0,ip0-1,band,quad)
            if (k5.lt.0.0D+0) then
               call error(label)
               write(*,*) 'k5=',k5
               stop
            endif
            k6=ka(it0,ix0,ip0-1,band,quad)
            if (k6.lt.0.0D+0) then
               call error(label)
               write(*,*) 'k6=',k6
               stop
            endif
            k7=ka(it0-1,ix0,ip0,band,quad)
            if (k7.lt.0.0D+0) then
               call error(label)
               write(*,*) 'k7=',k7
               stop
            endif
            k8=ka(it0,ix0,ip0,band,quad)
            if (k8.lt.0.0D+0) then
               call error(label)
               write(*,*) 'k8=',k8
               stop
            endif

c     ========================================================
c     Interpolation over temperature axis: linear
c     ========================================================
c     Interpolation between k1 (it0-1,ip0-1,ix0-1) and k2 (it0,ip0-1,ix0-1) -> k9
            call linear_interpolation(T(it0-1),T(it0),temperature,
     &           k1,k2,k9)
c     Debug
c            write(*,*) 'k1=',k1,' k2=',k2
c            write(*,*) 'k9=',k9
c     Debug
            mink=k1
            if (k2.lt.k1) then
               mink=k2
            endif
            mint=T(it0-1)
            maxt=T(it0)
            if (T(it0).lt.T(it0-1)) then
               mint=T(it0)
               maxt=T(it0-1)
            endif
            if (k9.le.0.0D+0) then
               if ((k1.gt.0.0D+0).and.(k2.gt.0.0D+0)
     &              .and.(temperature.ge.mint)
     &              .and.(temperature.le.maxt)) then
                  call error(label)
                  write(*,*) 'k9=',k9
                  write(*,*) 'k1=',k1,' k2=',k2
                  write(*,*) 'T(',it0-1,')=',T(it0-1),' k1=',k1
                  write(*,*) 'T(',it0,')=',T(it0),' k2=',k2
                  write(*,*) 'temperature=',temperature
                  stop
               else
                  k9=1.0D-50
c     Debug
c                  write(*,*) 'k9 was set to:',k9
c     Debug
               endif
            endif
            if ((k9.lt.mink)
     &           .and.(temperature.ge.mint)
     &           .and.(temperature.le.maxt)) then
               call error(label)
               write(*,*) 'k9=',k9
               write(*,*) '< mink=',mink
               write(*,*) 'T(',it0-1,')=',T(it0-1),' k1=',k1
               write(*,*) 'T(',it0,')=',T(it0),' k2=',k2
               write(*,*) 'temperature=',temperature
               stop
            endif

c     Interpolation between k3 (it0-1,ip0,ix0-1) and k4 (it0,ip0,ix0-1) -> k10
            call linear_interpolation(T(it0-1),T(it0),temperature,
     &           k3,k4,k10)
c     Debug
c            write(*,*) 'k3=',k3,' k4=',k4
c            write(*,*) 'k10=',k10
c     Debug
            mink=k3
            if (k4.lt.k3) then
               mink=k4
            endif
            mint=T(it0-1)
            maxt=T(it0)
            if (T(it0).lt.T(it0-1)) then
               mint=T(it0)
               maxt=T(it0-1)
            endif
            if (k10.le.0.0D+0) then
               if ((k1.gt.0.0D+0).and.(k2.gt.0.0D+0)
     &              .and.(temperature.ge.mint)
     &              .and.(temperature.le.maxt)) then
                  call error(label)
                  write(*,*) 'k10=',k10
                  write(*,*) 'k3=',k3,' k4=',k4
                  write(*,*) 'T(',it0-1,')=',T(it0-1),' k3=',k3
                  write(*,*) 'T(',it0,')=',T(it0),' k4=',k4
                  write(*,*) 'temperature=',temperature
                  stop
               else
                  k10=1.0D-50
c     Debug
c                  write(*,*) 'k10 was set to:',k10
c     Debug
               endif
            endif
            if ((k10.lt.mink)
     &           .and.(temperature.ge.mint)
     &           .and.(temperature.le.maxt)) then
               call error(label)
               write(*,*) 'k10=',k10
               write(*,*) '< mink=',mink
               write(*,*) 'T(',it0-1,')=',T(it0-1),' k3=',k3
               write(*,*) 'T(',it0,')=',T(it0),' k4=',k4
               write(*,*) 'temperature=',temperature
               stop
            endif

c     Interpolation between k5 (it0-1,ip0-1,ix0) and k6 (it0,ip0-1,ix0) -> k11
            call linear_interpolation(T(it0-1),T(it0),temperature,
     &           k5,k6,k11)
c     Debug
c            write(*,*) 'k5=',k5,' k6=',k6
c            write(*,*) 'k11=',k11
c     Debug
            mink=k5
            if (k6.lt.k5) then
               mink=k6
            endif
            mint=T(it0-1)
            maxt=T(it0)
            if (T(it0).lt.T(it0-1)) then
               mint=T(it0)
               maxt=T(it0-1)
            endif
            if (k11.le.0.0D+0) then
               if ((k5.gt.0.0D+0).and.(k6.gt.0.0D+0)
     &              .and.(temperature.ge.mint)
     &              .and.(temperature.le.maxt)) then
                  call error(label)
                  write(*,*) 'k11=',k11
                  write(*,*) 'k5=',k5,' k6=',k6
                  write(*,*) 'T(',it0-1,')=',T(it0-1),' k5=',k6
                  write(*,*) 'T(',it0,')=',T(it0),' k6=',k6
                  write(*,*) 'temperature=',temperature
                  stop
               else
                  k11=1.0D-50
c     Debug
c                  write(*,*) 'k11 was set to:',k11
c     Debug
               endif
            endif
            if ((k11.lt.mink)
     &           .and.(temperature.ge.mint)
     &           .and.(temperature.le.maxt)) then
               call error(label)
               write(*,*) 'k11=',k11
               write(*,*) '< mink=',mink
               write(*,*) 'T(',it0-1,')=',T(it0-1),' k5=',k5
               write(*,*) 'T(',it0,')=',T(it0),' k6=',k6
               write(*,*) 'temperature=',temperature
               stop
            endif

c     Interpolation between k7 (it0-1,ip0,ix0) and k8 (it0,ip0,ix0) -> k12
            call linear_interpolation(T(it0-1),T(it0),temperature,
     &           k7,k8,k12)
c     Debug
c            write(*,*) 'k7=',k7,' k8=',k8
c            write(*,*) 'k12=',k12
c     Debug
            mink=k7
            if (k8.lt.k7) then
               mink=k8
            endif
            mint=T(it0-1)
            maxt=T(it0)
            if (T(it0).lt.T(it0-1)) then
               mint=T(it0)
               maxt=T(it0-1)
            endif
            if (k12.le.0.0D+0) then
               if ((k1.gt.0.0D+0).and.(k2.gt.0.0D+0)
     &              .and.(temperature.ge.mint)
     &              .and.(temperature.le.maxt)) then
                  call error(label)
                  write(*,*) 'k12=',k12
                  write(*,*) 'k7=',k7,' k8=',k8
                  write(*,*) 'T(',it0-1,')=',T(it0-1),' k7=',k7
                  write(*,*) 'T(',it0,')=',T(it0),' k8=',k8
                  write(*,*) 'temperature=',temperature
                  stop
               else
                  k12=1.0D-50
c     Debug
c                  write(*,*) 'k12 was set to:',k12
c     Debug
               endif
            endif
            if ((k12.lt.mink)
     &           .and.(temperature.ge.mint)
     &           .and.(temperature.le.maxt)) then
               call error(label)
               write(*,*) 'k12=',k12
               write(*,*) '< mink=',mink
               write(*,*) 'T(',it0-1,')=',T(it0-1),' k7=',k7
               write(*,*) 'T(',it0,')=',T(it0),' k8=',k8
               write(*,*) 'temperature=',temperature
               stop
            endif

c     ========================================================
c     Interpolation over pressure axis: log-log
c     ========================================================
c     Interpolation between k9 (T,ip0-1,ix0-1) and k10 (T,ip0,ix0-1) -> k13
c     Debug
c            write(*,*) 'k13:'
c            write(*,*) 'P(',ip0-1,')=',P(ip0-1)
c            write(*,*) 'P(',ip0,')=',P(ip0)
c     Debug
            call log_log_interpolation(P(ip0-1),P(ip0),pressure,
     &           k9,k10,k13)
            call test_nan_dble(k13,is_nan)
            if (is_nan) then
               call error(label)
               write(*,*) 'k13=',k13
               write(*,*) 'k9=',k9,' k10=',k10
               write(*,*) 'k1=',k1,' k2=',k2
               write(*,*) 'k3=',k3,' k4=',k4
               stop
            endif
c     Debug
c            write(*,*) 'k9=',k9,' k10=',k10,' k13=',k13
c            write(*,*) 'P(',ip0,')=',P(ip0),' P(',ip0-1,')=',P(ip0-1)
c            write(*,*) 'pressure=',pressure
c     Debug
c     Interpolation between k11 (T,ip0-1,ix0) and k12 (T,ip0,ix0) -> k14
c     Debug
c            write(*,*) 'k14:'
c            write(*,*) 'P(',ip0-1,')=',P(ip0-1)
c            write(*,*) 'P(',ip0,')=',P(ip0)
c     Debug
            call log_log_interpolation(P(ip0-1),P(ip0),pressure,
     &           k11,k12,k14)
            call test_nan_dble(k14,is_nan)
            if (is_nan) then
               call error(label)
               write(*,*) 'k14=',k14
               write(*,*) 'k11=',k11,' k12=',k12
               write(*,*) 'k5=',k5,' k6=',k6
               write(*,*) 'k7=',k7,' k8=',k8
               stop
            endif

c     ========================================================
c     Interpolation over concentration axis: log-log
c     ========================================================
c     Interpolation between k13 (T,P,ix0-1) and k14 (T,P,ix0) -> the result !
            if (molar_fraction.eq.0.0D+0) then
               ck_interp(band,quad)=0.0D+0
            else
c     Debug
c               write(*,*) 'ck_interp:'
c               write(*,*) 'P(',ip0-1,')=',P(ip0-1)
c               write(*,*) 'P(',ip0,')=',P(ip0)
c     Debug
               call log_log_interpolation(x(ix0-1),x(ix0),
     &              molar_fraction,
     &              k13,k14,ck_interp(band,quad))
c     Debug
               if (debug) then
                  write(*,*) 'ck_interp(',band,',',quad,')=',
     &                 ck_interp(band,quad)
               endif
c     Debug
               call test_nan_dble(ck_interp(band,quad),is_nan)
               if (is_nan) then
                  call error(label)
                  write(*,*) 'ck_interp(',band,',',quad,')=',
     &                 ck_interp(band,quad)
                  write(*,*) 'k13=',k13,' k14=',k14
                  write(*,*) 'k9=',k9,' k10=',k10
                  write(*,*) 'k11=',k11,' k12=',k12
                  stop
               endif
            endif               ! molar_fraction=0
c     Debug
c            if ((debug).and.(band.eq.1).and.(quad.eq.1)) then
c               write(*,*) 'k13=',k13,' k14=',k14
c               write(*,*) 'x(',ix0-1,')=',x(ix0-1)
c               write(*,*) 'x(',ix0,')=',x(ix0)
c               write(*,*) 'molar_fraction=',molar_fraction
c               write(*,*) 'ck_interp(',band,',',quad,')=',
c     &              ck_interp(band,quad)
c            endif
c     stop
c     Debug

         enddo ! quad
      enddo ! band

      return
      end



      subroutine log_log_interpolation(x1,x2,x0,f1,f2,f0)
      implicit none
      include 'max.inc'
c
c     Purpose: to perform a log-log interpolation: ln(f) linear with ln(x)
c
c     Input:
c       + x1: value of x1
c       + x2: value of x2
c       + x0: value of x where function "f" has to be interpolated
c       + f1: value of "f" at x1
c       + f2: value of "f" at x2
c     
c     Output:
c       + f0: value of "f" interpolated at x0
c
c     I/O
      double precision x1,x2,x0
      double precision f1,f2,f0
c     temp
      double precision ln_f0
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine log_log_interpolation'

      if (x1.eq.x2) then
         call error(label)
         write(*,*) 'Bad input arguments:'
         write(*,*) 'x1=',x1
         write(*,*) 'x2=',x2
         write(*,*) 'are equal'
         stop
      endif

      if (x1.le.0.0D+0) then
         call error(label)
         write(*,*) 'Bad input argument:'
         write(*,*) 'x1=',x1
         write(*,*) 'must be positive'
         stop
      endif

      if (x2.le.0.0D+0) then
         call error(label)
         write(*,*) 'Bad input argument:'
         write(*,*) 'x2=',x2
         write(*,*) 'must be positive'
         stop
      endif

      if (x0.le.0.0D+0) then
         call error(label)
         write(*,*) 'Bad input argument:'
         write(*,*) 'x0=',x0
         write(*,*) 'must be positive'
         stop
      endif

      if (f1.le.0.0D+0) then
         call error(label)
         write(*,*) 'Bad input argument:'
         write(*,*) 'f1=',f1
         write(*,*) 'must be positive'
         stop
      endif

      if (f2.le.0.0D+0) then
         call error(label)
         write(*,*) 'Bad input argument:'
         write(*,*) 'f2=',f2
         write(*,*) 'must be positive'
         stop
      endif

      if (x0.eq.x1) then
         f0=f1
      else if (x0.eq.x2) then
         f0=f2
      else
         call linear_interpolation(dlog(x1),dlog(x2),dlog(x0),
     &        dlog(f1),dlog(f2),ln_f0)
         f0=dexp(ln_f0)
c     Debug
c         write(*,*) 'log(x1)=',dlog(x1)
c         write(*,*) 'log(x2)=',dlog(x2)
c         write(*,*) 'log(x0)=',dlog(x0)
c         write(*,*) 'log(f1)=',dlog(f1)
c         write(*,*) 'log(f2)=',dlog(f2)
c         write(*,*) 'ln_f0=',ln_f0,dexp(ln_f0)
c     Debug
      endif

      return
      end



      subroutine linear_interpolation(x1,x2,x0,f1,f2,f0)
      implicit none
      include 'max.inc'
c
c     Purpose: to perform a linear interpolation:
c     f(x)=f(x1)+[f(x2)-f(x1)]/[x2-x1]*[x-x1]
c
c     Input:
c       + x1: value of x1
c       + x2: value of x2
c       + x0: value of x where function "f" has to be interpolated
c       + f1: value of "f" at x1
c       + f2: value of "f" at x2
c     
c     Output:
c       + f0: value of "f" interpolated at x0
c
c     I/O
      double precision x1,x2,x0
      double precision f1,f2,f0
c     temp
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine linear_interpolation'

      if (x1.eq.x2) then
         call error(label)
         write(*,*) 'Bad input arguments:'
         write(*,*) 'x1=',x1
         write(*,*) 'x2=',x2
         stop
      endif

      if (x0.eq.x1) then
         f0=f1
      else if (x0.eq.x2) then
         f0=f2
      else
         f0=f1+(f2-f1)/(x2-x1)*(x0-x1)
      endif

      return
      end



      subroutine log_interpolation(x1,x2,x0,f1,f2,f0)
      implicit none
      include 'max.inc'
c
c     Purpose: to perform a log interpolation:
c     f(x)=f(x1)*exp[-alpha*(x-x1)] where alpha=ln[f(x1)/f(x2)]/[x2-x1]
c
c     Input:
c       + x1: value of x1
c       + x2: value of x2
c       + x0: value of x where function "f" has to be interpolated
c       + f1: value of "f" at x1
c       + f2: value of "f" at x2
c     
c     Output:
c       + f0: value of "f" interpolated at x0
c
c     I/O
      double precision x1,x2,x0
      double precision f1,f2,f0
c     temp
      double precision alpha
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine log_interpolation'

      if (x1.eq.x2) then
         call error(label)
         write(*,*) 'Bad input arguments:'
         write(*,*) 'x1=',x1
         write(*,*) 'x2=',x2
         stop
      endif

      if (x0.eq.x1) then
         f0=f1
      else if (x0.eq.x2) then
         f0=f2
      else
c     Debug
c         write(*,*) 'x1=',x1,' x2=',x2
c         write(*,*) 'f1=',f1,' f2=',f2
c     Debug
         alpha=dlog(f1/f2)/(x2-x1)
c     Debug
c         write(*,*) 'alpha=',alpha,f1/f2,dlog(f1/f2)
c     Debug
         f0=f1*dexp(-alpha*(x0-x1))
c     Debug
c         write(*,*) 'f0=',f0
c     Debug
      endif

      return
      end
