var/da/da_radiance/iceem_amsu.inc

   1 subroutine  iceem_amsu(theta,frequency,depth,ts,tba,tbb,esv,esh)
   2 !
   3 !$$$  subprogram documentation block
   4 !                .      .    .                                       .
   5 ! subprogram: iceem_amsua  noaa/nesdis emissivity model over ice for  AMSU-A/B
   6 !
   7 !   prgmmr: Banghua Yan      org: nesdis              date: 2004-03-01
   8 !           Fuzhong Weng
   9 !
  10 ! abstract: noaa/nesdis emissivity model to compute microwave emissivity over
  11 !       ice for AMSU-A/B
  12 !
  13 !    reference:
  14 !    Yan, B., F. Weng and K.Okamoto,2004:
  15 !       "A microwave snow emissivity model, submitted to TGRS
  16 !
  17 !   version: beta (sea ice type is to be determined)
  18 !
  19 ! program history log:
  20 !   2004-01-01  yan,b   - implement the algorithm for the ice emissivity
  21 !   2004-03-01  yan,b   - modify the code for SSI
  22 !   2004-07-23  okamoto - modify the code for GSI
  23 !
  24 ! input argument list:
  25 !      theta            -  local zenith angle in radian
  26 !      frequency        -  frequency in GHz
  27 !      ts               -  surface temperature (K)    (GDAS)
  28 !      depth            -  scatter medium depth (mm)  (not used here) (GDAS) !
  29 !      tba[1] ~ tba[4]  -  brightness temperature at four AMSU-A window channels
  30 !                              tba[1] : 23.8 GHz
  31 !                              tba[2] : 31.4 GHz
  32 !                              tba[3] : 50.3 GHz
  33 !                              tba[4] : 89 GHz
  34 !      tbb[1] ~ tbb[2]  -  brightness temperature at two AMSU-B window channels:
  35 !                              tbb[1] : 89 GHz
  36 !                              tbb[2] : 150 GHz
  37 !                          When tba[ ] or tbb[ ] = -999.9, it means a missing value (no available data)
  38 !
  39 ! output argument list:
  40 !   em_vector        -  esv, esh
  41 !       esv       : emissivity at vertical polarization
  42 !       esh       : emissivity at horizontal polarization
  43 !       sea ice_type (to be determined)
  44 !
  45 ! remarks:
  46 !
  47 !  Questions/comments: Please send to Fuzhong.Weng@noaa.gov and Banghua.Yan@noaa.gov
  48 !
  49 ! attributes:
  50 !   language: f90
  51 !   machine:  ibm rs/6000 sp
  52 !
  53 !$$$
  54
  55 !  use kinds, only: r_kind,i_kind
  56 !  use constants, only: zero, one
  57   implicit none
  58
  59   integer(i_kind)      :: nch,nwcha,nwchb,nwch,nalg
  60   Parameter(nwcha = 4, nwchb = 2, nwch = 5,nalg = 7)
  61   real(r_kind)    :: theta,frequency,depth,ts
  62   real(r_kind)    :: em_vector(2),esv,esh
  63   real(r_kind)    :: tb(nwch),tba(nwcha),tbb(nwchb)
  64   logical :: INDATA(nalg),AMSUAB,AMSUA,AMSUB,ABTs,ATs,BTs,MODL
  65   integer(i_kind) :: seaice_type,input_type,i,ich,np,k
  66
  67   Equivalence(INDATA(1), ABTs)
  68   Equivalence(INDATA(2), ATs)
  69   Equivalence(INDATA(3), AMSUAB)
  70   Equivalence(INDATA(4), AMSUA)
  71   Equivalence(INDATA(5), BTs)
  72   Equivalence(INDATA(6), AMSUB)
  73   Equivalence(INDATA(7), MODL)
  74
  75 !  Initialization
  76
  77   em_vector(1) = 0.85_r_kind
  78   em_vector(2) = 0.82_r_kind
  79   seaice_type  = -999
  80   input_type = -999
  81   do k = 1, nalg
  82      INDATA(k) = .TRUE.
  83   end do
  84
  85 ! Read AMSU & Ts data and set available option
  86 ! Get five AMSU-A/B window measurements
  87   tb(1) = tba(1); tb(2) = tba(2);  tb(3) = tba(3)
  88   tb(4) = tba(4); tb(5) = tbb(2)
  89
  90 ! Check available data
  91   if((ts <= 100.0_r_kind) .or. (ts >= 320.0_r_kind) ) then
  92      ABTs = .false.;   ATs = .false.;   BTs = .false.;  MODL = .false.
  93   end if
  94   do i=1,nwcha
  95      if((tba(i) <= 100.0_r_kind) .or. (tba(i) >= 320.0_r_kind) ) then
  96         ABTs = .false.;  ATs = .false.;   AMSUAB = .false.;  AMSUA = .false.
  97         exit
  98      end if
  99   end do
 100   do i=1,nwchb
 101      if((tbb(i) <= 100.0_r_kind) .or. (tbb(i) >= 320.0_r_kind) ) then
 102         ABTs = .false.;  AMSUAB = .false.;  BTs  = .false.;  AMSUB  = .false.
 103         exit
 104      end if
 105   end do
 106   if((depth <  zero) .or. (depth >= 3000.0_r_kind)) MODL = .false.
 107   if((frequency >= 80.0_r_kind) .and. (BTs)) then
 108      ATs = .false.;   AMSUAB = .false.
 109   end if
 110
 111 ! Check input type and call a specific Option/subroutine
 112   DO np = 1, nalg
 113      if (INDATA(np)) then
 114         input_type = np
 115         exit
 116      end if
 117   ENDDO
 118
 119   GET_option: SELECT CASE (input_type)
 120   CASE (1)
 121 !        call siem_abts(theta,frequency,tb,ts,seaice_type,em_vector)
 122   CASE (2)
 123      call siem_ats(theta,frequency,tba,ts,seaice_type,em_vector)
 124   CASE (3)
 125 !        call siem_ab(theta,frequency,tb,seaice_type,em_vector)
 126   CASE (4)
 127 !        call siem_amsua(theta,frequency,tba,seaice_type,em_vector)
 128   CASE(5)
 129      call siem_bts(theta,frequency,tbb,ts,seaice_type,em_vector)
 130   CASE(6)
 131 !        call siem_amsub(theta,frequency,tbb,seaice_type,em_vector)
 132   CASE(7)
 133 !        call siem_default(theta,frequency,depth,ts,seaice_type,em_vector)
 134   END SELECT GET_option
 135
 136   if (em_vector(1) > one)         em_vector(1) = one
 137   if (em_vector(2) > one)         em_vector(2) = one
 138   if (em_vector(1) < 0.6_r_kind) em_vector(1) = 0.6_r_kind
 139   if (em_vector(2) < 0.6_r_kind) em_vector(2) = 0.6_r_kind
 140   esv = em_vector(1)
 141   esh = em_vector(2)
 142
 143 end subroutine iceem_amsu