FV3 Bundle
Emission_Module.f90
Go to the documentation of this file.
1 !
2 ! Emission_Module
3 !
4 ! Module containing the emission radiative transfer
5 ! solution procedures in the CRTM.
6 !
7 !
8 ! CREATION HISTORY:
9 ! Written by: Quanhua Liu, QSS at JCSDA; quanhua.liu@noaa.gov
10 ! Yong Han, NOAA/NESDIS; yong.han@noaa.gov
11 ! Paul van Delst; CIMMS/SSEC; paul.vandelst@noaa.gov
12 ! 08-Jun-2004
13 
15 
16  ! ------------------
17  ! Environment set up
18  ! ------------------
19  ! Module use statements
20  USE rtv_define
21  USE crtm_parameters
22  USE type_kinds
23 
24  IMPLICIT NONE
25 
26  ! --------------------
27  ! Default visibilities
28  ! --------------------
29  ! Everything private by default
30  PRIVATE
31 
32  PUBLIC crtm_emission
33  PUBLIC crtm_emission_tl
34  PUBLIC crtm_emission_ad
35 
36  ! -----------------
37  ! Module parameters
38  ! -----------------
39  ! Version Id for the module
40  CHARACTER(*), PARAMETER :: module_version_id = &
41  '$Id: $'
42 
43 CONTAINS
44 
45 !################################################################################
46 !################################################################################
47 !## ##
48 !## ## PRIVATE MODULE ROUTINES ## ##
49 !## ##
50 !################################################################################
51 !################################################################################
52 
53 
54  SUBROUTINE crtm_emission(n_Layers, & ! Input number of atmospheric layers
55  n_Angles, & ! number angles used in SfcOptics
56  Diffuse_Surface, & ! Input TRUE: Lambertian, FALSE: specular
57  u, & ! Input cosine of local viewing angle
58  T_OD, & ! Input nadir layer optical depth
59  Planck_Atmosphere, & ! Input atmospheric layer Planck radiance
60  Planck_Surface, & ! Input surface Planck radiance
61  emissivity, & ! Input surface emissivity
62  reflectivity, & ! Input surface reflectivity matrix
63  direct_reflectivity, & ! Input reflectivity for direct irradiance
64  cosmic_background, & ! Input cosmic background radiance
65  Solar_irradiance, & ! Input Solar spectral irradiance
66  Is_Solar_Channel, & ! Input Indicate solar affected channel
67  Source_Zenith_Radian, & ! Input Point source (e.g. solar) zenith angle
68  rtv) ! Output TOA radiance and others
69 ! ----------------------------------------------------------------------------- !
70 ! FUNCTION: Compute IR/MW upward radiance at the top of the profile. !
71 ! This code heritages the concept from previous operational code. !
72 ! It starts from cosmic background downward. !
73 ! The downward radiance at the lower level is the transmitted radiance !
74 ! from upper level adding the layer downward source function. !
75 ! The downward angle is either the same as satellite viewing zenith for a !
76 ! specular surface or the diffuse angle for a lambertian surface. The upward !
77 ! radiance at the surface is the surface emission term adding from surface !
78 ! reflected downward radiance. Then, the upward radiance is the sum of !
79 ! from the lower level transmitted radiance adding the upward layer !
80 ! source function. !
81 ! !
82 ! Quanhua Liu Quanhua.Liu@noaa.gov !
83 ! ----------------------------------------------------------------------------- !
84 
85  ! Arguments
86  INTEGER, INTENT(IN) :: n_layers
87  INTEGER, INTENT(IN) :: n_angles
88  LOGICAL, INTENT(IN) :: diffuse_surface
89  REAL(fp), INTENT(IN) :: u
90  REAL(fp), DIMENSION(:), INTENT(IN) :: t_od
91  REAL(fp), DIMENSION(0:), INTENT(IN) :: planck_atmosphere
92  REAL(fp), INTENT(IN) :: planck_surface
93  REAL(fp), DIMENSION(:), INTENT(IN) :: emissivity
94  REAL(fp), DIMENSION(:,:), INTENT(IN) :: reflectivity
95  REAL(fp), DIMENSION(:), INTENT(IN) :: direct_reflectivity
96  REAL(fp), INTENT(IN) :: cosmic_background
97  REAL(fp), INTENT(IN) :: solar_irradiance
98  LOGICAL, INTENT(IN) :: is_solar_channel
99  REAL(fp), INTENT(IN) :: source_zenith_radian
100  TYPE(rtv_type), INTENT(IN OUT) :: rtv
101  ! Local variables
102  REAL(fp) :: layer_source_up, cosine_u0
103  INTEGER :: k
104 
105  ! --------------------
106  ! Downwelling radiance
107  ! --------------------
108  ! Determing secant downward angle from surface behavior
109  IF( diffuse_surface ) THEN
110  rtv%Secant_Down_Angle = secant_diffusivity
111  ELSE
112  rtv%Secant_Down_Angle = one/u
113  END IF
114 
115  ! Start from the top of the atmosphere
116  rtv%e_Level_Rad_DOWN(0) = cosmic_background
117  rtv%Total_OD = zero
118 
119  ! Loop from top layer to bottom layer
120  DO k = 1, n_layers
121  ! Accumulate optical depth
122  rtv%Total_OD = rtv%Total_OD + t_od(k)
123  ! Layer downward transmittance
124  rtv%e_Layer_Trans_DOWN(k) = exp(-t_od(k)*rtv%Secant_Down_Angle)
125  ! Downward radiance
126  rtv%e_Level_Rad_DOWN(k) = (rtv%e_Level_Rad_DOWN(k-1)*rtv%e_Layer_Trans_DOWN(k)) + &
127  (planck_atmosphere(k)*(one-rtv%e_Layer_Trans_DOWN(k)))
128 
129  rtv%e_Layer_Trans_UP(k) = exp(-t_od(k)/u)
130 
131  ! GSI cloud detection
132  rtv%e_Cloud_Radiance_UP(k) = rtv%e_Source_UP(k-1) + planck_atmosphere(k)*rtv%e_Level_Trans_UP(k-1)
133  rtv%e_Source_UP(k) = rtv%e_Source_UP(k-1)+rtv%e_Level_Trans_UP(k-1)*planck_atmosphere(k)*(one-rtv%e_Layer_Trans_UP(k))
134  rtv%e_Level_Trans_UP(k) = rtv%e_Level_Trans_UP(k-1)*rtv%e_Layer_Trans_UP(k)
135  END DO
136 
137  ! ----------------
138  ! Surface radiance
139  ! ----------------
140  ! upward radiance at the surface ( emission part + reflection part)
141  rtv%e_Level_Rad_UP(n_layers) = (emissivity(n_angles)*planck_surface) + &
142  (reflectivity(1,1)*rtv%e_Level_Rad_DOWN(n_layers))
143 
144  ! Solar contribution to the upward radiance at the surface
145  rtv%Down_Solar_Radiance = zero
146  IF( is_solar_channel ) THEN
147  cosine_u0 = cos(source_zenith_radian)
148  IF( cosine_u0 > zero) THEN
149  rtv%Down_Solar_Radiance = cosine_u0*exp(-rtv%Total_OD/cosine_u0)*solar_irradiance/pi
150  rtv%e_Level_Rad_UP(n_layers) = rtv%e_Level_Rad_UP(n_layers) + &
151  (rtv%Down_Solar_Radiance*direct_reflectivity(1))
152  END IF
153  END IF
154 
155  ! ------------------
156  ! Upwelling radiance
157  ! ------------------
158  ! Initialise upwelling radiance
159  rtv%Up_Radiance = zero
160 
161  ! Loop from SFC->TOA
162  DO k = n_layers, 1, -1
163  ! layer upwelling transmittance
164 !! RTV%e_Layer_Trans_UP(k) = EXP(-T_OD(k)/u)
165  ! layer upwelling source function
166  layer_source_up = planck_atmosphere(k) * ( one - rtv%e_Layer_Trans_UP(k) )
167  ! upwelling radiance (including reflected downwelling and surface)
168  rtv%e_Level_Rad_UP(k-1) = (rtv%e_Level_Rad_UP(k)*rtv%e_Layer_Trans_UP(k)) + &
169  layer_source_up
170  ! upwelling radiance (atmospheric portion only)
171  rtv%Up_Radiance = (rtv%Up_Radiance*rtv%e_Layer_Trans_UP(k)) + layer_source_up
172  END DO
173 
174  END SUBROUTINE crtm_emission
175 
176  SUBROUTINE crtm_emission_tl(n_Layers, & ! Input number of atmospheric layers
177  n_Angles, & ! number angles used in SfcOptics
178  u, & ! Input cosine of local viewing angle
179  Planck_Atmosphere, & ! Input atmospheric layer Planck radiance
180  Planck_Surface, & ! Input surface Planck radiance
181  emissivity, & ! Input surface emissivity
182  reflectivity, & ! Input surface reflectivity matrix
183  direct_reflectivity, & ! Input reflectivity for direct irradiance
184  Solar_irradiance, & ! Input Solar spectral irradiance
185  Is_Solar_Channel, & ! Input Indicate solar affected channel
186  Source_Zenith_Radian, & ! Input Point source (e.g. solar) zenith angle
187  rtv, & ! Input Structure containing forward part results
188  t_od_tl, & ! Input tangent-linear of layer optical depth
189  planck_atmosphere_tl, & ! Input TL atmospheric layer Planck radiance
190  planck_surface_tl, & ! Input TL surface Planck radiance
191  emissivity_tl, & ! Input TL surface emissivity
192  reflectivity_tl, & ! Input TL surface reflectivity matrix
193  direct_reflectivity_tl, & ! Input TL surface ditrct reflectivity
194  up_rad_tl) ! Output TL TOA radiance
195 ! --------------------------------------------------------------------------- !
196 ! FUNCTION: Compute tangent-linear upward radiance at the top of the !
197 ! atmosphere using carried results in RTV structure from forward !
198 ! calculation. !
199 ! Quanhua Liu Quanhua.Liu@noaa.gov !
200 ! --------------------------------------------------------------------------- !
201  IMPLICIT NONE
202  INTEGER, INTENT(IN) :: n_layers, n_angles
203  LOGICAL, INTENT(IN) :: is_solar_channel
204  REAL (fp), INTENT(IN) :: solar_irradiance, source_zenith_radian
205  REAL (fp), INTENT(IN), DIMENSION( : ) :: emissivity,t_od_tl,emissivity_tl
206  REAL (fp), INTENT(IN), DIMENSION( :,: ) :: reflectivity ,reflectivity_tl
207  REAL (fp), INTENT(IN), DIMENSION( : ) :: direct_reflectivity,direct_reflectivity_tl
208  REAL (fp), INTENT(IN), DIMENSION( 0: ) :: planck_atmosphere,planck_atmosphere_tl
209  REAL (fp), INTENT(IN) :: planck_surface,u,planck_surface_tl
210  REAL (fp), INTENT(INOUT) :: up_rad_tl
211 
212  ! Structure RTV carried in variables from forward calculation.
213  TYPE(rtv_type), INTENT( IN) :: rtv
214  ! internal variables
215  REAL (fp) :: layer_source_up_tl, layer_source_down_tl,a_tl,down_rad_tl
216  REAL (fp) :: total_od, total_od_tl
217  INTEGER :: k
218  REAL( fp) :: cosine_u0
219 
220  !#--------------------------------------------------------------------------#
221  !# -- Downwelling TL radiance -- #
222  !#--------------------------------------------------------------------------#
223 
224  down_rad_tl = zero
225  total_od_tl = zero
226 
227  total_od = rtv%Total_OD
228 
229  DO k = 1, n_layers
230  ! accumulate tangent-linear optical depth
231  total_od_tl = total_od_tl + t_od_tl(k)
232  a_tl = -t_od_tl(k) * rtv%Secant_Down_Angle
233 
234  layer_source_down_tl = planck_atmosphere_tl(k) * ( one - rtv%e_Layer_Trans_DOWN(k) ) &
235  - planck_atmosphere(k) * rtv%e_Layer_Trans_DOWN(k) * a_tl
236 
237  ! downward tangent-linear radiance
238  ! down_rad(k) = down_rad(k-1) * layer_trans(k) + layer_source_down
239  down_rad_tl = down_rad_tl*rtv%e_Layer_Trans_DOWN(k) &
240  +rtv%e_Level_Rad_DOWN(k-1)*rtv%e_Layer_Trans_DOWN(k)*a_tl+layer_source_down_tl
241  ENDDO
242 
243  !#--------------------------------------------------------------------------#
244  !# -- at surface -- #
245  !#--------------------------------------------------------------------------#
246 
247  ! upward tangent-linear radiance at the surface
248  up_rad_tl =emissivity_tl(n_angles)*planck_surface+emissivity(n_angles)*planck_surface_tl &
249  +reflectivity_tl(1,1)*rtv%e_Level_Rad_DOWN(n_layers)+reflectivity(1,1)*down_rad_tl
250 
251  ! point source (e.g. solar radiation)
252  IF( is_solar_channel ) THEN
253  cosine_u0 = cos(source_zenith_radian)
254  IF( cosine_u0 > zero) THEN
255  up_rad_tl = up_rad_tl + cosine_u0*solar_irradiance/pi &
256  * direct_reflectivity_tl(1) * exp(-total_od/cosine_u0) &
257  - solar_irradiance/pi * direct_reflectivity(1) &
258  * total_od_tl * exp(-total_od/cosine_u0)
259  ENDIF
260  ENDIF
261 
262  !#--------------------------------------------------------------------------#
263  !# -- Upwelling TL radiance -- #
264  !#--------------------------------------------------------------------------#
265 
266  DO k = n_layers, 1, -1
267  a_tl = -t_od_tl(k)/u
268  layer_source_up_tl = planck_atmosphere_tl(k) * ( one - rtv%e_Layer_Trans_UP(k) ) &
269  - planck_atmosphere(k) * rtv%e_Layer_Trans_UP(k) * a_tl
270 
271  ! upward tangent linear radiance
272  up_rad_tl=up_rad_tl*rtv%e_Layer_Trans_UP(k) &
273  +rtv%e_Level_Rad_UP(k)*rtv%e_Layer_Trans_UP(k)*a_tl+layer_source_up_tl
274  ENDDO
275 !
276  RETURN
277  END SUBROUTINE crtm_emission_tl
278 !
279 !
280  SUBROUTINE crtm_emission_ad(n_Layers, & ! Input number of atmospheric layers
281  n_Angles, & ! number angles used in SfcOptics
282  u, & ! Input cosine of local viewing angle
283  Planck_Atmosphere, & ! Input atmospheric layer Planck radiance
284  Planck_Surface, & ! Input surface Planck radiance
285  emissivity, & ! Input surface emissivity
286  reflectivity, & ! Input surface reflectivity matrix
287  direct_reflectivity, & ! Input surface reflectivity matrix
288  Solar_irradiance, & ! Input Solar spectral irradiance
289  Is_Solar_Channel, & ! Input Indicate solar affected channel
290  Source_Zenith_Radian, & ! Input Point source (e.g. solar) zenith angle
291  rtv, & ! Input Structure containing forward part results
292  up_rad_ad_in, & ! Input adjoint radiance at the top
293  t_od_ad, & ! Output AD layer optical depth
294  planck_atmosphere_ad, & ! Output AD atmospheric layer Planck radiance
295  planck_surface_ad, & ! Output AD surface Planck radiance
296  emissivity_ad, & ! Output AD surface emissivity
297  reflectivity_ad, & ! Output AD surface reflectivity matrix
298  direct_reflectivity_ad) ! Output AD surface direct reflectivity
299 ! --------------------------------------------------------------------------- !
300 ! FUNCTION: Compute adjoint upward radiance at the top of the !
301 ! atmosphere using carried results in RTV structure from forward !
302 ! calculation. !
303 ! Quanhua Liu Quanhua.Liu@noaa.gov !
304 ! --------------------------------------------------------------------------- !
305  IMPLICIT NONE
306  INTEGER, INTENT(IN) :: n_layers, n_angles
307  LOGICAL, INTENT(IN) :: is_solar_channel
308  REAL (fp), INTENT(IN) :: solar_irradiance, source_zenith_radian
309  REAL (fp), INTENT(IN), DIMENSION( : ) :: emissivity
310  REAL (fp), INTENT(IN), DIMENSION( :,: ) :: reflectivity
311  REAL (fp), INTENT(IN), DIMENSION( : ) :: direct_reflectivity
312  REAL (fp), INTENT(IN), DIMENSION( 0: ) :: planck_atmosphere
313  REAL (fp), INTENT(IN) :: planck_surface,u
314  REAL (fp), INTENT(IN) :: up_rad_ad_in
315  REAL (fp), INTENT(IN OUT), DIMENSION( : ) :: t_od_ad,emissivity_ad
316  REAL (fp), INTENT(IN OUT), DIMENSION( :,: ) :: reflectivity_ad
317  REAL (fp), INTENT(IN OUT), DIMENSION( : ) :: direct_reflectivity_ad
318  REAL (fp), INTENT(IN OUT), DIMENSION( 0: ) :: planck_atmosphere_ad
319  REAL (fp), INTENT(IN OUT) :: planck_surface_ad
320  TYPE(rtv_type), INTENT( IN) :: rtv
321  ! internal variables
322  REAL (fp) :: layer_source_up_ad, layer_source_down_ad,a_ad,down_rad_ad
323  REAL (fp) :: cosine_u0, up_rad_ad, total_od, total_od_ad
324  INTEGER :: k
325 !
326  ! Initialize variables
327  total_od_ad = zero
328  t_od_ad = zero
329  planck_atmosphere_ad = zero
330  planck_surface_ad = zero
331  emissivity_ad = zero
332  reflectivity_ad = zero
333  direct_reflectivity_ad = zero
334  up_rad_ad = up_rad_ad_in
335 
336  ! Total column optical depth carried from forward part
337  total_od = rtv%Total_OD
338 
339  !#--------------------------------------------------------------------------#
340  !# -- Upwelling adjoint radiance -- #
341  !#--------------------------------------------------------------------------#
342 !
343  DO k = 1, n_layers
344  a_ad = rtv%e_Level_Rad_UP(k)*rtv%e_Layer_Trans_UP(k)*up_rad_ad
345  layer_source_up_ad = up_rad_ad
346  up_rad_ad = up_rad_ad * rtv%e_Layer_Trans_UP(k)
347 
348  planck_atmosphere_ad(k) = planck_atmosphere_ad(k) + &
349  layer_source_up_ad * (one - rtv%e_Layer_Trans_UP(k))
350  a_ad = a_ad - planck_atmosphere(k) * rtv%e_Layer_Trans_UP(k)* layer_source_up_ad
351 
352  t_od_ad(k) = t_od_ad(k) - a_ad/u
353  ENDDO
354  !#--------------------------------------------------------------------------#
355  !# -- at surface -- #
356  !#--------------------------------------------------------------------------#
357 
358  IF( is_solar_channel ) THEN
359  cosine_u0 = cos(source_zenith_radian)
360  IF( cosine_u0 > zero) THEN
361  total_od_ad = -solar_irradiance/pi * direct_reflectivity(1) &
362  * up_rad_ad * exp(-total_od/cosine_u0)
363  direct_reflectivity_ad(1) = cosine_u0 * solar_irradiance/pi &
364  * up_rad_ad* exp(-total_od/cosine_u0)
365  ENDIF
366  ENDIF
367 
368  emissivity_ad(n_angles)=up_rad_ad*planck_surface
369  planck_surface_ad = emissivity(n_angles)*up_rad_ad
370  reflectivity_ad(1,1)=up_rad_ad*rtv%e_Level_Rad_DOWN(n_layers)
371  down_rad_ad = reflectivity(1,1)*up_rad_ad
372 !
373  !#--------------------------------------------------------------------------#
374  !# -- Downward adjoint radiance -- #
375  !#--------------------------------------------------------------------------#
376  DO k = n_layers, 1, -1
377 
378  a_ad = rtv%e_Level_Rad_DOWN(k-1)*rtv%e_Layer_Trans_DOWN(k)*down_rad_ad
379  layer_source_down_ad = down_rad_ad
380  down_rad_ad = down_rad_ad*rtv%e_Layer_Trans_DOWN(k)
381 
382  planck_atmosphere_ad(k) = planck_atmosphere_ad(k) + layer_source_down_ad * &
383  (one - rtv%e_Layer_Trans_DOWN(k))
384  a_ad = a_ad - planck_atmosphere(k) * rtv%e_Layer_Trans_DOWN(k)* layer_source_down_ad
385 
386 
387  t_od_ad(k) = t_od_ad(k) - a_ad * rtv%Secant_Down_Angle
388 
389  t_od_ad(k) = t_od_ad(k) + total_od_ad
390  ENDDO
391 
392  down_rad_ad = zero
393 
394  RETURN
395  END SUBROUTINE crtm_emission_ad
396 
397 END MODULE emission_module
character(*), parameter module_version_id
real(fp), parameter, public zero
subroutine, public crtm_emission_ad(n_Layers, n_Angles, u, Planck_Atmosphere, Planck_Surface, emissivity, reflectivity, direct_reflectivity, Solar_irradiance, Is_Solar_Channel, Source_Zenith_Radian, RTV, up_rad_AD_in, T_OD_AD, Planck_Atmosphere_AD, Planck_Surface_AD, emissivity_AD, reflectivity_AD, direct_reflectivity_AD)
real(fp), parameter, public secant_diffusivity
real(fp), parameter, public one
subroutine, public crtm_emission(n_Layers, n_Angles, Diffuse_Surface, u, T_OD, Planck_Atmosphere, Planck_Surface, emissivity, reflectivity, direct_reflectivity, cosmic_background, Solar_irradiance, Is_Solar_Channel, Source_Zenith_Radian, RTV)
subroutine, public crtm_emission_tl(n_Layers, n_Angles, u, Planck_Atmosphere, Planck_Surface, emissivity, reflectivity, direct_reflectivity, Solar_irradiance, Is_Solar_Channel, Source_Zenith_Radian, RTV, T_OD_TL, Planck_Atmosphere_TL, Planck_Surface_TL, emissivity_TL, reflectivity_TL, direct_reflectivity_TL, up_rad_TL)
real(fp), parameter, public pi