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 solve_Tb(lambda_min,lambda_max,
     &     intensity,Tb)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the brightness temperature that fits the specified specific intensity
c     for a given spectral interval
c
c     Input:
c       + lambda_min: lower limit of the spectral interval (micrometers)
c       + lambda_max: higher limit of the spectral interval (micrometers)
c       + intensity: specific intensity for the spectral interval (W/m^2/sr between lambda_min and lambda_max)
c     
c     Output:
c       + Tb: brightness temperature (K) so that sigma*Trad^4*(F(lambda_max,Trad)-F(lambda_min,Trad))=intensity
c
c     I/O
      double precision lambda_min,lambda_max
      double precision intensity
      double precision Tb
c     temp
      integer iter
      double precision T0,T1,Tmid
      double precision int0,int1,f0,f1,fmid
      double precision err_x,err_f,dx,df
      parameter(err_x=1.0D-4) ! K
      parameter(err_f=1.0D-14) ! W/m^2/sr
      logical solution_found,keep_going
      double precision dT0,dT
      double precision int1p
c     funtions
      double precision sigmaT4,F_wavlng
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine solve_brightness_temp'

c     Debug
c      write(*,*) 'intensity=',intensity
c     Debug

      if (intensity.le.0.0D+0) then
         intensity=0.0D+0
         T0=0.0D+0
         goto 112
      endif
      
c     identify 'T0' a radiance temperature that minimizes 'intensity'
      T0=300.0D+0
      dT0=100.0D+0
      dT=dT0
      int0=sigmaT4(T0)*(F_wavlng(lambda_max,T0)
     &     -F_wavlng(lambda_min,T0))
      do while (int0.gt.intensity)
         T0=T0-dT
         int0=sigmaT4(T0)*(F_wavlng(lambda_max,T0)
     &        -F_wavlng(lambda_min,T0))
c     Debug
c         write(*,*) 'T0=',T0,' int0=',int0
c     Debug
         if (int0.le.0.0D+0) then
c            call error(label)
c            write(*,*) 'Could not compute T0:'
c            write(*,*) 'intensity=',intensity
c            write(*,*) 'lamda_min=',lambda_min
c            write(*,*) 'lamda_max=',lambda_max
c            write(*,*) 'T0=',T0,' int0=',int0
c     stop
            T0=0.0D+0
            goto 112
         endif
      enddo
c     Debug
c      write(*,*) 'T0=',T0,' int0=',int0
c     Debug
 112  continue

c     identify 'T1' a radiance temperature that maximizes 'intensity'
      T1=300.0D+0
      dT=dT0
      int1=sigmaT4(T1)*(F_wavlng(lambda_max,T1)
     &     -F_wavlng(lambda_min,T1))
      int1p=int1
      do while (int1.lt.intensity)
         T1=T1+dT
         int1=sigmaT4(T1)*(F_wavlng(lambda_max,T1)
     &        -F_wavlng(lambda_min,T1))
c     Debug
c         write(*,*) 'T1=',T1,' int1=',int1
c     Debug
         if (int1.lt.int1p) then
            T1=T1-dT
            dT=dT/2.0D+0
         else
            int1p=int1
         endif
         if (dT.lt.1.0D-5) then
            call warning(label)
            write(*,*) 'Impossible to find T1 for intensity=',intensity
            write(*,*) 'Maximum reached:'
            write(*,*) 'T1=',T1,' int1=',int1
            write(*,*) 'now using intensity=',int1
            intensity=int1
            goto 111
         endif
c         if (int1.le.0.0D+0) then
c            call error(label)
c            write(*,*) 'Could not compute T1:'
c            write(*,*) 'intensity=',intensity
c            write(*,*) 'lamda_min=',lambda_min
c            write(*,*) 'lamda_max=',lambda_max
c            write(*,*) 'T1=',T1,' int1=',int1
c            stop
c         endif
      enddo
 111  continue
c     Debug
c      write(*,*) 'T1=',T1,' int1=',int1
c     Debug

c     Dichotomy procedure to find a precise value
      keep_going=.true.
      solution_found=.false.
      iter=0
      do while (keep_going)
         iter=iter+1
         f0=sigmaT4(T0)*(F_wavlng(lambda_max,T0)
     &        -F_wavlng(lambda_min,T0))
         f1=sigmaT4(T1)*(F_wavlng(lambda_max,T1)
     &        -F_wavlng(lambda_min,T1))
         Tmid=(T0+T1)/2.0D+0
         fmid=sigmaT4(Tmid)*(F_wavlng(lambda_max,Tmid)
     &        -F_wavlng(lambda_min,Tmid))
         if (fmid.lt.intensity) then
            T0=Tmid
         else
            T1=Tmid
         endif
         dx=dabs(T1-T0)
         df=dabs(f1-f0)
         if ((dx.lt.err_x).or.(df.lt.err_f)) then
            keep_going=.false.
            solution_found=.true.
            Tb=Tmid
c     Debug
c            write(*,*) 'solution found !'
c            write(*,*) 'Tb=',Tb
c            write(*,*) 'intensity=',intensity
c            write(*,*) 'fmid=',fmid
c     Debug
         endif
         if (iter.gt.Niter_mx) then
            keep_going=.false.
            solution_found=.false.
         endif
      enddo ! while ! keep_going

      if (.not.solution_found) then
         call error(label)
         write(*,*) 'Solution could not be found:'
         write(*,*) 'lambda_min=',lambda_min
         write(*,*) 'lambda_max=',lambda_max
         write(*,*) 'intensity=',intensity
         write(*,*) 'iter=',iter
         write(*,*) 'dx=',dx
         write(*,*) 'df=',df
         write(*,*) 'T0=',T0,' f0=',f0
         write(*,*) 'T1=',T1,' f1=',f1
         stop
      endif

      return
      end



      subroutine net_flux_toa_to_obs_intensity(net_flux_toa,
     &     obs_intensity)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the intensity (W/m^2/sr) perceived by a remote detector
c     from the TOA net flux (W/m^2 at top of the atmosphere). This net flux @ TOA is
c     assumed to be homogeneously dispersed over 2pi steradians.
c
c     Input:
c       + net_flux_toa: net flux at the top of the atmosphere (W/m^2)
c     
c     Output:
c       + obs_intensity: intensity perceived by a remote detector (W/m^2/sr)
c         I mean Watts perceived by square meter of detector surface,
c         per steradian of solid angle covered by the detector.
c
c     I/O
      double precision net_flux_toa
      double precision obs_intensity
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine net_flux_toa_to_obs_intensity'

c      if (net_flux_toa.lt.0.0D+0) then
c         call warning(label)
c         write(*,*) 'net_flux_toa=',net_flux_toa
c         write(*,*) 'is negative'
c      endif
      obs_intensity=net_flux_toa/pi
      
      return
      end

