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