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
      double precision function Blambda(T,lambda)
      implicit none
c     
c     Planck intensity (W/m²/sr/µm) as function of wavelenght (µm) and temperature (K)
c     
c     Inputs:
c       + T: temperature in K
c       + lambda: wavelenght (µm)
c
c     Output: B (W/m²/sr/µm)
c
      double precision B,T,lambda
      double precision c1,c2,in
      double precision hPl,kBz,c0,pi
      parameter(kBz=1.3806D-23) ! J/K (Boltzmann constant)
      parameter(hPl=6.62606896D-34) ! J.s (Planck constant)
      parameter(c0=2.99792458D+8) ! m/s

      pi=4.0D+0*datan(1.0D+0)

      c1=2*pi*hPl*c0**2 ! W.m²
      c2=hPl*c0/kBz*1.D+6 ! µm.K
      in=lambda*T
      if (T.eq.0) then
         Blambda=0.0D+0
      else
         Blambda=c1/(in**5*(dexp(c2/in)-1))*T**5*1.D+24/pi ! W/m²/sr/µm
      endif

      return
      end



      double precision function Bnu(T,nu)
      implicit none
c     
c     Planck intensity (W/m²/sr/cm¯¹) as function of wavenumber (cm¯¹) and temperature (K)
c     
c     Inputs:
c       + T: temperature in K
c       + nu: wavenumber (cm¯¹)
c
c     Output: B (W/m²/sr/cm¯¹)
c
      double precision B,T,nu
      double precision Blambda,Bl,lambda,dlambda_dnu

      call nu2lambda(nu,lambda)
      Bl=Blambda(T,lambda) ! W/m²/sr/µm
      Bnu=Bl*dabs(dlambda_dnu(lambda)) ! W/m²/sr/cm¯¹
      
      return
      end



      double precision function dlambda_dnu(lambda)
      implicit none
c
c     Purpose: to compute d(lambda)/d(nu) at a given value of lambda
c
c     Input:
c       + lambda: wavelength (micrometers)
c
c     Output:
c       + dlambda_dnu: d(lambda)/d(nu), micrometers per inverse centimeters
c
c     I/O
      double precision lambda,nu

      call lambda2nu(lambda,nu)
      dlambda_dnu=-1.0D+4/(nu**2.0D+0)

      return
      end



      double precision function F_wavnb(nu,T)
      implicit none
      include 'max.inc'
c
c     Purpose: to compute the fraction of energy between 0 and wavenumber "nu"
c

c     Inputs:
c       + nu: wavenumber [cm^{-1}]
c       + T: temperature [K]
c
c     Output:
c       + F: fraction of energy between 0 and nu
c
      double precision nu,T
      double precision sigmaT4
      double precision nu_min
      parameter(nu_min=1.0D-5)
      double precision planck_int_wavnb
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine F_wavnb'

      if (nu.le.0.0D+0) then
         call error(label)
         write(*,*) 'Incorrect input parameter:'
         write(*,*) 'nu=',nu
         stop
      endif

      if (T.lt.0.0D+0) then
         call error(label)
         write(*,*) 'Incorrect input parameter:'
         write(*,*) 'T=',T
         stop
      endif

      F_wavnb=planck_int_wavnb(nu_min,nu,T)/sigmaT4(T)

      if (F_wavnb.gt.1.0D+0) then
         F_wavnb=1.0D+0
      endif

      return
      end



      double precision function F_wavlng(lambda,T)
      implicit none
      include 'max.inc'
c
c     Purpose: to compute the fraction of energy between 0 and wavenlength "lambda"
c

c     Inputs:
c       + nu: wavenlength [µm]
c       + T: temperature [K]
c
c     Output:
c       + F: fraction of energy between 0 and lambda
c
      double precision lambda,T
      double precision sigmaT4
      double precision lambda_min
      parameter(lambda_min=1.0D-5)
      double precision planck_int_wavlng
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine F_wavlng'

      if (lambda.le.0.0D+0) then
         call error(label)
         write(*,*) 'Incorrect input parameter:'
         write(*,*) 'lambda=',lambda
         stop
      endif

      if (T.lt.0.0D+0) then
         call error(label)
         write(*,*) 'Incorrect input parameter:'
         write(*,*) 'T=',T
         stop
      endif

      F_wavlng=planck_int_wavlng(lambda_min,lambda,T)/sigmaT4(T)

      if (F_wavlng.gt.1.0D+0) then
         F_wavlng=1.0D+0
      endif

      return
      end




      double precision function sigmaT4(T)
      implicit none
      include 'max.inc'
      include 'param.inc'
c
c     Purpose: to compute the total energy emitted by a blackbody at temperature T
c
c     Input:
c       + T: temperature [K]
c
c     Output:
c       + sigmaT4 [W/m²/sr]
c
      double precision T
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine sigmaT4'

      if (T.lt.0.0D+0) then
         call error(label)
         write(*,*) 'Incorrect input parameter:'
         write(*,*) 'T=',T
         stop
      endif

      sigmaT4=Pl*T**4.0D+0/pi ! W/m²/sr

      return
      end




      double precision function planck_int_wavnb(nu_lo,nu_hi,T)
      implicit none
      include 'max.inc'
c
c     Purpose: to compute the Planck function, integrated between two
c     values of the wavenumber
c
c     Inputs:
c       + nu_lo: lower value of wavenumber [cm^{-1}]
c       + nu_hi: higer value of wavenumber [cm^{-1}]
c       + T: temperature [K]
c
c     Output:
c       + planck_int_wavnb: Planck function at temperature T, integrated between
c            nu_lo and nu_hi [W//m²/sr]
c

c     inputs
      double precision nu_lo,nu_hi,T
c     temp
      real PLKAVG
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine planck_int_wavnb'

      if (nu_hi.lt.nu_lo) then
         call error(label)
         write(*,*) 'Incorrect input parameters:'
         write(*,*) 'nu_lo=',nu_lo,' > nu_hi=',nu_hi
         stop
      endif

      if (T.lt.0.0D+0) then
         call error(label)
         write(*,*) 'Incorrect input parameter:'
         write(*,*) 'T=',T
         stop
      endif

      planck_int_wavnb=PLKAVG(real(nu_lo),real(nu_hi),real(T)) ! W/m²/sr

      return
      end



      double precision function planck_int_wavlng(lambda_lo,lambda_hi,
     &     T)
      implicit none
      include 'max.inc'
c
c     Purpose: to compute the Planck function, integrated between two
c     values of the wavelength
c
c     Inputs:
c       + lambda_lo: lower value of wavelength [µm]
c       + lambda_hi: higer value of wavelength [µm]
c       + T: temperature [K]
c
c     Output:
c       + planck_int_wavlng: Planck function at temperature T, integrated between
c            lambda_lo and lambda_hi [W//m²/sr]
c

c     inputs
      double precision lambda_lo,lambda_hi,T
c     temp
      double precision planck_int_wavnb
      double precision nu_lo,nu_hi
c     label
      integer strlen
      character*(Nchar_mx) label
      label='function planck_int_wavlng'

      if (lambda_hi.lt.lambda_lo) then
         call error(label)
         write(*,*) 'Incorrect input parameters:'
         write(*,*) 'lambda_lo=',lambda_lo,' > lambda_hi=',lambda_hi
         stop
      endif

      if (T.lt.0.0D+0) then
         call error(label)
         write(*,*) 'Incorrect input parameter:'
         write(*,*) 'T=',T
         stop
      endif

      call lambda2nu(lambda_lo,nu_hi)
      call lambda2nu(lambda_hi,nu_lo)
      planck_int_wavlng=planck_int_wavnb(nu_lo,nu_hi,T) ! W/m²/sr

      return
      end



      double precision function dBint_dT(lambda_lo,lambda_hi,T)
      implicit none
      include 'max.inc'
c
c     Purpose: to compute the derivative of the Planck function
c     (integrated between two values of the wavelength)
c     relative to temperature
c
c     Inputs:
c       + lambda_lo: lower value of wavelength [µm]
c       + lambda_hi: higer value of wavelength [µm]
c       + T: temperature [K]
c
c     Output:
c       + dBint_dT: d(int(B(lambda,T),lambda,lambda_lo,lambda_hi))/d(T) (W/m²/sr/K)
c

c     inputs
      double precision lambda_lo,lambda_hi,T
c     temp
      double precision T1,T2,dT,Bint_T1,Bint_T2
      double precision planck_int_wavlng
c     label
      integer strlen
      character*(Nchar_mx) label
      label='function dBint_dT'
      
      dT=2.0D-1 ! K
      T1=T
      T2=T1+dT
      Bint_T1=planck_int_wavlng(lambda_lo,lambda_hi,T1) ! W/m²/sr
      Bint_T2=planck_int_wavlng(lambda_lo,lambda_hi,T2) ! W/m²/sr

      dBint_dT=(Bint_T2-Bint_T1)/dT ! W/m²/sr/K

      return
      end



      double precision function d2Bint_dT2(lambda_lo,lambda_hi,T)
      implicit none
      include 'max.inc'
c
c     Purpose: to compute the second derivative of the Planck function
c     (integrated between two values of the wavelength)
c     relative to temperature
c
c     Inputs:
c       + lambda_lo: lower value of wavelength [µm]
c       + lambda_hi: higer value of wavelength [µm]
c       + T: temperature [K]
c
c     Output:
c       + d2Bint_dT2: d2(int(B(lambda,T),lambda,lambda_lo,lambda_hi))/d(T^2)
c

c     inputs
      double precision lambda_lo,lambda_hi,T
c     temp
      double precision T1,T2,dT,dBint_dT1,dBint_dT2
      double precision dBint_dT
c     label
      integer strlen
      character*(Nchar_mx) label
      label='function dBint_dT'
      
      dT=1.0D+0 ! K
      T1=T
      T2=T1+dT
      dBint_dT1=dBint_dT(lambda_lo,lambda_hi,T1)
      dBint_dT2=dBint_dT(lambda_lo,lambda_hi,T2)

      d2Bint_dT2=(dBint_dT2-dBint_dT1)/dT

      return
      end



      subroutine nu2lambda(nu,lambda)
      implicit none
      include 'max.inc'
c
c     Purpose: to convert a wavenumber (cm¯¹) into a wavelength (µm)
c
c     I/O
      double precision nu,lambda
c     temp
      integer strlen
      character*(Nchar_mx) label
      label='subroutine nu2lambda'

      if (nu.le.0.0D+0) then
         call error(label)
         write(*,*) 'Bad input parameter:'
         write(*,*) 'nu=',nu
         stop
      else
         lambda=1.0D+4/nu
      endif

      return
      end



      subroutine lambda2nu(lambda,nu)
      implicit none
      include 'max.inc'
c
c     Purpose: to convert a wavelength (µm) into a wavenumber (cm¯¹)
c
c     I/O
      double precision lambda,nu
c     temp
c     label
      integer strlen
      character*(Nchar_mx) label
      label='subroutine lambda2nu'

      if (lambda.le.0.0D+0) then
         call error(label)
         write(*,*) 'Bad input parameter:'
         write(*,*) 'lambda=',lambda
         stop
      else
         nu=1.0D+4/lambda
      endif

      return
      end
