var/da/da_radiance/da_mspps_emis.inc

   1 subroutine da_mspps_emis(tb, nchan, em)
   2
   3 ! http://www.star.nesdis.noaa.gov/corp/scsb/mspps/algorithms.html
   4 ! land algorithms for emissivities at three AMSU channels (23.8, 31.4, 50.3 GHz)
   5
   6    implicit none
   7
   8    integer,                intent(in)  :: nchan
   9    real, dimension(nchan), intent(in)  :: tb
  10    real, dimension(nchan), intent(out) :: em
  11
  12    real, dimension(3), parameter :: b0 = (/ -2.5404E-1,-2.2606E-1, 8.9494E-2 /)
  13    real, dimension(3), parameter :: b1 = (/  1.1326E-2, 3.4481E-3,-3.6615E-3 /)
  14    real, dimension(3), parameter :: b2 = (/ -1.9479E-5,-9.7185E-6,-4.2390E-7 /)
  15    real, dimension(3), parameter :: b3 = (/ -4.5763E-3, 4.3299E-3, 1.0636E-2 /)
  16    real, dimension(3), parameter :: b4 = (/  1.7833E-5, 5.3281E-6,-6.4559E-6 /)
  17    real, dimension(3), parameter :: b5 = (/  3.2324E-3, 1.8668E-3,-4.2449E-4 /)
  18    real, dimension(3), parameter :: b6 = (/ -1.9056E-5,-1.5369E-5,-6.6878E-6 /)
  19    real, parameter :: f1  = 23.8
  20    real, parameter :: f2  = 31.4
  21    real, parameter :: f3  = 50.3
  22    real, parameter :: f4  = 52.8
  23    real, parameter :: f5  = 53.596
  24    real, parameter :: f15 = 89.0
  25    real, parameter :: rmiss =   0.0
  26    real, parameter :: tbmin =  50.0
  27    real, parameter :: tbmax = 550.0
  28
  29    integer :: k
  30
  31    em = rmiss  ! initialize
  32
  33    if ( tb(1) > tbmin .and. tb(1) < tbmax .and.  &
  34         tb(2) > tbmin .and. tb(2) < tbmax .and.  &
  35         tb(3) > tbmin .and. tb(3) < tbmax ) then
  36       do k = 1, 2
  37       ! do k = 1, 3
  38          em(k) = b0(k)+b1(k)*tb(1)+b2(k)*tb(1)**2+b3(k)*tb(2)+b4(k)*tb(2)**2 &
  39                 +b5(k)*tb(3)+b6(k)*tb(3)**2
  40       end do
  41       em(3)=em(2)+(f3-f2)*(em(2)-em(1))/(f2-f1)   !linear interpolated
  42       em(4)=em(3)+(f4-f3)*(em(3)-em(2))/(f3-f2)   !linear interpolated
  43       em(5)=em(4)+(f5-f4)*(em(4)-em(3))/(f4-f3)
  44       em(15)=em(4)+(f15-f4)*(em(4)-em(3))/(f4-f3)
  45    end if
  46
  47 end subroutine da_mspps_emis
  48