FV3 Bundle
CRTM_AOD_Module.f90
Go to the documentation of this file.
1 !
2 ! CRTM_AOD_Module
3 !
4 ! Module containing the CRTM Aerosol Optical Depth (AOD) at nadir
5 ! functions.
6 !
7 !
8 ! CREATION HISTORY:
9 ! Written by: Quanhua Liu, 29-Jun-2010
10 ! Quanhua.Liu@noaa.gov
11 !
12 
13 MODULE crtm_aod_module
14 
15 
16  ! ------------
17  ! Module usage
18  ! ------------
19  USE message_handler, ONLY: success, failure, display_message
20  USE crtm_parameters, ONLY: zero, &
21  max_n_phase_elements, &
22  max_n_legendre_terms
23  USE crtm_atmosphere_define, ONLY: crtm_atmosphere_type, &
24  crtm_atmosphere_isvalid
25  USE crtm_channelinfo_define, ONLY: crtm_channelinfo_type, &
26  crtm_channelinfo_n_channels
27  USE crtm_options_define, ONLY: crtm_options_type
28  USE crtm_atmoptics_define, ONLY: crtm_atmoptics_type , &
29  crtm_atmoptics_associated, &
30  crtm_atmoptics_create , &
31  crtm_atmoptics_destroy , &
32  crtm_atmoptics_zero
33  USE crtm_aerosolscatter, ONLY: crtm_compute_aerosolscatter, &
34  crtm_compute_aerosolscatter_tl, &
35  crtm_compute_aerosolscatter_ad
36  USE crtm_rtsolution_define, ONLY: crtm_rtsolution_type, &
37  crtm_rtsolution_associated
38  USE crtm_aerosolcoeff, ONLY: crtm_aerosolcoeff_isloaded
39 
40  ! Internal variable definition modules
41  ! ...AerosolScatter
42  USE asvar_define, ONLY: asvar_type, &
43  asvar_associated, &
44  asvar_destroy , &
45  asvar_create
46 
47 
48  ! -----------------------
49  ! Disable implicit typing
50  ! -----------------------
51  IMPLICIT NONE
52 
53 
54  ! ------------
55  ! Visibilities
56  ! ------------
57  ! Everything private by default
58  PRIVATE
59  ! Public procedures
60  PUBLIC :: crtm_aod
61  PUBLIC :: crtm_aod_tl
62  PUBLIC :: crtm_aod_ad
63  PUBLIC :: crtm_aod_k
64  PUBLIC :: crtm_aod_version
65 
66 
67  ! -----------------
68  ! Module parameters
69  ! -----------------
70  ! Version Id for the module
71  CHARACTER(*), PARAMETER :: module_version_id = &
72  '$Id: CRTM_AOD_Module.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
73  ! Message string length
74  INTEGER, PARAMETER :: ml = 256
75 
76 
77 CONTAINS
78 
79 
80 !--------------------------------------------------------------------------------
81 !:sdoc+:
82 !
83 ! NAME:
84 ! CRTM_AOD
85 !
86 ! PURPOSE:
87 ! Function that calculates layer total optical depth profile at nadir.
88 !
89 ! CALLING SEQUENCE:
90 ! Error_Status = CRTM_AOD( Atmosphere , &
91 ! ChannelInfo , &
92 ! RTSolution , &
93 ! Options = Options )
94 !
95 ! INPUTS:
96 ! Atmosphere: Structure containing the Atmosphere data.
97 ! UNITS: N/A
98 ! TYPE: CRTM_Atmosphere_type
99 ! DIMENSION: Rank-1 (n_Profiles)
100 ! ATTRIBUTES: INTENT(IN)
101 !
102 ! ChannelInfo: Structure returned from the CRTM_Init() function
103 ! that contains the satellite/sensor channel index
104 ! information.
105 ! UNITS: N/A
106 ! TYPE: CRTM_ChannelInfo_type
107 ! DIMENSION: Rank-1 (n_Sensors)
108 ! ATTRIBUTES: INTENT(IN)
109 !
110 ! OUTPUTS:
111 ! RTSolution: Structure containing the layer aerosol optical
112 ! profile for the given inputs.
113 ! UNITS: N/A
114 ! TYPE: CRTM_RTSolution_type
115 ! DIMENSION: Rank-2 (n_Channels x n_Profiles)
116 ! ATTRIBUTES: INTENT(IN OUT)
117 !
118 ! OPTIONAL INPUTS:
119 ! Options: Options structure containing the optional arguments
120 ! for the CRTM.
121 ! UNITS: N/A
122 ! TYPE: CRTM_Options_type
123 ! DIMENSION: Same as input Atmosphere structure
124 ! ATTRIBUTES: INTENT(IN), OPTIONAL
125 !
126 ! FUNCTION RESULT:
127 ! Error_Status: The return value is an integer defining the error status.
128 ! The error codes are defined in the Message_Handler module.
129 ! If == SUCCESS the computation was sucessful
130 ! == FAILURE an unrecoverable error occurred
131 ! UNITS: N/A
132 ! TYPE: INTEGER
133 ! DIMENSION: Scalar
134 !
135 ! COMMENTS:
136 ! - Many of the components of the Options optional input structure
137 ! are not used in this function. Consult the CRTM User Guide for
138 ! which Options components are usable for AOD calculations.
139 !
140 !:sdoc-:
141 !--------------------------------------------------------------------------------
142 
143  FUNCTION crtm_aod( &
144  Atmosphere , & ! Input, M
145  ChannelInfo, & ! Input, M
146  RTSolution , & ! Output, L x M
147  Options ) & ! Optional input, M
148  result( error_status )
149  ! Arguments
150  TYPE(crtm_atmosphere_type), INTENT(IN) :: atmosphere(:) ! M
151  TYPE(crtm_channelinfo_type), INTENT(IN) :: channelinfo(:) ! n_Sensors
152  TYPE(crtm_rtsolution_type), INTENT(IN OUT) :: rtsolution(:,:) ! L x M
153  TYPE(crtm_options_type), OPTIONAL, INTENT(IN) :: options(:) ! M
154  ! Function result
155  INTEGER :: error_status
156  ! Local parameters
157  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_AOD'
158  ! Local variables
159  CHARACTER(ML) :: message
160  LOGICAL :: options_present
161  LOGICAL :: check_input
162  INTEGER :: n, n_sensors, sensorindex
163  INTEGER :: l, n_channels, channelindex
164  INTEGER :: m, n_profiles
165  INTEGER :: ln
166  ! Component variables
167  TYPE(crtm_atmoptics_type) :: atmoptics
168  TYPE(asvar_type) :: asvar
169 
170 
171  ! ------
172  ! SET UP
173  ! ------
174  error_status = success
175 
176 
177  ! If no sensors or channels, simply return
178  n_sensors = SIZE(channelinfo)
179  n_channels = sum(crtm_channelinfo_n_channels(channelinfo))
180  IF ( n_sensors == 0 .OR. n_channels == 0 ) RETURN
181 
182 
183  ! Check the number of channels
184  IF ( SIZE(rtsolution,dim=1) < n_channels ) THEN
185  error_status = failure
186  WRITE( message,'("Output RTSolution structure array too small (",i0,&
187  &") to hold results for the number of requested channels (",i0,")")') &
188  SIZE(rtsolution,dim=1), n_channels
189  CALL display_message( routine_name, message, error_status )
190  RETURN
191  END IF
192 
193 
194  ! Check the number of profiles
195  ! ...Number of atmospheric profiles.
196  n_profiles = SIZE(atmosphere)
197  ! ...Check the profile dimensionality of the other mandatory arguments
198  IF ( SIZE(rtsolution,dim=2) /= n_profiles ) THEN
199  error_status = failure
200  message = 'Inconsistent profile dimensionality for RTSolution argument.'
201  CALL display_message( routine_name, message, error_status )
202  RETURN
203  END IF
204  ! ...Check the profile dimensionality of the other optional arguments
205  options_present = PRESENT(options)
206  IF ( options_present ) THEN
207  IF ( SIZE(options) /= n_profiles ) THEN
208  error_status = failure
209  message = 'Inconsistent profile dimensionality for Options optional input argument.'
210  CALL display_message( routine_name, message, error_status )
211  RETURN
212  END IF
213  END IF
214 
215 
216  ! Check the RTSolution structure has been allocated
217  IF ( any(.NOT. crtm_rtsolution_associated(rtsolution)) ) THEN
218  error_status = failure
219  message = 'RTSolution output structure components have not been allocated'
220  CALL display_message( routine_name, message, error_status )
221  RETURN
222  END IF
223 
224 
225  ! ------------
226  ! PROFILE LOOP
227  ! ------------
228  profile_loop: DO m = 1, n_profiles
229 
230 
231  ! Check the aerosol coeff. data for cases with aerosols
232  IF( atmosphere(m)%n_Aerosols > 0 .AND. .NOT. crtm_aerosolcoeff_isloaded() )THEN
233  error_status = failure
234  WRITE( message,'("The AerosolCoeff data must be loaded (with CRTM_Init routine) ", &
235  &"for the aerosol case profile #",i0)' ) m
236  CALL display_message( routine_name, message, error_status )
237  RETURN
238  END IF
239 
240 
241  ! Check the optional Options structure argument
242  check_input = .true.
243  IF (options_present) THEN
244  check_input = options(m)%Check_Input
245  END IF
246 
247 
248  ! Check the input atmosphere if required
249  IF ( check_input ) THEN
250  IF ( .NOT. crtm_atmosphere_isvalid( atmosphere(m) ) ) THEN
251  error_status = failure
252  WRITE( message,'("Input data check failed for profile #",i0)' ) m
253  CALL display_message( routine_name, message, error_status )
254  RETURN
255  END IF
256  END IF
257 
258 
259  ! Check the RTSolution layer dimension
260  IF ( any(rtsolution(:,m)%n_Layers < atmosphere(m)%n_Layers) ) THEN
261  error_status=failure
262  WRITE( message,'("Number of RTSolution layers < Atmosphere for profile #",i0)' ) m
263  CALL display_message( routine_name, message, error_status )
264  RETURN
265  END IF
266 
267 
268  ! Allocate AtmOptics based on Atmosphere dimension
269  CALL crtm_atmoptics_create( atmoptics, &
270  atmosphere(m)%n_Layers, &
271  max_n_legendre_terms, &
272  max_n_phase_elements )
273  IF ( .NOT. crtm_atmoptics_associated( atmoptics ) ) THEN
274  error_status = failure
275  WRITE( message,'("Error allocating AtmOptics data structure for profile #",i0)' ) m
276  CALL display_message( routine_name, message, error_status )
277  RETURN
278  END IF
279  ! ...Set default number of streams
280  atmoptics%n_Legendre_Terms = 4
281 
282 
283  ! Allocate the aerosol scattering internal variable if necessary
284  IF ( atmosphere(m)%n_Aerosols > 0 ) THEN
285  CALL asvar_create( asvar, &
286  max_n_legendre_terms , &
287  max_n_phase_elements , &
288  atmosphere(m)%n_Layers , &
289  atmosphere(m)%n_Aerosols )
290  END IF
291 
292 
293  ! -----------
294  ! SENSOR LOOP
295  ! -----------
296  ! Initialise channel counter for channel(l)/sensor(n) count
297  ln = 0
298 
299  sensor_loop: DO n = 1, n_sensors
300 
301  ! Shorter name
302  sensorindex = channelinfo(n)%Sensor_Index
303 
304 
305  ! ------------
306  ! CHANNEL LOOP
307  ! ------------
308  channel_loop: DO l = 1, channelinfo(n)%n_Channels
309 
310  ! Channel setup
311  ! ...Skip channel if requested
312  IF ( .NOT. channelinfo(n)%Process_Channel(l) ) cycle channel_loop
313  ! ...Shorter name
314  channelindex = channelinfo(n)%Channel_Index(l)
315  ! ...Increment the processed channel counter
316  ln = ln + 1
317  ! ...Assign sensor+channel information to output
318  rtsolution(ln,m)%Sensor_Id = channelinfo(n)%Sensor_Id
319  rtsolution(ln,m)%WMO_Satellite_Id = channelinfo(n)%WMO_Satellite_Id
320  rtsolution(ln,m)%WMO_Sensor_Id = channelinfo(n)%WMO_Sensor_Id
321  rtsolution(ln,m)%Sensor_Channel = channelinfo(n)%Sensor_Channel(l)
322 
323 
324  ! Initialisations
325  CALL crtm_atmoptics_zero( atmoptics )
326 
327 
328  ! Compute the aerosol absorption/scattering properties
329  IF ( atmosphere(m)%n_Aerosols > 0 ) THEN
330  error_status = crtm_compute_aerosolscatter( atmosphere(m), & ! Input
331  sensorindex , & ! Input
332  channelindex , & ! Input
333  atmoptics , & ! In/Output
334  asvar ) ! Internal variable output
335  IF ( error_status /= success ) THEN
336  WRITE( message,'("Error computing AerosolScatter for ",a,&
337  &", channel ",i0,", profile #",i0)' ) &
338  trim(channelinfo(n)%Sensor_ID), channelinfo(n)%Sensor_Channel(l), m
339  CALL display_message( routine_name, message, error_status )
340  RETURN
341  END IF
342  END IF
343 
344 
345  ! Save the nadir optical depth
346  rtsolution(ln,m)%Layer_Optical_Depth(1:atmosphere(m)%n_Layers) = atmoptics%Optical_Depth
347 
348  END DO channel_loop
349 
350  END DO sensor_loop
351 
352 
353  ! Deallocate local sensor independent data structures
354  CALL crtm_atmoptics_destroy( atmoptics )
355 
356  END DO profile_loop
357 
358  END FUNCTION crtm_aod
359 
360 
361 !--------------------------------------------------------------------------------
362 !:sdoc+:
363 !
364 ! NAME:
365 ! CRTM_AOD_TL
366 !
367 ! PURPOSE:
368 ! Function that calculates tangent-linear layer total optical depth.
369 !
370 ! CALLING SEQUENCE:
371 ! Error_Status = CRTM_AOD_TL( Atmosphere , &
372 ! Atmosphere_TL , &
373 ! ChannelInfo , &
374 ! RTSolution , &
375 ! RTSolution_TL , &
376 ! Options = Options )
377 !
378 ! INPUTS:
379 ! Atmosphere: Structure containing the Atmosphere data.
380 ! UNITS: N/A
381 ! TYPE: CRTM_Atmosphere_type
382 ! DIMENSION: Rank-1 (n_Profiles)
383 ! ATTRIBUTES: INTENT(IN)
384 !
385 ! Atmosphere_TL: Structure containing the tangent-linear Atmosphere data.
386 ! UNITS: N/A
387 ! TYPE: CRTM_Atmosphere_type
388 ! DIMENSION: Same as input Atmosphere structure
389 ! ATTRIBUTES: INTENT(IN)
390 !
391 ! ChannelInfo: Structure returned from the CRTM_Init() function
392 ! that contains the satellite/sensor channel index
393 ! information.
394 ! UNITS: N/A
395 ! TYPE: CRTM_ChannelInfo_type
396 ! DIMENSION: Rank-1 (n_Sensors)
397 ! ATTRIBUTES: INTENT(IN)
398 !
399 ! OUTPUTS:
400 ! RTSolution: Structure containing the layer aerosol optical
401 ! profile for the given inputs.
402 ! UNITS: N/A
403 ! TYPE: CRTM_RTSolution_type
404 ! DIMENSION: Rank-2 (n_Channels x n_Profiles)
405 ! ATTRIBUTES: INTENT(IN OUT)
406 !
407 ! RTSolution_TL: Structure containing the tangent-linear aerosol
408 ! optical depth profile for the given inputs.
409 ! UNITS: N/A
410 ! TYPE: CRTM_RTSolution_type
411 ! DIMENSION: Same as RTSolution output
412 ! ATTRIBUTES: INTENT(IN OUT)
413 !
414 ! OPTIONAL INPUTS:
415 ! Options: Options structure containing the optional arguments
416 ! for the CRTM.
417 ! UNITS: N/A
418 ! TYPE: CRTM_Options_type
419 ! DIMENSION: Same as input Atmosphere structure
420 ! ATTRIBUTES: INTENT(IN), OPTIONAL
421 !
422 ! FUNCTION RESULT:
423 ! Error_Status: The return value is an integer defining the error status.
424 ! The error codes are defined in the Message_Handler module.
425 ! If == SUCCESS the computation was sucessful
426 ! == FAILURE an unrecoverable error occurred
427 ! UNITS: N/A
428 ! TYPE: INTEGER
429 ! DIMENSION: Scalar
430 !
431 ! COMMENTS:
432 ! - Many of the components of the Options optional input structure
433 ! are not used in this function. Consult the CRTM User Guide for
434 ! which Options components are usable for AOD calculations.
435 !
436 !:sdoc-:
437 !--------------------------------------------------------------------------------
438 
439  FUNCTION crtm_aod_tl( &
440  Atmosphere , & ! Input, M
441  Atmosphere_TL, & ! Input, M
442  ChannelInfo , & ! Input, M
443  RTSolution , & ! Output, L x M
444  RTSolution_TL, & ! Output, L x M
445  Options ) & ! Optional FWD input, M
446  result( error_status )
447  ! Arguments
448  TYPE(crtm_atmosphere_type), INTENT(IN) :: atmosphere(:) ! M
449  TYPE(crtm_atmosphere_type), INTENT(IN) :: atmosphere_tl(:) ! M
450  TYPE(crtm_channelinfo_type), INTENT(IN) :: channelinfo(:) ! n_Sensors
451  TYPE(crtm_rtsolution_type), INTENT(IN OUT) :: rtsolution(:,:) ! L x M
452  TYPE(crtm_rtsolution_type), INTENT(IN OUT) :: rtsolution_tl(:,:) ! L x M
453  TYPE(crtm_options_type), OPTIONAL, INTENT(IN) :: options(:) ! M
454  ! Function result
455  INTEGER :: error_status
456  ! Local parameters
457  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_AOD_TL'
458  ! Local variables
459  CHARACTER(ML) :: message
460  LOGICAL :: options_present
461  LOGICAL :: check_input
462  INTEGER :: status_fwd, status_tl
463  INTEGER :: n, n_sensors, sensorindex
464  INTEGER :: l, n_channels, channelindex
465  INTEGER :: m, n_profiles
466  INTEGER :: ln
467  ! Component variables
468  TYPE(crtm_atmoptics_type) :: atmoptics, atmoptics_tl
469  TYPE(asvar_type) :: asvar
470 
471 
472  ! ------
473  ! SET UP
474  ! ------
475  error_status = success
476 
477 
478  ! If no sensors or channels, simply return
479  n_sensors = SIZE(channelinfo)
480  n_channels = sum(crtm_channelinfo_n_channels(channelinfo))
481  IF ( n_sensors == 0 .OR. n_channels == 0 ) RETURN
482 
483 
484  ! Check the number of channels
485  IF ( SIZE(rtsolution, dim=1) < n_channels .OR. &
486  SIZE(rtsolution_tl,dim=1) < n_channels ) THEN
487  error_status = failure
488  WRITE( message,'("Output RTSolution structure arrays too small (",i0,&
489  &") to hold results for the number of requested channels (",i0,")")') &
490  SIZE(rtsolution,dim=1), n_channels
491  CALL display_message( routine_name, message, error_status )
492  RETURN
493  END IF
494 
495 
496  ! Check the number of profiles
497  n_profiles = SIZE(atmosphere)
498  ! ...Check the profile dimensionality of the other mandatory arguments
499  IF ( SIZE(atmosphere_tl) /= n_profiles .OR. &
500  SIZE(rtsolution, dim=2) /= n_profiles .OR. &
501  SIZE(rtsolution_tl,dim=2) /= n_profiles ) THEN
502  error_status = failure
503  message = 'Inconsistent profile dimensionality for input arguments.'
504  CALL display_message( routine_name, trim(message), error_status )
505  RETURN
506  END IF
507  ! ...Check the profile dimensionality of the other optional arguments
508  options_present = PRESENT(options)
509  IF ( options_present ) THEN
510  IF ( SIZE(options) /= n_profiles ) THEN
511  error_status = failure
512  message = 'Inconsistent profile dimensionality for Options optional input argument.'
513  CALL display_message( routine_name, message, error_status )
514  RETURN
515  END IF
516  END IF
517 
518 
519  ! Check the RTSolution structures have been allocated
520  IF ( any(.NOT. crtm_rtsolution_associated(rtsolution)) .OR. &
521  any(.NOT. crtm_rtsolution_associated(rtsolution_tl)) ) THEN
522  error_status = failure
523  message = 'RTSolution output structure components have not been allocated'
524  CALL display_message( routine_name, message, error_status )
525  RETURN
526  END IF
527 
528 
529  ! ------------
530  ! PROFILE LOOP
531  ! ------------
532  profile_loop: DO m = 1, n_profiles
533 
534 
535  ! Check the aerosol coeff. data for cases with aerosols
536  IF( atmosphere(m)%n_Aerosols > 0 .AND. .NOT. crtm_aerosolcoeff_isloaded() )THEN
537  error_status = failure
538  WRITE( message,'("The AerosolCoeff data must be loaded (with CRTM_Init routine) ", &
539  &"for the aerosol case profile #",i0)' ) m
540  CALL display_message( routine_name, message, error_status )
541  RETURN
542  END IF
543 
544 
545  ! Check the optional Options structure argument
546  check_input = .true.
547  IF (options_present) THEN
548  check_input = options(m)%Check_Input
549  END IF
550 
551 
552  ! Check the input atmosphere if required
553  IF ( check_input ) THEN
554  IF ( .NOT. crtm_atmosphere_isvalid( atmosphere(m) ) ) THEN
555  error_status = failure
556  WRITE( message,'("Input data check failed for profile #",i0)' ) m
557  CALL display_message( routine_name, message, error_status )
558  RETURN
559  END IF
560  END IF
561 
562 
563  ! Check the RTSolution layer dimensions
564  IF ( any(rtsolution(:,m)%n_Layers < atmosphere(m)%n_Layers) .OR. &
565  any(rtsolution_tl(:,m)%n_Layers < atmosphere(m)%n_Layers) ) THEN
566  error_status=failure
567  WRITE( message,'("Number of RTSolution layers < Atmosphere for profile #",i0)' ) m
568  CALL display_message( routine_name, message, error_status )
569  RETURN
570  END IF
571 
572 
573  ! Allocate AtmOptics based on Atmosphere dimensions
574  CALL crtm_atmoptics_create( atmoptics, &
575  atmosphere(m)%n_Layers, &
576  max_n_legendre_terms , &
577  max_n_phase_elements )
578  CALL crtm_atmoptics_create( atmoptics_tl, &
579  atmosphere(m)%n_Layers, &
580  max_n_legendre_terms , &
581  max_n_phase_elements )
582  IF ( .NOT. crtm_atmoptics_associated( atmoptics ) .OR. &
583  .NOT. crtm_atmoptics_associated( atmoptics_tl ) ) THEN
584  error_status = failure
585  WRITE( message,'("Error allocating AtmOptics data structures for profile #",i0)' ) m
586  CALL display_message( routine_name, message, error_status )
587  RETURN
588  END IF
589  ! ...Set default number of streams
590  atmoptics%n_Legendre_Terms = 4
591  atmoptics_tl%n_Legendre_Terms = atmoptics%n_Legendre_Terms
592 
593 
594  ! Allocate the aerosol scattering internal variable if necessary
595  IF ( atmosphere(m)%n_Aerosols > 0 ) THEN
596  CALL asvar_create( asvar, &
597  max_n_legendre_terms , &
598  max_n_phase_elements , &
599  atmosphere(m)%n_Layers , &
600  atmosphere(m)%n_Aerosols )
601  END IF
602 
603 
604  ! -----------
605  ! SENSOR LOOP
606  ! -----------
607  ! Initialise channel counter for channel(l)/sensor(n) count
608  ln = 0
609 
610  sensor_loop: DO n = 1, n_sensors
611 
612  ! Shorter name
613  sensorindex = channelinfo(n)%Sensor_Index
614 
615 
616  ! ------------
617  ! CHANNEL LOOP
618  ! ------------
619  channel_loop: DO l = 1, channelinfo(n)%n_Channels
620 
621  ! Channel setup
622  ! ...Skip channel if requested
623  IF ( .NOT. channelinfo(n)%Process_Channel(l) ) cycle channel_loop
624  ! ...Shorter name
625  channelindex = channelinfo(n)%Channel_Index(l)
626  ! ...Increment the processed channel counter
627  ln = ln + 1
628  ! ...Assign sensor+channel information to output
629  rtsolution(ln,m)%Sensor_Id = channelinfo(n)%Sensor_Id
630  rtsolution(ln,m)%WMO_Satellite_Id = channelinfo(n)%WMO_Satellite_Id
631  rtsolution(ln,m)%WMO_Sensor_Id = channelinfo(n)%WMO_Sensor_Id
632  rtsolution(ln,m)%Sensor_Channel = channelinfo(n)%Sensor_Channel(l)
633  rtsolution_tl(ln,m)%Sensor_Id = rtsolution(ln,m)%Sensor_Id
634  rtsolution_tl(ln,m)%WMO_Satellite_Id = rtsolution(ln,m)%WMO_Satellite_Id
635  rtsolution_tl(ln,m)%WMO_Sensor_Id = rtsolution(ln,m)%WMO_Sensor_Id
636  rtsolution_tl(ln,m)%Sensor_Channel = rtsolution(ln,m)%Sensor_Channel
637 
638 
639  ! Initialisations
640  CALL crtm_atmoptics_zero( atmoptics )
641  CALL crtm_atmoptics_zero( atmoptics_tl )
642 
643 
644  ! Compute the aerosol absorption/scattering properties
645  IF ( atmosphere(m)%n_Aerosols > 0 ) THEN
646  status_fwd = crtm_compute_aerosolscatter( atmosphere(m), & ! Input
647  sensorindex , & ! Input
648  channelindex , & ! Input
649  atmoptics , & ! In/Output
650  asvar ) ! Internal variable output
651  status_tl = crtm_compute_aerosolscatter_tl( atmosphere(m) , & ! FWD Input
652  atmoptics , & ! FWD Input
653  atmosphere_tl(m), & ! TL Input
654  sensorindex , & ! Input
655  channelindex , & ! Input
656  atmoptics_tl , & ! TL Output
657  asvar ) ! Internal variable
658  IF ( status_fwd /= success .OR. status_tl /= success) THEN
659  error_status = failure
660  WRITE( message,'("Error computing AerosolScatter for ",a,&
661  &", channel ",i0,", profile #",i0)' ) &
662  trim(channelinfo(n)%Sensor_ID), channelinfo(n)%Sensor_Channel(l), m
663  CALL display_message( routine_name, trim(message), error_status )
664  RETURN
665  END IF
666 
667  END IF
668 
669  ! Save the nadir optical depths
670  rtsolution(ln,m)%Layer_Optical_Depth(1:atmosphere(m)%n_Layers) = atmoptics%Optical_Depth
671  rtsolution_tl(ln,m)%Layer_Optical_Depth(1:atmosphere(m)%n_Layers) = atmoptics_tl%Optical_Depth
672 
673  END DO channel_loop
674 
675  END DO sensor_loop
676 
677 
678  ! Deallocate local sensor independent data structures
679  CALL crtm_atmoptics_destroy( atmoptics )
680  CALL crtm_atmoptics_destroy( atmoptics_tl )
681 
682  END DO profile_loop
683 
684  END FUNCTION crtm_aod_tl
685 
686 
687 !--------------------------------------------------------------------------------
688 !:sdoc+:
689 !
690 ! NAME:
691 ! CRTM_AOD_AD
692 !
693 ! PURPOSE:
694 ! Function that calculates the adjoint nadir aerosol optical depth.
695 !
696 ! CALLING SEQUENCE:
697 ! Error_Status = CRTM_AOD_AD( Atmosphere , &
698 ! RTSolution_AD , &
699 ! ChannelInfo , &
700 ! RTSolution , &
701 ! Atmosphere_AD , &
702 ! Options = Options )
703 !
704 ! INPUTS:
705 ! Atmosphere: Structure containing the Atmosphere data.
706 ! UNITS: N/A
707 ! TYPE: CRTM_Atmosphere_type
708 ! DIMENSION: Rank-1 (n_Profiles)
709 ! ATTRIBUTES: INTENT(IN)
710 !
711 ! RTSolution_AD: Structure containing the RT solution adjoint inputs.
712 ! **NOTE: On EXIT from this function, the contents of
713 ! this structure may be modified (e.g. set to
714 ! zero.)
715 ! UNITS: N/A
716 ! TYPE: CRTM_RTSolution_type
717 ! DIMENSION: Rank-2 (n_Channels x n_Profiles)
718 ! ATTRIBUTES: INTENT(IN OUT)
719 !
720 ! ChannelInfo: Structure returned from the CRTM_Init() function
721 ! that contains the satellite/sensor channel index
722 ! information.
723 ! UNITS: N/A
724 ! TYPE: CRTM_ChannelInfo_type
725 ! DIMENSION: Rank-1 (n_Sensors)
726 ! ATTRIBUTES: INTENT(IN)
727 !
728 ! OUTPUTS:
729 ! RTSolution: Structure containing the soluition to the RT equation
730 ! for the given inputs.
731 ! UNITS: N/A
732 ! TYPE: CRTM_RTSolution_type
733 ! DIMENSION: Rank-2 (n_Channels x n_Profiles)
734 ! ATTRIBUTES: INTENT(IN OUT)
735 !
736 ! Atmosphere_AD: Structure containing the adjoint Atmosphere data.
737 ! **NOTE: On ENTRY to this function, the contents of
738 ! this structure should be defined (e.g.
739 ! initialized to some value based on the
740 ! position of this function in the call chain.)
741 ! UNITS: N/A
742 ! TYPE: CRTM_Atmosphere_type
743 ! DIMENSION: Same as input Atmosphere argument
744 ! ATTRIBUTES: INTENT(IN OUT)
745 !
746 ! OPTIONAL INPUTS:
747 ! Options: Options structure containing the optional arguments
748 ! for the CRTM.
749 ! UNITS: N/A
750 ! TYPE: CRTM_Options_type
751 ! DIMENSION: Same as input Atmosphere structure
752 ! ATTRIBUTES: INTENT(IN), OPTIONAL
753 !
754 ! FUNCTION RESULT:
755 ! Error_Status: The return value is an integer defining the error status.
756 ! The error codes are defined in the Message_Handler module.
757 ! If == SUCCESS the computation was sucessful
758 ! == FAILURE an unrecoverable error occurred
759 ! UNITS: N/A
760 ! TYPE: INTEGER
761 ! DIMENSION: Scalar
762 !
763 ! COMMENTS:
764 ! - Many of the components of the Options optional input structure
765 ! are not used in this function. Consult the CRTM User Guide for
766 ! which Options components are usable for AOD calculations.
767 !
768 !:sdoc-:
769 !--------------------------------------------------------------------------------
770 
771  FUNCTION crtm_aod_ad( &
772  Atmosphere , & ! Input, M
773  RTSolution_AD, & ! Input, M
774  ChannelInfo , & ! Input, M
775  RTSolution , & ! Output, L x M
776  Atmosphere_AD, & ! Output, L x M
777  Options ) & ! Optional input, M
778  result( error_status )
779  ! Arguments
780  TYPE(crtm_atmosphere_type), INTENT(IN) :: atmosphere(:) ! M
781  TYPE(crtm_rtsolution_type), INTENT(IN OUT) :: rtsolution_ad(:,:) ! L x M
782  TYPE(crtm_channelinfo_type), INTENT(IN) :: channelinfo(:) ! n_Sensors
783  TYPE(crtm_rtsolution_type), INTENT(IN OUT) :: rtsolution(:,:) ! L x M
784  TYPE(crtm_atmosphere_type), INTENT(IN OUT) :: atmosphere_ad(:) ! M
785  TYPE(crtm_options_type), OPTIONAL, INTENT(IN) :: options(:) ! M
786  ! Function result
787  INTEGER :: error_status
788  ! Local parameters
789  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_AOD_AD'
790  ! Local variables
791  CHARACTER(ML) :: message
792  LOGICAL :: options_present
793  LOGICAL :: check_input
794  INTEGER :: status_fwd, status_ad
795  INTEGER :: n, n_sensors, sensorindex
796  INTEGER :: l, n_channels, channelindex
797  INTEGER :: m, n_profiles
798  INTEGER :: na
799  INTEGER :: ln
800  ! Component variables
801  TYPE(crtm_atmoptics_type) :: atmoptics, atmoptics_ad
802  TYPE(asvar_type) :: asvar
803 
804 
805  ! ------
806  ! SET UP
807  ! ------
808  error_status = success
809 
810 
811  ! If no sensors or channels, simply return
812  n_sensors = SIZE(channelinfo)
813  n_channels = sum(crtm_channelinfo_n_channels(channelinfo))
814  IF ( n_sensors == 0 .OR. n_channels == 0 ) RETURN
815 
816 
817  ! Check the number of channels
818  IF ( SIZE(rtsolution, dim=1) < n_channels .OR. &
819  SIZE(rtsolution_ad,dim=1) < n_channels ) THEN
820  error_status = failure
821  WRITE( message,'("Output RTSolution structure arrays too small (",i0,&
822  &") to hold results for the number of requested channels (",i0,")")') &
823  SIZE(rtsolution,dim=1), n_channels
824  CALL display_message( routine_name, message, error_status )
825  RETURN
826  END IF
827 
828 
829  ! Check the number of profiles
830  n_profiles = SIZE(atmosphere)
831  ! ...Check the profile dimensionality of the other mandatory arguments
832  IF ( SIZE(atmosphere_ad) /= n_profiles .OR. &
833  SIZE(rtsolution, dim=2) /= n_profiles .OR. &
834  SIZE(rtsolution_ad,dim=2) /= n_profiles ) THEN
835  error_status = failure
836  message = 'Inconsistent profile dimensionality for input arguments.'
837  CALL display_message( routine_name, trim(message), error_status )
838  RETURN
839  END IF
840  ! ...Check the profile dimensionality of the other optional arguments
841  options_present = PRESENT(options)
842  IF ( options_present ) THEN
843  IF ( SIZE(options) /= n_profiles ) THEN
844  error_status = failure
845  message = 'Inconsistent profile dimensionality for Options optional input argument.'
846  CALL display_message( routine_name, message, error_status )
847  RETURN
848  END IF
849  END IF
850 
851 
852  ! Check the RTSolution structures have been allocated
853  IF ( any(.NOT. crtm_rtsolution_associated(rtsolution)) .OR. &
854  any(.NOT. crtm_rtsolution_associated(rtsolution_ad)) ) THEN
855  error_status = failure
856  message = 'RTSolution output structure components have not been allocated'
857  CALL display_message( routine_name, message, error_status )
858  RETURN
859  END IF
860 
861 
862  ! ------------
863  ! PROFILE LOOP
864  ! ------------
865  profile_loop: DO m = 1, n_profiles
866 
867 
868  ! Check the aerosol coeff. data for cases with aerosols
869  IF( atmosphere(m)%n_Aerosols > 0 .AND. .NOT. crtm_aerosolcoeff_isloaded() )THEN
870  error_status = failure
871  WRITE( message,'("The AerosolCoeff data must be loaded (with CRTM_Init routine) ", &
872  &"for the aerosol case profile #",i0)' ) m
873  CALL display_message( routine_name, message, error_status )
874  RETURN
875  END IF
876 
877 
878  ! Check the optional Options structure argument
879  check_input = .true.
880  IF (options_present) THEN
881  check_input = options(m)%Check_Input
882  END IF
883 
884 
885  ! Check the input atmosphere if required
886  IF ( check_input ) THEN
887  IF ( .NOT. crtm_atmosphere_isvalid( atmosphere(m) ) ) THEN
888  error_status = failure
889  WRITE( message,'("Input data check failed for profile #",i0)' ) m
890  CALL display_message( routine_name, message, error_status )
891  RETURN
892  END IF
893  END IF
894 
895 
896  ! Check the RTSolution layer dimensions
897  IF ( any(rtsolution(:,m)%n_Layers < atmosphere(m)%n_Layers) .OR. &
898  any(rtsolution_ad(:,m)%n_Layers < atmosphere(m)%n_Layers) ) THEN
899  error_status=failure
900  WRITE( message,'("Number of RTSolution layers < Atmosphere for profile #",i0)' ) m
901  CALL display_message( routine_name, message, error_status )
902  RETURN
903  END IF
904 
905 
906  ! Allocate AtmOptics based on Atmosphere dimensions
907  CALL crtm_atmoptics_create( atmoptics, &
908  atmosphere(m)%n_Layers, &
909  max_n_legendre_terms , &
910  max_n_phase_elements )
911  CALL crtm_atmoptics_create( atmoptics_ad, &
912  atmosphere(m)%n_Layers, &
913  max_n_legendre_terms , &
914  max_n_phase_elements )
915  IF ( .NOT. crtm_atmoptics_associated( atmoptics ) .OR. &
916  .NOT. crtm_atmoptics_associated( atmoptics_ad ) ) THEN
917  error_status = failure
918  WRITE( message,'("Error allocating AtmOptics data structures for profile #",i0)' ) m
919  CALL display_message( routine_name, message, error_status )
920  RETURN
921  END IF
922  ! ...Set default number of streams
923  atmoptics%n_Legendre_Terms = 4
924  atmoptics_ad%n_Legendre_Terms = atmoptics%n_Legendre_Terms
925 
926 
927  ! Allocate the aerosol scattering internal variable if necessary
928  IF ( atmosphere(m)%n_Aerosols > 0 ) THEN
929  CALL asvar_create( asvar, &
930  max_n_legendre_terms , &
931  max_n_phase_elements , &
932  atmosphere(m)%n_Layers , &
933  atmosphere(m)%n_Aerosols )
934  END IF
935 
936 
937  ! Copy over atmosphere info to adjoint output
938  ! ...Climatology
939  atmosphere_ad(m)%Climatology = atmosphere(m)%Climatology
940  ! ...Absorber info
941  atmosphere_ad(m)%Absorber_Id = atmosphere(m)%Absorber_Id
942  atmosphere_ad(m)%Absorber_Units = atmosphere(m)%Absorber_Units
943  ! ...Aerosol info
944  DO na = 1, atmosphere(m)%n_Aerosols
945  atmosphere_ad(m)%Aerosol(na)%Type = atmosphere(m)%Aerosol(na)%Type
946  END DO
947 
948 
949  ! -----------
950  ! SENSOR LOOP
951  ! -----------
952  ! Initialise channel counter for sensor(n)/channel(l) count
953  ln = 0
954 
955  sensor_loop: DO n = 1, n_sensors
956 
957 
958  ! Shorter name
959  sensorindex = channelinfo(n)%Sensor_Index
960 
961 
962  ! ------------
963  ! CHANNEL LOOP
964  ! ------------
965  channel_loop: DO l = 1, channelinfo(n)%n_Channels
966 
967  ! Channel setup
968  ! ...Skip channel if requested
969  IF ( .NOT. channelinfo(n)%Process_Channel(l) ) cycle channel_loop
970  ! ...Shorter name
971  channelindex = channelinfo(n)%Channel_Index(l)
972  ! ...Increment the processed channel counter
973  ln = ln + 1
974  ! ...Assign sensor+channel information to output
975  rtsolution(ln,m)%Sensor_Id = channelinfo(n)%Sensor_Id
976  rtsolution(ln,m)%WMO_Satellite_Id = channelinfo(n)%WMO_Satellite_Id
977  rtsolution(ln,m)%WMO_Sensor_Id = channelinfo(n)%WMO_Sensor_Id
978  rtsolution(ln,m)%Sensor_Channel = channelinfo(n)%Sensor_Channel(l)
979  rtsolution_ad(ln,m)%Sensor_Id = rtsolution(ln,m)%Sensor_Id
980  rtsolution_ad(ln,m)%WMO_Satellite_Id = rtsolution(ln,m)%WMO_Satellite_Id
981  rtsolution_ad(ln,m)%WMO_Sensor_Id = rtsolution(ln,m)%WMO_Sensor_Id
982  rtsolution_ad(ln,m)%Sensor_Channel = rtsolution(ln,m)%Sensor_Channel
983 
984 
985  ! Initialisations
986  CALL crtm_atmoptics_zero( atmoptics )
987  CALL crtm_atmoptics_zero( atmoptics_ad )
988  atmoptics_ad%Optical_Depth = rtsolution_ad(ln,m)%Layer_Optical_Depth(1:atmosphere(m)%n_Layers)
989 
990 
991  ! Compute the aerosol absorption/scattering properties
992  IF ( atmosphere(m)%n_Aerosols > 0 ) THEN
993  status_fwd = crtm_compute_aerosolscatter( atmosphere(m), & ! Input
994  sensorindex , & ! Input
995  channelindex , & ! Input
996  atmoptics , & ! In/Output
997  asvar ) ! Internal variable output
998  status_ad = crtm_compute_aerosolscatter_ad( atmosphere(m) , & ! FWD Input
999  atmoptics , & ! FWD Input
1000  atmoptics_ad , & ! AD Input
1001  sensorindex , & ! Input
1002  channelindex , & ! Input
1003  atmosphere_ad(m), & ! AD Output
1004  asvar ) ! Internal variable input
1005  IF ( status_fwd /= success .OR. status_ad /= success) THEN
1006  error_status = failure
1007  WRITE( message,'("Error computing AerosolScatter for ",a,&
1008  &", channel ",i0,", profile #",i0)' ) &
1009  trim(channelinfo(n)%Sensor_ID), channelinfo(n)%Sensor_Channel(l), m
1010  CALL display_message( routine_name, message, error_status )
1011  RETURN
1012  END IF
1013  END IF
1014 
1015 
1016  ! Save the nadir optical depths
1017  rtsolution(ln,m)%Layer_Optical_Depth(1:atmosphere(m)%n_Layers) = atmoptics%Optical_Depth
1018 
1019  END DO channel_loop
1020 
1021  END DO sensor_loop
1022 
1023 
1024  ! Deallocate local sensor independent data structures
1025  CALL crtm_atmoptics_destroy( atmoptics )
1026  CALL crtm_atmoptics_destroy( atmoptics_ad )
1027 
1028  END DO profile_loop
1029 
1030  END FUNCTION crtm_aod_ad
1031 
1032 
1033 !--------------------------------------------------------------------------------
1034 !:sdoc+:
1035 !
1036 ! NAME:
1037 ! CRTM_AOD_K
1038 !
1039 ! PURPOSE:
1040 ! Function that calculates the K-matrix nadir aerosol optical depth.
1041 !
1042 ! CALLING SEQUENCE:
1043 ! Error_Status = CRTM_AOD_K( Atmosphere , &
1044 ! RTSolution_K , &
1045 ! ChannelInfo , &
1046 ! RTSolution , &
1047 ! Atmosphere_K , &
1048 ! Opttions = Options )
1049 !
1050 ! INPUTS:
1051 ! Atmosphere: Structure containing the Atmosphere data.
1052 ! UNITS: N/A
1053 ! TYPE: CRTM_Atmosphere_type
1054 ! DIMENSION: Rank-1 (n_Profiles)
1055 ! ATTRIBUTES: INTENT(IN)
1056 !
1057 ! RTSolution_K: Structure containing the aerosol optical depth
1058 ! profile K-matrix input.
1059 ! **NOTE: On EXIT from this function, the contents of
1060 ! this structure may be modified (e.g. set to
1061 ! zero.)
1062 ! UNITS: N/A
1063 ! TYPE: CRTM_RTSolution_type
1064 ! DIMENSION: Rank-2 (n_Channels x n_Profiles)
1065 ! ATTRIBUTES: INTENT(IN OUT)
1066 !
1067 ! ChannelInfo: Structure returned from the CRTM_Init() function
1068 ! that contains the satellite/sensor channel index
1069 ! information.
1070 ! UNITS: N/A
1071 ! TYPE: CRTM_ChannelInfo_type
1072 ! DIMENSION: Rank-1 (n_Sensors)
1073 ! ATTRIBUTES: INTENT(IN)
1074 !
1075 ! OUTPUTS:
1076 ! RTSolution: Structure containing the layer aerosol optical
1077 ! depth profile for the given inputs.
1078 ! UNITS: N/A
1079 ! TYPE: CRTM_RTSolution_type
1080 ! DIMENSION: Rank-2 (n_Channels x n_Profiles)
1081 ! ATTRIBUTES: INTENT(IN OUT)
1082 !
1083 ! Atmosphere_K: Structure containing the K-matrix Atmosphere data.
1084 ! **NOTE: On ENTRY to this function, the contents of
1085 ! this structure should be defined (e.g.
1086 ! initialized to some value based on the
1087 ! position of this function in the call chain.)
1088 ! UNITS: N/A
1089 ! TYPE: CRTM_Atmosphere_type
1090 ! DIMENSION: Same as input RTSolution_K argument
1091 ! ATTRIBUTES: INTENT(IN OUT)
1092 !
1093 ! OPTIONAL INPUTS:
1094 ! Options: Options structure containing the optional arguments
1095 ! for the CRTM.
1096 ! UNITS: N/A
1097 ! TYPE: CRTM_Options_type
1098 ! DIMENSION: Same as input Atmosphere structure
1099 ! ATTRIBUTES: INTENT(IN), OPTIONAL
1100 !
1101 ! FUNCTION RESULT:
1102 ! Error_Status: The return value is an integer defining the error status.
1103 ! The error codes are defined in the Message_Handler module.
1104 ! If == SUCCESS the computation was sucessful
1105 ! == FAILURE an unrecoverable error occurred
1106 ! UNITS: N/A
1107 ! TYPE: INTEGER
1108 ! DIMENSION: Scalar
1109 !
1110 ! COMMENTS:
1111 ! - Many of the components of the Options optional input structure
1112 ! are not used in this function. Consult the CRTM User Guide for
1113 ! which Options components are usable for AOD calculations.
1114 !
1115 !:sdoc-:
1116 !--------------------------------------------------------------------------------
1117 
1118  FUNCTION crtm_aod_k ( &
1119  Atmosphere , & ! Input, M
1120  RTSolution_K, & ! Input, M
1121  ChannelInfo , & ! Input, M
1122  RTSolution , & ! Output, L x M
1123  Atmosphere_K, & ! Output, L x M
1124  Options ) & ! Optional input, M
1125  result( error_status )
1126  ! Arguments
1127  TYPE(crtm_atmosphere_type), INTENT(IN) :: atmosphere(:) ! M
1128  TYPE(crtm_rtsolution_type), INTENT(IN OUT) :: rtsolution_k(:,:) ! L x M
1129  TYPE(crtm_channelinfo_type), INTENT(IN) :: channelinfo(:) ! n_Sensors
1130  TYPE(crtm_rtsolution_type), INTENT(IN OUT) :: rtsolution(:,:) ! L x M
1131  TYPE(crtm_atmosphere_type), INTENT(IN OUT) :: atmosphere_k(:,:) ! L x M
1132  TYPE(crtm_options_type), OPTIONAL, INTENT(IN) :: options(:) ! M
1133  ! Function result
1134  INTEGER :: error_status
1135  ! Local parameters
1136  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_AOD_K'
1137  ! Local variables
1138  CHARACTER(ML) :: message
1139  LOGICAL :: options_present
1140  LOGICAL :: check_input
1141  INTEGER :: status_fwd, status_k
1142  INTEGER :: n, n_sensors, sensorindex
1143  INTEGER :: l, n_channels, channelindex
1144  INTEGER :: m, n_profiles
1145  INTEGER :: na
1146  INTEGER :: ln
1147  ! Component variables
1148  TYPE(crtm_atmoptics_type) :: atmoptics, atmoptics_k
1149  TYPE(asvar_type) :: asvar
1150 
1151 
1152  ! ------
1153  ! SET UP
1154  ! ------
1155  error_status = success
1156 
1157 
1158  ! If no sensors or channels, simply return
1159  n_sensors = SIZE(channelinfo)
1160  n_channels = sum(crtm_channelinfo_n_channels(channelinfo))
1161  IF ( n_sensors == 0 .OR. n_channels == 0 ) RETURN
1162 
1163 
1164  ! Check spectral arrays
1165  IF ( SIZE(rtsolution ,dim=1) < n_channels .OR. &
1166  SIZE(atmosphere_k,dim=1) < n_channels .OR. &
1167  SIZE(rtsolution_k,dim=1) < n_channels ) THEN
1168  error_status = failure
1169  WRITE( message,'("RTSolution and K-matrix (Atm,RT) structure arrays too small (",&
1170  &2(i0,","),i0,") for the number of requested channels (",i0,")")') &
1171  SIZE(rtsolution ,dim=1), &
1172  SIZE(atmosphere_k,dim=1), &
1173  SIZE(rtsolution_k,dim=1), &
1174  n_channels
1175  CALL display_message( routine_name, message, error_status )
1176  RETURN
1177  END IF
1178 
1179 
1180  ! Check the number of profiles
1181  ! ...Number of atmospheric profiles.
1182  n_profiles = SIZE(atmosphere)
1183  ! ...Check the profile dimensionality of the other mandatory arguments
1184  IF ( SIZE(rtsolution_k,dim=2) /= n_profiles .OR. &
1185  SIZE(atmosphere_k,dim=2) /= n_profiles .OR. &
1186  SIZE(rtsolution ,dim=2) /= n_profiles ) THEN
1187  error_status = failure
1188  message = 'Inconsistent profile dimensionality for input arguments.'
1189  CALL display_message( routine_name, message, error_status )
1190  RETURN
1191  END IF
1192  ! ...Check the profile dimensionality of the other optional arguments
1193  options_present = PRESENT(options)
1194  IF ( options_present ) THEN
1195  IF ( SIZE( options ) /= n_profiles ) THEN
1196  error_status = failure
1197  message = 'Inconsistent profile dimensionality for Options optional input argument.'
1198  CALL display_message( routine_name, message, error_status )
1199  RETURN
1200  END IF
1201  END IF
1202 
1203 
1204  ! Check the RTSolution structures have been allocated
1205  IF ( any(.NOT. crtm_rtsolution_associated(rtsolution)) .OR. &
1206  any(.NOT. crtm_rtsolution_associated(rtsolution_k)) ) THEN
1207  error_status = failure
1208  message = 'RTSolution output structure components have not been allocated'
1209  CALL display_message( routine_name, message, error_status )
1210  RETURN
1211  END IF
1212 
1213 
1214  ! ------------
1215  ! PROFILE LOOP
1216  ! ------------
1217  profile_loop: DO m = 1, n_profiles
1218 
1219 
1220  ! Check the aerosol coeff. data for cases with aerosols
1221  IF( atmosphere(m)%n_Aerosols > 0 .AND. .NOT. crtm_aerosolcoeff_isloaded() )THEN
1222  error_status = failure
1223  WRITE( message,'("The AerosolCoeff data must be loaded (with CRTM_Init routine) ", &
1224  &"for the aerosol case profile #",i0)' ) m
1225  CALL display_message( routine_name, message, error_status )
1226  RETURN
1227  END IF
1228 
1229 
1230  ! Check the optional Options structure argument
1231  check_input = .true.
1232  IF (options_present) THEN
1233  check_input = options(m)%Check_Input
1234  END IF
1235 
1236 
1237  ! Check the input atmosphere if required
1238  IF ( check_input ) THEN
1239  IF ( .NOT. crtm_atmosphere_isvalid( atmosphere(m) ) ) THEN
1240  error_status = failure
1241  WRITE( message,'("Input data check failed for profile #",i0)' ) m
1242  CALL display_message( routine_name, message, error_status )
1243  RETURN
1244  END IF
1245  END IF
1246 
1247 
1248  ! Check the RTSolution layer dimensions
1249  IF ( any(rtsolution(:,m)%n_Layers < atmosphere(m)%n_Layers) .OR. &
1250  any(rtsolution_k(:,m)%n_Layers < atmosphere(m)%n_Layers) ) THEN
1251  error_status=failure
1252  WRITE( message,'("Number of RTSolution layers < Atmosphere for profile #",i0)' ) m
1253  CALL display_message( routine_name, message, error_status )
1254  RETURN
1255  END IF
1256 
1257 
1258  ! Allocate AtmOptics based on Atmosphere dimensions
1259  CALL crtm_atmoptics_create( atmoptics, &
1260  atmosphere(m)%n_Layers, &
1261  max_n_legendre_terms , &
1262  max_n_phase_elements )
1263  CALL crtm_atmoptics_create( atmoptics_k, &
1264  atmosphere(m)%n_Layers, &
1265  max_n_legendre_terms , &
1266  max_n_phase_elements )
1267  IF ( .NOT. crtm_atmoptics_associated( atmoptics ) .OR. &
1268  .NOT. crtm_atmoptics_associated( atmoptics_k ) ) THEN
1269  error_status = failure
1270  WRITE( message,'("Error allocating AtmOptics data structures for profile #",i0)' ) m
1271  CALL display_message( routine_name, message, error_status )
1272  RETURN
1273  END IF
1274  ! ...Set default number of streams
1275  atmoptics%n_Legendre_Terms = 4
1276  atmoptics_k%n_Legendre_Terms = atmoptics%n_Legendre_Terms
1277 
1278 
1279  ! Allocate the aerosol scattering internal variable if necessary
1280  IF ( atmosphere(m)%n_Aerosols > 0 ) THEN
1281  CALL asvar_create( asvar, &
1282  max_n_legendre_terms , &
1283  max_n_phase_elements , &
1284  atmosphere(m)%n_Layers , &
1285  atmosphere(m)%n_Aerosols )
1286  END IF
1287 
1288 
1289  ! -----------
1290  ! SENSOR LOOP
1291  ! -----------
1292  ! Initialise channel counter for sensor(n)/channel(l) count
1293  ln = 0
1294 
1295  sensor_loop: DO n = 1, n_sensors
1296 
1297 
1298  ! Shorter name
1299  sensorindex = channelinfo(n)%Sensor_Index
1300 
1301 
1302  ! ------------
1303  ! CHANNEL LOOP
1304  ! ------------
1305  channel_loop: DO l = 1, channelinfo(n)%n_Channels
1306 
1307  ! Channel setup
1308  ! ...Skip channel if requested
1309  IF ( .NOT. channelinfo(n)%Process_Channel(l) ) cycle channel_loop
1310  ! ...Shorter name
1311  channelindex = channelinfo(n)%Channel_Index(l)
1312  ! ...Increment the processed channel counter
1313  ln = ln + 1
1314  ! ...Assign sensor+channel information to output
1315  rtsolution(ln,m)%Sensor_Id = channelinfo(n)%Sensor_Id
1316  rtsolution(ln,m)%WMO_Satellite_Id = channelinfo(n)%WMO_Satellite_Id
1317  rtsolution(ln,m)%WMO_Sensor_Id = channelinfo(n)%WMO_Sensor_Id
1318  rtsolution(ln,m)%Sensor_Channel = channelinfo(n)%Sensor_Channel(l)
1319  rtsolution_k(ln,m)%Sensor_Id = rtsolution(ln,m)%Sensor_Id
1320  rtsolution_k(ln,m)%WMO_Satellite_Id = rtsolution(ln,m)%WMO_Satellite_Id
1321  rtsolution_k(ln,m)%WMO_Sensor_Id = rtsolution(ln,m)%WMO_Sensor_Id
1322  rtsolution_k(ln,m)%Sensor_Channel = rtsolution(ln,m)%Sensor_Channel
1323 
1324 
1325  ! Copy over atmosphere info to k-matrix output
1326  ! ...Climatology
1327  atmosphere_k(ln,m)%Climatology = atmosphere(m)%Climatology
1328  ! ...Absorber info
1329  atmosphere_k(ln,m)%Absorber_Id = atmosphere(m)%Absorber_Id
1330  atmosphere_k(ln,m)%Absorber_Units = atmosphere(m)%Absorber_Units
1331  ! ...Aerosol info
1332  DO na = 1, atmosphere(m)%n_Aerosols
1333  atmosphere_k(ln,m)%Aerosol(na)%Type = atmosphere(m)%Aerosol(na)%Type
1334  END DO
1335 
1336 
1337  ! Initialisations
1338  CALL crtm_atmoptics_zero( atmoptics )
1339  CALL crtm_atmoptics_zero( atmoptics_k )
1340  atmoptics_k%Optical_Depth = rtsolution_k(ln,m)%Layer_Optical_Depth(1:atmosphere(m)%n_Layers)
1341 
1342 
1343  ! Compute the aerosol absorption/scattering properties
1344  IF ( atmosphere(m)%n_Aerosols > 0 ) THEN
1345  status_fwd = crtm_compute_aerosolscatter( atmosphere(m), & ! Input
1346  sensorindex , & ! Input
1347  channelindex , & ! Input
1348  atmoptics , & ! In/Output
1349  asvar ) ! Internal variable output
1350  status_k = crtm_compute_aerosolscatter_ad( atmosphere(m) , & ! FWD Input
1351  atmoptics , & ! FWD Input
1352  atmoptics_k , & ! AD Input
1353  sensorindex , & ! Input
1354  channelindex , & ! Input
1355  atmosphere_k(ln,m), & ! AD Output
1356  asvar ) ! Internal variable input
1357  IF ( status_fwd /= success .OR. status_k /= success) THEN
1358  error_status = failure
1359  WRITE( message,'("Error computing AerosolScatter for ",a,&
1360  &", channel ",i0,", profile #",i0)' ) &
1361  trim(channelinfo(n)%Sensor_ID), channelinfo(n)%Sensor_Channel(l), m
1362  CALL display_message( routine_name, message, error_status )
1363  RETURN
1364  END IF
1365  END IF
1366 
1367 
1368  ! Save the nadir optical depths
1369  rtsolution(ln,m)%Layer_Optical_Depth(1:atmosphere(m)%n_Layers) = atmoptics%Optical_Depth
1370 
1371  END DO channel_loop
1372 
1373  END DO sensor_loop
1374 
1375 
1376  ! Deallocate local sensor independent data structures
1377  CALL crtm_atmoptics_destroy( atmoptics )
1378  CALL crtm_atmoptics_destroy( atmoptics_k )
1379 
1380  END DO profile_loop
1381 
1382  END FUNCTION crtm_aod_k
1383 
1384 
1385 !--------------------------------------------------------------------------------
1386 !:sdoc+:
1387 !
1388 ! NAME:
1389 ! CRTM_AOD_Version
1390 !
1391 ! PURPOSE:
1392 ! Subroutine to return the module version information.
1393 !
1394 ! CALLING SEQUENCE:
1395 ! CALL CRTM_AOD_Version( Id )
1396 !
1397 ! OUTPUTS:
1398 ! Id: Character string containing the version Id information
1399 ! for the module.
1400 ! UNITS: N/A
1401 ! TYPE: CHARACTER(*)
1402 ! DIMENSION: Scalar
1403 ! ATTRIBUTES: INTENT(OUT)
1404 !
1405 !:sdoc-:
1406 !--------------------------------------------------------------------------------
1407 
1408  SUBROUTINE crtm_aod_version( Id )
1409  CHARACTER(*), INTENT(OUT) :: id
1410  id = module_version_id
1411  END SUBROUTINE crtm_aod_version
1412 
1413 END MODULE crtm_aod_module
crtm_aerosolscatter::crtm_compute_aerosolscatter_ad
integer function, public crtm_compute_aerosolscatter_ad(Atm, AScat, AScat_AD, SensorIndex, ChannelIndex, Atm_AD, ASV)
Definition: CRTM_AerosolScatter.f90:628
crtm_aerosolcoeff::crtm_aerosolcoeff_isloaded
logical function, public crtm_aerosolcoeff_isloaded()
Definition: CRTM_AerosolCoeff.f90:297
crtm_aerosolscatter
Definition: CRTM_AerosolScatter.f90:16
message_handler::failure
integer, parameter, public failure
Definition: Message_Handler.f90:30
crtm_aod_module::crtm_aod_tl
integer function, public crtm_aod_tl(Atmosphere, Atmosphere_TL, ChannelInfo, RTSolution, RTSolution_TL, Options)
Definition: CRTM_AOD_Module.f90:447
crtm_aod_module::ml
integer, parameter ml
Definition: CRTM_AOD_Module.f90:74
crtm_aod_module::crtm_aod_ad
integer function, public crtm_aod_ad(Atmosphere, RTSolution_AD, ChannelInfo, RTSolution, Atmosphere_AD, Options)
Definition: CRTM_AOD_Module.f90:779
crtm_parameters::zero
real(fp), parameter, public zero
Definition: CRTM_Parameters.f90:70
crtm_parameters::max_n_phase_elements
integer, parameter, public max_n_phase_elements
Definition: CRTM_Parameters.f90:259
crtm_channelinfo_define
Definition: CRTM_ChannelInfo_Define.f90:13
crtm_atmoptics_define
Definition: CRTM_AtmOptics_Define.f90:12
crtm_aerosolscatter::crtm_compute_aerosolscatter_tl
integer function, public crtm_compute_aerosolscatter_tl(Atm, AScat, Atm_TL, SensorIndex, ChannelIndex, AScat_TL, ASV)
Definition: CRTM_AerosolScatter.f90:422
crtm_aod_module::crtm_aod_version
subroutine, public crtm_aod_version(Id)
Definition: CRTM_AOD_Module.f90:1409
crtm_parameters
Definition: CRTM_Parameters.f90:12
asvar_define::asvar_type
Definition: ASvar_Define.f90:106
crtm_atmosphere_define::crtm_atmosphere_isvalid
logical function, public crtm_atmosphere_isvalid(Atm)
Definition: CRTM_Atmosphere_Define.f90:797
crtm_atmoptics_define::crtm_atmoptics_destroy
elemental subroutine, public crtm_atmoptics_destroy(self)
Definition: CRTM_AtmOptics_Define.f90:196
crtm_parameters::max_n_legendre_terms
integer, parameter, public max_n_legendre_terms
Definition: CRTM_Parameters.f90:258
message_handler
Definition: Message_Handler.f90:4
crtm_atmoptics_define::crtm_atmoptics_associated
elemental logical function, public crtm_atmoptics_associated(self)
Definition: CRTM_AtmOptics_Define.f90:167
crtm_atmoptics_define::crtm_atmoptics_zero
elemental subroutine, public crtm_atmoptics_zero(self)
Definition: CRTM_AtmOptics_Define.f90:352
crtm_aerosolscatter::crtm_compute_aerosolscatter
integer function, public crtm_compute_aerosolscatter(Atm, SensorIndex, ChannelIndex, AScat, ASV)
Definition: CRTM_AerosolScatter.f90:182
crtm_aod_module
Definition: CRTM_AOD_Module.f90:13
crtm_options_define
Definition: CRTM_Options_Define.f90:13
crtm_aod_module::crtm_aod
integer function, public crtm_aod(Atmosphere, ChannelInfo, RTSolution, Options)
Definition: CRTM_AOD_Module.f90:149
crtm_rtsolution_define::crtm_rtsolution_associated
elemental logical function, public crtm_rtsolution_associated(RTSolution)
Definition: CRTM_RTSolution_Define.f90:195
message_handler::display_message
recursive subroutine, public display_message(Routine_Name, Message, Error_State, Message_Log)
Definition: Message_Handler.f90:118
asvar_define::asvar_destroy
elemental subroutine, public asvar_destroy(self)
Definition: ASvar_Define.f90:148
crtm_channelinfo_define::crtm_channelinfo_type
Definition: CRTM_ChannelInfo_Define.f90:74
crtm_atmoptics_define::crtm_atmoptics_create
elemental subroutine, public crtm_atmoptics_create(self, n_Layers, n_Legendre_Terms, n_Phase_Elements)
Definition: CRTM_AtmOptics_Define.f90:266
asvar_define
Definition: ASvar_Define.f90:13
crtm_aod_module::module_version_id
character(*), parameter module_version_id
Definition: CRTM_AOD_Module.f90:71
asvar_define::asvar_associated
elemental logical function, public asvar_associated(self)
Definition: ASvar_Define.f90:141
crtm_rtsolution_define
Definition: CRTM_RTSolution_Define.f90:13
crtm_rtsolution_define::crtm_rtsolution_type
Definition: CRTM_RTSolution_Define.f90:114
crtm_aerosolcoeff
Definition: CRTM_AerosolCoeff.f90:24
crtm_channelinfo_define::crtm_channelinfo_n_channels
elemental integer function, public crtm_channelinfo_n_channels(ChannelInfo)
Definition: CRTM_ChannelInfo_Define.f90:341
crtm_atmosphere_define::crtm_atmosphere_type
Definition: CRTM_Atmosphere_Define.f90:361
crtm_atmosphere_define
Definition: CRTM_Atmosphere_Define.f90:13
asvar_define::asvar_create
elemental subroutine, public asvar_create(self, n_Legendre_Terms, n_Phase_Elements, n_Layers, n_Aerosols)
Definition: ASvar_Define.f90:163
crtm_atmoptics_define::crtm_atmoptics_type
Definition: CRTM_AtmOptics_Define.f90:93
message_handler::success
integer, parameter, public success
Definition: Message_Handler.f90:27
crtm_options_define::crtm_options_type
Definition: CRTM_Options_Define.f90:105
crtm_aod_module::crtm_aod_k
integer function, public crtm_aod_k(Atmosphere, RTSolution_K, ChannelInfo, RTSolution, Atmosphere_K, Options)
Definition: CRTM_AOD_Module.f90:1126