FV3 Bundle
CRTM_RTSolution.f90
Go to the documentation of this file.
1 !
2 ! CRTM_RTSolution
3 !
4 ! Module containing the CRTM radiative transfer solution routines.
5 !
6 !
7 ! CREATION HISTORY:
8 ! Written by: Quanhua Liu, QSS at JCSDA; Quanhua.Liu@noaa.gov
9 ! Yong Han, NOAA/NESDIS; Yong.Han@noaa.gov
10 ! Paul van Delst, CIMSS/SSEC; paul.vandelst@ssec.wisc.edu
11 ! 08-Jun-2004
12 
13 MODULE crtm_rtsolution
14 
15  ! ------------------
16  ! Environment set up
17  ! ------------------
18  ! Module use statements
19  USE type_kinds , ONLY: fp
20  USE message_handler , ONLY: success, failure, display_message
21  USE crtm_parameters , ONLY: zero, one, two, pi, &
22  max_n_angles, &
23  rt_ada, rt_soi
24  USE common_rtsolution , ONLY: assign_common_input, &
25  assign_common_output, &
26  assign_common_input_tl, &
27  assign_common_output_tl, &
28  assign_common_input_ad, &
29  assign_common_output_ad
30  USE crtm_spccoeff , ONLY: sc
31  USE crtm_atmosphere_define , ONLY: crtm_atmosphere_type
32  USE crtm_surface_define , ONLY: crtm_surface_type
33  USE crtm_geometryinfo_define, ONLY: crtm_geometryinfo_type
34  USE crtm_atmoptics_define , ONLY: crtm_atmoptics_type
35  USE crtm_sfcoptics_define , ONLY: crtm_sfcoptics_type
36  USE crtm_rtsolution_define , ONLY: crtm_rtsolution_type
37  USE crtm_utility
38  USE rtv_define
39  ! RT modules
40  USE soi_module
41  USE ada_module
42  USE emission_module
43  ! Disable all implicit typing
44  IMPLICIT NONE
45 
46  ! --------------------
47  ! Default visibilities
48  ! --------------------
49  ! Everything private by default
50  PRIVATE
51  ! RTSolution structure entities
52  ! ...Datatypes
53  PUBLIC :: crtm_rtsolution_type
54  ! RTV structure entities
55  ! ...Datatypes
56  PUBLIC :: rtv_type
57  ! Module procedures
58  PUBLIC :: crtm_compute_rtsolution
59  PUBLIC :: crtm_compute_rtsolution_tl
60  PUBLIC :: crtm_compute_rtsolution_ad
61  PUBLIC :: crtm_compute_nstreams
62  PUBLIC :: crtm_rtsolution_version
63 
64  ! -----------------
65  ! Module parameters
66  ! -----------------
67  ! Version Id for the module
68  CHARACTER(*), PARAMETER :: module_version_id = &
69  '$Id: CRTM_RTSolution.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
70 
71 CONTAINS
72 
73 !################################################################################
74 !################################################################################
75 !## ##
76 !## ## PUBLIC MODULE ROUTINES ## ##
77 !## ##
78 !################################################################################
79 !################################################################################
80 
81 !--------------------------------------------------------------------------------
82 !
83 ! NAME:
84 ! CRTM_Compute_RTSolution
85 !
86 ! PURPOSE:
87 ! Function to solve the radiative transfer equation.
88 !
89 ! CALLING SEQUENCE:
90 ! Error_Status = CRTM_Compute_RTSolution( Atmosphere , & ! Input
91 ! Surface , & ! Input
92 ! AtmOptics , & ! Input
93 ! SfcOptics , & ! Input
94 ! GeometryInfo, & ! Input
95 ! SensorIndex , & ! Input
96 ! ChannelIndex, & ! Input
97 ! RTSolution , & ! Output
98 ! RTV ) ! Internal variable output
99 !
100 ! INPUT ARGUMENTS:
101 ! Atmosphere: Structure containing the atmospheric state data.
102 ! UNITS: N/A
103 ! TYPE: CRTM_Atmosphere_type
104 ! DIMENSION: Scalar
105 ! ATTRIBUTES: INTENT(IN)
106 !
107 ! Surface: Structure containing the surface state data.
108 ! UNITS: N/A
109 ! TYPE: CRTM_Surface_type
110 ! DIMENSION: Scalar
111 ! ATTRIBUTES: INTENT(IN)
112 !
113 ! AtmOptics: Structure containing the combined atmospheric
114 ! optical properties for gaseous absorption, clouds,
115 ! and aerosols.
116 ! UNITS: N/A
117 ! TYPE: CRTM_AtmOptics_type
118 ! DIMENSION: Scalar
119 ! ATTRIBUTES: INTENT(IN)
120 !
121 ! SfcOptics: Structure containing the surface optical properties
122 ! data. Argument is defined as INTENT (IN OUT ) as
123 ! different RT algorithms may compute the surface
124 ! optics properties before this routine is called.
125 ! UNITS: N/A
126 ! TYPE: CRTM_SfcOptics_type
127 ! DIMENSION: Scalar
128 ! ATTRIBUTES: INTENT(IN OUT)
129 !
130 ! GeometryInfo: Structure containing the view geometry data.
131 ! UNITS: N/A
132 ! TYPE: CRTM_GeometryInfo_type
133 ! DIMENSION: Scalar
134 ! ATTRIBUTES: INTENT(IN)
135 !
136 ! SensorIndex: Sensor index id. This is a unique index associated
137 ! with a (supported) sensor used to access the
138 ! shared coefficient data for a particular sensor.
139 ! See the ChannelIndex argument.
140 ! UNITS: N/A
141 ! TYPE: INTEGER
142 ! DIMENSION: Scalar
143 ! ATTRIBUTES: INTENT(IN)
144 !
145 ! ChannelIndex: Channel index id. This is a unique index associated
146 ! with a (supported) sensor channel used to access the
147 ! shared coefficient data for a particular sensor's
148 ! channel.
149 ! See the SensorIndex argument.
150 ! UNITS: N/A
151 ! TYPE: INTEGER
152 ! DIMENSION: Scalar
153 ! ATTRIBUTES: INTENT(IN)
154 !
155 ! OUTPUT ARGUMENTS:
156 ! RTSolution: Structure containing the soluition to the RT equation
157 ! for the given inputs.
158 ! UNITS: N/A
159 ! TYPE: CRTM_RTSolution_type
160 ! DIMENSION: Scalar
161 ! ATTRIBUTES: INTENT(IN OUT)
162 !
163 ! RTV: Structure containing internal variables required for
164 ! subsequent tangent-linear or adjoint model calls.
165 ! The contents of this structure are NOT accessible
166 ! outside of the CRTM_RTSolution module.
167 ! UNITS: N/A
168 ! TYPE: RTV_type
169 ! DIMENSION: Scalar
170 ! ATTRIBUTES: INTENT(OUT)
171 !
172 ! FUNCTION RESULT:
173 ! Error_Status: The return value is an integer defining the error status.
174 ! The error codes are defined in the Message_Handler module.
175 ! If == SUCCESS the computation was sucessful
176 ! == FAILURE an unrecoverable error occurred
177 ! UNITS: N/A
178 ! TYPE: INTEGER
179 ! DIMENSION: Scalar
180 !
181 ! COMMENTS:
182 ! Note the INTENT on the output RTSolution argument is IN OUT rather than
183 ! just OUT. This is necessary because the argument is defined upon
184 ! input. To prevent memory leaks, the IN OUT INTENT is a must.
185 !
186 !--------------------------------------------------------------------------------
187 
188  FUNCTION crtm_compute_rtsolution( &
189  Atmosphere , & ! Input
190  Surface , & ! Input
191  AtmOptics , & ! Input
192  SfcOptics , & ! Input
193  GeometryInfo, & ! Input
194  SensorIndex , & ! Input
195  ChannelIndex, & ! Input
196  RTSolution , & ! Output
197  RTV ) & ! Internal variable output
198  result( error_status )
199  ! Arguments
200  TYPE(crtm_atmosphere_type), INTENT(IN) :: atmosphere
201  TYPE(crtm_surface_type), INTENT(IN) :: surface
202  TYPE(crtm_atmoptics_type), INTENT(IN) :: atmoptics
203  TYPE(crtm_sfcoptics_type), INTENT(IN OUT) :: sfcoptics
204  TYPE(crtm_geometryinfo_type), INTENT(IN OUT) :: geometryinfo
205  INTEGER, INTENT(IN) :: sensorindex
206  INTEGER, INTENT(IN) :: channelindex
207  TYPE(crtm_rtsolution_type), INTENT(IN OUT) :: rtsolution
208  TYPE(rtv_type), INTENT(IN OUT) :: rtv
209  ! Function result
210  INTEGER :: error_status
211  ! Local parameters
212  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Compute_RTSolution'
213  ! Local variables
214  CHARACTER(256) :: message
215  INTEGER :: i, nz
216 
217  error_status = success
218 
219  ! Populate the RTV structure
220  error_status = assign_common_input( atmosphere , &
221  surface , &
222  atmoptics , &
223  sfcoptics , &
224  geometryinfo, &
225  sensorindex , &
226  channelindex, &
227  rtsolution , &
228  nz , &
229  rtv )
230  IF ( error_status /= success ) THEN
231  message = 'Error assigning input for RTSolution algorithms'
232  CALL display_message( routine_name, trim(message), error_status )
233  RETURN
234  END IF
235 
236 
237  ! Direct reflectivity normalisation fix for visible sensors
238  IF( rtv%Visible_Flag_true ) THEN
239  DO i = 1, nz
240  sfcoptics%Direct_Reflectivity(i,1) = sfcoptics%Direct_Reflectivity(i,1) * pi
241  ! ...Apply the UW limiter
242  IF (sfcoptics%Direct_Reflectivity(i,1) > one) THEN
243  sfcoptics%Direct_Reflectivity(i,1) = one
244  END IF
245  END DO
246  END IF
247 
248 
249  ! ------------------------------
250  ! Perform the radiative transfer
251  ! ------------------------------
252  ! Select the RT model
253  IF( rtv%Scattering_RT ) THEN
254 
255  ! Select the scattering RT model
256  SELECT CASE(rtv%RT_Algorithm_Id)
257  CASE (rt_ada) ;
258  rtsolution%RT_Algorithm_Name = 'ADA'
259  ! NESDIS advanced adding-doubling method
260  CALL crtm_ada( &
261  atmosphere%n_Layers , & ! Input, number of atmospheric layers
262  atmoptics%Single_Scatter_Albedo , & ! Input, layer single scattering albedo
263  atmoptics%Optical_Depth , & ! Input, layer optical depth
264  rtv%Cosmic_Background_Radiance , & ! Input, cosmic background radiation
265  sfcoptics%Emissivity( 1:nz, 1 ) , & ! Input, surface emissivity
266  sfcoptics%Reflectivity( 1:nz, 1, 1:nz, 1 ), & ! Input, surface reflectivity
267  sfcoptics%Direct_Reflectivity(1:nz,1) , & ! Input, surface reflectivity for a point source
268  rtv ) ! Output, Internal variables
269  CASE (rt_soi) ;
270  rtsolution%RT_Algorithm_Name = 'SOI'
271  ! UW SOI RT solver
272  CALL crtm_soi( &
273  atmosphere%n_Layers , & ! Input, number of atmospheric layers
274  atmoptics%Single_Scatter_Albedo , & ! Input, layer single scattering albedo
275  atmoptics%Optical_Depth , & ! Input, layer optical depth
276  rtv%Cosmic_Background_Radiance , & ! Input, cosmic background radiation
277  sfcoptics%Emissivity( 1:nz, 1 ) , & ! Input, surface emissivity
278  sfcoptics%Reflectivity( 1:nz, 1, 1:nz, 1 ), & ! Input, surface reflectivity
279  sfcoptics%Index_Sat_Ang , & ! Input, Satellite angle index
280  rtv ) ! Output, Internal variables
281  END SELECT
282 
283  ELSE
284 
285  ! -----------------
286  ! Emission model RT
287  ! -----------------
288  rtsolution%RT_Algorithm_Name = 'Emission'
289  CALL crtm_emission( &
290  atmosphere%n_Layers, & ! Input, number of atmospheric layers
291  rtv%n_Angles, & ! Input, number of discrete zenith angles
292  rtv%Diffuse_Surface, & ! Input, surface behavior
293  geometryinfo%Cosine_Sensor_Zenith, & ! Input, cosine of sensor zenith angle
294  atmoptics%Optical_Depth, & ! Input, layer optical depth
295  rtv%Planck_Atmosphere, & ! Input, layer radiances
296  rtv%Planck_Surface, & ! Input, surface radiance
297  sfcoptics%Emissivity(1:nz,1), & ! Input, surface emissivity
298  sfcoptics%Reflectivity(1:nz,1,1:nz,1), & ! Input, surface reflectivity
299  sfcoptics%Direct_Reflectivity(1:nz,1), & ! Input, surface reflectivity for a point source
300  rtv%Cosmic_Background_Radiance, & ! Input, cosmic background radiation
301  rtv%Solar_Irradiance, & ! Input, Source irradiance at TOA
302  rtv%Is_Solar_Channel, & ! Input, Source sensitive channel info.
303  geometryinfo%Source_Zenith_Radian, & ! Input, Source zenith angle
304  rtv ) ! Output, Internal variables
305 
306  END IF
307 
308  error_status = assign_common_output( atmosphere, &
309  sfcoptics, &
310  geometryinfo, &
311  sensorindex, &
312  channelindex, &
313  rtv, &
314  rtsolution )
315  IF ( error_status /= success ) THEN
316  message = 'Error assigning output for RTSolution algorithms'
317  CALL display_message( routine_name, trim(message), error_status )
318  RETURN
319  END IF
320 
321  END FUNCTION crtm_compute_rtsolution
322 
323 !--------------------------------------------------------------------------------
324 !
325 ! NAME:
326 ! CRTM_Compute_RTSolution_TL
327 !
328 ! PURPOSE:
329 ! Function to solve the tangent-linear radiative transfer equation.
330 !
331 ! CALLING SEQUENCE:
332 ! Error_Status = CRTM_Compute_RTSolution_TL( Atmosphere , & ! FWD Input
333 ! Surface , & ! FWD Input
334 ! AtmOptics , & ! FWD Input
335 ! SfcOptics , & ! FWD Input
336 ! RTSolution , & ! FWD Input
337 ! Atmosphere_TL, & ! TL Input
338 ! Surface_TL , & ! TL Input
339 ! AtmOptics_TL , & ! TL Input
340 ! SfcOptics_TL , & ! TL Input
341 ! GeometryInfo , & ! Input
342 ! SensorIndex , & ! Input
343 ! ChannelIndex , & ! Input
344 ! RTSolution_TL, & ! TL Output
345 ! RTV ) ! Internal variable input
346 !
347 ! INPUT ARGUMENTS:
348 ! Atmosphere: Structure containing the atmospheric state data.
349 ! UNITS: N/A
350 ! TYPE: CRTM_Atmosphere_type
351 ! DIMENSION: Scalar
352 ! ATTRIBUTES: INTENT(IN)
353 !
354 ! Surface: Structure containing the surface state data.
355 ! UNITS: N/A
356 ! TYPE: CRTM_Surface_type
357 ! DIMENSION: Scalar
358 ! ATTRIBUTES: INTENT(IN)
359 !
360 ! AtmOptics: Structure containing the combined atmospheric
361 ! optical properties for gaseous absorption, clouds,
362 ! and aerosols.
363 ! UNITS: N/A
364 ! TYPE: CRTM_AtmOptics_type
365 ! DIMENSION: Scalar
366 ! ATTRIBUTES: INTENT(IN)
367 !
368 ! SfcOptics: Structure containing the surface optical properties
369 ! data.
370 ! UNITS: N/A
371 ! TYPE: CRTM_SfcOptics_type
372 ! DIMENSION: Scalar
373 ! ATTRIBUTES: INTENT(IN)
374 !
375 ! RTSolution: Structure containing the solution to the RT equation
376 ! for the given inputs.
377 ! UNITS: N/A
378 ! TYPE: CRTM_RTSolution_type
379 ! DIMENSION: Scalar
380 ! ATTRIBUTES: INTENT(IN)
381 !
382 ! Atmosphere_TL: Structure containing the tangent-linear atmospheric
383 ! state data.
384 ! UNITS: N/A
385 ! TYPE: CRTM_Atmosphere_type
386 ! DIMENSION: Scalar
387 ! ATTRIBUTES: INTENT(IN)
388 !
389 ! Surface_TL: Structure containing the tangent-linear surface state data.
390 ! UNITS: N/A
391 ! TYPE: CRTM_Surface_type
392 ! DIMENSION: Scalar
393 ! ATTRIBUTES: INTENT(IN)
394 !
395 ! AtmOptics_TL: Structure containing the tangent-linear atmospheric
396 ! optical properties.
397 ! UNITS: N/A
398 ! TYPE: CRTM_AtmOptics_type
399 ! DIMENSION: Scalar
400 ! ATTRIBUTES: INTENT(IN)
401 !
402 ! SfcOptics_TL: Structure containing the tangent-linear surface optical
403 ! properties. Argument is defined as INTENT (IN OUT ) as
404 ! different RT algorithms may compute the surface optics
405 ! properties before this routine is called.
406 ! UNITS: N/A
407 ! TYPE: CRTM_SfcOptics_type
408 ! DIMENSION: Scalar
409 ! ATTRIBUTES: INTENT( IN OUT)
410 !
411 ! GeometryInfo: Structure containing the view geometry data.
412 ! UNITS: N/A
413 ! TYPE: CRTM_GeometryInfo_type
414 ! DIMENSION: Scalar
415 ! ATTRIBUTES: INTENT(IN)
416 !
417 ! SensorIndex: Sensor index id. This is a unique index associated
418 ! with a (supported) sensor used to access the
419 ! shared coefficient data for a particular sensor.
420 ! See the ChannelIndex argument.
421 ! UNITS: N/A
422 ! TYPE: INTEGER
423 ! DIMENSION: Scalar
424 ! ATTRIBUTES: INTENT(IN)
425 !
426 ! ChannelIndex: Channel index id. This is a unique index associated
427 ! with a (supported) sensor channel used to access the
428 ! shared coefficient data for a particular sensor's
429 ! channel.
430 ! See the SensorIndex argument.
431 ! UNITS: N/A
432 ! TYPE: INTEGER
433 ! DIMENSION: Scalar
434 ! ATTRIBUTES: INTENT(IN)
435 !
436 ! RTV: Structure containing internal forward model variables
437 ! required for subsequent tangent-linear or adjoint model
438 ! calls. The contents of this structure are NOT accessible
439 ! outside of the CRTM_RTSolution module.
440 ! UNITS: N/A
441 ! TYPE: RTV_type
442 ! DIMENSION: Scalar
443 ! ATTRIBUTES: INTENT(OUT)
444 !
445 ! OUTPUT ARGUMENTS:
446 ! RTSolution_TL: Structure containing the solution to the tangent-linear
447 ! RT equation for the given inputs.
448 ! UNITS: N/A
449 ! TYPE: CRTM_RTSolution_type
450 ! DIMENSION: Scalar
451 ! ATTRIBUTES: INTENT(IN OUT)
452 !
453 ! FUNCTION RESULT:
454 ! Error_Status: The return value is an integer defining the error status
455 ! The error codes are defined in the Message_Handler module.
456 ! If == SUCCESS the computation was sucessful
457 ! == FAILURE an unrecoverable error occurred
458 ! UNITS: N/A
459 ! TYPE: INTEGER
460 ! DIMENSION: Scalar
461 !
462 ! COMMENTS:
463 ! Note the INTENT on the output RTSolution_TL argument is IN OUT rather
464 ! than just OUT. This is necessary because the argument may be defined
465 ! upon input. To prevent memory leaks, the IN OUT INTENT is a must.
466 !
467 !--------------------------------------------------------------------------------
468 
469  FUNCTION crtm_compute_rtsolution_tl( &
470  Atmosphere , & ! FWD Input
471  Surface , & ! FWD Input
472  AtmOptics , & ! FWD Input
473  SfcOptics , & ! FWD Input
474  RTSolution , & ! FWD Input
475  Atmosphere_TL, & ! TL Input
476  Surface_TL , & ! TL Input
477  AtmOptics_TL , & ! TL Input
478  SfcOptics_TL , & ! TL Input
479  GeometryInfo , & ! Input
480  SensorIndex , & ! Input
481  ChannelIndex , & ! Input
482  RTSolution_TL, & ! TL Output
483  RTV ) & ! Internal variable input
484  result( error_status )
485  ! Arguments
486  TYPE(crtm_atmosphere_type), INTENT(IN) :: atmosphere
487  TYPE(crtm_surface_type), INTENT(IN) :: surface
488  TYPE(crtm_atmoptics_type), INTENT(IN) :: atmoptics
489  TYPE(crtm_sfcoptics_type), INTENT(IN) :: sfcoptics
490  TYPE(crtm_rtsolution_type), INTENT(IN) :: rtsolution
491  TYPE(crtm_atmosphere_type), INTENT(IN) :: atmosphere_tl
492  TYPE(crtm_surface_type), INTENT(IN) :: surface_tl
493  TYPE(crtm_atmoptics_type), INTENT(IN) :: atmoptics_tl
494  TYPE(crtm_sfcoptics_type), INTENT(IN OUT) :: sfcoptics_tl
495  TYPE(crtm_geometryinfo_type), INTENT(IN) :: geometryinfo
496  INTEGER, INTENT(IN) :: sensorindex
497  INTEGER, INTENT(IN) :: channelindex
498  TYPE(crtm_rtsolution_type), INTENT(IN OUT) :: rtsolution_tl
499  TYPE(rtv_type), INTENT(IN) :: rtv
500  ! Function result
501  INTEGER :: error_status
502  ! Local parameters
503  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Compute_RTSolution_TL'
504  ! Local variables
505  CHARACTER(256) :: message
506  INTEGER :: nz
507  REAL(fp) :: user_emissivity_tl, direct_reflectivity_tl
508  REAL(fp) :: planck_surface_tl ! Surface TL radiance
509  REAL(fp), DIMENSION( 0:Atmosphere%n_Layers ) :: planck_atmosphere_tl ! *LAYER* TL radiances
510 
511  ! The following variables are RT model specific
512  REAL(fp), DIMENSION( MAX_N_ANGLES, & MAX_N_ANGLES+1, & Atmosphere%n_Layers ) :: pff_tl ! Forward scattering TL phase matrix
513  REAL(fp), DIMENSION( MAX_N_ANGLES, & MAX_N_ANGLES+1, & Atmosphere%n_Layers ) :: pbb_tl ! Backward scattering TL phase matrix
514  REAL(fp), DIMENSION( MAX_N_ANGLES ) :: scattering_radiance_tl
515  REAL(fp) :: radiance_tl
516 
517  ! ------
518  ! Set up
519  ! ------
520  error_status = success
521 
522  rtsolution_tl%RT_Algorithm_Name = rtsolution%RT_Algorithm_Name
523 
524  error_status = assign_common_input_tl( atmosphere , & ! FWD Input
525  surface , & ! FWD Input
526  atmoptics , & ! FWD Input
527  sfcoptics , & ! FWD Input
528  atmosphere_tl , & ! TL Input
529  surface_tl , & ! TL Input
530  atmoptics_tl , & ! TL Input
531  sfcoptics_tl , & ! TL Input Output
532  geometryinfo , & ! Input
533  sensorindex , & ! Input
534  channelindex , & ! Input
535  rtsolution_tl , & ! TL Output
536  nz , & ! Output
537  user_emissivity_tl , & ! Output
538  direct_reflectivity_tl , & ! Output
539  planck_surface_tl , & ! Output
540  planck_atmosphere_tl , & ! Output
541  pff_tl , & ! Output
542  pbb_tl , & ! Output
543  rtv ) ! Internal variable input
544  IF ( error_status /= success ) THEN
545  message = 'Error assigning input for TL RTSolution algorithms'
546  CALL display_message( routine_name, trim(message), error_status )
547  RETURN
548  END IF
549 
550  ! ---------------------------------------------
551  ! Perform the tangent-linear radiative transfer
552  ! ---------------------------------------------
553  ! Select the RT model
554  IF( rtv%Scattering_RT ) THEN
555 
556  ! Select the scattering RT model
557  SELECT CASE(rtv%RT_Algorithm_Id)
558 
559  CASE (rt_ada)
560  ! NESDIS advanced adding-doubling method
561  CALL crtm_ada_tl( &
562  atmosphere%n_Layers, & ! Input, number of atmospheric layers
563  atmoptics%Single_Scatter_Albedo, & ! Input, FWD layer single scattering albedo
564  atmoptics%Optical_Depth, & ! Input, FWD layer optical depth
565  rtv%Cosmic_Background_Radiance, & ! cosmic background radiation
566  sfcoptics%Emissivity(1:nz,1), & ! Input, FWD surface emissivity
567  sfcoptics%Direct_Reflectivity(1:nz,1), & ! Input, surface direct reflectivity
568  rtv, & ! Input, structure containing forward results
569  planck_atmosphere_tl, & ! Input, TL layer radiances
570  planck_surface_tl, & ! Input, TL surface radiance
571  atmoptics_tl%Single_Scatter_Albedo, & ! Input, TL layer single scattering albedo
572  atmoptics_tl%Optical_Depth, & ! Input, TL layer optical depth
573  sfcoptics_tl%Emissivity(1:nz,1), & ! Input, TL surface emissivity
574  sfcoptics_tl%Reflectivity(1:nz,1,1:nz,1), & ! Input, TL surface reflectivity
575  sfcoptics_tl%Direct_Reflectivity(1:nz,1), & ! Input, TL surface direct reflectivity
576  pff_tl(1:nz,1:(nz+1),:), & ! Input, TL layer forward phase matrix
577  pbb_tl(1:nz,1:(nz+1),:), & ! Input, TL layer backward phase matrix
578  scattering_radiance_tl(1:nz) ) ! Output, TL radiances
579  CASE (rt_soi)
580  ! UW SOI RT solver
581  CALL crtm_soi_tl( &
582  atmosphere%n_Layers, & ! Input, number of atmospheric layers
583  atmoptics%Single_Scatter_Albedo, & ! Input, FWD layer single scattering albedo
584  atmoptics%Optical_Depth, & ! Input, FWD layer optical depth
585  sfcoptics%Emissivity(1:nz,1), & ! Input, FWD surface emissivity
586  sfcoptics%Reflectivity(1:nz,1,1:nz,1), & ! Input, surface reflectivity
587  sfcoptics%Index_Sat_Ang, & ! Input, Satellite angle index
588  rtv, & ! Input, structure containing forward results
589  planck_atmosphere_tl, & ! Input, TL layer radiances
590  planck_surface_tl, & ! Input, TL surface radiance
591  atmoptics_tl%Single_Scatter_Albedo, & ! Input, TL layer single scattering albedo
592  atmoptics_tl%Optical_Depth, & ! Input, TL layer optical depth
593  sfcoptics_tl%Emissivity(1:nz,1), & ! Input, TL surface emissivity
594  sfcoptics_tl%Reflectivity(1:nz,1,1:nz,1), & ! Input, TL surface reflectivity
595  pff_tl(1:nz,1:nz,:), & ! Input, TL layer forward phase matrix
596  pbb_tl(1:nz,1:nz,:), & ! Input, TL layer backward phase matrix
597  scattering_radiance_tl(1:nz) ) ! Output, TL radiances
598  END SELECT
599  ELSE
600  ! -----------------
601  ! Emission model RT
602  ! -----------------
603  CALL crtm_emission_tl( &
604  atmosphere%n_Layers, & ! Input, number of atmospheric layers
605  rtv%n_Angles, & ! Input, number of discrete zenith angles
606  geometryinfo%Cosine_Sensor_Zenith, & ! Input, cosine of sensor zenith angle
607  rtv%Planck_Atmosphere, & ! Input, FWD layer radiances
608  rtv%Planck_Surface, & ! Input, FWD surface radiance
609  sfcoptics%Emissivity(1:nz,1), & ! Input, FWD surface emissivity
610  sfcoptics%Reflectivity(1:nz,1,1:nz,1), & ! Input, FWD surface reflectivity
611  sfcoptics%Direct_Reflectivity(1:nz,1), & ! Input, FWD surface reflectivity for a point source
612  rtv%Solar_Irradiance, & ! Input, Source irradiance at TOA
613  rtv%Is_Solar_Channel, & ! Input, Source sensitive channel info.
614  geometryinfo%Source_Zenith_Radian, & ! Input, Source zenith angle
615  rtv, & ! Input, internal variables
616  atmoptics_tl%Optical_Depth, & ! Input, TL layer optical depth
617  planck_atmosphere_tl, & ! Input, TL layer radiances
618  planck_surface_tl, & ! Input, TL surface radiance
619  sfcoptics_tl%Emissivity(1:nz,1), & ! Input, TL surface emissivity
620  sfcoptics_tl%Reflectivity(1:nz,1,1:nz,1), & ! Input, TL surface reflectivity
621  sfcoptics_tl%Direct_Reflectivity(1:nz,1), & ! Input, TL surface reflectivity for a point source
622  radiance_tl ) ! Output, TL radiances
623  END IF
624 
625  error_status = assign_common_output_tl( sfcoptics , &
626  rtsolution , &
627  geometryinfo , &
628  radiance_tl , &
629  scattering_radiance_tl, &
630  sensorindex , &
631  channelindex , &
632  rtv , &
633  rtsolution_tl )
634  IF ( error_status /= success ) THEN
635  message = 'Error assigning output for TL RTSolution algorithms'
636  CALL display_message( routine_name, trim(message), error_status )
637  RETURN
638  END IF
639 
640  END FUNCTION crtm_compute_rtsolution_tl
641 !--------------------------------------------------------------------------------
642 !
643 ! NAME:
644 ! CRTM_Compute_RTSolution_AD
645 !
646 ! PURPOSE:
647 ! Function to solve the adjoint radiative transfer equation.
648 !
649 ! CALLING SEQUENCE:
650 ! Error_Status = CRTM_Compute_RTSolution_AD( Atmosphere , & ! FWD Input
651 ! Surface , & ! FWD Input
652 ! AtmOptics , & ! FWD Input
653 ! SfcOptics , & ! FWD Input
654 ! RTSolution , & ! FWD Input
655 ! RTSolution_AD, & ! AD Input
656 ! GeometryInfo , & ! Input
657 ! SensorIndex , & ! Input
658 ! ChannelIndex , & ! Input
659 ! Atmosphere_AD, & ! AD Output
660 ! Surface_AD , & ! AD Output
661 ! AtmOptics_AD , & ! AD Output
662 ! SfcOptics_AD , & ! AD Output
663 ! RTV ) ! Internal variable input
664 !
665 ! INPUT ARGUMENTS:
666 ! Atmosphere: Structure containing the atmospheric state data.
667 ! UNITS: N/A
668 ! TYPE: CRTM_Atmosphere_type
669 ! DIMENSION: Scalar
670 ! ATTRIBUTES: INTENT(IN)
671 !
672 ! Surface: Structure containing the surface state data.
673 ! UNITS: N/A
674 ! TYPE: CRTM_Surface_type
675 ! DIMENSION: Scalar
676 ! ATTRIBUTES: INTENT(IN)
677 !
678 ! AtmOptics: Structure containing the combined atmospheric
679 ! optical properties for gaseous absorption, clouds,
680 ! and aerosols.
681 ! UNITS: N/A
682 ! TYPE: CRTM_AtmOptics_type
683 ! DIMENSION: Scalar
684 ! ATTRIBUTES: INTENT(IN)
685 !
686 ! SfcOptics: Structure containing the surface optical properties
687 ! data.
688 ! UNITS: N/A
689 ! TYPE: CRTM_SfcOptics_type
690 ! DIMENSION: Scalar
691 ! ATTRIBUTES: INTENT(IN)
692 !
693 ! RTSolution: Structure containing the solution to the RT equation
694 ! for the given inputs.
695 ! UNITS: N/A
696 ! TYPE: CRTM_RTSolution_type
697 ! DIMENSION: Scalar
698 ! ATTRIBUTES: INTENT(IN)
699 !
700 ! RTSolution_AD: Structure containing the RT solution adjoint inputs.
701 ! UNITS: N/A
702 ! TYPE: CRTM_RTSolution_type
703 ! DIMENSION: Scalar
704 ! ATTRIBUTES: INTENT(IN OUT)
705 !
706 ! GeometryInfo: Structure containing the view geometry data.
707 ! UNITS: N/A
708 ! TYPE: CRTM_GeometryInfo_type
709 ! DIMENSION: Scalar
710 ! ATTRIBUTES: INTENT(IN)
711 !
712 ! SensorIndex: Sensor index id. This is a unique index associated
713 ! with a (supported) sensor used to access the
714 ! shared coefficient data for a particular sensor.
715 ! See the ChannelIndex argument.
716 ! UNITS: N/A
717 ! TYPE: INTEGER
718 ! DIMENSION: Scalar
719 ! ATTRIBUTES: INTENT(IN)
720 !
721 ! ChannelIndex: Channel index id. This is a unique index associated
722 ! with a (supported) sensor channel used to access the
723 ! shared coefficient data for a particular sensor's
724 ! channel.
725 ! See the SensorIndex argument.
726 ! UNITS: N/A
727 ! TYPE: INTEGER
728 ! DIMENSION: Scalar
729 ! ATTRIBUTES: INTENT(IN)
730 !
731 ! RTV: Structure containing internal forward model variables
732 ! required for subsequent tangent-linear or adjoint model
733 ! calls. The contents of this structure are NOT accessible
734 ! outside of the CRTM_RTSolution module.
735 ! UNITS: N/A
736 ! TYPE: RTV_type
737 ! DIMENSION: Scalar
738 ! ATTRIBUTES: INTENT(IN)
739 !
740 ! OUTPUT ARGUMENTS:
741 ! Atmosphere_AD: Structure containing the adjoint atmospheric
742 ! state data.
743 ! UNITS: N/A
744 ! TYPE: CRTM_Atmosphere_type
745 ! DIMENSION: Scalar
746 ! ATTRIBUTES: INTENT(IN OUT)
747 !
748 ! Surface_AD: Structure containing the adjoint surface state data.
749 ! UNITS: N/A
750 ! TYPE: CRTM_Surface_type
751 ! DIMENSION: Scalar
752 ! ATTRIBUTES: INTENT(IN OUT)
753 !
754 ! AtmOptics_AD: Structure containing the adjoint combined atmospheric
755 ! optical properties for gaseous absorption, clouds,
756 ! and aerosols.
757 ! UNITS: N/A
758 ! TYPE: CRTM_AtmOptics_type
759 ! DIMENSION: Scalar
760 ! ATTRIBUTES: INTENT(IN OUT)
761 !
762 ! SfcOptics_AD: Structure containing the adjoint surface optical
763 ! properties data.
764 ! UNITS: N/A
765 ! TYPE: CRTM_SfcOptics_type
766 ! DIMENSION: Scalar
767 ! ATTRIBUTES: INTENT( IN OUT)
768 !
769 ! FUNCTION RESULT:
770 ! Error_Status: The return value is an integer defining the error status
771 ! The error codes are defined in the Message_Handler module.
772 ! If == SUCCESS the computation was sucessful
773 ! == FAILURE an unrecoverable error occurred
774 ! UNITS: N/A
775 ! TYPE: INTEGER
776 ! DIMENSION: Scalar
777 !
778 ! COMMENTS:
779 ! Note the INTENT on all of the adjoint arguments (whether input or output)
780 ! is IN OUT rather than just OUT. This is necessary because the Input
781 ! adjoint arguments are modified, and the Output adjoint arguments must
782 ! be defined prior to entry to this routine. So, anytime a structure is
783 ! to be output, to prevent memory leaks the IN OUT INTENT is a must.
784 !
785 !--------------------------------------------------------------------------------
786 
787  FUNCTION crtm_compute_rtsolution_ad( &
788  Atmosphere , & ! FWD Input
789  Surface , & ! FWD Input
790  AtmOptics , & ! FWD Input
791  SfcOptics , & ! FWD Input
792  RTSolution , & ! FWD Input
793  RTSolution_AD, & ! AD Input
794  GeometryInfo , & ! Input
795  SensorIndex , & ! Input
796  ChannelIndex , & ! Input
797  Atmosphere_AD, & ! AD Output
798  Surface_AD , & ! AD Output
799  AtmOptics_AD , & ! AD Output
800  SfcOptics_AD , & ! AD Output
801  RTV ) & ! Internal variable input
802  result( error_status )
803  ! Arguments
804  TYPE(crtm_atmosphere_type), INTENT(IN) :: atmosphere
805  TYPE(crtm_surface_type), INTENT(IN) :: surface
806  TYPE(crtm_atmoptics_type), INTENT(IN) :: atmoptics
807  TYPE(crtm_sfcoptics_type), INTENT(IN) :: sfcoptics
808  TYPE(crtm_rtsolution_type), INTENT(IN) :: rtsolution
809  TYPE(crtm_rtsolution_type), INTENT(IN OUT) :: rtsolution_ad
810  TYPE(crtm_geometryinfo_type), INTENT(IN) :: geometryinfo
811  INTEGER, INTENT(IN) :: sensorindex
812  INTEGER, INTENT(IN) :: channelindex
813  TYPE(crtm_atmosphere_type), INTENT(IN OUT) :: atmosphere_ad
814  TYPE(crtm_surface_type), INTENT(IN OUT) :: surface_ad
815  TYPE(crtm_atmoptics_type), INTENT(IN OUT) :: atmoptics_ad
816  TYPE(crtm_sfcoptics_type), INTENT(IN OUT) :: sfcoptics_ad
817  TYPE(rtv_type), INTENT(IN) :: rtv
818  ! Function result
819  INTEGER :: error_status
820  ! Local parameters
821  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Compute_RTSolution_AD'
822  ! Local variables
823  CHARACTER(256) :: message
824  INTEGER :: nz
825  REAL(fp) :: planck_surface_ad ! Surface AD radiance
826  REAL(fp), DIMENSION( 0:Atmosphere%n_Layers ) :: planck_atmosphere_ad ! *LAYER* AD radiances
827  REAL(fp) :: user_emissivity_ad ! Temporary adjoint variable for SfcOptics calcs.
828  ! The following variables are RT model specific
829  REAL(fp), DIMENSION( MAX_N_ANGLES, & MAX_N_ANGLES+1, & Atmosphere%n_Layers ) :: pff_ad ! Forward scattering AD phase matrix
830  REAL(fp), DIMENSION( MAX_N_ANGLES, & MAX_N_ANGLES+1, & Atmosphere%n_Layers ) :: pbb_ad ! Backward scattering AD phase matrix
831  REAL (fp),DIMENSION( MAX_N_ANGLES ) :: scattering_radiance_ad
832  REAL (fp) :: radiance_ad
833 
834  ! -----
835  ! Setup
836  ! -----
837  error_status = success
838 
839  rtsolution_ad%RT_Algorithm_Name = rtsolution%RT_Algorithm_Name
840 
841  error_status = assign_common_input_ad( sfcoptics , & ! FWD Input
842  rtsolution , & ! FWD Input
843  geometryinfo , & ! Input
844  sensorindex , & ! Input
845  channelindex , & ! Input
846  rtsolution_ad , & ! AD Output/Input
847  sfcoptics_ad , & ! AD Output
848  planck_surface_ad , & ! AD Output
849  planck_atmosphere_ad , & ! AD Output
850  radiance_ad , & ! AD Output
851  nz , & ! Output
852  rtv ) ! Internal variable input
853  IF ( error_status /= success ) THEN
854  message = 'Error assigning input for AD RTSolution algorithms'
855  CALL display_message( routine_name, trim(message), error_status )
856  RETURN
857  END IF
858 
859  ! --------------------------------------
860  ! Perform the adjoint radiative transfer
861  ! --------------------------------------
862  ! Select the RT model
863  IF( rtv%Scattering_RT ) THEN
864 
865  ! Initialise the input adjoint radiance
866  scattering_radiance_ad = zero
867  scattering_radiance_ad( sfcoptics%Index_Sat_Ang ) = radiance_ad
868 !! RTSolution_AD%Radiance = ZERO
869 
870  ! Select the scattering RT model
871  IF ( rtv%RT_Algorithm_Id == rt_ada ) THEN
872  ! NESDIS advanced adding-doubling method
873  CALL crtm_ada_ad( &
874  atmosphere%n_Layers, & ! Input, number of atmospheric layers
875  atmoptics%Single_Scatter_Albedo, & ! Input, FWD layer single scattering albedo
876  atmoptics%Optical_Depth, & ! Input, FWD layer optical depth
877  rtv%Cosmic_Background_Radiance, & ! Input, cosmic background radiation
878  sfcoptics%Emissivity(1:nz,1), & ! Input, FWD surface emissivity
879  sfcoptics%Direct_Reflectivity(1:nz,1), & ! Input, FWD surface reflectivity for a point source
880  rtv, & ! In/Output, internal variables
881  scattering_radiance_ad(1:nz), & ! Input, AD radiances
882  planck_atmosphere_ad, & ! Output, AD layer radiances
883  planck_surface_ad, & ! Output, AD surface radiance
884  atmoptics_ad%Single_Scatter_Albedo, & ! Output, AD layer single scattering albedo
885  atmoptics_ad%Optical_Depth, & ! Output, AD layer optical depth
886  sfcoptics_ad%Emissivity(1:nz,1), & ! Output, AD surface emissivity
887  sfcoptics_ad%Reflectivity(1:nz,1,1:nz,1), & ! Output, AD surface reflectivity
888  sfcoptics_ad%Direct_Reflectivity(1:nz,1), & ! Output, AD surface reflectivity for a point source
889  pff_ad(1:nz,1:(nz+1),:), & ! Output, AD layer forward phase matrix
890  pbb_ad(1:nz,1:(nz+1),:) ) ! Output, AD layer backward phase matrix
891  ELSE
892  ! UW SOI RT solver
893  CALL crtm_soi_ad( &
894  atmosphere%n_Layers, & ! Input, number of atmospheric layers
895  atmoptics%Single_Scatter_Albedo, & ! Input, FWD layer single scattering albedo
896  atmoptics%Optical_Depth, & ! Input, FWD layer optical depth
897  sfcoptics%Emissivity(1:nz,1), & ! Input, FWD surface emissivity
898  sfcoptics%Reflectivity(1:nz,1,1:nz,1), & ! Input, FWD surface reflectivity
899  sfcoptics%Index_Sat_Ang, & ! Input, Satellite angle index
900  rtv, & ! In/Output, internal variables
901  scattering_radiance_ad(1:nz), & ! Input, AD radiances
902  planck_atmosphere_ad, & ! Output AD atmospheric layer Planck radiance
903  planck_surface_ad, & ! Output AD surface Planck radiance
904  atmoptics_ad%Single_Scatter_Albedo, & ! Output, AD layer single scattering albedo
905  atmoptics_ad%Optical_Depth, & ! Output, AD layer optical depth
906  sfcoptics_ad%Emissivity(1:nz,1), & ! Output, AD surface emissivity
907  sfcoptics_ad%Reflectivity(1:nz,1,1:nz,1), & ! Output, AD surface reflectivity
908  pff_ad(1:nz,1:(nz+1),:), & ! Output, AD layer forward phase matrix
909  pbb_ad(1:nz,1:(nz+1),:) ) ! Output, AD layer backward phase matrix
910 
911  END IF
912 
913  ELSE
914 
915  ! -----------------
916  ! Emission model RT
917  ! -----------------
918  CALL crtm_emission_ad( &
919  atmosphere%n_Layers, & ! Input, number of atmospheric layers
920  rtv%n_Angles, & ! Input, number of discrete zenith angles
921  geometryinfo%Cosine_Sensor_Zenith, & ! Input, cosine of sensor zenith angle
922  rtv%Planck_Atmosphere, & ! Input, FWD layer radiances
923  rtv%Planck_Surface, & ! Input, FWD surface radiance
924  sfcoptics%Emissivity(1:nz,1), & ! Input, FWD surface emissivity
925  sfcoptics%Reflectivity(1:nz,1,1:nz,1), & ! Input, FWD surface reflectivity
926  sfcoptics%Direct_Reflectivity(1:nz,1), & ! Input, FWD surface reflectivity for a point source
927  rtv%Solar_Irradiance, & ! Input, Source irradiance at TOA
928  rtv%Is_Solar_Channel, & ! Input, Source sensitive channel info.
929  geometryinfo%Source_Zenith_Radian, & ! Input, Source zenith angle
930  rtv, & ! Input, internal variables
931  radiance_ad, & ! Input, AD radiance
932  atmoptics_ad%Optical_Depth, & ! Output, AD layer optical depth
933  planck_atmosphere_ad, & ! Output, AD layer radiances
934  planck_surface_ad, & ! Output, AD surface radiance
935  sfcoptics_ad%Emissivity(1:nz,1), & ! Output, AD surface emissivity
936  sfcoptics_ad%Reflectivity(1:nz,1,1:nz,1), & ! Output, AD surface reflectivity
937  sfcoptics_ad%Direct_Reflectivity(1:nz,1) ) ! Output, AD surface reflectivity for a point source
938  END IF
939 
940  error_status = assign_common_output_ad( atmosphere , & ! Input
941  surface , & ! Input
942  atmoptics , & ! Input
943  sfcoptics , & ! Input
944  pff_ad , & ! Input
945  pbb_ad , & ! Input
946  geometryinfo , & ! Input
947  sensorindex , & ! Input
948  channelindex , & ! Input
949  nz , & ! Input
950  atmoptics_ad , & ! Output
951  sfcoptics_ad , & ! Output
952  planck_surface_ad , & ! Output
953  planck_atmosphere_ad , & ! Output
954  user_emissivity_ad , & ! Output
955  atmosphere_ad , & ! Output
956  surface_ad , & ! Output
957  rtsolution_ad , & ! Output
958  rtv ) ! Input
959  IF ( error_status /= success ) THEN
960  message = 'Error assigning output for AD RTSolution algorithms'
961  CALL display_message( routine_name, trim(message), error_status )
962  RETURN
963  END IF
964 
965 
966  END FUNCTION crtm_compute_rtsolution_ad
967 
968 !--------------------------------------------------------------------------------
969 !
970 ! NAME:
971 ! CRTM_Compute_n_Streams
972 !
973 ! PURPOSE:
974 ! Function to compute the number of streams required for subsequent
975 ! radiative transfer calculations
976 !
977 ! CALLING SEQUENCE:
978 ! nStreams = CRTM_Compute_n_Streams( Atmosphere, & ! Input
979 ! SensorIndex, & ! Input
980 ! ChannelIndex, & ! Input
981 ! RTSolution ) ! Output
982 !
983 ! INPUT ARGUMENTS:
984 ! Atmosphere: Structure containing the atmospheric state data.
985 ! UNITS: N/A
986 ! TYPE: CRTM_Atmosphere_type
987 ! DIMENSION: Scalar
988 ! ATTRIBUTES: INTENT(IN)
989 !
990 ! SensorIndex: Sensor index id. This is a unique index associated
991 ! with a (supported) sensor used to access the
992 ! shared coefficient data for a particular sensor.
993 ! See the ChannelIndex argument.
994 ! UNITS: N/A
995 ! TYPE: INTEGER
996 ! DIMENSION: Scalar
997 ! ATTRIBUTES: INTENT(IN)
998 !
999 ! ChannelIndex: Channel index id. This is a unique index associated
1000 ! with a (supported) sensor channel used to access the
1001 ! shared coefficient data for a particular sensor's
1002 ! channel.
1003 ! See the SensorIndex argument.
1004 ! UNITS: N/A
1005 ! TYPE: INTEGER
1006 ! DIMENSION: Scalar
1007 ! ATTRIBUTES: INTENT(IN)
1008 !
1009 ! OUTPUT ARGUMENTS:
1010 ! RTSolution: Structure containing the scattering flag to be set
1011 ! for the RT calcs.
1012 ! UNITS: N/A
1013 ! TYPE: CRTM_RTSolution_type
1014 ! DIMENSION: Scalar
1015 ! ATTRIBUTES: INTENT(IN OUT)
1016 !
1017 ! FUNCTION RESULT:
1018 ! nStreams: The number of RT streams required to perform radiative
1019 ! transfer in a scattering atmosphere.
1020 ! UNITS: N/A
1021 ! TYPE: INTEGER
1022 ! DIMENSION: Scalar
1023 !
1024 !--------------------------------------------------------------------------------
1025 
1026  FUNCTION crtm_compute_nstreams( &
1027  Atmosphere , & ! Input
1028  SensorIndex , & ! Input
1029  ChannelIndex, & ! Input
1030  RTSolution ) & ! Output
1031  result( nstreams )
1032  ! Arguments
1033  TYPE(crtm_atmosphere_type), INTENT(IN) :: atmosphere
1034  INTEGER, INTENT(IN) :: sensorindex
1035  INTEGER, INTENT(IN) :: channelindex
1036  TYPE(crtm_rtsolution_type), INTENT(IN OUT) :: rtsolution
1037  ! Function result
1038  INTEGER :: nstreams
1039  ! Local variables
1040  REAL(fp) :: maxreff, reff, mieparameter
1041  INTEGER :: n
1042 
1043  ! Set up
1044  nstreams = 0
1045  rtsolution%n_full_Streams = nstreams
1046  rtsolution%Scattering_FLAG = .false.
1047 
1048  ! If no clouds and no aerosols, no scattering, so return
1049  IF ( atmosphere%n_Clouds == 0 .AND. &
1050  atmosphere%n_Aerosols == 0 ) RETURN
1051 
1052  ! Determine the maximum cloud particle size
1053  maxreff = zero
1054  DO n = 1, atmosphere%n_Clouds
1055  reff = maxval(atmosphere%Cloud(n)%Effective_Radius)
1056  IF( reff > maxreff) maxreff = reff
1057  END DO
1058  DO n = 1, atmosphere%n_Aerosols
1059  reff = maxval(atmosphere%Aerosol(n)%Effective_Radius)
1060  IF( reff > maxreff) maxreff = reff
1061  END DO
1062 
1063  ! Compute the Mie parameter, 2.pi.Reff/lambda
1064  mieparameter = two * pi * maxreff * sc(sensorindex)%Wavenumber(channelindex)/10000.0_fp
1065 
1066  ! Determine the number of streams based on Mie parameter
1067  IF ( mieparameter < 0.01_fp ) THEN
1068  nstreams = 2
1069  ELSE IF( mieparameter < one ) THEN
1070  nstreams = 4
1071  ELSE
1072  nstreams = 6
1073  END IF
1074 
1075 ! Hardcode number of streams for testing purposes
1076 ! nStreams = 6
1077 
1078  ! Set RTSolution scattering info
1079  rtsolution%Scattering_Flag = .true.
1080  rtsolution%n_full_Streams = nstreams + 2
1081 
1082  END FUNCTION crtm_compute_nstreams
1083 
1084 !--------------------------------------------------------------------------------
1085 !:sdoc+:
1086 !
1087 ! NAME:
1088 ! CRTM_RTSolution_Version
1089 !
1090 ! PURPOSE:
1091 ! Subroutine to return the module version information.
1092 !
1093 ! CALLING SEQUENCE:
1094 ! CALL CRTM_RTSolution_Version( Id )
1095 !
1096 ! OUTPUT ARGUMENTS:
1097 ! Id: Character string containing the version Id information
1098 ! for the module.
1099 ! UNITS: N/A
1100 ! TYPE: CHARACTER(*)
1101 ! DIMENSION: Scalar
1102 ! ATTRIBUTES: INTENT(OUT)
1103 !
1104 !:sdoc-:
1105 !--------------------------------------------------------------------------------
1106 
1107  SUBROUTINE crtm_rtsolution_version( Id )
1108  CHARACTER(*), INTENT(OUT) :: id
1109  id = module_version_id
1110  END SUBROUTINE crtm_rtsolution_version
1111 
1112 END MODULE crtm_rtsolution
1113 
crtm_sfcoptics_define::crtm_sfcoptics_type
Definition: CRTM_SfcOptics_Define.f90:67
common_rtsolution::assign_common_output
integer function, public assign_common_output(Atmosphere, SfcOptics, GeometryInfo, SensorIndex, ChannelIndex, RTV, RTSolution)
Definition: Common_RTSolution.f90:1100
common_rtsolution::assign_common_output_ad
integer function, public assign_common_output_ad(Atmosphere, Surface, AtmOptics, SfcOptics, Pff_AD, Pbb_AD, GeometryInfo, SensorIndex, ChannelIndex, nZ, AtmOptics_AD, SfcOptics_AD, Planck_Surface_AD, Planck_Atmosphere_AD, User_Emissivity_AD, Atmosphere_AD, Surface_AD, RTSolution_AD, RTV)
Definition: Common_RTSolution.f90:1530
message_handler::failure
integer, parameter, public failure
Definition: Message_Handler.f90:30
crtm_utility
Definition: CRTM_Utility.f90:17
crtm_parameters::zero
real(fp), parameter, public zero
Definition: CRTM_Parameters.f90:70
crtm_atmoptics_define
Definition: CRTM_AtmOptics_Define.f90:12
ada_module::crtm_ada
subroutine, public crtm_ada(n_Layers, w, T_OD, cosmic_background, emissivity, reflectivity, direct_reflectivity, RTV)
Definition: ADA_Module.f90:64
type_kinds::fp
integer, parameter, public fp
Definition: Type_Kinds.f90:124
common_rtsolution::assign_common_output_tl
integer function, public assign_common_output_tl(SfcOptics, RTSolution, GeometryInfo, Radiance_TL, Scattering_Radiance_TL, SensorIndex, ChannelIndex, RTV, RTSolution_TL)
Definition: Common_RTSolution.f90:1285
crtm_parameters::max_n_angles
integer, parameter, public max_n_angles
Definition: CRTM_Parameters.f90:261
common_rtsolution
Definition: Common_RTSolution.f90:12
crtm_parameters
Definition: CRTM_Parameters.f90:12
crtm_rtsolution::crtm_compute_rtsolution_tl
integer function, public crtm_compute_rtsolution_tl(Atmosphere, Surface, AtmOptics, SfcOptics, RTSolution, Atmosphere_TL, Surface_TL, AtmOptics_TL, SfcOptics_TL, GeometryInfo, SensorIndex, ChannelIndex, RTSolution_TL, RTV)
Definition: CRTM_RTSolution.f90:485
crtm_spccoeff
Definition: CRTM_SpcCoeff.f90:24
crtm_sfcoptics_define
Definition: CRTM_SfcOptics_Define.f90:15
emission_module::crtm_emission_ad
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)
Definition: Emission_Module.f90:299
crtm_surface_define::crtm_surface_type
Definition: CRTM_Surface_Define.f90:202
crtm_geometryinfo_define::crtm_geometryinfo_type
Definition: CRTM_GeometryInfo_Define.f90:104
soi_module::crtm_soi
subroutine, public crtm_soi(n_Layers, w, T_OD, cosmic_background, emissivity, reflectivity, Index_Sat_Angle, RTV)
Definition: SOI_Module.f90:75
crtm_rtsolution
Definition: CRTM_RTSolution.f90:13
crtm_rtsolution::crtm_compute_rtsolution
integer function, public crtm_compute_rtsolution(Atmosphere, Surface, AtmOptics, SfcOptics, GeometryInfo, SensorIndex, ChannelIndex, RTSolution, RTV)
Definition: CRTM_RTSolution.f90:199
message_handler
Definition: Message_Handler.f90:4
ada_module
Definition: ADA_Module.f90:14
crtm_surface_define
Definition: CRTM_Surface_Define.f90:15
ada_module::crtm_ada_tl
subroutine, public crtm_ada_tl(n_Layers, w, T_OD, cosmic_background, emissivity, direct_reflectivity, RTV, Planck_Atmosphere_TL, Planck_Surface_TL, w_TL, T_OD_TL, emissivity_TL, reflectivity_TL, direct_reflectivity_TL, Pff_TL, Pbb_TL, s_rad_up_TL)
Definition: ADA_Module.f90:474
ada_module::module_version_id
character(*), parameter module_version_id
Definition: ADA_Module.f90:42
crtm_parameters::one
real(fp), parameter, public one
Definition: CRTM_Parameters.f90:71
message_handler::display_message
recursive subroutine, public display_message(Routine_Name, Message, Error_State, Message_Log)
Definition: Message_Handler.f90:118
common_rtsolution::assign_common_input_ad
integer function, public assign_common_input_ad(SfcOptics, RTSolution, GeometryInfo, SensorIndex, ChannelIndex, RTSolution_AD, SfcOptics_AD, Planck_Surface_AD, Planck_Atmosphere_AD, Radiance_AD, nz, RTV)
Definition: Common_RTSolution.f90:945
crtm_parameters::two
real(fp), parameter, public two
Definition: CRTM_Parameters.f90:72
crtm_rtsolution::crtm_compute_nstreams
integer function, public crtm_compute_nstreams(Atmosphere, SensorIndex, ChannelIndex, RTSolution)
Definition: CRTM_RTSolution.f90:1040
emission_module
Definition: Emission_Module.f90:14
emission_module::crtm_emission
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)
Definition: Emission_Module.f90:69
crtm_rtsolution::crtm_compute_rtsolution_ad
integer function, public crtm_compute_rtsolution_ad(Atmosphere, Surface, AtmOptics, SfcOptics, RTSolution, RTSolution_AD, GeometryInfo, SensorIndex, ChannelIndex, Atmosphere_AD, Surface_AD, AtmOptics_AD, SfcOptics_AD, RTV)
Definition: CRTM_RTSolution.f90:807
rtv_define::rtv_type
Definition: RTV_Define.f90:106
crtm_parameters::rt_soi
integer, parameter, public rt_soi
Definition: CRTM_Parameters.f90:245
crtm_spccoeff::sc
type(spccoeff_type), dimension(:), allocatable, save, public sc
Definition: CRTM_SpcCoeff.f90:114
soi_module::crtm_soi_tl
subroutine, public crtm_soi_tl(n_Layers, w, T_OD, emissivity, reflectivity, Index_Sat_Angle, RTV, Planck_Atmosphere_TL, Planck_Surface_TL, w_TL, T_OD_TL, emissivity_TL, reflectivity_TL, Pff_TL, Pbb_TL, s_rad_up_TL)
Definition: SOI_Module.f90:306
common_rtsolution::assign_common_input
integer function, public assign_common_input(Atmosphere, Surface, AtmOptics, SfcOptics, GeometryInfo, SensorIndex, ChannelIndex, RTSolution, nz, RTV)
Definition: Common_RTSolution.f90:201
crtm_parameters::rt_ada
integer, parameter, public rt_ada
Definition: CRTM_Parameters.f90:244
crtm_rtsolution_define
Definition: CRTM_RTSolution_Define.f90:13
soi_module::crtm_soi_ad
subroutine, public crtm_soi_ad(n_Layers, w, T_OD, emissivity, reflectivity, Index_Sat_Angle, RTV, s_rad_up_AD, Planck_Atmosphere_AD, Planck_Surface_AD, w_AD, T_OD_AD, emissivity_AD, reflectivity_AD, Pff_AD, Pbb_AD)
Definition: SOI_Module.f90:497
type_kinds
Definition: Type_Kinds.f90:12
crtm_rtsolution_define::crtm_rtsolution_type
Definition: CRTM_RTSolution_Define.f90:114
common_rtsolution::assign_common_input_tl
integer function, public assign_common_input_tl(Atmosphere, Surface, AtmOptics, SfcOptics, Atmosphere_TL, Surface_TL, AtmOptics_TL, SfcOptics_TL, GeometryInfo, SensorIndex, ChannelIndex, RTSolution_TL, nz, User_Emissivity_TL, Direct_Reflectivity_TL, Planck_Surface_TL, Planck_Atmosphere_TL, Pff_TL, Pbb_TL, RTV)
Definition: Common_RTSolution.f90:643
soi_module
Definition: SOI_Module.f90:13
emission_module::crtm_emission_tl
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)
Definition: Emission_Module.f90:195
crtm_rtsolution::crtm_rtsolution_version
subroutine, public crtm_rtsolution_version(Id)
Definition: CRTM_RTSolution.f90:1116
crtm_atmosphere_define::crtm_atmosphere_type
Definition: CRTM_Atmosphere_Define.f90:361
crtm_atmosphere_define
Definition: CRTM_Atmosphere_Define.f90:13
crtm_geometryinfo_define
Definition: CRTM_GeometryInfo_Define.f90:13
crtm_atmoptics_define::crtm_atmoptics_type
Definition: CRTM_AtmOptics_Define.f90:93
message_handler::success
integer, parameter, public success
Definition: Message_Handler.f90:27
rtv_define
Definition: RTV_Define.f90:21
crtm_parameters::pi
real(fp), parameter, public pi
Definition: CRTM_Parameters.f90:86
ada_module::crtm_ada_ad
subroutine, public crtm_ada_ad(n_Layers, w, T_OD, cosmic_background, emissivity, direct_reflectivity, RTV, s_rad_up_AD, Planck_Atmosphere_AD, Planck_Surface_AD, w_AD, T_OD_AD, emissivity_AD, reflectivity_AD, direct_reflectivity_AD, Pff_AD, Pbb_AD)
Definition: ADA_Module.f90:949