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 analytic_fluxes(ai,mu,Nlay,tau,B,Bg,Bs,
     &     epsilon_ground,ref,
     &     flux_up,flux_dn,flux_net)
      implicit none
      include 'max.inc'
      include 'param.inc'
c     
c     Purpose: to compute analytic monochromatic upward, downward and net fluxes
c
c     Input:
c       + ai: true if angular integration is enabled
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + Nlay: number of layers
c       + tau: array of optical depth for each layer
c              tau(i) is the optical depth of layer index i,
c              between levels i-1 and i.
c       + B: array of Planck intensities at layers interfaces (W/m²/sr/cm¯¹)
c            B(i) is the Planck intensity at level index i:
c            B(0) at ground level, B(1) at the top of layer 1, ...
c            B(Nlay) at the top of layer Nlay
c       + Bg: Planck intensity of the ground (W/m²/sr/cm¯¹)
c       + Bs: Planck intensity of space (W/m²/sr/cm¯¹)
c       + epsilon_ground: ground emisivity
c       + ref: option for reflection
c         - ref=1: specular reflection
c         - ref=2: diffuse reflection
c     
c     Output:
c       + flux_up: monochromatic upward fluxes (W/m²/cm¯¹)
c       + flux_dn: monochromatic downward fluxes (W/m²/cm¯¹)
c       + flux_net: monochromatic net fluxes (W/m²/cm¯¹)
c
c     I/O
      logical ai
      double precision mu
      integer Nlay
      double precision tau(1:Nlay_mx)
      double precision B(0:Nlay_mx)
      double precision Bg,Bs
      double precision epsilon_ground
      integer ref
      double precision flux_up(0:Nlay_mx)
      double precision flux_dn(0:Nlay_mx)
      double precision flux_net(0:Nlay_mx)
c     temp
      integer i
      double precision Fh(0:Nlay_mx)
      double precision Fb(0:Nlay_mx)
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine analytic_fluxes'

c     tests
      if (Nlay.le.0) then
         call error(label)
         write(*,*) 'Bad input parameter:'
         write(*,*) 'Nlay=',Nlay
         stop
      endif
      if (Nlay.gt.Nlay_mx) then
         call error(label)
         write(*,*) 'Bad input parameter:'
         write(*,*) 'Nlay=',Nlay
         write(*,*) 'while Nlay_mx=',Nlay_mx
         stop
      endif
      do i=1,Nlay
         if (tau(i).lt.0.0D+0) then
            call error(label)
            write(*,*) 'Bad input parameter:'
            write(*,*) 'tau(',i,')=',tau(i)
            stop
         endif
      enddo ! i
      do i=0,Nlay
         if (B(i).lt.0.0D+0) then
            call error(label)
            write(*,*) 'Bad input parameter:'
            write(*,*) 'B(',i,')=',B(i)
            stop
         endif
      enddo ! i
      if (Bg.lt.0.0D+0) then
         call error(label)
         write(*,*) 'Bad input parameter:'
         write(*,*) 'Bg=',Bg
         stop
      endif
      if (Bs.lt.0.0D+0) then
         call error(label)
         write(*,*) 'Bad input parameter:'
         write(*,*) 'Bs=',Bs
         stop
      endif
      if (epsilon_ground.lt.0.0D+0) then
         call error(label)
         write(*,*) 'Bad input parameter:'
         write(*,*) 'epsilon_ground=',epsilon_ground
         write(*,*) 'is < 0'
         stop
      endif
      if (epsilon_ground.gt.1.0D+0) then
         call error(label)
         write(*,*) 'Bad input parameter:'
         write(*,*) 'epsilon_ground=',epsilon_ground
         write(*,*) 'is > 1'
         stop
      endif

c     computing upward and downward fluxes at each interface
      call Fasc(ai,mu,Nlay,tau,B,Bg,Bs,epsilon_ground,ref,1,0.0D+0,
     &     flux_up(0))
      call Fdes(ai,mu,Nlay,tau,B,Bg,Bs,epsilon_ground,ref,1,tau(1),
     &     flux_dn(0))
      do i=1,Nlay
         call Fasc(ai,mu,Nlay,tau,B,Bg,Bs,epsilon_ground,ref,i,tau(i),
     &        flux_up(i))
         call Fdes(ai,mu,Nlay,tau,B,Bg,Bs,epsilon_ground,ref,i,0.0D+0,
     &        flux_dn(i))
      enddo                     ! i

c      call upward_flux_at_tau(ai,mu,Nlay,1,epsilon_ground,
c     &     B,Bg,Bs,0.0D+0,tau,flux_up(0))
c      call downward_flux_at_tau(ai,mu,Nlay,1,B,Bs,0.0D+0,tau,
c     &     flux_dn(0))
c      do i=1,Nlay
c         call upward_flux_at_tau(ai,mu,Nlay,i,epsilon_ground,
c     &        B,Bg,Bs,tau(i),tau,flux_up(i))
c         call downward_flux_at_tau(ai,mu,Nlay,i,B,Bs,0.0D+0,tau,
c     &        flux_dn(i))
c      enddo ! i

      do i=0,Nlay ! i: interface index
         flux_net(i)=flux_up(i)-flux_dn(i) ! W/m²/cm¯¹
      enddo
      
      return
      end

      

      subroutine Fasc(ai,mu,Nlay,tau,B,Bg,Bs,epsilon_ground,ref,i,
     &     tau_from_bottom,fh)
      implicit none
      include 'max.inc'
      include 'param.inc'
c     
c     Purpose: to compute analytic monochromatic upward flux at a given
c     location within the atmosphere
c
c     Input:
c       + ai: true if angular integration is enabled
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + Nlay: number of layers
c       + tau: array of optical depth for each layer
c              tau(i) is the optical depth of layer index i,
c              between levels i-1 and i.
c       + B: array of Planck intensities at layers interfaces (W/m²/sr/cm¯¹)
c            B(i) is the Planck intensity at level index i:
c            B(0) at ground level, B(1) at the top of layer 1, ...
c            B(Nlay) at the top of layer Nlay
c       + Bg: Planck intensity of the ground (W/m²/sr/cm¯¹)
c       + Bs: Planck intensity of space (W/m²/sr/cm¯¹)
c       + epsilon_ground: ground emisivity
c       + ref: option for reflection
c         - ref=1: specular reflection
c         - ref=2: diffuse reflection
c       + i: index of the layer that contains the location the
c         upward flux has to be computed at.
c       + tau_from_bottom: optical thickness between the bottom of layer i and the
c         location the upward flux has to be computed at.
c
c     Output:
c       + fh: upward flux at interface 'i'
c         Unit: W/m² of ground/cm¯¹ if angular integration is performed
c               W/m² of ground/cm¯¹/sr if 1D calculation
c
c     I/O
      logical ai
      double precision mu
      integer Nlay
      double precision tau(1:Nlay_mx)
      double precision B(0:Nlay_mx)
      double precision Bg,Bs
      double precision epsilon_ground
      integer ref,i
      double precision tau_from_bottom
      double precision fh
c     temp
      double precision Tau_gz1,Tau_z3z1,Tau_z4z1
      double precision Tau_z2s,Tau_z2z3,Tau_z2z4
      double precision tmp1,tmp2,tmp3
      double precision Ac,Bc
      double precision tauH,Tau_gz3
      double precision Fd0
      double precision part1,part2
      integer j,ii
c     functions
      double precision expint
c     Debug
      logical is_nan
c     Debug
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine Fasc'

c     tests
      if (tau_from_bottom.gt.tau(i)) then
         call error(label)
         write(*,*) 'Inconsistency between:'
         write(*,*) 'tau(',i,')=',tau(i)
         write(*,*) 'tau_from_bottom=',tau_from_bottom
         stop
      endif

c     tauH is the optical depth of the atmosphere
      tauH=0.0D+0
      do ii=1,Nlay
         tauH=tauH+tau(ii)
      enddo

c     Tau_gz1 is the optical depth between the ground and the bottom of layer 'i'
      Tau_gz1=0.0D+0
      do ii=1,i-1
         Tau_gz1=Tau_gz1+tau(ii)
      enddo                     ! ii

      if (ref.eq.1) then ! specular reflection at ground level
         Bc=0.0D+0
         do j=2,Nlay
c     Tau_gz3 is the optical depth between the ground and the bottom of layer 'j'
            Tau_gz3=0.0D+0
c            do ii=0,j-1
            do ii=1,j-1
               Tau_gz3=Tau_gz3+tau(ii)
            enddo               ! ii
            if (ai) then        ! angular integration
               Bc=Bc
     &              +B(j-1)*expint(3,Tau_gz1+tau_from_bottom+Tau_gz3)
     &              +(B(j)-B(j-1))/tau(j)
     &              *expint(4,Tau_gz1+tau_from_bottom+Tau_gz3)
     &              -B(j)
     &              *expint(3,Tau_gz1+tau_from_bottom+Tau_gz3+tau(j))
     &              -(B(j)-B(j-1))/tau(j)
     &              *expint(4,Tau_gz1+tau_from_bottom+Tau_gz3+tau(j))
            else                ! 1D computation
               Bc=Bc
     &              +B(j-1)*mu
     &              *dexp(-(Tau_gz1+tau_from_bottom+Tau_gz3)/mu)
     &              +(B(j)-B(j-1))/tau(j)*mu**2.0D+0
     &              *dexp(-(Tau_gz1+tau_from_bottom+Tau_gz3)/mu)
     &              -B(j)*mu
     &              *dexp(-(Tau_gz1+tau_from_bottom+Tau_gz3+tau(j))/mu)
     &              -(B(j)-B(j-1))/tau(j)*mu**2.0D+0
     &              *dexp(-(Tau_gz1+tau_from_bottom+Tau_gz3+tau(j))/mu)
            endif
         enddo                  ! j
         if (ai) then           ! angular integration
            Ac=B(0)*expint(3,Tau_gz1+tau_from_bottom)
     &           +(B(1)-B(0))/tau(1)*expint(4,Tau_gz1+tau_from_bottom)
     &           +Bs*expint(3,tauH+Tau_gz1+tau_from_bottom)
     &           -B(1)*expint(3,tau(1)+Tau_gz1+tau_from_bottom)
     &           -(B(1)-B(0))/tau(1)
     &           *expint(4,tau(1)+Tau_gz1+tau_from_bottom)
     &           +Bc
         else                   ! 1D computation
            Ac=B(0)*mu*dexp(-(Tau_gz1+tau_from_bottom)/mu)
     &           +(B(1)-B(0))/tau(1)*mu**2.0D+0
     &           *dexp(-(Tau_gz1+tau_from_bottom)/mu)
     &           +Bs*mu*dexp(-(tauH+Tau_gz1+tau_from_bottom)/mu)
     &           -B(1)*mu*dexp(-(tau(1)+Tau_gz1+tau_from_bottom)/mu)
     &           -(B(1)-B(0))/tau(1)*mu**2.0D+0
     &           *dexp(-(tau(1)+Tau_gz1+tau_from_bottom)/mu)
     &           +Bc
         endif
c     "Ac" is the downward flux at ground level transmitted to level z.
         if (ai) then ! angular integration
            tmp1=epsilon_ground*Bg*expint(3,tau_from_bottom+Tau_gz1)
     &           +(1.0D+0-epsilon_ground)*Ac
         else                   ! 1D computation
            tmp1=epsilon_ground*Bg*mu
     &           *dexp(-(tau_from_bottom+Tau_gz1)/mu)
     &           +(1.0D+0-epsilon_ground)*Ac
c     Debug
c$$$            call test_nan_dble(tmp1,is_nan)
c$$$            if (is_nan) then
c$$$               call error(label)
c$$$               write(*,*) 'tmp1=',tmp1
c$$$               write(*,*) 'Bg=',Bg
c$$$               write(*,*) 'epsilon_ground=',epsilon_ground
c$$$               write(*,*) 'Ac=',Ac
c$$$               write(*,*) 'tau_from_bottom=',tau_from_bottom
c$$$               write(*,*) 'Tau_gz1=',Tau_gz1
c$$$               write(*,*) 'mu=',mu
c$$$               stop
c$$$            endif
c     Debug
         endif

      else if (ref.eq.2) then   ! diffuse reflection at ground level
         if (ai) then           ! angular integration
            call Fdes(ai,mu,Nlay,tau,B,Bg,Bs,
     &           epsilon_ground,ref,1,tau(1),Fd0)
            tmp1=(epsilon_ground*Bg+(1.0D+0-epsilon_ground)*Fd0/pi)
     &           *expint(3,Tau_gz1+tau_from_bottom)
         else                   ! 1D computation
            tmp1=0.0D+0
c     because no angular integration should be performed, and a specular
c     reflexion requires an angular integration
         endif
      else
         call error(label)
         write(*,*) 'Incorrect input parameter:'
         write(*,*) 'ref=',ref
         stop
      endif ! over ref

      part1=tmp1
c     "part1" is the flux emitted at ground level, plus the downward flux at 
c     ground level that is reflected by the ground, and transmitted to z.
c     It can also be seen as the upward flux at ground level, attenuated to altitude z.

      tmp2=0.0D+0
      if (i.gt.1) then
         do j=1,i-1
            Tau_z4z1=0.0D+0
            do ii=j+1,i-1
               Tau_z4z1=Tau_z4z1+tau(ii)
            enddo               ! ii
            Tau_z3z1=0.0D+0
            do ii=j,i-1
               Tau_z3z1=Tau_z3z1+tau(ii)
            enddo               ! ii
            if (ai) then        ! angular integration
               tmp2=tmp2
     &              +B(j)*expint(3,tau_from_bottom+Tau_z4z1)
     &              -(B(j)-B(j-1))/tau(j)
     &              *expint(4,tau_from_bottom+Tau_z4z1)
     &              -B(j-1)*expint(3,tau_from_bottom+Tau_z3z1)
     &              +(B(j)-B(j-1))/tau(j)
     &              *expint(4,tau_from_bottom+Tau_z3z1)
            else                ! 1D computation
               tmp2=tmp2
     &              +dexp(-(Tau_z4z1+tau_from_bottom)/mu)*(
     &              B(j)*mu
     &              -(B(j)-B(j-1))/tau(j)*mu**2.0D+0
     &              -B(j-1)*mu*dexp(-tau(j)/mu)
     &              +(B(j)-B(j-1))/tau(j)*mu**2.0D+0*dexp(-tau(j)/mu))
            endif               ! ai
         enddo
      endif
c     Debug
c      write(*,*) 'tmp2=',tmp2
c     Debug

      if (ai) then              ! angular integration
         tmp3=(B(i-1)+(B(i)-B(i-1))/tau(i)*tau_from_bottom)/2.0D+0
     &        -(B(i)-B(i-1))/tau(i)/3.0D+0
     &        -B(i-1)*expint(3,tau_from_bottom)
     &        +(B(i)-B(i-1))/tau(i)*expint(4,tau_from_bottom)
      else                      ! 1D computation
         tmp3=(B(i-1)+(B(i)-B(i-1))/tau(i)*tau_from_bottom)*mu
     &        -(B(i)-B(i-1))/tau(i)*mu**2.0D+0
     &        -B(i-1)*mu*dexp(-tau_from_bottom/mu)
     &        +(B(i)-B(i-1))/tau(i)
     &        *mu**2.0D+0*dexp(-tau_from_bottom/mu)
      endif                     ! ai

      part2=tmp2+tmp3
c     "part2" is the upward emission attenuated to altitude z.

      if (ai) then
         fh=2.0D+0*pi*(part1+part2)
      else
         fh=part1+part2
      endif
c     Debug
c$$$      call test_nan_dble(fh,is_nan)
c$$$      if (is_nan) then
c$$$         call error(label)
c$$$         write(*,*) 'fh=',fh
c$$$         write(*,*) 'part1=',part1,' part2=',part2
c$$$         stop
c$$$      endif
c     Debug

      return
      end

      

      subroutine Fdes(ai,mu,Nlay,tau,B,Bg,Bs,epsilon_ground,ref,i,
     &     tau_from_top,fd)
      implicit none
      include 'max.inc'
      include 'param.inc'
c     
c     Purpose: to compute analytic monochromatic upward flux at a given
c     location within the atmosphere
c
c     Input:
c       + ai: true if angular integration is enabled
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + Nlay: number of layers
c       + tau: array of optical depth for each layer
c              tau(i) is the optical depth of layer index i,
c              between levels i-1 and i.
c       + B: array of Planck intensities at layers interfaces (W/m²/sr/cm¯¹)
c            B(i) is the Planck intensity at level index i:
c            B(0) at ground level, B(1) at the top of layer 1, ...
c            B(Nlay) at the top of layer Nlay
c       + Bg: Planck intensity of the ground (W/m²/sr/cm¯¹)
c       + Bs: Planck intensity of space (W/m²/sr/cm¯¹)
c       + epsilon_ground: ground emisivity
c       + ref: option for reflection
c         - ref=1: specular reflection
c         - ref=2: diffuse reflection
c       + i: index of the layer that contains the location the
c         upward flux has to be computed at.
c       + tau_from_top: optical thickness between the top of layer i and the
c         location the downward flux has to be computed at.
c
c     Output:
c       + fd: downward flux at interface 'i'
c         Unit: W/m² of ground/cm¯¹ if angular integration is performed
c               W/m² of ground/cm¯¹/sr if 1D calculation
c
c     I/O
      logical ai
      double precision mu
      integer Nlay
      double precision tau(1:Nlay_mx)
      double precision B(0:Nlay_mx)
      double precision Bg,Bs
      double precision epsilon_ground
      integer ref,i
      double precision tau_from_top
      double precision fd
c     temp
      double precision dBi,dBj
      double precision Tau_gz1,Tau_z3z1,Tau_z4z1
      double precision Tau_z2s,Tau_z2z3,Tau_z2z4
      integer j,ii
      double precision tmp1,tmp2
c     functions
      double precision expint
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine Fdes'

c     tests
      if (tau_from_top.gt.tau(i)) then
         call error(label)
         write(*,*) 'Inconsistency between:'
         write(*,*) 'tau(',i,')=',tau(i)
         write(*,*) 'tau_from_top=',tau_from_top
         stop
      endif

      Tau_z2s=0.0D+0
      do ii=i+1,Nlay
         Tau_z2s=Tau_z2s+tau(ii)
      enddo
      if (ai) then              ! angular integration
         tmp1=Bs*expint(3,tau_from_top+Tau_z2s)
     &        +(B(i)-(B(i)-B(i-1))/tau(i)*tau_from_top)/2.0D+0
     &        +(B(i)-B(i-1))/tau(i)/3.0D+0
     &        -B(i)*expint(3,tau_from_top)
     &        -(B(i)-B(i-1))/tau(i)*expint(4,tau_from_top)
      else                      ! 1D computation
         tmp1=Bs*mu*dexp(-(tau_from_top+Tau_z2s)/mu)
     &        +(B(i)-(B(i)-B(i-1))/tau(i)*tau_from_top)*mu
     &        +(B(i)-B(i-1))/tau(i)*mu**2.0D+0
     &        -B(i)*mu*dexp(-tau_from_top/mu)
     &        -(B(i)-B(i-1))/tau(i)*mu**2.0D+0*dexp(-tau_from_top/mu)
      endif                     ! ai
      tmp2=0.0D+0
      do j=i+1,Nlay
         Tau_z2z3=0.0D+0
         do ii=i+1,j-1
            Tau_z2z3=Tau_z2z3+tau(ii)
         enddo
         Tau_z2z4=Tau_z2z3+tau(j)
         if (ai) then           ! angular integration
            tmp2=tmp2
     &           +B(j-1)*expint(3,tau_from_top+Tau_z2z3)
     &           +(B(j)-B(j-1))/tau(j)*expint(4,tau_from_top+Tau_z2z3)
     &           -B(j)*expint(3,tau_from_top+Tau_z2z4)
     &           -(B(j)-B(j-1))/tau(j)*expint(4,tau_from_top+Tau_z2z4)
         else                   ! 1D computation
            tmp2=tmp2
     &           +B(j-1)*mu*dexp(-(tau_from_top+Tau_z2z3)/mu)
     &           +(B(j)-B(j-1))/tau(j)*mu**2.0D+0
     &           *dexp(-(tau_from_top+Tau_z2z3)/mu)
     &           -B(j)*mu*dexp(-(tau_from_top+Tau_z2z4)/mu)
     &           -(B(j)-B(j-1))/tau(j)*mu**2.0D+0
     &           *dexp(-(tau_from_top+Tau_z2z4)/mu)
         endif                  ! ai
      enddo                     ! j
      if (ai) then
         fd=2.0D+0*pi*(tmp1+tmp2)
      else
         fd=tmp1+tmp2
      endif

      return
      end



      subroutine analytic_net_fluxes(Nlay,NER,net_flux)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute net fluxes from a NER matrix
c
c     Input:
c       + Nlay: number of gas layers
c       + NER: NER matrix (W/m²/cm¯¹)
c
c     Output:
c       + net_flux: net fluxes (W/m²/cm¯¹)
c
c
c     I/O
      integer Nlay
      double precision NER(0:Nlay_mx+1,0:Nlay_mx+1)
      double precision net_flux(0:Nlay_mx)
c     temp
      integer i,j,p
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine analytic_net_fluxes'

c     tests
      if (Nlay.le.0) then
         call error(label)
         write(*,*) 'Bad input parameter:'
         write(*,*) 'Nlay=',Nlay
         stop
      endif
      if (Nlay.gt.Nlay_mx) then
         call error(label)
         write(*,*) 'Bad input parameter:'
         write(*,*) 'Nlay=',Nlay
         write(*,*) 'while Nlay_mx=',Nlay_mx
         stop
      endif

      do p=0,Nlay ! p: index of the interface
         net_flux(p)=0.0D+0
         do i=0,p
            do j=p+1,Nlay+1
               net_flux(p)=net_flux(p)+NER(i,j) ! W/m²/cm¯¹
            enddo               ! over j
         enddo                  ! over i
      enddo                     ! over p

      return
      end



      
      subroutine upward_flux_at_tau(ai,mu,Nlay,i,epsilon_ground,
     &     B,Bg,Bs,ftau,tau,F_up)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the upward flux at a given position
c
c     Input:
c       + ai: true if angular integration is enabled
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + Nlay: number of atmospheric layers
c       + i: index of the layer where the flux has to be evaluated
c       + epsilon_ground: emissivity of the ground
c       + B: array of Planck intensities at layers interfaces (W/m²/sr/cm¯¹)
c            B(i) is the Planck intensity at level index i:
c            B(0) at ground level, B(1) at the top of layer 1, ...
c            B(Nlay) at the top of layer Nlay
c       + Bg: Planck intensity of the ground (W//m^2/cm^-1/sr)
c       + Bs: Planck intensity at space level (W//m^2/cm^-1/sr)
c       + ftau: value of the optical thickness (in the layer) where the flux must be computed
c       + tau: array of optical thickness of each layer
c     
c     Output:
c       + F_up: upward flux at "ftau"
c         Unit: W/m² of ground/cm¯¹ if angular integration is performed
c               W/m² of ground/cm¯¹/sr if 1D calculation
c     
c     I/O
      logical ai
      double precision mu
      integer Nlay
      integer i
      double precision epsilon_ground
      double precision B(0:Nlay_mx)
      double precision Bg,Bs
      double precision ftau
      double precision tau(1:Nlay_mx)
      double precision F_up
c     temp
      integer j,k
      double precision Ac,Bc
      double precision tmp1,tmp2
      double precision tau_atm
      double precision tau_gz1,tau_gz3
      double precision tau_z1z3,tau_z1z4
c     functions
      double precision expint
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine upward_flux_at_tau'

c     tau_atm: optical thickness of the atmosphere
      tau_atm=0.0D+0
      do j=1,Nlay
         tau_atm=tau_atm+tau(j)
      enddo ! j
c     tau_gz1: optical thickness between the ground and the bottom of layer i
      tau_gz1=0.0D+0
      if (i.gt.1) then
         do j=1,i-1
            tau_gz1=tau_gz1+tau(j)
         enddo ! j
      endif

      Bc=0.0D+0
      do j=2,Nlay
c     tau_gz3: optical thickness between the ground and the bottom of layer j
         tau_gz3=0.0D+0
         do k=1,j-1
            tau_gz3=tau_gz3+tau(k)
         enddo ! k
c     "Bc" term
         if (ai) then
            Bc=Bc
     &           +B(j-1)
     &           *expint(3,tau_gz1+ftau+tau_gz3)
     &           +(B(j)-B(j-1))/tau(j)
     &           *expint(4,tau_gz1+ftau+tau_gz3)
     &           -B(j)*expint(3,tau_gz1+ftau+tau_gz3+tau(j))
     &           -(B(j)-B(j-1))/tau(j)
     &           *expint(4,tau_gz1+ftau+tau_gz3+tau(j))
         else
            Bc=Bc
     &           +B(j-1)*mu
     &           *dexp(-(tau_gz1+ftau+tau_gz3)/mu)
     &           +(B(j)-B(j-1))/tau(j)*mu**2.0D+0
     &           *dexp(-(tau_gz1+ftau+tau_gz3)/mu)
     &           -B(j)*mu*dexp(-(tau_gz1+ftau+tau_gz3+tau(j))/mu)
     &           -(B(j)-B(j-1))/tau(j)*mu**2.0D+0
     &           *dexp(-(tau_gz1+ftau+tau_gz3+tau(j))/mu)
         endif
      enddo ! j
c     "Ac" term
      if (ai) then
         Ac=Bc
     &        +B(0)*expint(3,tau_gz1+ftau)
     &        +(B(1)-B(0))/tau(1)
     &        *expint(4,tau_gz1+ftau)
     &        +Bs*expint(3,tau_atm+tau_gz1+ftau)
     &        -B(1)*expint(3,tau(1)+tau_gz1+ftau)
     &        -(B(1)-B(0))/tau(1)
     &        *expint(4,tau(1)+tau_gz1+ftau)
      else
         Ac=Bc
     &        +B(0)*mu*dexp(-(tau_gz1+ftau)/mu)
     &        +(B(1)-B(0))/tau(1)*mu**2.0D+0
     &        *dexp(-(tau_gz1+ftau)/mu)
     &        +Bs*mu*dexp(-(tau_atm+tau_gz1+ftau)/mu)
     &        -B(1)*mu*dexp(-(tau(1)+tau_gz1+ftau)/mu)
     &        -(B(1)-B(0))/tau(1)*mu**2.0D+0
     &        *dexp(-(tau(1)+tau_gz1+ftau)/mu)
      endif
c     "tmp1" term
      if (ai) then
         tmp1=(B(i-1)+(B(i)-B(i-1))/tau(i)*ftau)/2.0D+0
     &        -(B(i)-B(i-1))/(3.0D+0*tau(i))
     &        -B(i-1)*expint(3,ftau)
     &        +(B(i)-B(i-1))/tau(i)*expint(4,ftau)
     &        +epsilon_ground*Bg*expint(3,tau_gz1+ftau)
     &        +(1.0D+0-epsilon_ground)*Ac
      else
         tmp1=(B(i-1)+(B(i)-B(i-1))/tau(i)*ftau)*mu
     &        -(B(i)-B(i-1))/tau(i)*mu**2.0D+0
     &        -B(i-1)*mu*dexp(-(ftau)/mu)
     &        +(B(i)-B(i-1))/tau(i)*mu**2.0D+0
     &        *dexp(-(ftau)/mu)
     &        +epsilon_ground*Bg*mu*dexp(-(tau_gz1+ftau)/mu)
     &        +(1.0D+0-epsilon_ground)*Ac
      endif
      tmp2=0.0D+0
      if (i.gt.1) then
         do j=1,i-1
c     tau_z1z3: optical thickness between the bottom of layer i and the bottom of layer j
            tau_z1z3=0.0D+0
            do k=j,i-1
               tau_z1z3=tau_z1z3+tau(k)
            enddo ! k
c     tau_z1z4: optical thickness between the bottom of layer i and the top of layer j
            tau_z1z4=tau_z1z3-tau(j)
            if (ai) then
               tmp2=tmp2
     &              +B(j)*expint(3,tau_z1z4+ftau)
     &              -(B(j)-B(j-1))/tau(j)*expint(4,tau_z1z4+ftau)
     &              -B(j-1)*expint(3,tau_z1z3+ftau)
     &              +(B(j)-B(j-1))/tau(j)*expint(4,tau_z1z3+ftau)
            else
               tmp2=tmp2
     &              +B(j)*mu*dexp(-(tau_z1z4+ftau)/mu)
     &              -(B(j)-B(j-1))/tau(j)*mu**2.0D+0
     &              *dexp(-(tau_z1z4+ftau)/mu)
     &              -B(j-1)*mu*dexp(-(tau_z1z3+ftau)/mu)
     &              +(B(j)-B(j-1))/tau(j)*mu**2.0D+0
     &              *dexp(-(tau_z1z3+ftau)/mu)
            endif
         enddo ! j
      endif
      if (ai) then
         F_up=2.0D+0*pi*(tmp1+tmp2)
      else
         F_up=tmp1+tmp2
      endif

      return
      end

      
      
      subroutine downward_flux_at_tau(ai,mu,Nlay,i,B,Bs,ftau,tau,F_down)
      implicit none
      include 'max.inc'
      include 'param.inc'
c     
c     Purpose: to compute the downward flux at a given position
c
c     Input:
c       + ai: true if angular integration is enabled
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + Nlay: number of atmospheric layers
c       + i: index of the layer where the flux has to be evaluated
c       + B: array of Planck intensities at layers interfaces (W/m²/sr/cm¯¹)
c            B(i) is the Planck intensity at level index i:
c            B(0) at ground level, B(1) at the top of layer 1, ...
c            B(Nlay) at the top of layer Nlay
c       + Bs: Planck intensity at space level (W//m^2/cm^-1/sr)
c       + ftau: value of the optical thickness (in the layer) where the flux must be computed
c       + tau: array of optical thickness of each layer
c     
c     Output:
c       + F_down: downward flux at "ftau"
c         Unit: W/m² of ground/cm¯¹ if angular integration is performed
c               W/m² of ground/cm¯¹/sr if 1D calculation
c     
c     I/O
      logical ai
      double precision mu
      integer Nlay
      integer i
      double precision B(0:Nlay_mx)
      double precision Bs
      double precision ftau
      double precision tau(1:Nlay_mx)
      double precision F_down
c     temp
      integer j,k
      double precision tau_z2s,tau_z2z3,tau_z2z4
      double precision tmp1,tmp2
      logical is_nan
c     functions
      double precision expint
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine downward_flux_at_tau'

c     tau_z2s: optical thickness between the top of layer i and space
      tau_z2s=0.0D+0
      do j=i+1,Nlay
         tau_z2s=tau_z2s+tau(j)
      enddo ! j
c     First term of the flux
      if (ai) then
         tmp1=(B(i-1)+(B(i)-B(i-1))/tau(i)*ftau)/2.0D+0
     &        +(B(i)-B(i-1))/(3.0D+0*tau(i))
     &        -B(i)*expint(3,tau(i)-ftau)
     &        +Bs*expint(3,tau_z2s+tau(i)-ftau)
     &        -(B(i)-B(i-1))/tau(i)*expint(4,tau(i)-ftau)
      else
         tmp1=(B(i-1)+(B(i)-B(i-1))/tau(i)*ftau)*mu
     &        +(B(i)-B(i-1))/tau(i)*mu**2.0D+0
     &        -B(i)*mu*dexp(-(tau(i)-ftau)/mu)
     &        +Bs*mu*dexp(-(tau_z2s+tau(i)-ftau)/mu)
     &        -(B(i)-B(i-1))/tau(i)*mu**2.0D+0
     &        *dexp(-(tau(i)-ftau)/mu)
      endif
c     Second term of the flux
      tmp2=0.0D+0
      if (i.lt.Nlay) then
         do j=i+1,Nlay
c     tau_z2z3: optical thickness between the top of layer i and the bottom of layer j
            tau_z2z3=0.0D+0
            if (j.gt.i+1) then
               do k=i+1,j-1
                  tau_z2z3=tau_z2z3+tau(k)
               enddo ! k
            endif
c     tau_z2z4: optical thickness between the top of layer i and the top of layer j
            tau_z2z4=tau_z2z3+tau(j)
            if (ai) then
               tmp2=tmp2
     &              +B(j-1)*expint(3,tau_z2z3+tau(i)-ftau)
     &              +(B(j)-B(j-1))/tau(j)
     &              *expint(4,tau_z2z3+tau(i)-ftau)
     &              -B(j)*expint(3,tau_z2z4+tau(i)-ftau)
     &              -(B(j)-B(j-1))/tau(j)
     &              *expint(4,tau_z2z4+tau(i)-ftau)
            else
               tmp2=tmp2
     &              +B(j-1)*mu*dexp(-(tau_z2z3+tau(i)-ftau)/mu)
     &              +(B(j)-B(j-1))/tau(j)*mu**2.0D+0
     &              *dexp(-(tau_z2z3+tau(i)-ftau)/mu)
     &              -B(j)*mu*dexp(-(tau_z2z4+tau(i)-ftau)/mu)
     &              -(B(j)-B(j-1))/tau(j)*mu**2.0D+0
     &              *dexp(-(tau_z2z4+tau(i)-ftau)/mu)
            endif
         enddo ! j
      endif
      if (ai) then
         F_down=2.0D+0*pi*(tmp1+tmp2)
      else
         F_down=tmp1+tmp2
      endif

c     Debug
c$$$      call test_nan_dble(F_down,is_nan)
c$$$      if (is_nan) then
c$$$         call error(label)
c$$$         write(*,*) 'F_down=',F_down
c$$$         write(*,*) 'tmp1=',tmp1
c$$$         write(*,*) 'tmp2=',tmp2
c$$$         write(*,*) 'ftau=',ftau
c$$$         write(*,*) 'B(',i-1,')=',B(i-1)
c$$$         write(*,*) 'B(',i,')=',B(i)
c$$$         write(*,*) 'tau(',i,')=',tau(i)
c$$$         write(*,*) 'tau_z2s=',tau_z2s
c$$$         write(*,*) 'Bs=',Bs
c$$$         write(*,*) 'tau(i)-ftau=',tau(i)-ftau
c$$$         write(*,*) 'E3(tau(i)-ftau)=',expint(3,tau(i)-ftau)
c$$$         write(*,*) 'E3(tau_z2s+tau(i)-ftau)=',
c$$$     &        expint(3,tau_z2s+tau(i)-ftau)
c$$$         write(*,*) 'E4(tau(i)-ftau)=',expint(4,tau(i)-ftau)
c$$$         stop
c$$$      endif
c     Debug

      return
      end
