<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
<A NAME='ICEEM_AMSU'><A href='../../html_code/radiance/iceem_amsu.inc.html#ICEEM_AMSU' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine iceem_amsu(theta,frequency,depth,ts,tba,tbb,esv,esh) 1
!
!$$$ subprogram documentation block
! . . . .
! subprogram: iceem_amsua noaa/nesdis emissivity model over ice for AMSU-A/B
!
! prgmmr: Banghua Yan org: nesdis date: 2004-03-01
! Fuzhong Weng
!
! abstract: noaa/nesdis emissivity model to compute microwave emissivity over
! ice for AMSU-A/B
!
! reference:
! Yan, B., F. Weng and K.Okamoto,2004:
! "A microwave snow emissivity model, submitted to TGRS
!
! version: beta (sea ice type is to be determined)
!
! program history log:
! 2004-01-01 yan,b - implement the algorithm for the ice emissivity
! 2004-03-01 yan,b - modify the code for SSI
! 2004-07-23 okamoto - modify the code for GSI
!
! input argument list:
! theta - local zenith angle in radian
! frequency - frequency in GHz
! ts - surface temperature (K) (GDAS)
! depth - scatter medium depth (mm) (not used here) (GDAS) !
! tba[1] ~ tba[4] - brightness temperature at four AMSU-A window channels
! tba[1] : 23.8 GHz
! tba[2] : 31.4 GHz
! tba[3] : 50.3 GHz
! tba[4] : 89 GHz
! tbb[1] ~ tbb[2] - brightness temperature at two AMSU-B window channels:
! tbb[1] : 89 GHz
! tbb[2] : 150 GHz
! When tba[ ] or tbb[ ] = -999.9, it means a missing value (no available data)
!
! output argument list:
! em_vector - esv, esh
! esv : emissivity at vertical polarization
! esh : emissivity at horizontal polarization
! sea ice_type (to be determined)
!
! remarks:
!
! Questions/comments: Please send to Fuzhong.Weng@noaa.gov and Banghua.Yan@noaa.gov
!
! attributes:
! language: f90
! machine: ibm rs/6000 sp
!
!$$$
! use kinds, only: r_kind,i_kind
! use constants, only: zero, one
implicit none
integer(i_kind) :: nch,nwcha,nwchb,nwch,nalg
Parameter(nwcha = 4, nwchb = 2, nwch = 5,nalg = 7)
real(r_kind) :: theta,frequency,depth,ts
real(r_kind) :: em_vector(2),esv,esh
real(r_kind) :: tb(nwch),tba(nwcha),tbb(nwchb)
logical :: INDATA(nalg),AMSUAB,AMSUA,AMSUB,ABTs,ATs,BTs,MODL
integer(i_kind) :: seaice_type,input_type,i,ich,np,k
Equivalence(INDATA(1), ABTs)
Equivalence(INDATA(2), ATs)
Equivalence(INDATA(3), AMSUAB)
Equivalence(INDATA(4), AMSUA)
Equivalence(INDATA(5), BTs)
Equivalence(INDATA(6), AMSUB)
Equivalence(INDATA(7), MODL)
! Initialization
em_vector(1) = 0.85_r_kind
em_vector(2) = 0.82_r_kind
seaice_type = -999
input_type = -999
do k = 1, nalg
INDATA(k) = .TRUE.
end do
! Read AMSU & Ts data and set available option
! Get five AMSU-A/B window measurements
tb(1) = tba(1); tb(2) = tba(2); tb(3) = tba(3)
tb(4) = tba(4); tb(5) = tbb(2)
! Check available data
if((ts <= 100.0_r_kind) .or. (ts >= 320.0_r_kind) ) then
ABTs = .false.; ATs = .false.; BTs = .false.; MODL = .false.
end if
do i=1,nwcha
if((tba(i) <= 100.0_r_kind) .or. (tba(i) >= 320.0_r_kind) ) then
ABTs = .false.; ATs = .false.; AMSUAB = .false.; AMSUA = .false.
exit
end if
end do
do i=1,nwchb
if((tbb(i) <= 100.0_r_kind) .or. (tbb(i) >= 320.0_r_kind) ) then
ABTs = .false.; AMSUAB = .false.; BTs = .false.; AMSUB = .false.
exit
end if
end do
if((depth < zero) .or. (depth >= 3000.0_r_kind)) MODL = .false.
if((frequency >= 80.0_r_kind) .and. (BTs)) then
ATs = .false.; AMSUAB = .false.
end if
! Check input type and call a specific Option/subroutine
DO np = 1, nalg
if (INDATA(np)) then
input_type = np
exit
end if
ENDDO
GET_option: SELECT CASE (input_type)
CASE (1)
! call siem_abts(theta,frequency,tb,ts,seaice_type,em_vector)
CASE (2)
call siem_ats
(theta,frequency,tba,ts,seaice_type,em_vector)
CASE (3)
! call siem_ab(theta,frequency,tb,seaice_type,em_vector)
CASE (4)
! call siem_amsua(theta,frequency,tba,seaice_type,em_vector)
CASE(5)
call siem_bts(theta,frequency,tbb,ts,seaice_type,em_vector)
CASE(6)
! call siem_amsub(theta,frequency,tbb,seaice_type,em_vector)
CASE(7)
! call siem_default(theta,frequency,depth,ts,seaice_type,em_vector)
END SELECT GET_option
if (em_vector(1) > one) em_vector(1) = one
if (em_vector(2) > one) em_vector(2) = one
if (em_vector(1) < 0.6_r_kind) em_vector(1) = 0.6_r_kind
if (em_vector(2) < 0.6_r_kind) em_vector(2) = 0.6_r_kind
esv = em_vector(1)
esh = em_vector(2)
end subroutine iceem_amsu