!-------------------------------------- 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_AVHRR(TS, tg,emi,rcal,btobs,radobs,sfctau,cldflag, & 1,4
& ichref,nchn,nprf)
#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
! -NPRF : NUMBER OF PROFILES
!
! OUTPUT:
! -TS(NPRF) : RETRIEVED SKIN TEMPERATURE (-1. FOR MISSING)
!
!
!***********************************************************************
#endif
use mod_tovs
use airsch
use iasich
USE avhrr_var_mod
IMPLICIT NONE
INTEGER :: JN,JC,NCHN,NPRF,CLDFLAG(NPRF),IREF
INTEGER :: ICHN,ICHREF(NPRF)
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
TS1(:,:) = -1.
TS(:) = -1.
RADTG(:,:) = -1.
!* transform guess skin temperature to plank radiances
DO JN = 1, NPRF
IF ( CLDFLAG(JN) == -1 ) CYCLE
DO JC = 1, NCHN
t_effective = coeff_avhrr(1)%ff_bco(jc) + coeff_avhrr(1)%ff_bcs(jc) * TG(jn)
RADTG(JC,jn) = coeff_avhrr(1)%planck1(jc) / &
& ( Exp( coeff_avhrr(1)%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, NCHN
tstore = coeff_avhrr(1)%planck2(jc) / Log( 1+coeff_avhrr(1)%planck1(jc)/RADTS )
TS1(JC,jn) = ( tstore-coeff_avhrr(1)%ff_bco(jc) ) / coeff_avhrr(1)%ff_bcs(jc)
! print '(A,1x,i3,1x,i3,1x,2e14.6)',"zx",JC,JN,tstore,TS1(JC,jn)
END DO
! print '(A,1x,i4,1x,6e14.6)',"ABC",JN,TS1(ichref(jn),jn),btobs(ICHREF(JN),JN)
TS(JN) = TS1(ichref(jn),jn)
END DO
END SUBROUTINE ESTIM_TS_AVHRR