iceem_amsu.inc
References to this file elsewhere.
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