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_NER(ai,mu,ref,Nlay,epsilon_ground,
     &     Bg,Bs,B,
     &     tau,
     &     NER)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the NER matrix at a single wavenumber.
c
c     Input:
c       + ai: true if angular integration is enabled
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + ref: option for reflection
c         - ref=1: specular reflection
c         - ref=2: diffuse reflection
c       + Nlay: number of layers
c       + epsilon_ground: ground emisivity
c       + Bg: Planck intensity of the ground (W/m²/sr/cm¯¹)
c       + Bs: Planck intensity of space (W/m²/sr/cm¯¹)
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       + 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
c     Output:
c       + NER: NER matrix
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 ref
      integer Nlay
      double precision epsilon_ground
      double precision Bg,Bs
      double precision B(0:Nlay_mx)
      double precision tau(1:Nlay_mx)
      double precision NER(0:Nlay_mx+1,0:Nlay_mx+1)
c     temp
      integer i,j,ii
      double precision tau_below,tau_above
      double precision tau_atmos,tau_between
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine analytic_NER'

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 NER(ground,space)
c     tau_atmos is the optical depth of the atmosphere
      tau_atmos=0.0D+0
      do ii=1,Nlay
         tau_atmos=tau_atmos+tau(ii)
      enddo
      call NER_gs(ai,mu,epsilon_ground,Bg,Bs,tau_atmos,NER(0,Nlay+1)) ! NER(0,Nlay+1)=W/m²/cm¯¹

      do i=1,Nlay ! i: gas layer index
c     computing NER(i,ground)
c     tau_below is the optical depth between the ground and the bottom of layer i
         tau_below=0.0D+0
         do ii=1,i-1
            tau_below=tau_below+tau(ii)
         enddo ! ii
         call NER_ig(ai,mu,epsilon_ground,
     &        Bg,B(i-1),B(i),
     &        tau(i),tau_below,
     &        NER(i,0)) ! [NER(i,0)]=W/m²/cm¯¹
c     computing NER(i,space)
c     tau_above is the optical depth between the top of layer i and space
         tau_above=0.0D+0
         do ii=i+1,Nlay
            tau_above=tau_above+tau(ii)
         enddo ! ii
         call NER_is(ai,mu,ref,epsilon_ground,
     &        Bs,B(i-1),B(i),
     &        tau(i),tau_below,tau_above,
     &        NER(i,Nlay+1)) ! [NER(i,Nlay+1)]=W/m²/cm¯¹

c     Computing NER(i,j), j=i+1,Nlay
         do j=i+1,Nlay ! j: gas layer index
c     tau_between is the optical depth between the top of layer i and
c     the bottom of layer j
            tau_between=0.0D+0
            do ii=i+1,j-1
               tau_between=tau_between+tau(ii)
            enddo ! ii
            call NER_ij(ai,mu,ref,epsilon_ground,
     &           B(i-1),B(i),B(j-1),B(j),
     &           tau(i),tau(j),tau_between,tau_below,
     &           NER(i,j))      ! [NER(i,j)]=W/m²/cm¯¹
         enddo                  ! j
      enddo                     ! i

c     Symetryzing the NER matrix
      do i=1,Nlay
         do j=1,i-1
            NER(i,j)=-NER(j,i)
         enddo
         NER(i,i)=0.0D+0
         NER(0,i)=-NER(i,0)
         NER(Nlay+1,i)=-NER(i,Nlay+1)
      enddo
      NER(Nlay+1,0)=-NER(0,Nlay+1) ! W/m²/cm¯¹
      
      return
      end



      subroutine NER_gs(ai,mu,epsilon_ground,Bg,Bs,tau_atmos,NERgs)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the monochromatic NER between the ground and space
c
c     Input:
c       + ai: true if angular integration is enabled
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + epsilon_ground: ground emissivity
c       + Bg: Planck intensity of the ground (W/m²/sr/cm¯¹)
c       + Bs: Planck intensity of space (W/m²/sr/cm¯¹)
c       + tau_atmos: optical depth of the atmosphere, at a given wavenumber
c     
c     Output:
c       + NERgs: NER between the ground and space
c         Unit: W/m² of ground/cm¯¹ if angular integration is performed
c               W/m² of ground/cm¯¹/sr if 1D calculation
c         NERgs > O means the ground is cooled by a radiative exchange with space
c
c     I/O
      logical ai
      double precision mu
      double precision epsilon_ground,Bg,Bs,tau_atmos
      double precision NERgs
c     temp
c     functions
      double precision expint
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine NER_gs'

      if (ai) then              ! angular integration over 2pi
         NERgs=2.0D+0*pi*epsilon_ground*(Bg-Bs)
     &        *expint(3,tau_atmos)
      else                      ! 1D calculation (direction: mu)
         NERgs=epsilon_ground*mu*(Bg-Bs)*dexp(-tau_atmos/mu)
      endif

      return
      end



      subroutine analytic_NER_is(ai,mu,ref,Nlay,epsilon_ground,
     &     Bg,Bs,B,
     &     tau,
     &     NER)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute only the i-space NERs at a single wavenumber.
c
c     Input:
c       + ai: true if angular integration is enabled
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + ref: option for reflection
c         - ref=1: specular reflection
c         - ref=2: diffuse reflection
c       + Nlay: number of layers
c       + epsilon_ground: ground emisivity
c       + Bg: Planck intensity of the ground (W/m²/sr/cm¯¹)
c       + Bs: Planck intensity of space (W/m²/sr/cm¯¹)
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       + 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
c     Output:
c       + NER: NER matrix (W/m²/cm¯¹) where only (i,Nlay+1) terms have been computed
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 ref
      integer Nlay
      double precision epsilon_ground
      double precision Bg,Bs
      double precision B(0:Nlay_mx)
      double precision tau(1:Nlay_mx)
      double precision NER(0:Nlay_mx+1,0:Nlay_mx+1)
c     temp
      integer i,j,ii
      double precision tau_below
      double precision tau_above
      double precision tau_atmos
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine analytic_NER_is'

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
         stop
      endif

c     Computing NER(ground,space)
c     tau_atmos is the optical depth of the atmosphere
      tau_atmos=0.0D+0
      do ii=1,Nlay
         tau_atmos=tau_atmos+tau(ii)
      enddo
      call NER_gs(ai,mu,epsilon_ground,Bg,Bs,tau_atmos,NER(0,Nlay+1)) ! NER(0,Nlay+1)=W/m²/cm¯¹

      do i=1,Nlay ! i: gas layer index
c     computing NER(i,space)
c     tau_below is the optical depth between the ground and the bottom of layer i
         tau_below=0.0D+0
         do ii=1,i-1
            tau_below=tau_below+tau(ii)
         enddo ! ii
c     tau_above is the optical depth between the top of layer i and space
         tau_above=0.0D+0
         do ii=i+1,Nlay
            tau_above=tau_above+tau(ii)
         enddo ! ii
         call NER_is(ai,mu,ref,epsilon_ground,
     &        Bs,B(i-1),B(i),
     &        tau(i),tau_below,tau_above,
     &        NER(i,Nlay+1)) ! [NER(i,Nlay+1)]=W/m²/cm¯¹
      enddo                     ! i

c     Symetryzing the NER matrix
      do i=1,Nlay
         NER(Nlay+1,i)=-NER(i,Nlay+1)
      enddo
      NER(Nlay+1,0)=-NER(0,Nlay+1) ! W/m²/cm¯¹
      
      return
      end
      


      subroutine NER_ig(ai,mu,epsilon_ground,Bg,B1,B2,taui,tau_below,
     &     NERig)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the direct (i.e. reflexion by the ground is
c     not taken into account) monochromatic NER between a given gas layer and the ground
c
c     Input:
c       + ai: true if angular integration is enabled
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + epsilon_ground: ground emissivity
c       + Bg: Planck intensity of the ground (W/m²/cm¯¹)
c       + B1: Planck intensity at the bottom of the gas layer (W/m²/cm¯¹)
c       + B2: Planck intensity at the top of the gas layer (W/m²/cm¯¹)
c       + taui: optical depth of the gas layer, at a given wavenumber
c       + tau_below: optical depth between the ground and the bottom
c         of the gas layer, at a given wavenumber
c
c     Output:
c       + NERig: direct NER between the gas layer and the ground (W/m²/cm¯¹)
c         Unit: W/m² of ground/cm¯¹ if angular integration is performed
c               W/m² of ground/cm¯¹/sr if 1D calculation
c         NERig > 0 means the gas layer is cooled by a radiative exchange with the ground
c
c     I/O
      logical ai
      double precision mu
      double precision epsilon_ground,Bg,B1,B2,taui,tau_below
      double precision NERig
c     temp
c     functions
      double precision expint
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine NER_ig'

      if (ai) then              ! angular integration
         NERig=2.0D+0*pi
     &        *epsilon_ground
     &        *(
     &        +(B1-Bg)*expint(3,tau_below)
     &        -(B2-Bg)*expint(3,tau_below+taui)
     &        +(B2-B1)/taui
     &        *(
     &        expint(4,tau_below)
     &        -expint(4,tau_below+taui)
     &        )
     &        )
      else                      ! 1D calculation
         NERig=epsilon_ground*dexp(-tau_below/mu)*(
     &        (B1-Bg)*mu
     &        -(B2-Bg)*mu*dexp(-taui/mu)
     &        +(B2-B1)/taui*mu**2.0D+0*(
     &        1.0D+0-dexp(-taui/mu)))
      endif

      return
      end
      


      subroutine NER_is(ai,mu,ref,epsilon_ground,
     &     Bs,B1,B2,
     &     taui,tau_below,tau_above,
     &     NERis)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the monochromatic NER between a gas layer and space
c
c     Input:
c       + ai: true if angular integration is enabled
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + ref: option for reflection
c         - ref=1: specular reflection
c         - ref=2: diffuse reflection
c       + epsilon_ground: ground emissivity
c       + Bs: Planck intensity of space (W/m²/cm¯¹)
c       + B1: Planck intensity at the bottom of the gas layer (W/m²/cm¯¹)
c       + B2: Planck intensity at the top of the gas layer (W/m²/cm¯¹)
c       + taui: optical depth of the gas layer, at a given wavenumber
c       + tau_below: optical depth between the ground and the bottom of
c         the gas layer, at a given wavenumber
c       + tau_above: optical depth between the top of the gas layer and space,
c         at a given wavenumber
c
c     Output:
c       + NERis: NER between the gas layer and space (W/m²/cm¯¹)
c         Unit: W/m² of ground/cm¯¹ if angular integration is performed
c               W/m² of ground/cm¯¹/sr if 1D calculation
c         NERis > 0 means the gas layer is cooled by a radiative exchange with space
c
c     I/O
      logical ai
      double precision mu
      integer ref
      double precision epsilon_ground
      double precision Bs,B1,B2
      double precision taui,tau_below,tau_above
      double precision NERis
c     temp
      double precision NERis_direct
      double precision NERis_ref
c     functions
      double precision expint
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine NER_is'

c     direct exchange
      call NER_is_direct(ai,mu,Bs,B1,B2,taui,tau_above,NERis_direct)
c     reflected part
      if (ai) then              ! angular integration
         if (ref.eq.1) then
            call NER_is_specular_reflection_real(ai,mu,epsilon_ground,
     &           Bs,B1,B2,
     &           taui,tau_below,tau_above,
     &           NERis_ref)
         else if (ref.eq.2) then
            call NER_is_diffuse_reflection(epsilon_ground,
     &           Bs,B1,B2,
     &           taui,tau_below,tau_above,
     &           NERis_ref)
         else
            call error(label)
            write(*,*) 'ref=',ref
            write(*,*) 'allowed values: 1, 2'
            stop
         endif
      else                      ! 1D computation: no choice of reflexion (specular only)
         call NER_is_specular_reflection_virtual(ai,mu,
     &        epsilon_ground,
     &        Bs,B1,B2,
     &        taui,tau_below,tau_above,
     &        NERis_ref)
      endif

      NERis=NERis_direct+NERis_ref

      return
      end
      


      subroutine NER_is_direct(ai,mu,Bs,B1,B2,taui,tau_above,
     &     NERis_direct)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the direct (i.e. reflexion by the ground is
c     not taken into account) monochromatic NER between a gas layer and space
c
c     Input:
c       + ai: true if angular integration is enabled
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + Bs: Planck intensity of space (W/m²/cm¯¹)
c       + B1: Planck intensity at the bottom of the gas layer (W/m²/cm¯¹)
c       + B2: Planck intensity at the top of the gas layer (W/m²/cm¯¹)
c       + taui: optical depth of the gas layer, at a given wavenumber
c       + tau_above: optical depth between the top of the gas layer and space,
c         at a given wavenumber
c
c     Output:
c       + NERis_direct: direct NER between the gas layer and space (W/m²/cm¯¹)
c         Unit: W/m² of ground/cm¯¹ if angular integration is performed
c               W/m² of ground/cm¯¹/sr if 1D calculation
c         NERis_direct > 0 means the gas layer is cooled by a radiative exchange with space
c
c     I/O
      logical ai
      double precision mu
      double precision Bs,B1,B2,taui,tau_above
      double precision NERis_direct
c     temp
c     functions
      double precision expint
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine NER_is_direct'

      if (ai) then              ! angular integration
         NERis_direct=2.0D+0*pi
     &        *(
     &        (B2-Bs)*expint(3,tau_above)
     &        -(B1-Bs)*expint(3,tau_above+taui)
     &        +(B1-B2)/taui*
     &        (
     &        expint(4,tau_above)-expint(4,tau_above+taui)
     &        )
     &        )
      else                      ! 1D computation
         NERis_direct=dexp(-tau_above/mu)*(
     &        (B2-Bs)*mu
     &        -(B1-Bs)*mu*dexp(-taui/mu)
     &        +(B1-B2)/taui*mu**2.0D+0*(
     &        1.0D+0-dexp(-taui/mu)))
      endif

      return
      end
      


      subroutine NER_is_specular_reflection_virtual(ai,mu,
     &     epsilon_ground,
     &     Bs,B1,B2,taui,tau_below,tau_above,NER_is_ref)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the indirect (i.e. only reflexion by the ground is
c     taken into account) monochromatic NER between a gas layer and space,
c     for specular reflexion by the ground.
c
c     Input:
c       + ai: true if angular integration is enabled
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + epsilon_ground: ground emissivity
c       + Bs: Planck intensity of space (W/m²/cm¯¹)
c       + B1: Planck intensity at the bottom of the gas layer (W/m²/cm¯¹)
c       + B2: Planck intensity at the top of the gas layer (W/m²/cm¯¹)
c       + taui: optical depth of the gas layer, at a given wavenumber
c       + tau_below: optical depth between the ground and the bottom of
c         the gas layer, at a given wavenumber
c       + tau_above: optical depth between the top of the gas layer and space,
c         at a given wavenumber
c
c     Output:
c       + NER_is_ref: indirect NER between the gas layer and space (W/m²/cm¯¹)
c         Unit: W/m² of ground/cm¯¹ if angular integration is performed
c               W/m² of ground/cm¯¹/sr if 1D calculation
c         NER_is_ref > 0 means the gas layer is cooled by a radiative exchange with space
c
c     This routine uses the concept of a virtual gas layer, that would be the symetric
c     of the real gas layer relative to the ground. I/O are the same than using
c     routine "NER_is_specular_reflection_real"
c
c     I/O
      logical ai
      double precision mu
      double precision epsilon_ground,Bs,B1,B2,taui,tau_below,tau_above
      double precision NER_is_ref
c     temp
      double precision B1_ref,B2_ref,tau_B_ref
      double precision NERis_direct
c     functions
      double precision expint
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine NER_is_specular_reflection_virtual'

      B1_ref=B2
      B2_ref=B1
      tau_B_ref=tau_above+taui+2.0D+0*tau_below
      call NER_is_direct(ai,mu,Bs,B1_ref,B2_ref,taui,tau_B_ref,
     &     NERis_direct)
      NER_is_ref=(1.0D+0-epsilon_ground)*NERis_direct

      return
      end
      


      subroutine NER_is_specular_reflection_real(ai,mu,epsilon_ground,
     &     Bs,B1,B2,
     &     taui,tau_below,tau_above,
     &     NER_is_ref)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the indirect (i.e. only reflexion by the ground is
c     taken into account) monochromatic NER between a gas layer and space,
c     for specular reflexion by the ground.
c
c     Input:
c       + ai: true if angular integration is enabled
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + epsilon_ground: ground emissivity
c       + Bs: Planck intensity of space (W/m²/cm¯¹)
c       + B1: Planck intensity at the bottom of the gas layer (W/m²/cm¯¹)
c       + B2: Planck intensity at the top of the gas layer (W/m²/cm¯¹)
c       + taui: optical depth of the gas layer, at a given wavenumber
c       + tau_below: optical depth between the ground and the bottom of
c         the gas layer, at a given wavenumber
c       + tau_above: optical depth between the top of the gas layer and space,
c         at a given wavenumber
c
c     Output:
c       + NER_is_ref: indirect NER between the gas layer and space (W/m²/cm¯¹)
c         Unit: W/m² of ground/cm¯¹ if angular integration is performed
c               W/m² of ground/cm¯¹/sr if 1D calculation
c         NER_is_ref > 0 means the gas layer is cooled by a radiative exchange with space
c
c     I/O
      logical ai
      double precision mu
      double precision epsilon_ground,Bs,B1,B2,taui,tau_below,tau_above
      double precision NER_is_ref
c     temp
      double precision tauH
c     functions
      double precision expint
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine NER_is_specular_reflection_real'

      tauH=tau_below+taui+tau_above
      if (ai) then              ! angular integration
         NER_is_ref=2.0D+0*pi
     &        *(1.0D+0-epsilon_ground)
     &        *(
     &        (B1-Bs)*expint(3,tauH+tau_below)
     &        -(B2-Bs)*expint(3,tauH+tau_below+taui)
     &        +(B2-B1)/taui*(expint(4,tauH+tau_below)-
     &        expint(4,tauH+tau_below+taui))
     &        )
      else                      ! 1D computation
         NER_is_ref=(1.0D+0-epsilon_ground)
     &        *dexp(-(tau_below+tauH)/mu)*(
     &        (B1-Bs)*mu
     &        -(B2-Bs)*mu*dexp(-taui/mu)
     &        +(B2-B1)/taui*mu**2.0D+0*(
     &        1.0D+0-dexp(-taui/mu)))
      endif

      return
      end
      


      subroutine NER_is_diffuse_reflection(epsilon_ground,
     &     Bs,B1,B2,
     &     taui,tau_below,tau_above,
     &     NER_is_ref)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the indirect (i.e. only reflexion by the ground is
c     taken into account) monochromatic NER between a gas layer and space,
c     for diffuse reflexion by the ground.
c
c     Input:
c       + epsilon_ground: ground emissivity
c       + Bs: Planck intensity of space (W/m²/cm¯¹)
c       + B1: Planck intensity at the bottom of the gas layer (W/m²/cm¯¹)
c       + B2: Planck intensity at the top of the gas layer (W/m²/cm¯¹)
c       + taui: optical depth of the gas layer, at a given wavenumber
c       + tau_below: optical depth between the ground and the bottom of
c         the gas layer, at a given wavenumber
c       + tau_above: optical depth between the top of the gas layer and space,
c         at a given wavenumber
c
c     Output:
c       + NER_is_ref: indirect NER between the gas layer and space (W/m²/cm¯¹)
c         NER_is_ref > 0 means the gas layer is cooled by a radiative exchange with space
c
c     I/O
      double precision epsilon_ground,Bs,B1,B2,taui,tau_below,tau_above
      double precision NER_is_ref
c     temp
      double precision tauH
c     functions
      double precision expint
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine NER_is_diffuse_reflection'

      tauH=tau_below+taui+tau_above
      NER_is_ref=4.0D+0*pi
     &     *(1.0D+0-epsilon_ground)
     &     *expint(3,tauH)
     &     *(
     &     (B1-Bs)*expint(3,tau_below)
     &     -(B2-Bs)*expint(3,tau_below+taui)
     &     +(B2-B1)/taui
     &     *(
     &     expint(4,tau_below)
     &     -expint(4,tau_below+taui)
     &     )
     &     )

      return
      end
      


      subroutine NER_ij(ai,mu,ref,epsilon_ground,
     &     B1,B2,B3,B4,
     &     taui,tauj,tau_between,tau_below,
     &     NERij)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the monochromatic NER between two gas layers
c     index 'i' and 'j', where 'i' HAS TO BE PHYSICALLY LOCATED BELOW 'j'.
c
c     Input:
c       + ai: true if angular integration is enabled
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + ref: option for reflection
c         - ref=1: specular reflection
c         - ref=2: diffuse reflection
c       + epsilon_ground: emissivity of the ground
c       + B1: Planck intensity at the bottom of gas layer index 'i' (W/m²/cm¯¹)
c       + B2: Planck intensity at the top of gas layer index 'i' (W/m²/cm¯¹)
c       + B3: Planck intensity at the bottom of gas layer index 'j' (W/m²/cm¯¹)
c       + B4: Planck intensity at the top of gas layer index 'j' (W/m²/cm¯¹)
c       + taui: optical depth of gas layer index 'i', at a given wavenumber
c       + tauj: optical depth of gas layer index 'j', at a given wavenumber
c       + tau_between: optical depth between the top of layer 'i' and the bottom of layer 'j'
c       + tau_below: optical depth between the ground and the bottom of
c         gas layer 'i', at a given wavenumber
c
c     Output:
c       + NERij: direct NER between gas layers 'i' and 'j' (W/m²/cm¯¹)
c         Unit: W/m² of ground/cm¯¹ if angular integration is performed
c               W/m² of ground/cm¯¹/sr if 1D calculation
c         NERij>0 means gas layer 'i' is cooled by a radiative exchange
c         with gas layer 'j'
c
c     I/O
      logical ai
      double precision mu
      integer ref
      double precision epsilon_ground
      double precision B1,B2,B3,B4
      double precision taui,tauj
      double precision tau_between
      double precision tau_below
      double precision NERij
c     temp
      double precision NERij_direct
      double precision NERij_ref
c     functions
      double precision expint
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine NER_ij'

c     direct exchange
      call NER_ij_direct(ai,mu,B1,B2,B3,B4,
     &     taui,tauj,tau_between,
     &     NERij_direct)
c     reflected part
      if (ai) then              ! angular integration
         if (ref.eq.1) then
            call NER_ij_specular_reflection_real(epsilon_ground,
     &           B1,B2,B3,B4,
     &           taui,tauj,tau_between,tau_below,
     &           NERij_ref)
         else if (ref.eq.2) then
            call NER_ij_diffuse_reflection(epsilon_ground,
     &           B1,B2,B3,B4,
     &           taui,tauj,tau_between,tau_below,
     &           NERij_ref)
         else
            call error(label)
            write(*,*) 'ref=',ref
            write(*,*) 'allowed values: 1, 2'
            stop
         endif
      else ! 1D computation
         call NER_ij_specular_reflection_virtual(ai,mu,
     &        epsilon_ground,
     &        B1,B2,B3,B4,
     &        taui,tauj,tau_between,tau_below,
     &        NERij_ref)
      endif

      NERij=NERij_direct+NERij_ref

      return
      end
      


      subroutine NER_ij_direct(ai,mu,B1,B2,B3,B4,
     &     taui,tauj,tau_between,
     &     NERij_direct)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the direct (i.e. reflexion by the ground is not
c     taken into account) monochromatic NER between two gas layers
c     index 'i' and 'j', where 'i' HAS TO BE PHYSICALLY LOCATED BELOW 'j'.
c
c     Input:
c       + ai: true if angular integration is enabled
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + B1: Planck intensity at the bottom of gas layer index 'i' (W/m²/cm¯¹)
c       + B2: Planck intensity at the top of gas layer index 'i' (W/m²/cm¯¹)
c       + B3: Planck intensity at the bottom of gas layer index 'j' (W/m²/cm¯¹)
c       + B4: Planck intensity at the top of gas layer index 'j' (W/m²/cm¯¹)
c       + taui: optical depth of gas layer index 'i', at a given wavenumber
c       + tauj: optical depth of gas layer index 'j', at a given wavenumber
c       + tau_between: optical depth between the top of layer 'i' and the bottom of layer 'j'
c
c     Output:
c       + NERij_direct: direct NER between gas layers 'i' and 'j' (W/m²/cm¯¹)
c         Unit: W/m² of ground/cm¯¹ if angular integration is performed
c               W/m² of ground/cm¯¹/sr if 1D calculation
c         NERij > 0 means gas layer 'i' is cooled by a radiative exchange
c         with gas layer 'j'
c
c     I/O
      logical ai
      double precision mu
      double precision B1,B2,B3,B4
      double precision taui,tauj,tau_between
      double precision NERij_direct
c     temp
c     functions
      double precision expint
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine NER_ij_direct'

      if (ai) then              ! angular integration
         NERij_direct=2.0D+0*pi
     &        *(
     &        (B2-B3)*expint(3,tau_between)
     &        +(B3-B1)*expint(3,tau_between+taui)
     &        +(B4-B2)*expint(3,tau_between+tauj)
     &        +(B1-B4)*expint(3,tau_between+taui+tauj)
     &        +((B2-B1)/taui+(B4-B3)/tauj)
     &        *(
     &        expint(4,tau_between+taui)
     &        +expint(4,tau_between+tauj)
     &        -expint(4,tau_between)
     &        -expint(4,tau_between+taui+tauj)
     &        )
     &        )
      else                      ! 1D computation
         NERij_direct=dexp(-tau_between/mu)*(
     &        mu*(B2-B3)
     &        +mu*dexp(-taui/mu)*(B3-B1)
     &        +mu*dexp(-tauj/mu)*(B4-B2)
     &        +mu*dexp(-(taui+tauj)/mu)*(B1-B4)
     &        +((B2-B1)/taui+(B4-B3)/tauj)
     &        *mu**2.0D+0*(
     &        +dexp(-taui/mu)
     &        +dexp(-tauj/mu)
     &        -1.0D+0
     &        -dexp(-(taui+tauj)/mu)))
      endif

      return
      end



      subroutine NER_ij_specular_reflection_virtual(ai,mu,
     &     epsilon_ground,
     &     B1,B2,B3,B4,
     &     taui,tauj,tau_between,tau_below,
     &     NER_ij_ref)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the indirect (i.e. only reflexion by the ground is
c     taken into account) monochromatic NER between two gas layers
c     index 'i' and 'j', where 'i' HAS TO BE PHYSICALLY LOCATED BELOW 'j',
c     for specular reflexion by the ground.
c
c     Input:
c       + ai: true if angular integration is enabled
c       + mu: cos(theta) if angular integration has been disabled (0-1)
c       + epsilon_ground: ground emissivity
c       + B1: Planck intensity at the bottom of gas layer index 'i' (W/m²/cm¯¹)
c       + B2: Planck intensity at the top of gas layer index 'i' (W/m²/cm¯¹)
c       + B3: Planck intensity at the bottom of gas layer index 'j' (W/m²/cm¯¹)
c       + B4: Planck intensity at the top of gas layer index 'j' (W/m²/cm¯¹)
c       + taui: optical depth of gas layer index 'i', at a given wavenumber
c       + tauj: optical depth of gas layer index 'j', at a given wavenumber
c       + tau_between: optical depth between the top of layer 'i' and the bottom of layer 'j'
c       + tau_below: optical depth between the ground and the bottom of
c         gas layer 'i', at a given wavenumber
c
c     Output:
c       + NER_ij_ref: indirect NER between gas layers 'i' and 'j' (W/m²/cm¯¹)
c         Unit: W/m² of ground/cm¯¹ if angular integration is performed
c               W/m² of ground/cm¯¹/sr if 1D calculation
c         NER_ij_ref > 0 means gas layer 'i' is cooled by a radiative exchange
c         with gas layer 'j'
c
c     I/O
      logical ai
      double precision mu
      double precision epsilon_ground
      double precision B1,B2,B3,B4
      double precision taui,tauj,tau_between,tau_below
      double precision NER_ij_ref
c     temp
      double precision B1_ref,B2_ref,B3_ref,B4_ref
      double precision taui_ref,tauj_ref,tau_between_ref
      double precision NERji_direct
c     functions
      double precision expint
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine NER_ij_specular_reflection_virtual'

c     layer '-j' becomes layer 'i'
      B1_ref=B4
      B2_ref=B3
      taui_ref=tauj
c     layer 'i' becomes layer 'j'
      B3_ref=B1
      B4_ref=B2
      tauj_ref=taui
c     optical thickness between the two layers
      tau_between_ref=2.0D+0*tau_below+taui+tau_between
      
      call NER_ij_direct(ai,mu,B1_ref,B2_ref,B3_ref,B4_ref,
     &     taui_ref,tauj_ref,tau_between_ref,
     &     NERji_direct)

      NER_ij_ref=-(1.0D+0-epsilon_ground)
     &     *NERji_direct
      
      return
      end



      subroutine NER_ij_specular_reflection_real(epsilon_ground,
     &     B1,B2,B3,B4,
     &     taui,tauj,tau_between,tau_below,
     &     NER_ij_ref)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the indirect (i.e. only reflexion by the ground is
c     taken into account) monochromatic NER between two gas layers
c     index 'i' and 'j', where 'i' HAS TO BE PHYSICALLY LOCATED BELOW 'j',
c     for specular reflexion by the ground.
c
c     Input:
c       + epsilon_ground: ground emissivity
c       + B1: Planck intensity at the bottom of gas layer index 'i' (W/m²/cm¯¹)
c       + B2: Planck intensity at the top of gas layer index 'i' (W/m²/cm¯¹)
c       + B3: Planck intensity at the bottom of gas layer index 'j' (W/m²/cm¯¹)
c       + B4: Planck intensity at the top of gas layer index 'j' (W/m²/cm¯¹)
c       + taui: optical depth of gas layer index 'i', at a given wavenumber
c       + tauj: optical depth of gas layer index 'j', at a given wavenumber
c       + tau_between: optical depth between the top of layer 'i' and the bottom of layer 'j'
c       + tau_below: optical depth between the ground and the bottom of
c         gas layer 'i', at a given wavenumber
c
c     Output:
c       + NER_ij_ref: indirect NER between gas layers 'i' and 'j' (W/m²/cm¯¹)
c         NER_ij_ref > 0 means gas layer 'i' is cooled by a radiative exchange
c         with gas layer 'j'
c
c     I/O
      double precision epsilon_ground
      double precision B1,B2,B3,B4
      double precision taui,tauj,tau_between,tau_below
      double precision NER_ij_ref
c     temp
      double precision tau_between1,tau_between2
      double precision a(1:6)
      double precision val1,val2
c     functions
      double precision expint
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine NER_ij_specular_reflection_real'

      tau_between1=tau_below
      tau_between2=tau_between1+taui+tau_between
      call a_coeffs(B1,B2,B3,B4,taui,tauj,a)

      NER_ij_ref=2.0D+0*pi
     &     *(1.0D+0-epsilon_ground)
     &     *(
     &     -a(1)*expint(3,tau_between1+tau_between2)
     &     -(a(2)+a(4))*expint(4,tau_between1+tau_between2)
     &     -a(3)*expint(3,tau_between1+tau_between2+taui)
     &     +(a(2)+a(4))*expint(4,tau_between1+tau_between2+taui)
     &     -a(5)*expint(3,tau_between1+tau_between2+tauj)
     &     +(a(2)+a(4))*expint(4,tau_between1+tau_between2+tauj)
     &     -a(6)*expint(3,tau_between1+tau_between2+taui+tauj)
     &     -(a(2)+a(4))*expint(4,tau_between1+tau_between2+taui+tauj)
     &     )

      return
      end



      subroutine NER_ij_diffuse_reflection(epsilon_ground,
     &     B1,B2,B3,B4,
     &     taui,tauj,tau_between,tau_below,
     &     NER_ij_ref)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the indirect (i.e. only reflexion by the ground is
c     taken into account) monochromatic NER between two gas layers
c     index 'i' and 'j', where 'i' HAS TO BE PHYSICALLY LOCATED BELOW 'j',
c     for diffuse reflexion by the ground.
c
c     Input:
c       + epsilon_ground: ground emissivity
c       + B1: Planck intensity at the bottom of gas layer index 'i' (W/m²/cm¯¹)
c       + B2: Planck intensity at the top of gas layer index 'i' (W/m²/cm¯¹)
c       + B3: Planck intensity at the bottom of gas layer index 'j' (W/m²/cm¯¹)
c       + B4: Planck intensity at the top of gas layer index 'j' (W/m²/cm¯¹)
c       + taui: optical depth of gas layer index 'i', at a given wavenumber
c       + tauj: optical depth of gas layer index 'j', at a given wavenumber
c       + tau_between: optical depth between the top of layer 'i' and the bottom of layer 'j'
c       + tau_below: optical depth between the ground and the bottom of
c         gas layer 'i', at a given wavenumber
c
c     Output:
c       + NER_ij_ref: indirect NER between gas layers 'i' and 'j' (W/m²/cm¯¹)
c         NER_ij_ref > 0 means gas layer 'i' is cooled by a radiative exchange
c         with gas layer 'j'
c
c     I/O
      double precision epsilon_ground,B1,B2,B3,B4,taui,tauj
      double precision tau_below,tau_between
      double precision NER_ij_ref
c     temp
      double precision tau_between1,tau_between2
      double precision alpha3,beta3,gamma3,delta3
      double precision a(1:6)
c     functions
      double precision expint
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine NER_ij_diffuse_reflection'

      tau_between1=tau_below
      tau_between2=tau_between1+taui+tau_between

      call coeffs3(B1,B2,B3,B4,taui,tauj,tau_between1,tau_between2,
     &     alpha3,beta3,gamma3,delta3)

      NER_ij_ref=4.0D+0*pi
     &     *(1.0D+0-epsilon_ground)
     &     *(
     &     -alpha3*expint(3,tau_between1)
     &     -beta3*expint(4,tau_between1)
     &     -gamma3*expint(3,tau_between1+taui)
     &     -delta3*expint(4,tau_between1+taui)
     &     )
      
      return
      end



      subroutine coeffs3(B1,B2,B3,B4,taui,tauj,tau_B1,tau_B2,
     &     alpha3,beta3,gamma3,delta3)
      implicit none
      include 'max.inc'
c     I/O
      double precision expint
      double precision B1,B2,B3,B4,taui,tauj,tau_B1,tau_B2
      double precision a(1:6)
      double precision alpha3,beta3,gamma3,delta3
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine coeffs3'

      call a_coeffs(B1,B2,B3,B4,taui,tauj,a)

      alpha3=a(1)*expint(3,tau_B2)+a(4)*expint(4,tau_B2)
     &     +a(5)*expint(3,tau_B2+tauj)-a(4)*expint(4,tau_B2+tauj)
      beta3=a(2)*(expint(3,tau_B2)-expint(3,tau_B2+tauj))
      gamma3=a(3)*expint(3,tau_B2)-a(4)*expint(4,tau_B2)
     &     +a(6)*expint(3,tau_B2+tauj)+a(4)*expint(4,tau_B2+tauj)
      delta3=-a(2)*(expint(3,tau_B2)-expint(3,tau_B2+tauj))

      return
      end



      subroutine a_coeffs(B1,B2,B3,B4,taui,tauj,a)
      implicit none
      include 'max.inc'
c     I/O
      double precision B1,B2,B3,B4
      double precision taui,tauj
      double precision a(1:6)
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine a_coeffs'

      a(1)=B3-B1
      a(2)=(B1-B2)/taui
      a(3)=B2-B3
      a(4)=(B4-B3)/tauj
      a(5)=B1-B4
      a(6)=B4-B2

      return
      end
