var/da/da_radiance/siem_bts.inc

   1 subroutine siem_bts(theta,frequency,tbb,ts,seaice_type,em_vector)
   2 !
   3 !$$$  subprogram documentation block
   4 !                .      .    .                                       .
   5 ! subprogram:
   6 !
   7 !   prgmmr:Banghua Yan                  org: nesdis              date: 2004-03-01
   8 !
   9 ! abstract:
  10 !         Calculate the emissivity discriminators and interpolate/extrapolate
  11 !  emissivity at required frequency with respect to secenery BTs
  12 !
  13 ! program history log:
  14 !
  15 ! input argument list:
  16 !
  17 !      frequency        -  frequency in GHz
  18 !      theta            -  local zenith angle (not used here)
  19 !      ts               -  surface temperature in degree
  20 !      tbb[1] ~ tbb[2]  -  brightness temperature at five AMSU-B window channels:
  21 !                              tbb[1] : 89  GHz
  22 !                              tbb[2] : 150 GHz
  23 !
  24 ! output argument list:
  25 !
  26 !   em_vector(1) and (2)  -  emissivity at two polarizations.
  27 !                              set esv = esh here and will be updated
  28 !       seaice_type        -  ?
  29 !
  30 ! important internal variables:
  31 !
  32 !   coe31   - fitting coefficients to estimate discriminator at 31.4 GHz
  33 !   coe89   - fitting coefficients to estimate discriminator at 89   GHz
  34 !   coe150  - fitting coefficients to estimate discriminator at 150  GHz
  35 !
  36 ! remarks:
  37 !
  38 ! attributes:
  39 !   language: f90
  40 !   machine:  ibm rs/6000 sp
  41 !
  42 !$$$
  43
  44 !  use kinds, only: r_kind,i_kind
  45   implicit none
  46
  47   integer(i_kind),parameter:: nch =10,nwch = 5,ncoe = 6
  48   real(r_kind)    :: tbb(*),theta
  49   real(r_kind)    :: em_vector(*),emissivity,ts,frequency,discriminator(nwch)
  50   integer(i_kind) :: seaice_type,i,k,ich,nvalid_ch
  51   real(r_kind)  :: coe23(0:ncoe),coe31(0:ncoe),coe50(0:ncoe),coe89(0:ncoe-3),coe150(0:ncoe-3)
  52   real(r_kind)  :: coe(nch*(ncoe+1))
  53
  54   Equivalence (coe(1),coe23)
  55   Equivalence (coe(11),coe31)
  56   Equivalence (coe(21),coe50)
  57   Equivalence (coe(31),coe89)
  58   Equivalence (coe(41),coe150)
  59
  60 ! Fitting Coefficients at 31.4 GHz
  61   data coe23/ 2.239429e+000_r_kind, -2.153967e-002_r_kind,  &
  62        5.785736e-005_r_kind,  1.366728e-002_r_kind,    &
  63        -3.749251e-005_r_kind, -5.128486e-002_r_kind, -2.184161e-003_r_kind/
  64   data coe31/ 1.768085e+000_r_kind, -1.643430e-002_r_kind,  &
  65        4.850989e-005_r_kind,  1.288753e-002_r_kind,   &
  66        -3.628051e-005_r_kind, -4.751277e-002_r_kind, -2.580649e-003_r_kind/
  67   data coe50/ 8.910227e-001_r_kind,  6.170706e-003_r_kind, &
  68        -3.772921e-006_r_kind, -4.146567e-004_r_kind,   &
  69        -2.208121e-006_r_kind, -3.163193e-002_r_kind, -3.863217e-003_r_kind/
  70   save coe23,coe31,coe50,coe89,coe150
  71
  72 ! Calculate emissivity discriminators at five AMSU window channels
  73   do ich = 1, nwch-2
  74      discriminator(ich) = coe(1+(ich-1)*10)
  75      nvalid_ch = 2
  76      do i=1,nvalid_ch
  77         discriminator(ich) = discriminator(ich) + coe((ich-1)*10 + 2*i)*tbb(i) + &
  78              coe((ich-1)*10 + 2*i+1)*tbb(i)*tbb(i)
  79      end do
  80      discriminator(ich) = discriminator(ich) +           &
  81           coe( (ich-1)*10 + (nvalid_ch+1)*2 )*cos(theta)  +   &
  82           coe( (ich-1)*10 + (nvalid_ch+1)*2 + 1 )*ts
  83   end do
  84   discriminator(4) = 9.278287e-001_r_kind +  5.549908e-003_r_kind*tbb(1) &
  85        - 5.728596e-004_r_kind*tbb(2) -  4.701641e-003_r_kind*ts
  86   discriminator(5) = 1.520531e+000_r_kind + 1.119648e-003_r_kind*tbb(1) &
  87        +  4.518667e-003_r_kind*tbb(2) - 7.744607e-003_r_kind*ts
  88
  89   call siem_interpolate(frequency,discriminator,emissivity,seaice_type)
  90
  91   em_vector(1) = emissivity
  92   em_vector(2) = emissivity
  93
  94 end subroutine siem_bts