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 monochromatic_rt(ai,mu,ref,Nlay,
     &     lambda_lo,lambda_hi,
     &     epsilon_ground,
     &     temp,Tground,Tspace,toa_sw,tau,
     &     NER,
     &     flux_up,flux_dn,flux_net,
     &     budget,gas_ground,gas_space,gas_gas,budget_from_fluxes)
      implicit none
      include 'max.inc'
      include 'param.inc'
c     
c     Purpose: to perform a "monochromatic" radiative transfer computation (for a given g-point)
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: 1 for a specular reflexion at ground
c              2 for a diffuse reflexion at ground
c       + Nlay: number of atmospheric layers
c       + lambda_lo: lower wavelength (micrometers)
c       + lambda_hi: upper wavelength (micrometers)
c       + epsilon_ground: ground emissivity
c       + temp: temperature at the top of each layer (K)
c       + Tground: temperature of the ground
c       + Tspace: temperature of space
c       + toa_sw: incoming SW flux @ TOA [W/m^2]
c       + tau: optical depth of each atmospheric layer
c     
c     Output:
c       + NER: NER matrix
c       + flux_up: upward fluxes
c       + flux_dn: downward fluxes 
c       + flux_net: net fluxes
c       + budget: radiative budget, from NER
c       + gas_ground: part of the radiative budget due to NERs with ground
c       + gas_space: part of the radiative budget due to NERs with space
c       + gas_gas: part of the radiative budget due to NERs between gas layers
c       + budget_from_fluxes: radiative budget, from net fluxes
c     
c     Units: all results are in W/mē if ai=T, W/mē/sr if ai=F
c     
c     I/O
      logical ai
      double precision mu
      integer ref
      integer Nlay
      double precision lambda_lo
      double precision lambda_hi
      double precision epsilon_ground
      double precision temp(0:Nlay_mx)
      double precision Tground
      double precision Tspace
      double precision toa_sw
      double precision tau(1:Nlay_mx)
      double precision NER(0:Nlay_mx+1,0:Nlay_mx+1)
      double precision flux_up(0:Nlay_mx)
      double precision flux_dn(0:Nlay_mx)
      double precision flux_net(0:Nlay_mx)
      double precision budget(1:Nlay_mx)
      double precision gas_ground(1:Nlay_mx)
      double precision gas_space(1:Nlay_mx)
      double precision gas_gas(1:Nlay_mx)
      double precision budget_from_fluxes(1:Nlay_mx)
c     temp
      integer i,j
      double precision Bg,Bs
      double precision B(0:Nlay_mx)
c     functions
      double precision planck_int_wavlng
c     label
      character*(Nchar_mx) label
      label='subroutine monochromatic_rt'

      Bg=planck_int_wavlng(lambda_lo,lambda_hi,Tground) ! W/mē/sr
c     For the LW:
c     Bs=planck_int_wavlng(lambda_lo,lambda_hi,Tspace) ! W/mē/sr
      
c     For the SW: the incoming flux @ TOA is translated into a blackbody radiance of space
c      Bs=planck_int_wavlng(lambda_lo,lambda_hi,Tspace)
c     &     *(R_sun/AU)**2.0D+0
      Bs=toa_sw/pi

c     Atmospheric profile
      do i=0,Nlay
         B(i)=planck_int_wavlng(lambda_lo,lambda_hi,temp(i)) ! W/mē/sr
      enddo                     ! i

      call analytic_NER(ai,mu,ref,Nlay,epsilon_ground,
     &     Bg,Bs,B,tau,
     &     NER) ! W/mē if ai=T, W/mē/sr if ai=F
      if (.not.ai) then
         do i=0,Nlay+1
            do j=0,Nlay+1
               NER(i,j)=pi*NER(i,j)
            enddo               ! j
         enddo                  ! i
      endif

      call analytic_fluxes(ai,mu,Nlay,tau,B,Bg,Bs,
     &     epsilon_ground,ref,
     &     flux_up,flux_dn,flux_net) ! W/mē if ai=T, W/mē/sr if ai=F
      if (.not.ai) then
         do i=0,Nlay
            flux_up(i)=pi*flux_up(i)
            flux_dn(i)=pi*flux_dn(i)
            flux_net(i)=pi*flux_net(i)
         enddo                  ! i
      endif

      call analytic_budgets_from_ner(ai,Nlay,NER,
     &     budget,gas_ground,gas_space,gas_gas) ! W/mē if ai=T, W/mē/sr if ai=F
      if (.not.ai) then
         do i=1,Nlay
            budget(i)=pi*budget(i)
            gas_ground(i)=pi*gas_ground(i)
            gas_space(i)=pi*gas_space(i)
            gas_gas(i)=pi*gas_gas(i)
         enddo                  ! i
      endif

      call analytic_budgets_from_net_fluxes(Nlay,flux_net,
     &     budget_from_fluxes)  ! W/mē if ai=T, W/mē/sr if ai=F
      if (.not.ai) then
         do i=1,Nlay
            budget_from_fluxes(i)=pi*budget_from_fluxes(i)
         enddo                  ! i
      endif
      
      return
      end
      
