!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
!                     version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!


      SUBROUTINE ESTIM_TS(TS, tg,emi,rcal,btobs,radobs,sfctau,cldflag, & 2,3
     &                    ichref,nchn,nchnkept,nprf,idairs,CINST)

#if defined (DOC)
!***********************************************************************
!
!**ID ESTIM_TS -- GET AN ESTIMATED SKIN TEMPERATURE
!
!       AUTHOR:   L. GARAND                   May 2004
!                 A. BEAULNE (CMDA/SMC)     March 2006  (ADAPT TO 3DVAR)                 
!
!       REVISION:
!
!       OBJECT:   GET AN ESTIMATED SKIN TEMPERATURE BY INVERSION OF
!          RADIATIVE TRANSFER EQUATION ASSUMING GUESS T AND Q PROFILES
!          ARE PERFECT. DESIGNED FOR A SINGLE CHANNEL ICHREF AND NPRF
!          PROFILES. ASSUMES A REAL TG (GUESS) OVER OCEANS AND A TG 
!          WITH HYPOTHESIS OF UNITY EMISSIVITY OVER LAND.
!      
!          USES:  RCAL = B(TG)*EMI*SFCTAU + ATMOS_PART
!             TS = B(TS)*EMI*SFCTAU + ATMOS_PART
!          SOLVES FOR TS
!
!       ARGUMENTS:
!          INPUT:
!            -TG(NPRF)          : GUESS SKIN TEMPERATURE (DEG K)
!            -EMI(NCHN,NPRF)    : SURFACE EMISSIVITIES FROM WINDOW CHANNEL (0.-1.)
!            -RCAL(NCHN,NPRF)   : COMPUTED CLEAR RADIANCES (MW/M2/SR/CM-1)
!            -BTOBS(NCHN,NPRF)  : OBSERVED BRIGHTNESS TEMPERATURES (DEG K)
!            -RADOBS(NCHN,NPRF) : COMPUTED OBSERVED RADIANCES (")
!            -SFCTAU(NCHN,NPRF) : SURFACE TO SPACE TRANSMITTANCES (0.-1.)
!            -CLDFLAG(NPRF)     : CLEAR(0), CLOUDY(1) OR UNDEFINED(-1) PROFILES
!            -ICHREF(NPRF)      : REFERENCE SURFACE CHANNEL (SUBSET VALUES)
!            -NCHN              : NUMBER OF CHANNELS
!            -NCHNKEPT          : NUMBER OF CHANNELS KEPT IN CMA
!            -NPRF              : NUMBER OF PROFILES
!            -IDAIRS            : AIRS SATELLITE IDENTYFIER
!            -CINST             : INTRUMENT IASI or AIRS
!
!          OUTPUT:
!            -TS(NPRF)          : RETRIEVED SKIN TEMPERATURE (-1. FOR MISSING)
!
!
!***********************************************************************
#endif

      use mod_tovs
      use airsch
      use iasich

      IMPLICIT NONE

      INTEGER    :: JN,JC,NCHN,NCHNKEPT,NPRF,IDAIRS,CLDFLAG(NPRF),IREF
      INTEGER    :: ICHN,ICHREF(NPRF),INDX
      REAL(8)    :: BTOBS(NCHN,NPRF),RADOBS(NCHN,NPRF)
      REAL(8)    :: RTG,TG(NPRF),RADTG(NCHN,NPRF)
      REAL(8)    :: EMI(NCHN,NPRF),SFCTAU(NCHN,NPRF)
      REAL(8)    :: RADTS,TS(NPRF),TS1(NCHN,NPRF),RCAL(NCHN,NPRF),tstore,t_effective
      CHARACTER (LEN=*) :: CINST


      TS1(:,:) = -1.
      TS(:) = -1.
      RADTG(:,:) = -1.

      IF (CINST(1:4)/="IASI" .AND. CINST(1:4)/="AIRS") THEN
         Write(*,*) "INVALID CINST VALUE : should be IASI or AIRS",CINST
         STOP
      ENDIF


!*    transform guess skin temperature to plank radiances 

      DO JN = 1, NPRF
        IF ( CLDFLAG(JN) == -1 ) CYCLE
        DO JC = 1, NCHNKEPT
          ICHN = ichan(JC,IDAIRS)
          t_effective =  coef(idairs)%ff_bco(jc) + coef(idairs)%ff_bcs(jc) * TG(jn)

          indx=airssch(ichn)
          IF (CINST=="IASI") indx=iasisch(ichn)
          RADTG(indx,jn) =  coef(idairs)%planck1(jc) / &
     &        ( Exp( coef(idairs)%planck2(jc)/t_effective ) - 1.0 )
        END DO
      END DO

      DO JN = 1, NPRF

        IF ( CLDFLAG(JN) /= 0 ) CYCLE

!*   compute TOA planck radiances due to guess skin planck radiances

        RTG =   RADTG(ICHREF(JN),JN)*EMI(ICHREF(JN),JN)*SFCTAU(ICHREF(JN),JN)

!*   compute true skin planck radiances due to TOA true planck radiances

        RADTS = ( RADOBS(ICHREF(JN),JN) + RTG - RCAL(ICHREF(JN),JN) ) / &
    &           ( EMI(ICHREF(JN),JN) * SFCTAU(ICHREF(JN),JN) )
    
!*   transform true skin planck radiances to true skin temperatures

        DO JC = 1, NCHNKEPT
          ICHN = ichan(JC,IDAIRS)
          tstore = coef(idairs)%planck2(jc) / Log( 1+coef(idairs)%planck1(jc)/RADTS )
          indx=airssch(ichn)
          IF (CINST=="IASI") indx=iasisch(ichn)
          TS1(indx,jn) = ( tstore-coef(idairs)%ff_bco(jc) ) / coef(idairs)%ff_bcs(jc)
        END DO

        TS(JN) = TS1(ichref(jn),jn)

      END DO


      END SUBROUTINE ESTIM_TS