FV3 Bundle
CRTM_Atmosphere_Define.f90
Go to the documentation of this file.
1 !
2 ! CRTM_Atmosphere_Define
3 !
4 ! Module defining the CRTM Atmosphere structure and containing routines to
5 ! manipulate it.
6 !
7 !
8 ! CREATION HISTORY:
9 ! Written by: Paul van Delst, 23-Feb-2004
10 ! paul.vandelst@noaa.gov
11 !
12 
13 MODULE crtm_atmosphere_define
14 
15  ! -----------------
16  ! Environment setup
17  ! -----------------
18  ! Intrinsic modules
19  USE iso_fortran_env , ONLY: output_unit
20  ! Module use
21  USE type_kinds , ONLY: fp
22  USE message_handler , ONLY: success, failure, warning, information, display_message
23  USE compare_float_numbers, ONLY: default_n_sigfig, &
24  OPERATOR(.equalto.), &
25  compares_within_tolerance
26  USE file_utility , ONLY: file_open, file_exists
27  USE binary_file_utility , ONLY: open_binary_file , &
28  writegatts_binary_file, &
29  readgatts_binary_file
30  USE crtm_parameters , ONLY: max_n_layers
31  USE crtm_cloud_define , ONLY: n_valid_cloud_categories, &
32  invalid_cloud, &
33  water_cloud, &
34  ice_cloud, &
35  rain_cloud, &
36  snow_cloud, &
37  graupel_cloud, &
38  hail_cloud, &
39  cloud_category_name, &
40  crtm_cloud_type, &
41  OPERATOR(==), &
42  OPERATOR(+), &
43  OPERATOR(-), &
44  crtm_cloud_categoryname, &
45  crtm_cloud_categoryid, &
46  crtm_cloud_categorylist, &
47  crtm_cloud_associated, &
48  crtm_cloud_destroy, &
49  crtm_cloud_create, &
50  crtm_cloud_addlayercopy, &
51  crtm_cloud_zero, &
52  crtm_cloud_isvalid, &
53  crtm_cloud_inspect, &
54  crtm_cloud_defineversion, &
55  crtm_cloud_compare, &
56  crtm_cloud_setlayers, &
57  crtm_cloud_readfile, &
58  crtm_cloud_writefile
59  USE crtm_aerosol_define , ONLY: n_valid_aerosol_categories, &
60  invalid_aerosol , &
61  dust_aerosol , &
62  seasalt_ssam_aerosol , &
63  seasalt_sscm1_aerosol , &
64  seasalt_sscm2_aerosol , &
65  seasalt_sscm3_aerosol , &
66  organic_carbon_aerosol, &
67  black_carbon_aerosol , &
68  sulfate_aerosol , &
69  aerosol_category_name, &
70  crtm_aerosol_type, &
71  OPERATOR(==), &
72  OPERATOR(+), &
73  OPERATOR(-), &
74  crtm_aerosol_categoryname, &
75  crtm_aerosol_categoryid, &
76  crtm_aerosol_categorylist, &
77  crtm_aerosol_associated, &
78  crtm_aerosol_destroy, &
79  crtm_aerosol_create, &
80  crtm_aerosol_addlayercopy, &
81  crtm_aerosol_zero, &
82  crtm_aerosol_isvalid, &
83  crtm_aerosol_inspect, &
84  crtm_aerosol_defineversion, &
85  crtm_aerosol_compare, &
86  crtm_aerosol_setlayers, &
87  crtm_aerosol_readfile, &
88  crtm_aerosol_writefile
89  ! Disable implicit typing
90  IMPLICIT NONE
91 
92 
93  ! ------------
94  ! Visibilities
95  ! ------------
96  ! Everything private by default
97  PRIVATE
98  ! Operators
99  PUBLIC :: OPERATOR(==)
100  PUBLIC :: OPERATOR(+)
101  PUBLIC :: OPERATOR(-)
102  ! Cloud entities
103  ! ...Parameters
104  PUBLIC :: n_valid_cloud_categories
105  PUBLIC :: invalid_cloud
106  PUBLIC :: water_cloud
107  PUBLIC :: ice_cloud
108  PUBLIC :: rain_cloud
109  PUBLIC :: snow_cloud
110  PUBLIC :: graupel_cloud
111  PUBLIC :: hail_cloud
112  PUBLIC :: cloud_category_name
113  ! ...Structures
114  PUBLIC :: crtm_cloud_type
115  ! ...Procedures
116  PUBLIC :: crtm_cloud_categoryname
117  PUBLIC :: crtm_cloud_categoryid
118  PUBLIC :: crtm_cloud_categorylist
119  PUBLIC :: crtm_cloud_associated
120  PUBLIC :: crtm_cloud_destroy
121  PUBLIC :: crtm_cloud_create
122  PUBLIC :: crtm_cloud_zero
123  PUBLIC :: crtm_cloud_isvalid
124  PUBLIC :: crtm_cloud_inspect
125  PUBLIC :: crtm_cloud_defineversion
126  PUBLIC :: crtm_cloud_setlayers
127  ! Aerosol entities
128  ! ...Parameters
129  PUBLIC :: n_valid_aerosol_categories
130  PUBLIC :: invalid_aerosol
131  PUBLIC :: dust_aerosol
132  PUBLIC :: seasalt_ssam_aerosol
133  PUBLIC :: seasalt_sscm1_aerosol
134  PUBLIC :: seasalt_sscm2_aerosol
135  PUBLIC :: seasalt_sscm3_aerosol
136  PUBLIC :: organic_carbon_aerosol
137  PUBLIC :: black_carbon_aerosol
138  PUBLIC :: sulfate_aerosol
139  PUBLIC :: aerosol_category_name
140  ! ...Structures
141  PUBLIC :: crtm_aerosol_type
142  ! ...Procedures
143  PUBLIC :: crtm_aerosol_categoryname
144  PUBLIC :: crtm_aerosol_categoryid
145  PUBLIC :: crtm_aerosol_categorylist
146  PUBLIC :: crtm_aerosol_associated
147  PUBLIC :: crtm_aerosol_destroy
148  PUBLIC :: crtm_aerosol_create
149  PUBLIC :: crtm_aerosol_zero
150  PUBLIC :: crtm_aerosol_isvalid
151  PUBLIC :: crtm_aerosol_inspect
152  PUBLIC :: crtm_aerosol_defineversion
153  PUBLIC :: crtm_aerosol_setlayers
154  ! Atmosphere entities
155  ! ...Parameters
156  PUBLIC :: n_valid_absorber_ids
157  PUBLIC :: invalid_absorber_id
158  PUBLIC :: h2o_id, co2_id, o3_id, n2o_id, co_id, ch4_id, &
159  o2_id, no_id, so2_id, no2_id, nh3_id, hno3_id, &
160  oh_id, hf_id, hcl_id, hbr_id, hi_id, clo_id, &
161  ocs_id, h2co_id, hocl_id, n2_id, hcn_id, ch3l_id, &
162  h2o2_id, c2h2_id, c2h6_id, ph3_id, cof2_id, sf6_id, &
163  h2s_id, hcooh_id
164  PUBLIC :: absorber_id_name
165  PUBLIC :: n_valid_absorber_units
166  PUBLIC :: invalid_absorber_units
167  PUBLIC :: volume_mixing_ratio_units
168  PUBLIC :: number_density_units
169  PUBLIC :: mass_mixing_ratio_units
170  PUBLIC :: mass_density_units
171  PUBLIC :: partial_pressure_units
172  PUBLIC :: dewpoint_temperature_k_units ! H2O only
173  PUBLIC :: dewpoint_temperature_c_units ! H2O only
174  PUBLIC :: relative_humidity_units ! H2O only
175  PUBLIC :: specific_amount_units
176  PUBLIC :: integrated_path_units
177  PUBLIC :: absorber_units_name
178  PUBLIC :: h2o_only_units_flag
179  PUBLIC :: n_valid_climatology_models
180  PUBLIC :: invalid_model
181  PUBLIC :: tropical
182  PUBLIC :: midlatitude_summer
183  PUBLIC :: midlatitude_winter
184  PUBLIC :: subarctic_summer
185  PUBLIC :: subarctic_winter
186  PUBLIC :: us_standard_atmosphere
187  PUBLIC :: climatology_model_name
188  ! ...Structures
189  PUBLIC :: crtm_atmosphere_type
190  ! ...Procedures
191  PUBLIC :: crtm_atmosphere_associated
192  PUBLIC :: crtm_atmosphere_destroy
193  PUBLIC :: crtm_atmosphere_create
194  PUBLIC :: crtm_atmosphere_addlayercopy
195  PUBLIC :: crtm_atmosphere_zero
196  PUBLIC :: crtm_atmosphere_isvalid
197  PUBLIC :: crtm_atmosphere_inspect
198  PUBLIC :: crtm_atmosphere_defineversion
199  PUBLIC :: crtm_atmosphere_compare
200  PUBLIC :: crtm_atmosphere_setlayers
201  PUBLIC :: crtm_atmosphere_inquirefile
202  PUBLIC :: crtm_atmosphere_readfile
203  PUBLIC :: crtm_atmosphere_writefile
204  ! ...Utilities
205  PUBLIC :: crtm_get_absorberidx
206  PUBLIC :: crtm_get_pressurelevelidx
207 
208 
209  ! -------------------
210  ! Procedure overloads
211  ! -------------------
212  INTERFACE OPERATOR(==)
213  MODULE PROCEDURE crtm_atmosphere_equal
214  END INTERFACE OPERATOR(==)
215 
216  INTERFACE OPERATOR(+)
217  MODULE PROCEDURE crtm_atmosphere_add
218  END INTERFACE OPERATOR(+)
219 
220  INTERFACE OPERATOR(-)
221  MODULE PROCEDURE crtm_atmosphere_subtract
222  END INTERFACE OPERATOR(-)
223 
224  INTERFACE crtm_atmosphere_inspect
225  MODULE PROCEDURE scalar_inspect
226  MODULE PROCEDURE rank1_inspect
227  MODULE PROCEDURE rank2_inspect
228  END INTERFACE crtm_atmosphere_inspect
229 
230  INTERFACE crtm_atmosphere_readfile
231  MODULE PROCEDURE read_atmosphere_rank1
232  MODULE PROCEDURE read_atmosphere_rank2
233  END INTERFACE crtm_atmosphere_readfile
234 
235  INTERFACE crtm_atmosphere_writefile
236  MODULE PROCEDURE write_atmosphere_rank1
237  MODULE PROCEDURE write_atmosphere_rank2
238  END INTERFACE crtm_atmosphere_writefile
239 
240 
241  ! -----------------
242  ! Module parameters
243  ! -----------------
244  CHARACTER(*), PARAMETER :: module_version_id = &
245  '$Id: CRTM_Atmosphere_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
246 
247  ! The absorber IDs. Use HITRAN definitions
248  INTEGER, PARAMETER :: n_valid_absorber_ids = 32
249  INTEGER, PARAMETER :: invalid_absorber_id = 0
250  INTEGER, PARAMETER :: h2o_id = 1
251  INTEGER, PARAMETER :: co2_id = 2
252  INTEGER, PARAMETER :: o3_id = 3
253  INTEGER, PARAMETER :: n2o_id = 4
254  INTEGER, PARAMETER :: co_id = 5
255  INTEGER, PARAMETER :: ch4_id = 6
256  INTEGER, PARAMETER :: o2_id = 7
257  INTEGER, PARAMETER :: no_id = 8
258  INTEGER, PARAMETER :: so2_id = 9
259  INTEGER, PARAMETER :: no2_id = 10
260  INTEGER, PARAMETER :: nh3_id = 11
261  INTEGER, PARAMETER :: hno3_id = 12
262  INTEGER, PARAMETER :: oh_id = 13
263  INTEGER, PARAMETER :: hf_id = 14
264  INTEGER, PARAMETER :: hcl_id = 15
265  INTEGER, PARAMETER :: hbr_id = 16
266  INTEGER, PARAMETER :: hi_id = 17
267  INTEGER, PARAMETER :: clo_id = 18
268  INTEGER, PARAMETER :: ocs_id = 19
269  INTEGER, PARAMETER :: h2co_id = 20
270  INTEGER, PARAMETER :: hocl_id = 21
271  INTEGER, PARAMETER :: n2_id = 22
272  INTEGER, PARAMETER :: hcn_id = 23
273  INTEGER, PARAMETER :: ch3l_id = 24
274  INTEGER, PARAMETER :: h2o2_id = 25
275  INTEGER, PARAMETER :: c2h2_id = 26
276  INTEGER, PARAMETER :: c2h6_id = 27
277  INTEGER, PARAMETER :: ph3_id = 28
278  INTEGER, PARAMETER :: cof2_id = 29
279  INTEGER, PARAMETER :: sf6_id = 30
280  INTEGER, PARAMETER :: h2s_id = 31
281  INTEGER, PARAMETER :: hcooh_id = 32
282  CHARACTER(*), PARAMETER, DIMENSION( 0:N_VALID_ABSORBER_IDS ) :: &
283  absorber_id_name = (/ 'Invalid', &
284  'H2O ', 'CO2 ', 'O3 ', 'N2O ', &
285  'CO ', 'CH4 ', 'O2 ', 'NO ', &
286  'SO2 ', 'NO2 ', 'NH3 ', 'HNO3 ', &
287  'OH ', 'HF ', 'HCl ', 'HBr ', &
288  'HI ', 'ClO ', 'OCS ', 'H2CO ', &
289  'HOCl ', 'N2 ', 'HCN ', 'CH3Cl ', &
290  'H2O2 ', 'C2H2 ', 'C2H6 ', 'PH3 ', &
291  'COF2 ', 'SF6 ', 'H2S ', 'HCOOH ' /)
292 
293  ! The absorber units. Use LBLRTM definitions and then some.
294  INTEGER, PARAMETER :: n_valid_absorber_units = 10
295  INTEGER, PARAMETER :: invalid_absorber_units = 0
296  INTEGER, PARAMETER :: volume_mixing_ratio_units = 1
297  INTEGER, PARAMETER :: number_density_units = 2
298  INTEGER, PARAMETER :: mass_mixing_ratio_units = 3
299  INTEGER, PARAMETER :: mass_density_units = 4
300  INTEGER, PARAMETER :: partial_pressure_units = 5
301  INTEGER, PARAMETER :: dewpoint_temperature_k_units = 6 ! H2O only
302  INTEGER, PARAMETER :: dewpoint_temperature_c_units = 7 ! H2O only
303  INTEGER, PARAMETER :: relative_humidity_units = 8 ! H2O only
304  INTEGER, PARAMETER :: specific_amount_units = 9
305  INTEGER, PARAMETER :: integrated_path_units = 10
306  CHARACTER(*), PARAMETER, DIMENSION( 0:N_VALID_ABSORBER_UNITS ) :: &
307  absorber_units_name = (/ 'Invalid units ', &
308  'Volume mixing ratio, ppmv ', &
309  'Number density, cm^-3 ', &
310  'Mass mixing ratio, g/kg ', &
311  'Mass density, g.m^-3 ', &
312  'Partial pressure, hPa ', &
313  'Dewpoint temperature, K (H2O ONLY)', &
314  'Dewpoint temperature, C (H2O ONLY)', &
315  'Relative humidity, % (H2O ONLY)', &
316  'Specific amount, g/g ', &
317  'Integrated path, mm ' /)
318  INTEGER, PARAMETER, DIMENSION( 0:N_VALID_ABSORBER_UNITS ) :: &
319  h2o_only_units_flag = (/ 0, & ! None
320  0, & ! Volume mixing ratio, ppmv
321  0, & ! Number density, cm^-3
322  0, & ! Mass mixing ratio, g/kg
323  0, & ! Mass density, g.m^-3
324  0, & ! Partial pressure, hPa
325  1, & ! Dewpoint temperature, K (H2O ONLY)
326  1, & ! Dewpoint temperature, C (H2O ONLY)
327  1, & ! Relative humidity, % (H2O ONLY)
328  0, & ! Specific amount, g/g
329  0 /) ! Integrated path, mm
330 
331  ! The climatology models
332  INTEGER, PARAMETER :: n_valid_climatology_models = 6
333  INTEGER, PARAMETER :: invalid_model = 0
334  INTEGER, PARAMETER :: tropical = 1
335  INTEGER, PARAMETER :: midlatitude_summer = 2
336  INTEGER, PARAMETER :: midlatitude_winter = 3
337  INTEGER, PARAMETER :: subarctic_summer = 4
338  INTEGER, PARAMETER :: subarctic_winter = 5
339  INTEGER, PARAMETER :: us_standard_atmosphere = 6
340  CHARACTER(*), PARAMETER, DIMENSION( 0:N_VALID_CLIMATOLOGY_MODELS ) :: &
341  climatology_model_name = (/ 'Invalid ', &
342  'Tropical ', &
343  'Midlatitude summer ', &
344  'Midlatitude winter ', &
345  'Subarctic summer ', &
346  'Subarctic winter ', &
347  'U.S. Standard Atmosphere' /)
348  ! Literal constants
349  REAL(fp), PARAMETER :: zero = 0.0_fp
350  REAL(fp), PARAMETER :: one = 1.0_fp
351  ! Message string length
352  INTEGER, PARAMETER :: ml = 256
353  ! File status on close after write error
354  CHARACTER(*), PARAMETER :: write_error_status = 'DELETE'
355 
356 
357  ! -------------------------------
358  ! Atmosphere structure definition
359  ! -------------------------------
360  !:tdoc+:
361  TYPE :: crtm_atmosphere_type
362  ! Allocation indicator
363  LOGICAL :: is_allocated = .false.
364  ! Dimension values
365  INTEGER :: max_layers = 0 ! K dimension
366  INTEGER :: n_layers = 0 ! Kuse dimension
367  INTEGER :: n_absorbers = 0 ! J dimension
368  INTEGER :: max_clouds = 0 ! Nc dimension
369  INTEGER :: n_clouds = 0 ! NcUse dimension
370  INTEGER :: max_aerosols = 0 ! Na dimension
371  INTEGER :: n_aerosols = 0 ! NaUse dimension
372  ! Number of added layers
373  INTEGER :: n_added_layers = 0
374  ! Climatology model associated with the profile
375  INTEGER :: climatology = us_standard_atmosphere
376  ! Absorber ID and units
377  INTEGER, ALLOCATABLE :: absorber_id(:) ! J
378  INTEGER, ALLOCATABLE :: absorber_units(:) ! J
379  ! Profile LEVEL and LAYER quantities
380  REAL(fp), ALLOCATABLE :: level_pressure(:) ! 0:K
381  REAL(fp), ALLOCATABLE :: pressure(:) ! K
382  REAL(fp), ALLOCATABLE :: temperature(:) ! K
383  REAL(fp), ALLOCATABLE :: absorber(:,:) ! K x J
384  ! Clouds associated with each profile
385  TYPE(crtm_cloud_type), ALLOCATABLE :: cloud(:) ! Nc
386  ! Aerosols associated with each profile
387  TYPE(crtm_aerosol_type), ALLOCATABLE :: aerosol(:) ! Na
388  END TYPE crtm_atmosphere_type
389  !:tdoc-:
390 
391 
392 CONTAINS
393 
394 
395 !################################################################################
396 !################################################################################
397 !## ##
398 !## ## PUBLIC MODULE ROUTINES ## ##
399 !## ##
400 !################################################################################
401 !################################################################################
402 
403 !--------------------------------------------------------------------------------
404 !:sdoc+:
405 !
406 ! NAME:
407 ! CRTM_Atmosphere_Associated
408 !
409 ! PURPOSE:
410 ! Elemental function to test the status of the allocatable components
411 ! of a CRTM Atmosphere object.
412 !
413 ! CALLING SEQUENCE:
414 ! Status = CRTM_Atmosphere_Associated( Atm )
415 !
416 ! OBJECTS:
417 ! Atm: Atmosphere structure which is to have its member's
418 ! status tested.
419 ! UNITS: N/A
420 ! TYPE: CRTM_Atmosphere_type
421 ! DIMENSION: Scalar or any rank
422 ! ATTRIBUTES: INTENT(IN)
423 !
424 ! FUNCTION RESULT:
425 ! Status: The return value is a logical value indicating the
426 ! status of the Atmosphere members.
427 ! .TRUE. - if the array components are allocated.
428 ! .FALSE. - if the array components are not allocated.
429 ! UNITS: N/A
430 ! TYPE: LOGICAL
431 ! DIMENSION: Same as input
432 !
433 !:sdoc-:
434 !--------------------------------------------------------------------------------
435 
436  ELEMENTAL FUNCTION crtm_atmosphere_associated( Atm ) RESULT( Status )
437  ! Arguments
438  TYPE(crtm_atmosphere_type), INTENT(IN) :: atm
439  ! Function result
440  LOGICAL :: status
441 
442  status = atm%Is_Allocated
443  ! ...Clouds
444  IF ( atm%n_Clouds > 0 .AND. ALLOCATED(atm%Cloud) ) &
445  status = status .AND. all(crtm_cloud_associated(atm%Cloud))
446  ! ...Aerosols
447  IF ( atm%n_Aerosols > 0 .AND. ALLOCATED(atm%Aerosol) ) &
448  status = status .AND. all(crtm_aerosol_associated(atm%Aerosol))
449 
450  END FUNCTION crtm_atmosphere_associated
451 
452 
453 !--------------------------------------------------------------------------------
454 !:sdoc+:
455 !
456 ! NAME:
457 ! CRTM_Atmosphere_Destroy
458 !
459 ! PURPOSE:
460 ! Elemental subroutine to re-initialize CRTM Atmosphere objects.
461 !
462 ! CALLING SEQUENCE:
463 ! CALL CRTM_Atmosphere_Destroy( Atm )
464 !
465 ! OBJECTS:
466 ! Atm: Re-initialized Atmosphere structure.
467 ! UNITS: N/A
468 ! TYPE: CRTM_Atmosphere_type
469 ! DIMENSION: Scalar or any rank
470 ! ATTRIBUTES: INTENT(OUT)
471 !
472 !:sdoc-:
473 !--------------------------------------------------------------------------------
474 
475  ELEMENTAL SUBROUTINE crtm_atmosphere_destroy( Atm )
476  TYPE(crtm_atmosphere_type), INTENT(OUT) :: atm
477  atm%Is_Allocated = .false.
478  END SUBROUTINE crtm_atmosphere_destroy
479 
480 
481 !--------------------------------------------------------------------------------
482 !:sdoc+:
483 !
484 ! NAME:
485 ! CRTM_Atmosphere_Create
486 !
487 ! PURPOSE:
488 ! Elemental subroutine to create an instance of the CRTM Atmosphere object.
489 !
490 ! CALLING SEQUENCE:
491 ! CALL CRTM_Atmosphere_Create( Atm , &
492 ! n_Layers , &
493 ! n_Absorbers, &
494 ! n_Clouds , &
495 ! n_Aerosols )
496 !
497 ! OBJECTS:
498 ! Atm: Atmosphere structure.
499 ! UNITS: N/A
500 ! TYPE: CRTM_Atmosphere_type
501 ! DIMENSION: Scalar or any rank
502 ! ATTRIBUTES: INTENT(OUT)
503 !
504 ! INPUTS:
505 ! n_Layers: Number of layers dimension.
506 ! Must be > 0.
507 ! UNITS: N/A
508 ! TYPE: INTEGER
509 ! DIMENSION: Same as atmosphere object
510 ! ATTRIBUTES: INTENT(IN)
511 !
512 ! n_Absorbers: Number of absorbers dimension.
513 ! Must be > 0.
514 ! UNITS: N/A
515 ! TYPE: INTEGER
516 ! DIMENSION: Same as atmosphere object
517 ! ATTRIBUTES: INTENT(IN)
518 !
519 ! n_Clouds: Number of clouds dimension.
520 ! Can be = 0 (i.e. clear sky).
521 ! UNITS: N/A
522 ! TYPE: INTEGER
523 ! DIMENSION: Same as atmosphere object
524 ! ATTRIBUTES: INTENT(IN)
525 !
526 ! n_Aerosols: Number of aerosols dimension.
527 ! Can be = 0 (i.e. no aerosols).
528 ! UNITS: N/A
529 ! TYPE: INTEGER
530 ! DIMENSION: Same as atmosphere object
531 ! ATTRIBUTES: INTENT(IN)
532 !
533 !:sdoc-:
534 !--------------------------------------------------------------------------------
535 
536  ELEMENTAL SUBROUTINE crtm_atmosphere_create( &
537  Atm , & ! Output
538  n_Layers , & ! Input
539  n_Absorbers, & ! Input
540  n_Clouds , & ! Input
541  n_Aerosols ) ! Input
542  ! Arguments
543  TYPE(crtm_atmosphere_type), INTENT(OUT) :: atm
544  INTEGER , INTENT(IN) :: n_layers
545  INTEGER , INTENT(IN) :: n_absorbers
546  INTEGER , INTENT(IN) :: n_clouds
547  INTEGER , INTENT(IN) :: n_aerosols
548  ! Local variables
549  INTEGER :: alloc_stat
550 
551  ! Check input
552  IF ( n_layers < 1 .OR. n_absorbers < 1 ) RETURN
553  IF ( n_clouds < 0 .OR. n_aerosols < 0 ) RETURN
554 
555  ! Perform the allocation
556  ALLOCATE( atm%Absorber_ID( n_absorbers ), &
557  atm%Absorber_Units( n_absorbers ), &
558  atm%Level_Pressure( 0:n_layers ), &
559  atm%Pressure( n_layers ), &
560  atm%Temperature( n_layers ), &
561  atm%Absorber( n_layers, n_absorbers ), &
562  stat = alloc_stat )
563  IF ( alloc_stat /= 0 ) RETURN
564 
565  ! Perform the substructure allocation
566  ! ...Cloud array
567  IF ( n_clouds > 0 ) THEN
568  ! Allocate the structure array
569  ALLOCATE( atm%Cloud( n_clouds ), stat = alloc_stat )
570  IF ( alloc_stat /= 0 ) THEN
571  CALL crtm_atmosphere_destroy( atm )
572  RETURN
573  END IF
574  ! Allocate the individual structures
575  CALL crtm_cloud_create( atm%Cloud, n_layers )
576  END IF
577  ! ...Aerosol array
578  IF ( n_aerosols > 0 ) THEN
579  ! Allocate the structure array
580  ALLOCATE( atm%Aerosol( n_aerosols ), stat = alloc_stat )
581  IF ( alloc_stat /= 0 ) THEN
582  CALL crtm_atmosphere_destroy( atm )
583  RETURN
584  END IF
585  ! Allocate the individual structures
586  CALL crtm_aerosol_create( atm%Aerosol, n_layers )
587  END IF
588 
589  ! Initialise
590  ! ...Dimensions
591  atm%Max_Layers = n_layers
592  atm%n_Layers = n_layers
593  atm%n_Absorbers = n_absorbers
594  atm%Max_Clouds = n_clouds
595  atm%n_Clouds = n_clouds
596  atm%Max_Aerosols = n_aerosols
597  atm%n_Aerosols = n_aerosols
598  atm%n_Added_Layers = 0
599  ! ...Arrays
600  atm%Absorber_ID = invalid_absorber_id
601  atm%Absorber_Units = invalid_absorber_units
602  atm%Level_Pressure = zero
603  atm%Pressure = zero
604  atm%Temperature = zero
605  atm%Absorber = zero
606 
607  ! Set allocation indicator
608  atm%Is_Allocated = .true.
609 
610  END SUBROUTINE crtm_atmosphere_create
611 
612 
613 
614 !--------------------------------------------------------------------------------
615 !:sdoc+:
616 !
617 ! NAME:
618 ! CRTM_Atmosphere_AddLayerCopy
619 !
620 ! PURPOSE:
621 ! Elemental function to copy an instance of the CRTM Atmosphere object
622 ! with additional layers added to the TOA of the input.
623 !
624 ! CALLING SEQUENCE:
625 ! Atm_out = CRTM_Atmosphere_AddLayerCopy( Atm, n_Added_Layers )
626 !
627 ! OBJECTS:
628 ! Atm: Atmosphere structure to copy.
629 ! UNITS: N/A
630 ! TYPE: CRTM_Atmosphere_type
631 ! DIMENSION: Scalar or any rank
632 ! ATTRIBUTES: INTENT(OUT)
633 !
634 ! INPUTS:
635 ! n_Added_Layers: Number of layers to add to the function result.
636 ! UNITS: N/A
637 ! TYPE: INTEGER
638 ! DIMENSION: Same as atmosphere object
639 ! ATTRIBUTES: INTENT(IN)
640 !
641 ! FUNCTION RESULT:
642 ! Atm_out: Copy of the input atmosphere structure with space for
643 ! extra layers added to TOA.
644 ! UNITS: N/A
645 ! TYPE: CRTM_Atmosphere_type
646 ! DIMENSION: Same as input.
647 ! ATTRIBUTES: INTENT(OUT)
648 !
649 !
650 !:sdoc-:
651 !--------------------------------------------------------------------------------
652 
653  ELEMENTAL FUNCTION crtm_atmosphere_addlayercopy( &
654  atm, &
655  n_Added_Layers ) &
656  result( atm_out )
657  ! Arguments
658  TYPE(crtm_atmosphere_type), INTENT(IN) :: atm
659  INTEGER, INTENT(IN) :: n_added_layers
660  ! Function result
661  TYPE(crtm_atmosphere_type) :: atm_out
662  ! Local variables
663  INTEGER :: i, na, no, nt
664 
665  ! Set the number of extra layers
666  na = max(n_added_layers,0)
667 
668  ! Create the output structure
669  CALL crtm_atmosphere_create( atm_out, &
670  atm%n_Layers+na, &
671  atm%n_Absorbers, &
672  atm%n_Clouds , &
673  atm%n_Aerosols )
674  IF ( .NOT. crtm_atmosphere_associated(atm_out) ) RETURN
675 
676  ! Assign data
677  atm_out%n_Added_Layers = atm%n_Added_Layers+na
678  ! ...Layer independent data
679  atm_out%Climatology = atm%Climatology
680  atm_out%Absorber_ID = atm%Absorber_ID
681  atm_out%Absorber_Units = atm%Absorber_Units
682  ! ...Layer dependent data
683  no = atm%n_Layers
684  nt = atm_out%n_Layers
685  atm_out%Level_Pressure(na:nt) = atm%Level_Pressure(0:no)
686  atm_out%Pressure(na+1:nt) = atm%Pressure(1:no)
687  atm_out%Temperature(na+1:nt) = atm%Temperature(1:no)
688  atm_out%Absorber(na+1:nt,:) = atm%Absorber(1:no,:)
689  ! ...Cloud components
690  IF ( atm%n_Clouds > 0 ) THEN
691  DO i = 1, atm%n_Clouds
692  atm_out%Cloud(i) = crtm_cloud_addlayercopy( atm%Cloud(i), atm_out%n_Added_Layers )
693  END DO
694  END IF
695  ! ...Aerosol components
696  IF ( atm%n_Aerosols > 0 ) THEN
697  DO i = 1, atm%n_Aerosols
698  atm_out%Aerosol(i) = crtm_aerosol_addlayercopy( atm%Aerosol(i), atm_out%n_Added_Layers )
699  END DO
700  END IF
701 
702  END FUNCTION crtm_atmosphere_addlayercopy
703 
704 
705 !--------------------------------------------------------------------------------
706 !:sdoc+:
707 !
708 ! NAME:
709 ! CRTM_Atmosphere_Zero
710 !
711 ! PURPOSE:
712 ! Elemental subroutine to zero out the data arrays
713 ! in a CRTM Atmosphere object.
714 !
715 ! CALLING SEQUENCE:
716 ! CALL CRTM_Atmosphere_Zero( Atm )
717 !
718 ! OUTPUTS:
719 ! Atm: CRTM Atmosphere structure in which the data arrays
720 ! are to be zeroed out.
721 ! UNITS: N/A
722 ! TYPE: CRTM_Atmosphere_type
723 ! DIMENSION: Scalar or any rank
724 ! ATTRIBUTES: INTENT(IN OUT)
725 !
726 ! COMMENTS:
727 ! - The dimension components of the structure are *NOT* set to zero.
728 ! - The Climatology, Absorber_ID, and Absorber_Units components are
729 ! *NOT* reset in this routine.
730 !
731 !:sdoc-:
732 !--------------------------------------------------------------------------------
733 
734  ELEMENTAL SUBROUTINE crtm_atmosphere_zero( Atmosphere )
735  TYPE(crtm_atmosphere_type), INTENT(IN OUT) :: atmosphere
736 
737  ! Do nothing if structure is unused
738  IF ( .NOT. crtm_atmosphere_associated(atmosphere) ) RETURN
739 
740  ! Reset the added layer count
741  atmosphere%n_Added_Layers = 0
742 
743  ! Only zero out the data arrays
744  atmosphere%Level_Pressure = zero
745  atmosphere%Pressure = zero
746  atmosphere%Temperature = zero
747  atmosphere%Absorber = zero
748 
749  ! Reset the structure components
750  IF ( atmosphere%n_Clouds > 0 ) CALL crtm_cloud_zero( atmosphere%Cloud )
751  IF ( atmosphere%n_Aerosols > 0 ) CALL crtm_aerosol_zero( atmosphere%Aerosol )
752 
753  END SUBROUTINE crtm_atmosphere_zero
754 
755 
756 !--------------------------------------------------------------------------------
757 !:sdoc+:
758 !
759 ! NAME:
760 ! CRTM_Atmosphere_IsValid
761 !
762 ! PURPOSE:
763 ! Non-pure function to perform some simple validity checks on a
764 ! CRTM Atmosphere object.
765 !
766 ! If invalid data is found, a message is printed to stdout.
767 !
768 ! CALLING SEQUENCE:
769 ! result = CRTM_Atmosphere_IsValid( Atm )
770 !
771 ! or
772 !
773 ! IF ( CRTM_Atmosphere_IsValid( Atm ) ) THEN....
774 !
775 ! OBJECTS:
776 ! Atm: CRTM Atmosphere object which is to have its
777 ! contents checked.
778 ! UNITS: N/A
779 ! TYPE: CRTM_Atmosphere_type
780 ! DIMENSION: Scalar
781 ! ATTRIBUTES: INTENT(IN)
782 !
783 ! FUNCTION RESULT:
784 ! result: Logical variable indicating whether or not the input
785 ! passed the check.
786 ! If == .FALSE., Atmosphere object is unused or contains
787 ! invalid data.
788 ! == .TRUE., Atmosphere object can be used in CRTM.
789 ! UNITS: N/A
790 ! TYPE: LOGICAL
791 ! DIMENSION: Scalar
792 !
793 !:sdoc-:
794 !--------------------------------------------------------------------------------
795 
796  FUNCTION crtm_atmosphere_isvalid( Atm ) RESULT( IsValid )
797  TYPE(crtm_atmosphere_type), INTENT(IN) :: atm
798  LOGICAL :: isvalid
799  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Atmosphere_IsValid'
800  CHARACTER(ML) :: msg
801  INTEGER :: nc, na
802 
803  ! Setup
804  isvalid = .false.
805  ! ...Check if structure is used
806  IF ( .NOT. crtm_atmosphere_associated(atm) ) THEN
807  msg = 'Atmosphere structure not allocated'
808  CALL display_message( routine_name, msg, information )
809  RETURN
810  ENDIF
811  IF ( atm%n_Layers < 1 .OR. atm%n_Absorbers < 1 ) THEN
812  msg = 'Atmosphere structure dimensions invalid'
813  CALL display_message( routine_name, msg, information )
814  RETURN
815  ENDIF
816  IF ( atm%n_Layers > max_n_layers ) THEN
817  WRITE(msg,'("No. of atmosphere structure layers [",i0,"(added:",i0,&
818  &")] is larger than maximum allowed [",i0,"]")') &
819  atm%n_Layers, atm%n_Added_Layers, max_n_layers
820  CALL display_message( routine_name, msg, information )
821  RETURN
822  ENDIF
823 
824  ! Check data
825  ! ...Change default so all entries can be checked
826  isvalid = .true.
827  ! ...The type of Atmosphere
828  IF ( atm%Climatology < 1 .OR. atm%Climatology > n_valid_climatology_models ) THEN
829  msg = 'Invalid climatology'
830  CALL display_message( routine_name, msg, information )
831  isvalid = .false.
832  ENDIF
833  ! ...The absorber id range
834  IF ( any(atm%Absorber_ID < 1) .OR. any(atm%Absorber_ID > n_valid_absorber_ids) ) THEN
835  msg = 'Invalid absorber ID'
836  CALL display_message( routine_name, msg, information )
837  isvalid = .false.
838  ENDIF
839  ! ...H2O *must* be specfied
840  IF ( .NOT. absorber_id_ispresent(h2o_id) ) THEN
841  msg = trim(absorber_id_name(h2o_id))//' absorber profile must be specified'
842  CALL display_message( routine_name, msg, information )
843  isvalid = .false.
844  ENDIF
845  ! ...O3 *must* be specfied
846  IF ( .NOT. absorber_id_ispresent(o3_id) ) THEN
847  msg = trim(absorber_id_name(o3_id))//' absorber profile must be specified'
848  CALL display_message( routine_name, msg, information )
849  isvalid = .false.
850  ENDIF
851  ! ...The absorber units range
852  IF ( any(atm%Absorber_Units < 1) .OR. any(atm%Absorber_Units > n_valid_absorber_units) ) THEN
853  msg = 'Invalid absorber units ID'
854  CALL display_message( routine_name, msg, information )
855  isvalid = .false.
856  ENDIF
857  ! ...Data limits. Only checking negative values
858  IF ( any(atm%Level_Pressure < zero ) ) THEN
859  msg = 'Negative level pressure found'
860  CALL display_message( routine_name, msg, information )
861  isvalid = .false.
862  ENDIF
863  IF ( any(atm%Pressure < zero ) ) THEN
864  msg = 'Negative layer pressure found'
865  CALL display_message( routine_name, msg, information )
866  isvalid = .false.
867  ENDIF
868  IF ( any(atm%Temperature < zero ) ) THEN
869  msg = 'Negative layer temperature found'
870  CALL display_message( routine_name, msg, information )
871  isvalid = .false.
872  ENDIF
873  IF ( any(atm%Absorber < zero ) ) THEN
874  msg = 'Negative level absorber found'
875  CALL display_message( routine_name, msg, information )
876  isvalid = .false.
877  ENDIF
878  ! ...Structure components
879  IF ( atm%n_Clouds > 0 ) THEN
880  DO nc = 1, atm%n_Clouds
881  isvalid = isvalid .AND. crtm_cloud_isvalid( atm%Cloud(nc) )
882  END DO
883  END IF
884  IF ( atm%n_Aerosols > 0 ) THEN
885  DO na = 1, atm%n_Aerosols
886  isvalid = isvalid .AND. crtm_aerosol_isvalid( atm%Aerosol(na) )
887  END DO
888  END IF
889 
890  CONTAINS
891 
892  FUNCTION absorber_id_ispresent( Id ) RESULT( IsPresent )
893  INTEGER, INTENT(IN) :: id
894  LOGICAL :: ispresent
895  ispresent = any(atm%Absorber_ID == id)
896  END FUNCTION absorber_id_ispresent
897 
898  END FUNCTION crtm_atmosphere_isvalid
899 
900 
901 !--------------------------------------------------------------------------------
902 !:sdoc+:
903 !
904 ! NAME:
905 ! CRTM_Atmosphere_Inspect
906 !
907 ! PURPOSE:
908 ! Subroutine to print the contents of a CRTM Atmosphere object to stdout.
909 !
910 ! CALLING SEQUENCE:
911 ! CALL CRTM_Atmosphere_Inspect( Atm, Unit=unit )
912 !
913 ! INPUTS:
914 ! Atm: CRTM Atmosphere object to display.
915 ! UNITS: N/A
916 ! TYPE: CRTM_Atmosphere_type
917 ! DIMENSION: Scalar
918 ! ATTRIBUTES: INTENT(IN)
919 !
920 ! OPTIONAL INPUTS:
921 ! Unit: Unit number for an already open file to which the output
922 ! will be written.
923 ! If the argument is specified and the file unit is not
924 ! connected, the output goes to stdout.
925 ! UNITS: N/A
926 ! TYPE: INTEGER
927 ! DIMENSION: Scalar
928 ! ATTRIBUTES: INTENT(IN), OPTIONAL
929 !
930 !:sdoc-:
931 !--------------------------------------------------------------------------------
932 
933  SUBROUTINE scalar_inspect( Atm, Unit )
934  ! Arguments
935  TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atm
936  INTEGER, OPTIONAL, INTENT(IN) :: Unit
937  ! Local variables
938  INTEGER :: fid
939  INTEGER :: lClimatology
940  INTEGER :: j, k
941 
942  ! Setup
943  fid = output_unit
944  IF ( PRESENT(unit) ) THEN
945  IF ( file_open(unit) ) fid = unit
946  END IF
947 
948 
949  WRITE(fid, '(1x,"ATMOSPHERE OBJECT")')
950  ! Dimensions
951  WRITE(fid, '(3x,"n_Layers :",1x,i0)') atm%n_Layers
952  WRITE(fid, '(3x,"n_Absorbers :",1x,i0)') atm%n_Absorbers
953  WRITE(fid, '(3x,"n_Clouds :",1x,i0)') atm%n_Clouds
954  WRITE(fid, '(3x,"n_Aerosols :",1x,i0)') atm%n_Aerosols
955  ! Climatology
956  lclimatology = atm%Climatology
957  IF ( lclimatology < 1 .OR. &
958  lclimatology > n_valid_climatology_models ) lclimatology = invalid_model
959  WRITE(fid, '(3x,"Climatology :",1x,a)') climatology_model_name(lclimatology)
960  IF ( .NOT. crtm_atmosphere_associated(atm) ) RETURN
961  ! Profile information
962  k = atm%n_Layers
963  WRITE(fid, '(3x,"Level pressure:")')
964  WRITE(fid, '(5(1x,es13.6,:))') atm%Level_Pressure(0:k)
965  WRITE(fid, '(3x,"Layer pressure:")')
966  WRITE(fid, '(5(1x,es13.6,:))') atm%Pressure(1:k)
967  WRITE(fid, '(3x,"Layer temperature:")')
968  WRITE(fid, '(5(1x,es13.6,:))') atm%Temperature(1:k)
969  WRITE(fid, '(3x,"Layer absorber:")')
970  DO j = 1, atm%n_Absorbers
971  WRITE(fid, '(5x,a,"(",a,")")') trim(absorber_id_name(atm%Absorber_Id(j))), &
972  trim(absorber_units_name(atm%Absorber_Units(j)))
973  WRITE(fid, '(5(1x,es13.6,:))') atm%Absorber(1:k,j)
974  END DO
975  ! Cloud information
976  IF ( atm%n_Clouds > 0 ) CALL crtm_cloud_inspect(atm%Cloud, unit=unit)
977  ! Aerosol information
978  IF ( atm%n_Aerosols > 0 ) CALL crtm_aerosol_inspect(atm%Aerosol, unit=unit)
979  END SUBROUTINE scalar_inspect
980 
981  SUBROUTINE rank1_inspect( Atmosphere, Unit )
982  TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atmosphere(:)
983  INTEGER, OPTIONAL, INTENT(IN) :: Unit
984  INTEGER :: fid
985  INTEGER :: i
986  fid = output_unit
987  IF ( PRESENT(unit) ) THEN
988  IF ( file_open(unit) ) fid = unit
989  END IF
990  DO i = 1, SIZE(atmosphere)
991  WRITE(fid, fmt='(1x,"RANK-1 INDEX:",i0," - ")', advance='NO') i
992  CALL scalar_inspect(atmosphere(i), unit=unit)
993  END DO
994  END SUBROUTINE rank1_inspect
995 
996  SUBROUTINE rank2_inspect( Atmosphere, Unit )
997  TYPE(CRTM_Atmosphere_type), INTENT(IN) :: Atmosphere(:,:)
998  INTEGER, OPTIONAL, INTENT(IN) :: Unit
999  INTEGER :: fid
1000  INTEGER :: i, j
1001  fid = output_unit
1002  IF ( PRESENT(unit) ) THEN
1003  IF ( file_open(unit) ) fid = unit
1004  END IF
1005  DO j = 1, SIZE(atmosphere,2)
1006  DO i = 1, SIZE(atmosphere,1)
1007  WRITE(fid, fmt='(1x,"RANK-2 INDEX:",i0,",",i0," - ")', advance='NO') i,j
1008  CALL scalar_inspect(atmosphere(i,j), unit=unit)
1009  END DO
1010  END DO
1011  END SUBROUTINE rank2_inspect
1012 
1013 
1014 !--------------------------------------------------------------------------------
1015 !:sdoc+:
1016 !
1017 ! NAME:
1018 ! CRTM_Atmosphere_DefineVersion
1019 !
1020 ! PURPOSE:
1021 ! Subroutine to return the module version information.
1022 !
1023 ! CALLING SEQUENCE:
1024 ! CALL CRTM_Atmosphere_DefineVersion( Id )
1025 !
1026 ! OUTPUTS:
1027 ! Id: Character string containing the version Id information
1028 ! for the module.
1029 ! UNITS: N/A
1030 ! TYPE: CHARACTER(*)
1031 ! DIMENSION: Scalar
1032 ! ATTRIBUTES: INTENT(OUT)
1033 !
1034 !:sdoc-:
1035 !--------------------------------------------------------------------------------
1036 
1037  SUBROUTINE crtm_atmosphere_defineversion( Id )
1038  CHARACTER(*), INTENT(OUT) :: id
1039  id = module_version_id
1040  END SUBROUTINE crtm_atmosphere_defineversion
1041 
1042 
1043 !--------------------------------------------------------------------------------
1044 !:sdoc+:
1045 ! NAME:
1046 ! CRTM_Atmosphere_Compare
1047 !
1048 ! PURPOSE:
1049 ! Elemental function to compare two CRTM_Atmosphere objects to within
1050 ! a user specified number of significant figures.
1051 !
1052 ! CALLING SEQUENCE:
1053 ! is_comparable = CRTM_Atmosphere_Compare( x, y, n_SigFig=n_SigFig )
1054 !
1055 ! OBJECTS:
1056 ! x, y: Two CRTM Atmosphere objects to be compared.
1057 ! UNITS: N/A
1058 ! TYPE: CRTM_Atmosphere_type
1059 ! DIMENSION: Scalar or any rank
1060 ! ATTRIBUTES: INTENT(IN)
1061 !
1062 ! OPTIONAL INPUTS:
1063 ! n_SigFig: Number of significant figure to compare floating point
1064 ! components.
1065 ! UNITS: N/A
1066 ! TYPE: INTEGER
1067 ! DIMENSION: Scalar or same as input
1068 ! ATTRIBUTES: INTENT(IN), OPTIONAL
1069 !
1070 ! FUNCTION RESULT:
1071 ! is_equal: Logical value indicating whether the inputs are equal.
1072 ! UNITS: N/A
1073 ! TYPE: LOGICAL
1074 ! DIMENSION: Same as inputs.
1075 !:sdoc-:
1076 !--------------------------------------------------------------------------------
1077 
1078  ELEMENTAL FUNCTION crtm_atmosphere_compare( &
1079  x, &
1080  y, &
1081  n_SigFig ) &
1082  result( is_comparable )
1083  TYPE(crtm_atmosphere_type), INTENT(IN) :: x, y
1084  INTEGER, OPTIONAL, INTENT(IN) :: n_sigfig
1085  LOGICAL :: is_comparable
1086  ! Variables
1087  INTEGER :: j
1088  INTEGER :: n
1089 
1090  ! Set up
1091  is_comparable = .false.
1092  IF ( PRESENT(n_sigfig) ) THEN
1093  n = abs(n_sigfig)
1094  ELSE
1095  n = default_n_sigfig
1096  END IF
1097 
1098  ! Check the structure association status
1099  IF ( (.NOT. crtm_atmosphere_associated(x)) .OR. &
1100  (.NOT. crtm_atmosphere_associated(y)) ) RETURN
1101 
1102  ! Check scalars
1103  IF ( (x%n_Layers /= y%n_Layers ) .OR. &
1104  (x%n_Absorbers /= y%n_Absorbers) .OR. &
1105  (x%n_Clouds /= y%n_Clouds ) .OR. &
1106  (x%n_Aerosols /= y%n_Aerosols ) .OR. &
1107  (x%Climatology /= y%Climatology) ) RETURN
1108 
1109  ! Check integer arrays
1110  j = x%n_Absorbers
1111  IF ( any(x%Absorber_ID(1:j) /= y%Absorber_ID(1:j) ) .OR. &
1112  any(x%Absorber_Units(1:j) /= y%Absorber_Units(1:j)) ) RETURN
1113 
1114  ! Check floating point arrays
1115  IF ( (.NOT. all(compares_within_tolerance(x%Level_Pressure,y%Level_Pressure,n))) .OR. &
1116  (.NOT. all(compares_within_tolerance(x%Pressure ,y%Pressure ,n))) .OR. &
1117  (.NOT. all(compares_within_tolerance(x%Temperature ,y%Temperature ,n))) .OR. &
1118  (.NOT. all(compares_within_tolerance(x%Absorber ,y%Absorber ,n))) ) RETURN
1119 
1120  ! Check clouds
1121  IF ( x%n_Clouds > 0 ) THEN
1122  IF ( .NOT. all(crtm_cloud_compare(x%Cloud,y%Cloud,n_sigfig=n)) ) RETURN
1123  END IF
1124 
1125  ! Check aerosols
1126  IF ( x%n_Aerosols > 0 ) THEN
1127  IF ( .NOT. all(crtm_aerosol_compare(x%Aerosol,y%Aerosol,n_sigfig=n)) ) RETURN
1128  END IF
1129 
1130  ! If we get here, the structures are comparable
1131  is_comparable = .true.
1132 
1133  END FUNCTION crtm_atmosphere_compare
1134 
1135 
1136 !--------------------------------------------------------------------------------
1137 !:sdoc+:
1138 !
1139 ! NAME:
1140 ! CRTM_Get_AbsorberIdx
1141 !
1142 ! PURPOSE:
1143 ! Function to determine the index of the requested absorber in the
1144 ! CRTM Atmosphere structure absorber component.
1145 !
1146 ! CALLING SEQUENCE:
1147 ! Idx = CRTM_Get_AbsorberIdx(Atm, AbsorberId)
1148 !
1149 ! INPUTS:
1150 ! Atm: CRTM Atmosphere structure.
1151 ! UNITS: N/A
1152 ! TYPE: CRTM_Atmosphere_type
1153 ! DIMENSION: Scalar
1154 ! ATTRIBUTES: INTENT(IN)
1155 !
1156 ! AbsorberId: Integer value used to identify absorbing molecular
1157 ! species. The accepted absorber Ids are defined in
1158 ! this module.
1159 ! UNITS: N/A
1160 ! TYPE: INTEGER
1161 ! DIMENSION: Scalar
1162 ! ATTRIBUTES: INTENT(IN)
1163 !
1164 ! FUNCTION RESULT:
1165 ! Idx: Index of the requested absorber in the
1166 ! Atm%Absorber array component.
1167 ! If the requested absorber cannot be found,
1168 ! a value of -1 is returned.
1169 ! UNITS: N/A
1170 ! TYPE: INTEGER
1171 ! DIMENSION: Scalar
1172 !
1173 !:sdoc-:
1174 !--------------------------------------------------------------------------------
1175 
1176  FUNCTION crtm_get_absorberidx(Atm, AbsorberId) RESULT(AbsorberIdx)
1177  ! Arguments
1178  TYPE(crtm_atmosphere_type), INTENT(IN) :: atm
1179  INTEGER , INTENT(IN) :: absorberid
1180  ! Function result
1181  INTEGER :: absorberidx
1182  ! Local variables
1183  INTEGER :: j, idx(1)
1184 
1185  ! Initialise result to "not found"
1186  absorberidx = -1
1187  ! Return if absorber not present
1188  IF ( count(atm%Absorber_ID == absorberid) /= 1 ) RETURN
1189  ! Find the location
1190  idx = pack((/(j,j=1,atm%n_Absorbers)/), atm%Absorber_ID==absorberid)
1191  absorberidx=idx(1)
1192 
1193  END FUNCTION crtm_get_absorberidx
1194 
1195 
1196 !--------------------------------------------------------------------------------
1197 !:sdoc+:
1198 !
1199 ! NAME:
1200 ! CRTM_Get_PressureLevelIdx
1201 !
1202 ! PURPOSE:
1203 ! Function to determine the index in the CRTM Atmosphere structure
1204 ! pressure level array component that corresponds to the value
1205 ! closest to the requested level pressure.
1206 !
1207 ! CALLING SEQUENCE:
1208 ! Idx = CRTM_Get_PressureLevelIdx(Atm, Level_Pressure)
1209 !
1210 ! INPUTS:
1211 ! Atm: CRTM Atmosphere structure.
1212 ! UNITS: N/A
1213 ! TYPE: CRTM_Atmosphere_type
1214 ! DIMENSION: Scalar
1215 ! ATTRIBUTES: INTENT(IN)
1216 !
1217 ! Level_Pressure: Level pressure for which the index in the atmosphere
1218 ! structure level pressure profile is required.
1219 ! UNITS: N/A
1220 ! TYPE: REAL(fp)
1221 ! DIMENSION: Scalar
1222 ! ATTRIBUTES: INTENT(IN)
1223 !
1224 ! FUNCTION RESULT:
1225 ! Idx: Index of the level in the Atm%Level_Pressure
1226 ! array component for the closest value to the
1227 ! input level pressure.
1228 ! UNITS: N/A
1229 ! TYPE: INTEGER
1230 ! DIMENSION: Scalar
1231 !
1232 !:sdoc-:
1233 !--------------------------------------------------------------------------------
1234 
1235  FUNCTION crtm_get_pressurelevelidx(Atm, Level_Pressure) RESULT(Level_Idx)
1236  ! Arguments
1237  TYPE(crtm_atmosphere_type), INTENT(IN) :: atm
1238  REAL(fp) , INTENT(IN) :: level_pressure
1239  ! Function result
1240  INTEGER :: level_idx
1241 
1242  ! Find the closest pressure level
1243  ! Note: The "- 1" takes into account the array starting at index 0.
1244  level_idx = minloc(abs(atm%Level_Pressure - level_pressure), dim=1) - 1
1245 
1246  END FUNCTION crtm_get_pressurelevelidx
1247 
1248 
1249 !--------------------------------------------------------------------------------
1250 !:sdoc+:
1251 !
1252 ! NAME:
1253 ! CRTM_Atmosphere_SetLayers
1254 !
1255 ! PURPOSE:
1256 ! Elemental subroutine to set the working number of layers to use
1257 ! in a CRTM Atmosphere object.
1258 !
1259 ! CALLING SEQUENCE:
1260 ! CALL CRTM_Atmosphere_SetLayers( Atmosphere, n_Layers )
1261 !
1262 ! OBJECT:
1263 ! Atmosphere: CRTM Atmosphere object which is to have its working number
1264 ! of layers updated.
1265 ! UNITS: N/A
1266 ! TYPE: CRTM_Atmosphere_type
1267 ! DIMENSION: Scalar or any rank
1268 ! ATTRIBUTES: INTENT(IN OUT)
1269 !
1270 ! INPUTS:
1271 ! n_Layers: The value to set the n_Layers component of the
1272 ! Atmosphere object.
1273 ! UNITS: N/A
1274 ! TYPE: CRTM_Atmosphere_type
1275 ! DIMENSION: Conformable with the Atmosphere object argument
1276 ! ATTRIBUTES: INTENT(IN)
1277 !
1278 ! COMMENTS:
1279 ! - The object is zeroed upon output.
1280 !
1281 ! - If n_Layers <= Atmosphere%Max_Layers, then only the n_Layers dimension
1282 ! value of the object, as well as any contained objects, is changed.
1283 !
1284 ! - If n_Layers > Atmosphere%Max_Layers, then the object is reallocated
1285 ! to the required number of layers. No other dimensions of the object
1286 ! or contained objects are altered.
1287 !
1288 !:sdoc-:
1289 !--------------------------------------------------------------------------------
1290 
1291  ELEMENTAL SUBROUTINE crtm_atmosphere_setlayers( Atmosphere, n_Layers )
1292  ! Arguments
1293  TYPE(crtm_atmosphere_type), INTENT(IN OUT) :: atmosphere
1294  INTEGER, INTENT(IN) :: n_layers
1295  ! Local variables
1296  INTEGER :: n_absorbers
1297  INTEGER :: max_clouds, n_clouds
1298  INTEGER :: max_aerosols, n_aerosols
1299 
1300  IF ( n_layers < atmosphere%Max_Layers ) THEN
1301  ! Just update the layer counts
1302  atmosphere%n_Layers = n_layers
1303  CALL crtm_cloud_setlayers(atmosphere%Cloud, n_layers)
1304  CALL crtm_aerosol_setlayers(atmosphere%Aerosol, n_layers)
1305  CALL crtm_atmosphere_zero(atmosphere)
1306  ELSE
1307  ! Reallocation is necessary
1308  ! ...Save other dimensions
1309  n_absorbers = atmosphere%n_Absorbers
1310  max_clouds = max(atmosphere%n_Clouds, atmosphere%Max_Clouds)
1311  n_clouds = min(atmosphere%n_Clouds, atmosphere%Max_Clouds)
1312  max_aerosols = max(atmosphere%n_Aerosols, atmosphere%Max_Aerosols)
1313  n_aerosols = min(atmosphere%n_Aerosols, atmosphere%Max_Aerosols)
1314  ! ...Reallocate
1315  CALL crtm_atmosphere_create( atmosphere, n_layers, n_absorbers, max_clouds, max_aerosols )
1316  IF ( .NOT. crtm_atmosphere_associated(atmosphere) ) RETURN
1317  ! ...Restore cloud and aerosol use dimensions
1318  atmosphere%n_Clouds = n_clouds
1319  atmosphere%n_Aerosols = n_aerosols
1320  END IF
1321  END SUBROUTINE crtm_atmosphere_setlayers
1322 
1323 
1324 !------------------------------------------------------------------------------
1325 !:sdoc+:
1326 !
1327 ! NAME:
1328 ! CRTM_Atmosphere_InquireFile
1329 !
1330 ! PURPOSE:
1331 ! Function to inquire CRTM Atmosphere object files.
1332 !
1333 ! CALLING SEQUENCE:
1334 ! Error_Status = CRTM_Atmosphere_InquireFile( Filename , &
1335 ! n_Channels = n_Channels, &
1336 ! n_Profiles = n_Profiles )
1337 !
1338 ! INPUTS:
1339 ! Filename: Character string specifying the name of a
1340 ! CRTM Atmosphere data file to read.
1341 ! UNITS: N/A
1342 ! TYPE: CHARACTER(*)
1343 ! DIMENSION: Scalar
1344 ! ATTRIBUTES: INTENT(IN)
1345 !
1346 ! OPTIONAL OUTPUTS:
1347 ! n_Channels: The number of spectral channels for which there is
1348 ! data in the file. Note that this value will always
1349 ! be 0 for a profile-only dataset-- it only has meaning
1350 ! for K-matrix data.
1351 ! UNITS: N/A
1352 ! TYPE: INTEGER
1353 ! DIMENSION: Scalar
1354 ! ATTRIBUTES: OPTIONAL, INTENT(OUT)
1355 !
1356 ! n_Profiles: The number of profiles in the data file.
1357 ! UNITS: N/A
1358 ! TYPE: INTEGER
1359 ! DIMENSION: Scalar
1360 ! ATTRIBUTES: OPTIONAL, INTENT(OUT)
1361 !
1362 ! FUNCTION RESULT:
1363 ! Error_Status: The return value is an integer defining the error status.
1364 ! The error codes are defined in the Message_Handler module.
1365 ! If == SUCCESS, the file inquire was successful
1366 ! == FAILURE, an unrecoverable error occurred.
1367 ! UNITS: N/A
1368 ! TYPE: INTEGER
1369 ! DIMENSION: Scalar
1370 !
1371 !:sdoc-:
1372 !------------------------------------------------------------------------------
1373 
1374  FUNCTION crtm_atmosphere_inquirefile( &
1375  Filename , & ! Input
1376  n_Channels , & ! Optional output
1377  n_Profiles ) & ! Optional output
1378  result( err_stat )
1379  ! Arguments
1380  CHARACTER(*), INTENT(IN) :: filename
1381  INTEGER , OPTIONAL, INTENT(OUT) :: n_channels
1382  INTEGER , OPTIONAL, INTENT(OUT) :: n_profiles
1383  ! Function result
1384  INTEGER :: err_stat
1385  ! Function parameters
1386  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Atmosphere_InquireFile'
1387  ! Function variables
1388  CHARACTER(ML) :: msg
1389  CHARACTER(ML) :: io_msg
1390  INTEGER :: io_stat
1391  INTEGER :: fid
1392  INTEGER :: l, m
1393 
1394  ! Set up
1395  err_stat = success
1396 
1397  ! Open the file
1398  err_stat = open_binary_file( filename, fid )
1399  IF ( err_stat /= success ) THEN
1400  msg = 'Error opening '//trim(filename)
1401  CALL inquire_cleanup(); RETURN
1402  END IF
1403 
1404  ! Read the number of channels,profiles
1405  READ( fid,iostat=io_stat,iomsg=io_msg ) l, m
1406  IF ( io_stat /= 0 ) THEN
1407  msg = 'Error reading dimensions from '//trim(filename)//' - '//trim(io_msg)
1408  CALL inquire_cleanup(); RETURN
1409  END IF
1410 
1411 
1412  ! Close the file
1413  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
1414  IF ( io_stat /= 0 ) THEN
1415  msg = 'Error closing '//trim(filename)//' - '//trim(io_msg)
1416  CALL inquire_cleanup(); RETURN
1417  END IF
1418 
1419 
1420  ! Set the optional return arguments
1421  IF ( PRESENT(n_channels) ) n_channels = l
1422  IF ( PRESENT(n_profiles) ) n_profiles = m
1423 
1424  CONTAINS
1425 
1426  SUBROUTINE inquire_cleanup()
1427  IF ( file_open(fid) ) THEN
1428  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
1429  IF ( io_stat /= success ) &
1430  msg = trim(msg)//'; Error closing input file during error cleanup - '//trim(io_msg)
1431  END IF
1432  err_stat = failure
1433  CALL display_message( routine_name, msg, err_stat )
1434  END SUBROUTINE inquire_cleanup
1435 
1436  END FUNCTION crtm_atmosphere_inquirefile
1437 
1438 
1439 !------------------------------------------------------------------------------
1440 !:sdoc+:
1441 !
1442 ! NAME:
1443 ! CRTM_Atmosphere_ReadFile
1444 !
1445 ! PURPOSE:
1446 ! Function to read CRTM Atmosphere object files.
1447 !
1448 ! CALLING SEQUENCE:
1449 ! Error_Status = CRTM_Atmosphere_ReadFile( Filename , &
1450 ! Atmosphere , &
1451 ! Quiet = Quiet , &
1452 ! n_Channels = n_Channels, &
1453 ! n_Profiles = n_Profiles )
1454 !
1455 ! INPUTS:
1456 ! Filename: Character string specifying the name of an
1457 ! Atmosphere format data file to read.
1458 ! UNITS: N/A
1459 ! TYPE: CHARACTER(*)
1460 ! DIMENSION: Scalar
1461 ! ATTRIBUTES: INTENT(IN)
1462 !
1463 ! OUTPUTS:
1464 ! Atmosphere: CRTM Atmosphere object array containing the Atmosphere
1465 ! data. Note the following meanings attributed to the
1466 ! dimensions of the object array:
1467 ! Rank-1: Only profile data are to be read in. The file
1468 ! does not contain channel information. The
1469 ! dimension of the structure is understood to
1470 ! be the PROFILE dimension.
1471 ! Rank-2: Channel and profile data are to be read in.
1472 ! The file contains both channel and profile
1473 ! information. The first dimension of the
1474 ! structure is the CHANNEL dimension, the second
1475 ! is the PROFILE dimension. This is to allow
1476 ! K-matrix structures to be read in with the
1477 ! same function.
1478 ! UNITS: N/A
1479 ! TYPE: CRTM_Atmosphere_type
1480 ! DIMENSION: Rank-1 or Rank-2
1481 ! ATTRIBUTES: INTENT(OUT), ALLOCATABLE
1482 !
1483 ! OPTIONAL INPUTS:
1484 ! Quiet: Set this logical argument to suppress INFORMATION
1485 ! messages being printed to stdout
1486 ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
1487 ! == .TRUE., INFORMATION messages are SUPPRESSED.
1488 ! If not specified, default is .FALSE.
1489 ! UNITS: N/A
1490 ! TYPE: LOGICAL
1491 ! DIMENSION: Scalar
1492 ! ATTRIBUTES: INTENT(IN), OPTIONAL
1493 !
1494 ! OPTIONAL OUTPUTS:
1495 ! n_Channels: The number of channels for which data was read. Note that
1496 ! this value will always be 0 for a profile-only dataset--
1497 ! it only has meaning for K-matrix data.
1498 ! UNITS: N/A
1499 ! TYPE: INTEGER
1500 ! DIMENSION: Scalar
1501 ! ATTRIBUTES: OPTIONAL, INTENT(OUT)
1502 !
1503 ! n_Profiles: The number of profiles for which data was read.
1504 ! UNITS: N/A
1505 ! TYPE: INTEGER
1506 ! DIMENSION: Scalar
1507 ! ATTRIBUTES: OPTIONAL, INTENT(OUT)
1508 !
1509 !
1510 ! FUNCTION RESULT:
1511 ! Error_Status: The return value is an integer defining the error status.
1512 ! The error codes are defined in the Message_Handler module.
1513 ! If == SUCCESS, the file read was successful
1514 ! == FAILURE, an unrecoverable error occurred.
1515 ! UNITS: N/A
1516 ! TYPE: INTEGER
1517 ! DIMENSION: Scalar
1518 !
1519 !:sdoc-:
1520 !------------------------------------------------------------------------------
1521 
1522  FUNCTION read_atmosphere_rank1( &
1523  Filename , & ! Input
1524  Atmosphere , & ! Output
1525  Quiet , & ! Optional input
1526  n_Channels , & ! Optional output
1527  n_Profiles , & ! Optional output
1528  Debug ) & ! Optional input (Debug output control)
1529  result( err_stat )
1530  ! Arguments
1531  CHARACTER(*), INTENT(IN) :: filename
1532  TYPE(crtm_atmosphere_type), ALLOCATABLE, INTENT(OUT) :: atmosphere(:) ! M
1533  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
1534  INTEGER, OPTIONAL, INTENT(OUT) :: n_channels
1535  INTEGER, OPTIONAL, INTENT(OUT) :: n_profiles
1536  LOGICAL, OPTIONAL, INTENT(IN) :: debug
1537  ! Function result
1538  INTEGER :: err_stat
1539  ! Function parameters
1540  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Atmosphere_ReadFile(M)'
1541  ! Function variables
1542  CHARACTER(ML) :: msg
1543  CHARACTER(ML) :: io_msg
1544  CHARACTER(ML) :: alloc_msg
1545  INTEGER :: io_stat
1546  INTEGER :: alloc_stat
1547  LOGICAL :: noisy
1548  INTEGER :: fid
1549  INTEGER :: n_input_channels
1550  INTEGER :: m, n_input_profiles
1551 
1552 
1553  ! Set up
1554  err_stat = success
1555  ! ...Check Quiet argument
1556  noisy = .true.
1557  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
1558  ! ...Override Quiet settings if debug set.
1559  IF ( PRESENT(debug) ) noisy = debug
1560 
1561 
1562  ! Open the file
1563  err_stat = open_binary_file( filename, fid )
1564  IF ( err_stat /= success ) THEN
1565  msg = 'Error opening '//trim(filename)
1566  CALL read_cleanup(); RETURN
1567  END IF
1568 
1569 
1570  ! Read the dimensions
1571  READ( fid,iostat=io_stat,iomsg=io_msg ) n_input_channels, n_input_profiles
1572  IF ( io_stat /= 0 ) THEN
1573  msg = 'Error reading dimensions from '//trim(filename)//' - '//trim(io_msg)
1574  CALL read_cleanup(); RETURN
1575  END IF
1576  ! ...Check that n_Channels is zero
1577  IF ( n_input_channels /= 0 ) THEN
1578  msg = 'n_Channels dimensions in '//trim(filename)//' is not zero for a rank-1 '//&
1579  '(i.e. profiles only) Atmosphere read.'
1580  CALL read_cleanup(); RETURN
1581  END IF
1582  ! ...Allocate the return structure array
1583  ALLOCATE(atmosphere(n_input_profiles), stat=alloc_stat, errmsg=alloc_msg)
1584  IF ( alloc_stat /= 0 ) THEN
1585  msg = 'Error allocating Atmosphere array - '//trim(alloc_msg)
1586  CALL read_cleanup(); RETURN
1587  END IF
1588 
1589 
1590  ! Loop over all the profiles
1591  profile_loop: DO m = 1, n_input_profiles
1592  err_stat = read_record( fid, atmosphere(m), &
1593  quiet = quiet, &
1594  debug = debug )
1595  IF ( err_stat /= success ) THEN
1596  WRITE( msg,'("Error reading Atmosphere element (",i0,") from ",a)' ) m, trim(filename)
1597  CALL read_cleanup(); RETURN
1598  END IF
1599  END DO profile_loop
1600 
1601 
1602  ! Close the file
1603  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
1604  IF ( io_stat /= 0 ) THEN
1605  msg = 'Error closing '//trim(filename)//' - '//trim(io_msg)
1606  CALL read_cleanup(); RETURN
1607  END IF
1608 
1609 
1610  ! Set the optional return values
1611  IF ( PRESENT(n_channels) ) n_channels = 0
1612  IF ( PRESENT(n_profiles) ) n_profiles = n_input_profiles
1613 
1614 
1615  ! Output an info message
1616  IF ( noisy ) THEN
1617  WRITE( msg,'("Number of profiles read from ",a,": ",i0)' ) trim(filename), n_input_profiles
1618  CALL display_message( routine_name, msg, information )
1619  END IF
1620 
1621  CONTAINS
1622 
1623  SUBROUTINE read_cleanup()
1624  IF ( file_open( filename ) ) THEN
1625  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
1626  IF ( io_stat /= 0 ) &
1627  msg = trim(msg)//'; Error closing input file during error cleanup - '//trim(io_msg)
1628  END IF
1629  IF ( ALLOCATED(atmosphere) ) THEN
1630  DEALLOCATE(atmosphere, stat=alloc_stat, errmsg=alloc_msg)
1631  IF ( alloc_stat /= 0 ) &
1632  msg = trim(msg)//'; Error deallocating Atmosphere array during error cleanup - '//&
1633  trim(alloc_msg)
1634  END IF
1635  err_stat = failure
1636  CALL display_message( routine_name, msg, err_stat )
1637  END SUBROUTINE read_cleanup
1638 
1639  END FUNCTION read_atmosphere_rank1
1640 
1641 
1642  FUNCTION read_atmosphere_rank2( &
1643  Filename , & ! Input
1644  Atmosphere , & ! Output
1645  Quiet , & ! Optional input
1646  n_Channels , & ! Optional output
1647  n_Profiles , & ! Optional output
1648  Debug ) & ! Optional input (Debug output control)
1649  result( err_stat )
1650  ! Arguments
1651  CHARACTER(*), INTENT(IN) :: filename
1652  TYPE(crtm_atmosphere_type), ALLOCATABLE, INTENT(OUT) :: atmosphere(:,:) ! L x M
1653  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
1654  INTEGER, OPTIONAL, INTENT(OUT) :: n_channels
1655  INTEGER, OPTIONAL, INTENT(OUT) :: n_profiles
1656  LOGICAL, OPTIONAL, INTENT(IN) :: debug
1657  ! Function result
1658  INTEGER :: err_stat
1659  ! Function parameters
1660  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Atmosphere_ReadFile(L x M)'
1661  ! Function variables
1662  CHARACTER(ML) :: msg
1663  CHARACTER(ML) :: io_msg
1664  CHARACTER(ML) :: alloc_msg
1665  INTEGER :: io_stat
1666  INTEGER :: alloc_stat
1667  LOGICAL :: noisy
1668  INTEGER :: fid
1669  INTEGER :: l, n_input_channels
1670  INTEGER :: m, n_input_profiles
1671 
1672 
1673  ! Set up
1674  err_stat = success
1675  ! ...Check Quiet argument
1676  noisy = .true.
1677  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
1678  ! ...Override Quiet settings if debug set.
1679  IF ( PRESENT(debug) ) noisy = debug
1680 
1681 
1682  ! Open the file
1683  err_stat = open_binary_file( filename, fid )
1684  IF ( err_stat /= success ) THEN
1685  msg = 'Error opening '//trim(filename)
1686  CALL read_cleanup(); RETURN
1687  END IF
1688 
1689 
1690  ! Read the dimensions
1691  READ( fid,iostat=io_stat,iomsg=io_msg ) n_input_channels, n_input_profiles
1692  IF ( io_stat /= 0 ) THEN
1693  msg = 'Error reading dimensions from '//trim(filename)//' - '//trim(io_msg)
1694  CALL read_cleanup(); RETURN
1695  END IF
1696  ! ...Allocate the return structure array
1697  ALLOCATE(atmosphere(n_input_channels, n_input_profiles), &
1698  stat=alloc_stat, errmsg=alloc_msg)
1699  IF ( alloc_stat /= 0 ) THEN
1700  msg = 'Error allocating Atmosphere array - '//trim(alloc_msg)
1701  CALL read_cleanup(); RETURN
1702  END IF
1703 
1704 
1705  ! Loop over all the profiles and channels
1706  profile_loop: DO m = 1, n_input_profiles
1707  channel_loop: DO l = 1, n_input_channels
1708  err_stat = read_record( fid, atmosphere(l,m), &
1709  quiet = quiet, &
1710  debug = debug )
1711  IF ( err_stat /= success ) THEN
1712  WRITE( msg,'("Error reading Atmosphere element (",i0,",",i0,") from ",a)' ) l, m, trim(filename)
1713  CALL read_cleanup(); RETURN
1714  END IF
1715  END DO channel_loop
1716  END DO profile_loop
1717 
1718 
1719  ! Close the file
1720  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
1721  IF ( io_stat /= 0 ) THEN
1722  msg = 'Error closing '//trim(filename)//' - '//trim(io_msg)
1723  CALL read_cleanup(); RETURN
1724  END IF
1725 
1726 
1727  ! Set the optional return values
1728  IF ( PRESENT(n_channels) ) n_channels = n_input_channels
1729  IF ( PRESENT(n_profiles) ) n_profiles = n_input_profiles
1730 
1731 
1732  ! Output an info message
1733  IF ( noisy ) THEN
1734  WRITE( msg,'("Number of channels and profiles read from ",a,": ",i0,1x,i0)' ) &
1735  trim(filename), n_input_channels, n_input_profiles
1736  CALL display_message( routine_name, msg, information )
1737  END IF
1738 
1739  CONTAINS
1740 
1741  SUBROUTINE read_cleanup()
1742  IF ( file_open( filename ) ) THEN
1743  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
1744  IF ( io_stat /= 0 ) &
1745  msg = trim(msg)//'; Error closing input file during error cleanup - '//trim(io_msg)
1746  END IF
1747  IF ( ALLOCATED(atmosphere) ) THEN
1748  DEALLOCATE(atmosphere, stat=alloc_stat, errmsg=alloc_msg)
1749  IF ( alloc_stat /= 0 ) &
1750  msg = trim(msg)//'; Error deallocating Atmosphere array during error cleanup - '//&
1751  trim(alloc_msg)
1752  END IF
1753  err_stat = failure
1754  CALL display_message( routine_name, msg, err_stat )
1755  END SUBROUTINE read_cleanup
1756 
1757  END FUNCTION read_atmosphere_rank2
1758 
1759 
1760 !------------------------------------------------------------------------------
1761 !:sdoc+:
1762 !
1763 ! NAME:
1764 ! CRTM_Atmosphere_WriteFile
1765 !
1766 ! PURPOSE:
1767 ! Function to write CRTM Atmosphere object files.
1768 !
1769 ! CALLING SEQUENCE:
1770 ! Error_Status = CRTM_Atmosphere_WriteFile( Filename , &
1771 ! Atmosphere , &
1772 ! Quiet = Quiet )
1773 !
1774 ! INPUTS:
1775 ! Filename: Character string specifying the name of the
1776 ! Atmosphere format data file to write.
1777 ! UNITS: N/A
1778 ! TYPE: CHARACTER(*)
1779 ! DIMENSION: Scalar
1780 ! ATTRIBUTES: INTENT(IN)
1781 !
1782 ! Atmosphere: CRTM Atmosphere object array containing the Atmosphere
1783 ! data. Note the following meanings attributed to the
1784 ! dimensions of the Atmosphere array:
1785 ! Rank-1: M profiles.
1786 ! Only profile data are to be read in. The file
1787 ! does not contain channel information. The
1788 ! dimension of the array is understood to
1789 ! be the PROFILE dimension.
1790 ! Rank-2: L channels x M profiles
1791 ! Channel and profile data are to be read in.
1792 ! The file contains both channel and profile
1793 ! information. The first dimension of the
1794 ! array is the CHANNEL dimension, the second
1795 ! is the PROFILE dimension. This is to allow
1796 ! K-matrix structures to be read in with the
1797 ! same function.
1798 ! UNITS: N/A
1799 ! TYPE: CRTM_Atmosphere_type
1800 ! DIMENSION: Rank-1 (M) or Rank-2 (L x M)
1801 ! ATTRIBUTES: INTENT(IN)
1802 !
1803 ! OPTIONAL INPUTS:
1804 ! Quiet: Set this logical argument to suppress INFORMATION
1805 ! messages being printed to stdout
1806 ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
1807 ! == .TRUE., INFORMATION messages are SUPPRESSED.
1808 ! If not specified, default is .FALSE.
1809 ! UNITS: N/A
1810 ! TYPE: LOGICAL
1811 ! DIMENSION: Scalar
1812 ! ATTRIBUTES: INTENT(IN), OPTIONAL
1813 !
1814 ! FUNCTION RESULT:
1815 ! Error_Status: The return value is an integer defining the error status.
1816 ! The error codes are defined in the Message_Handler module.
1817 ! If == SUCCESS, the file write was successful
1818 ! == FAILURE, an unrecoverable error occurred.
1819 ! UNITS: N/A
1820 ! TYPE: INTEGER
1821 ! DIMENSION: Scalar
1822 !
1823 ! SIDE EFFECTS:
1824 ! - If the output file already exists, it is overwritten.
1825 ! - If an error occurs during *writing*, the output file is deleted before
1826 ! returning to the calling routine.
1827 !
1828 !:sdoc-:
1829 !------------------------------------------------------------------------------
1830 
1831  FUNCTION write_atmosphere_rank1( &
1832  Filename , & ! Input
1833  Atmosphere , & ! Input
1834  Quiet , & ! Optional input
1835  Debug ) & ! Optional input (Debug output control)
1836  result( err_stat )
1837  ! Arguments
1838  CHARACTER(*), INTENT(IN) :: filename
1839  TYPE(crtm_atmosphere_type), INTENT(IN) :: atmosphere(:) ! M
1840  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
1841  LOGICAL, OPTIONAL, INTENT(IN) :: debug
1842  ! Function result
1843  INTEGER :: err_stat
1844  ! Function parameters
1845  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Atmosphere_WriteFile(M)'
1846  ! Function variables
1847  CHARACTER(ML) :: msg
1848  CHARACTER(ML) :: io_msg
1849  INTEGER :: io_stat
1850  LOGICAL :: noisy
1851  INTEGER :: fid
1852  INTEGER :: m, n_output_profiles
1853 
1854  ! Setup
1855  err_stat = success
1856  ! ...Check Quiet argument
1857  noisy = .true.
1858  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
1859  ! ...Override Quiet settings if debug set.
1860  IF ( PRESENT(debug) ) noisy = debug
1861 
1862 
1863  ! Any invalid profiles?
1864  IF ( any(atmosphere%n_Layers == 0 .OR. &
1865  atmosphere%n_Absorbers == 0 ) ) THEN
1866  msg = 'Zero dimension profiles in input!'
1867  CALL write_cleanup(); RETURN
1868  END IF
1869  n_output_profiles = SIZE(atmosphere)
1870 
1871 
1872  ! Open the file
1873  err_stat = open_binary_file( filename, fid, for_output = .true. )
1874  IF ( err_stat /= success ) THEN
1875  msg = 'Error opening '//trim(filename)
1876  CALL write_cleanup(); RETURN
1877  END IF
1878 
1879 
1880  ! Write the dimensions
1881  WRITE( fid,iostat=io_stat,iomsg=io_msg ) 0, n_output_profiles
1882  IF ( io_stat /= 0 ) THEN
1883  msg = 'Error writing dimensions to '//trim(filename)//'- '//trim(io_msg)
1884  CALL write_cleanup(); RETURN
1885  END IF
1886 
1887 
1888  ! Write the data
1889  profile_loop: DO m = 1, n_output_profiles
1890  err_stat = write_record( fid, atmosphere(m), &
1891  quiet = quiet, &
1892  debug = debug )
1893  IF ( err_stat /= success ) THEN
1894  WRITE( msg,'("Error writing Atmosphere element (",i0,") to ",a)' ) m, trim(filename)
1895  CALL write_cleanup(); RETURN
1896  END IF
1897  END DO profile_loop
1898 
1899 
1900  ! Close the file (if error, no delete)
1901  CLOSE( fid,status='KEEP',iostat=io_stat,iomsg=io_msg )
1902  IF ( io_stat /= 0 ) THEN
1903  msg = 'Error closing '//trim(filename)//'- '//trim(io_msg)
1904  CALL write_cleanup(); RETURN
1905  END IF
1906 
1907 
1908  ! Output an info message
1909  IF ( noisy ) THEN
1910  WRITE( msg,'("Number of profiles written to ",a,": ",i0)' ) trim(filename), n_output_profiles
1911  CALL display_message( routine_name, msg, information )
1912  END IF
1913 
1914  CONTAINS
1915 
1916  SUBROUTINE write_cleanup()
1917  IF ( file_open( filename ) ) THEN
1918  CLOSE( fid,status=write_error_status,iostat=io_stat,iomsg=io_msg )
1919  IF ( io_stat /= 0 ) &
1920  msg = trim(msg)//'; Error deleting output file during error cleanup - '//trim(io_msg)
1921  END IF
1922  err_stat = failure
1923  CALL display_message( routine_name, msg, err_stat )
1924  END SUBROUTINE write_cleanup
1925 
1926  END FUNCTION write_atmosphere_rank1
1927 
1928 
1929  FUNCTION write_atmosphere_rank2( &
1930  Filename , & ! Input
1931  Atmosphere , & ! Input
1932  Quiet , & ! Optional input
1933  Debug ) & ! Optional input (Debug output control)
1934  result( err_stat )
1935  ! Arguments
1936  CHARACTER(*), INTENT(IN) :: filename
1937  TYPE(crtm_atmosphere_type), INTENT(IN) :: atmosphere(:,:) ! L x M
1938  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
1939  LOGICAL, OPTIONAL, INTENT(IN) :: debug
1940  ! Function result
1941  INTEGER :: err_stat
1942  ! Function parameters
1943  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Atmosphere_WriteFile(L x M)'
1944  ! Function variables
1945  CHARACTER(ML) :: msg
1946  CHARACTER(ML) :: io_msg
1947  INTEGER :: io_stat
1948  LOGICAL :: noisy
1949  INTEGER :: fid
1950  INTEGER :: l, n_output_channels
1951  INTEGER :: m, n_output_profiles
1952 
1953  ! Set up
1954  err_stat = success
1955  ! ...Check Quiet argument
1956  noisy = .true.
1957  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
1958  ! ...Override Quiet settings if debug set.
1959  IF ( PRESENT(debug) ) noisy = debug
1960 
1961 
1962  ! Any invalid profiles?
1963  IF ( any(atmosphere%n_Layers == 0 .OR. &
1964  atmosphere%n_Absorbers == 0 ) ) THEN
1965  msg = 'Zero dimension profiles in input!'
1966  CALL write_cleanup(); RETURN
1967  END IF
1968  n_output_channels = SIZE(atmosphere,dim=1)
1969  n_output_profiles = SIZE(atmosphere,dim=2)
1970 
1971 
1972  ! Open the file
1973  err_stat = open_binary_file( filename, fid, for_output = .true. )
1974  IF ( err_stat /= success ) THEN
1975  msg = 'Error opening '//trim(filename)
1976  CALL write_cleanup(); RETURN
1977  END IF
1978 
1979 
1980  ! Write the dimensions
1981  WRITE( fid,iostat=io_stat,iomsg=io_msg ) n_output_channels, n_output_profiles
1982  IF ( io_stat /= 0 ) THEN
1983  msg = 'Error writing dimensions to '//trim(filename)//'- '//trim(io_msg)
1984  CALL write_cleanup(); RETURN
1985  END IF
1986 
1987 
1988  ! Write the data
1989  profile_loop: DO m = 1, n_output_profiles
1990  channel_loop: DO l = 1, n_output_channels
1991  err_stat = write_record( fid, atmosphere(l,m), &
1992  quiet = quiet, &
1993  debug = debug )
1994  IF ( err_stat /= success ) THEN
1995  WRITE( msg,'("Error writing Atmosphere element (",i0,",",i0,") to ",a)' ) l, m, trim(filename)
1996  CALL write_cleanup(); RETURN
1997  END IF
1998  END DO channel_loop
1999  END DO profile_loop
2000 
2001 
2002  ! Close the file (if error, no delete)
2003  CLOSE( fid,status='KEEP',iostat=io_stat,iomsg=io_msg )
2004  IF ( io_stat /= 0 ) THEN
2005  msg = 'Error closing '//trim(filename)//'- '//trim(io_msg)
2006  CALL write_cleanup(); RETURN
2007  END IF
2008 
2009 
2010  ! Output an info message
2011  IF ( noisy ) THEN
2012  WRITE( msg,'("Number of channels and profiles written to ",a,": ",i0,1x,i0 )' ) &
2013  trim(filename), n_output_channels, n_output_profiles
2014  CALL display_message( routine_name, msg, information )
2015  END IF
2016 
2017  CONTAINS
2018 
2019  SUBROUTINE write_cleanup()
2020  IF ( file_open( filename ) ) THEN
2021  CLOSE( fid,status=write_error_status,iostat=io_stat,iomsg=io_msg )
2022  IF ( io_stat /= 0 ) &
2023  msg = trim(msg)//'; Error deleting output file during error cleanup - '//trim(io_msg)
2024  END IF
2025  err_stat = failure
2026  CALL display_message( routine_name, msg, err_stat )
2027  END SUBROUTINE write_cleanup
2028 
2029  END FUNCTION write_atmosphere_rank2
2030 
2031 
2032 
2033 !##################################################################################
2034 !##################################################################################
2035 !## ##
2036 !## ## PRIVATE MODULE ROUTINES ## ##
2037 !## ##
2038 !##################################################################################
2039 !##################################################################################
2040 
2041 !--------------------------------------------------------------------------------
2042 !
2043 ! NAME:
2044 ! CRTM_Atmosphere_Equal
2045 !
2046 ! PURPOSE:
2047 ! Elemental function to test the equality of two CRTM_Atmosphere objects.
2048 ! Used in OPERATOR(==) interface block.
2049 !
2050 ! CALLING SEQUENCE:
2051 ! is_equal = CRTM_Atmosphere_Equal( x, y )
2052 !
2053 ! or
2054 !
2055 ! IF ( x == y ) THEN
2056 ! ...
2057 ! END IF
2058 !
2059 ! OBJECTS:
2060 ! x, y: Two CRTM Atmosphere objects to be compared.
2061 ! UNITS: N/A
2062 ! TYPE: CRTM_Atmosphere_type
2063 ! DIMENSION: Scalar or any rank
2064 ! ATTRIBUTES: INTENT(IN)
2065 !
2066 ! FUNCTION RESULT:
2067 ! is_equal: Logical value indicating whether the inputs are equal.
2068 ! UNITS: N/A
2069 ! TYPE: LOGICAL
2070 ! DIMENSION: Same as inputs.
2071 !
2072 !--------------------------------------------------------------------------------
2073 
2074  ELEMENTAL FUNCTION crtm_atmosphere_equal( x, y ) RESULT( is_equal )
2075  TYPE(crtm_atmosphere_type) , INTENT(IN) :: x, y
2076  LOGICAL :: is_equal
2077  ! Variables
2078  INTEGER :: j, k
2079 
2080  ! Set up
2081  is_equal = .false.
2082 
2083  ! Check the structure association status
2084  IF ( (.NOT. crtm_atmosphere_associated(x)) .OR. &
2085  (.NOT. crtm_atmosphere_associated(y)) ) RETURN
2086 
2087  ! Check contents
2088  ! ...Scalars
2089  IF ( (x%n_Layers /= y%n_Layers ) .OR. &
2090  (x%n_Absorbers /= y%n_Absorbers) .OR. &
2091  (x%n_Clouds /= y%n_Clouds ) .OR. &
2092  (x%n_Aerosols /= y%n_Aerosols ) .OR. &
2093  (x%Climatology /= y%Climatology) ) RETURN
2094  ! ...Arrays
2095  k = x%n_Layers
2096  j = x%n_Absorbers
2097  IF ( all(x%Absorber_ID(1:j) == y%Absorber_ID(1:j) ) .AND. &
2098  all(x%Absorber_Units(1:j) == y%Absorber_Units(1:j)) .AND. &
2099  all(x%Level_Pressure(0:) .equalto. y%Level_Pressure(0:)) .AND. &
2100  all(x%Pressure(1:k) .equalto. y%Pressure(1:k) ) .AND. &
2101  all(x%Temperature(1:k) .equalto. y%Temperature(1:k) ) .AND. &
2102  all(x%Absorber(1:k,1:j) .equalto. y%Absorber(1:k,1:j) ) ) is_equal = .true.
2103  ! ...Clouds
2104  IF ( x%n_Clouds > 0 ) THEN
2105  IF ( all(crtm_cloud_associated(x%Cloud)) .AND. all(crtm_cloud_associated(y%Cloud)) ) &
2106  is_equal = is_equal .AND. all(x%Cloud == y%Cloud)
2107  END IF
2108  ! ...Aerosols
2109  IF ( x%n_Aerosols > 0 ) THEN
2110  IF ( all(crtm_aerosol_associated(x%Aerosol)) .AND. all(crtm_aerosol_associated(y%Aerosol)) ) &
2111  is_equal = is_equal .AND. all(x%Aerosol == y%Aerosol)
2112  END IF
2113 
2114  END FUNCTION crtm_atmosphere_equal
2115 
2116 
2117 !--------------------------------------------------------------------------------
2118 !
2119 ! NAME:
2120 ! CRTM_Atmosphere_Add
2121 !
2122 ! PURPOSE:
2123 ! Pure function to add two CRTM Atmosphere objects.
2124 ! Used in OPERATOR(+) interface block.
2125 !
2126 ! CALLING SEQUENCE:
2127 ! atmsum = CRTM_Atmosphere_Add( atm1, atm2 )
2128 !
2129 ! or
2130 !
2131 ! atmsum = atm1 + atm2
2132 !
2133 !
2134 ! INPUTS:
2135 ! atm1, atm2: The Atmosphere objects to add.
2136 ! UNITS: N/A
2137 ! TYPE: CRTM_Atmosphere_type
2138 ! DIMENSION: Scalar
2139 ! ATTRIBUTES: INTENT(IN OUT)
2140 !
2141 ! RESULT:
2142 ! atmsum: Atmosphere structure containing the added components.
2143 ! UNITS: N/A
2144 ! TYPE: CRTM_Atmosphere_type
2145 ! DIMENSION: Scalar
2146 !
2147 !--------------------------------------------------------------------------------
2148 
2149  ELEMENTAL FUNCTION crtm_atmosphere_add( atm1, atm2 ) RESULT( atmsum )
2150  TYPE(crtm_atmosphere_type), INTENT(IN) :: atm1, atm2
2151  TYPE(crtm_atmosphere_type) :: atmsum
2152  ! Variables
2153  INTEGER :: i, j, k
2154 
2155  ! Check input
2156  ! ...If input structures not used, do nothing
2157  IF ( .NOT. crtm_atmosphere_associated( atm1 ) .OR. &
2158  .NOT. crtm_atmosphere_associated( atm2 ) ) RETURN
2159  ! ...If input structure for different Atmospheres, or sizes, do nothing
2160  IF ( atm1%Climatology /= atm2%Climatology .OR. &
2161  atm1%n_Layers /= atm2%n_Layers .OR. &
2162  atm1%n_Absorbers /= atm2%n_Absorbers .OR. &
2163  atm1%n_Clouds /= atm2%n_Clouds .OR. &
2164  atm1%n_Aerosols /= atm2%n_Aerosols .OR. &
2165  atm1%n_Added_Layers /= atm2%n_Added_Layers ) RETURN
2166  ! ...Dimenions the same, check absorber info
2167  IF ( any(atm1%Absorber_ID /= atm2%Absorber_ID ) .OR. &
2168  any(atm1%Absorber_Units /= atm2%Absorber_Units) ) RETURN
2169 
2170  ! Copy the first structure
2171  atmsum = atm1
2172 
2173  ! And add its components to the second one
2174  k = atm1%n_Layers
2175  j = atm1%n_Absorbers
2176  atmsum%Level_Pressure(0:k) = atmsum%Level_Pressure(0:k) + atm2%Level_Pressure(0:k)
2177  atmsum%Pressure(1:k) = atmsum%Pressure(1:k) + atm2%Pressure(1:k)
2178  atmsum%Temperature(1:k) = atmsum%Temperature(1:k) + atm2%Temperature(1:k)
2179  atmsum%Absorber(1:k,1:j) = atmsum%Absorber(1:k,1:j) + atm2%Absorber(1:k,1:j)
2180  ! ...Cloud component
2181  IF ( atm1%n_Clouds > 0 ) THEN
2182  DO i = 1, atm1%n_Clouds
2183  atmsum%Cloud(i) = atmsum%Cloud(i) + atm2%Cloud(i)
2184  END DO
2185  END IF
2186  ! ...Aerosol component
2187  IF ( atm1%n_Aerosols > 0 ) THEN
2188  DO i = 1, atm1%n_Aerosols
2189  atmsum%Aerosol(i) = atmsum%Aerosol(i) + atm2%Aerosol(i)
2190  END DO
2191  END IF
2192 
2193  END FUNCTION crtm_atmosphere_add
2194 
2195 
2196 
2197 !--------------------------------------------------------------------------------
2198 !
2199 ! NAME:
2200 ! CRTM_Atmosphere_Subtract
2201 !
2202 ! PURPOSE:
2203 ! Pure function to subtract two CRTM Atmosphere objects.
2204 ! Used in OPERATOR(-) interface block.
2205 !
2206 ! CALLING SEQUENCE:
2207 ! atmdiff = CRTM_Atmosphere_Subtract( atm1, atm2 )
2208 !
2209 ! or
2210 !
2211 ! atmdiff = atm1 - atm2
2212 !
2213 !
2214 ! INPUTS:
2215 ! atm1, atm2: The Atmosphere objects to subtract.
2216 ! UNITS: N/A
2217 ! TYPE: CRTM_Atmosphere_type
2218 ! DIMENSION: Scalar
2219 ! ATTRIBUTES: INTENT(IN OUT)
2220 !
2221 ! RESULT:
2222 ! atmdiff: Atmosphere structure containing the differenced components.
2223 ! UNITS: N/A
2224 ! TYPE: CRTM_Atmosphere_type
2225 ! DIMENSION: Scalar
2226 !
2227 !--------------------------------------------------------------------------------
2228 
2229  ELEMENTAL FUNCTION crtm_atmosphere_subtract( atm1, atm2 ) RESULT( atmdiff )
2230  TYPE(crtm_atmosphere_type), INTENT(IN) :: atm1, atm2
2231  TYPE(crtm_atmosphere_type) :: atmdiff
2232  ! Variables
2233  INTEGER :: i, j, k
2234 
2235  ! Check input
2236  ! ...If input structures not used, do nothing
2237  IF ( .NOT. crtm_atmosphere_associated( atm1 ) .OR. &
2238  .NOT. crtm_atmosphere_associated( atm2 ) ) RETURN
2239  ! ...If input structure for different Atmospheres, or sizes, do nothing
2240  IF ( atm1%Climatology /= atm2%Climatology .OR. &
2241  atm1%n_Layers /= atm2%n_Layers .OR. &
2242  atm1%n_Absorbers /= atm2%n_Absorbers .OR. &
2243  atm1%n_Clouds /= atm2%n_Clouds .OR. &
2244  atm1%n_Aerosols /= atm2%n_Aerosols .OR. &
2245  atm1%n_Added_Layers /= atm2%n_Added_Layers ) RETURN
2246  ! ...Dimenions the same, check absorber info
2247  IF ( any(atm1%Absorber_ID /= atm2%Absorber_ID ) .OR. &
2248  any(atm1%Absorber_Units /= atm2%Absorber_Units) ) RETURN
2249 
2250  ! Copy the first structure
2251  atmdiff = atm1
2252 
2253  ! And subtract the second one's components from it
2254  k = atm1%n_Layers
2255  j = atm1%n_Absorbers
2256  atmdiff%Level_Pressure(0:k) = atmdiff%Level_Pressure(0:k) - atm2%Level_Pressure(0:k)
2257  atmdiff%Pressure(1:k) = atmdiff%Pressure(1:k) - atm2%Pressure(1:k)
2258  atmdiff%Temperature(1:k) = atmdiff%Temperature(1:k) - atm2%Temperature(1:k)
2259  atmdiff%Absorber(1:k,1:j) = atmdiff%Absorber(1:k,1:j) - atm2%Absorber(1:k,1:j)
2260  ! ...Cloud component
2261  IF ( atm1%n_Clouds > 0 ) THEN
2262  DO i = 1, atm1%n_Clouds
2263  atmdiff%Cloud(i) = atmdiff%Cloud(i) - atm2%Cloud(i)
2264  END DO
2265  END IF
2266  ! ...Aerosol component
2267  IF ( atm1%n_Aerosols > 0 ) THEN
2268  DO i = 1, atm1%n_Aerosols
2269  atmdiff%Aerosol(i) = atmdiff%Aerosol(i) - atm2%Aerosol(i)
2270  END DO
2271  END IF
2272 
2273  END FUNCTION crtm_atmosphere_subtract
2274 
2275 
2276 !
2277 ! NAME:
2278 ! Read_Record
2279 !
2280 ! PURPOSE:
2281 ! Utility function to read a single atmosphere data record
2282 !
2283 
2284  FUNCTION read_record( &
2285  fid , & ! Input
2286  atm , & ! Output
2287  Quiet , & ! Optional input
2288  Debug ) & ! Optional input (Debug output control)
2289  result( err_stat )
2290  ! Arguments
2291  INTEGER, INTENT(IN) :: fid
2292  TYPE(crtm_atmosphere_type), INTENT(OUT) :: atm
2293  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
2294  LOGICAL, OPTIONAL, INTENT(IN) :: debug
2295  ! Function result
2296  INTEGER :: err_stat
2297  ! Function parameters
2298  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Atmosphere_ReadFile(Record)'
2299  ! Function variables
2300  CHARACTER(ML) :: fname
2301  CHARACTER(ML) :: msg
2302  CHARACTER(ML) :: io_msg
2303  INTEGER :: io_stat
2304  INTEGER :: n_layers
2305  INTEGER :: n_absorbers
2306  INTEGER :: n_clouds
2307  INTEGER :: n_aerosols
2308 
2309  ! Set up
2310  err_stat = success
2311 
2312 
2313  ! Read the dimensions
2314  READ( fid,iostat=io_stat,iomsg=io_msg ) &
2315  n_layers, &
2316  n_absorbers, &
2317  n_clouds, &
2318  n_aerosols
2319  IF ( io_stat /= 0 ) THEN
2320  msg = 'Error reading dimensions - '//trim(io_msg)
2321  CALL read_record_cleanup(); RETURN
2322  END IF
2323 
2324 
2325  ! Allocate the Atmosphere structure
2326  CALL crtm_atmosphere_create( atm, &
2327  n_layers, &
2328  n_absorbers, &
2329  n_clouds, &
2330  n_aerosols )
2331  IF ( .NOT. crtm_atmosphere_associated( atm ) ) THEN
2332  msg = 'Error creating output object.'
2333  CALL read_record_cleanup(); RETURN
2334  END IF
2335 
2336 
2337  ! Read the climatology model flag and absorber IDs
2338  READ( fid,iostat=io_stat,iomsg=io_msg ) &
2339  atm%Climatology, &
2340  atm%Absorber_ID, &
2341  atm%Absorber_Units
2342  IF ( io_stat /= 0 ) THEN
2343  msg = 'Error reading atmosphere climatology and absorber IDs - '//trim(io_msg)
2344  CALL read_record_cleanup(); RETURN
2345  END IF
2346 
2347 
2348  ! Read the atmospheric profile data
2349  READ( fid,iostat=io_stat,iomsg=io_msg ) &
2350  atm%Level_Pressure, &
2351  atm%Pressure, &
2352  atm%Temperature, &
2353  atm%Absorber
2354  IF ( io_stat /= 0 ) THEN
2355  msg = 'Error reading atmospheric profile data - '//trim(io_msg)
2356  CALL read_record_cleanup(); RETURN
2357  END IF
2358 
2359 
2360  ! Read the cloud data
2361  IF ( n_clouds > 0 ) THEN
2362  INQUIRE( unit=fid,name=fname )
2363  err_stat = crtm_cloud_readfile( fname, &
2364  atm%Cloud, &
2365  quiet = quiet, &
2366  no_close = .true., &
2367  debug = debug )
2368  IF ( err_stat /= success ) THEN
2369  msg = 'Error reading cloud data'
2370  CALL read_record_cleanup(); RETURN
2371  END IF
2372  END IF
2373 
2374 
2375  ! Read the aerosol data
2376  IF ( n_aerosols > 0 ) THEN
2377  INQUIRE( unit=fid,name=fname )
2378  err_stat = crtm_aerosol_readfile( fname, &
2379  atm%Aerosol, &
2380  quiet = quiet, &
2381  no_close = .true., &
2382  debug = debug )
2383  IF ( err_stat /= success ) THEN
2384  msg = 'Error reading aerosol data'
2385  CALL read_record_cleanup(); RETURN
2386  END IF
2387  END IF
2388 
2389  CONTAINS
2390 
2391  SUBROUTINE read_record_cleanup()
2392  CALL crtm_atmosphere_destroy( atm )
2393  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
2394  IF ( io_stat /= success ) &
2395  msg = trim(msg)//'; Error closing file during error cleanup - '//trim(io_msg)
2396  err_stat = failure
2397  CALL display_message( routine_name, msg, err_stat )
2398  END SUBROUTINE read_record_cleanup
2399 
2400  END FUNCTION read_record
2401 
2402 
2403 !
2404 ! NAME:
2405 ! Write_Record
2406 !
2407 ! PURPOSE:
2408 ! Function to write a single atmosphere data record
2409 !
2410 
2411  FUNCTION write_record( &
2412  fid , & ! Input
2413  atm , & ! Input
2414  Quiet, & ! Optional input
2415  Debug) & ! Optional input (Debug output control)
2416  result( err_stat )
2417  ! Arguments
2418  INTEGER, INTENT(IN) :: fid
2419  TYPE(crtm_atmosphere_type), INTENT(IN) :: atm
2420  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
2421  LOGICAL, OPTIONAL, INTENT(IN) :: debug
2422  ! Function result
2423  INTEGER :: err_stat
2424  ! Function parameters
2425  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Atmosphere_WriteFile(Record)'
2426  ! Function variables
2427  CHARACTER(ML) :: fname
2428  CHARACTER(ML) :: msg
2429  CHARACTER(ML) :: io_msg
2430  INTEGER :: io_stat
2431 
2432  ! Set up
2433  err_stat = success
2434  IF ( .NOT. crtm_atmosphere_associated( atm ) ) THEN
2435  msg = 'Input Atmosphere object is not used.'
2436  CALL write_record_cleanup(); RETURN
2437  END IF
2438 
2439 
2440  ! Write the data dimensions
2441  WRITE( fid,iostat=io_stat,iomsg=io_msg ) &
2442  atm%n_Layers, &
2443  atm%n_Absorbers, &
2444  atm%n_Clouds, &
2445  atm%n_Aerosols
2446  IF ( io_stat /= 0 ) THEN
2447  msg = 'Error writing dimensions - '//trim(io_msg)
2448  CALL write_record_cleanup(); RETURN
2449  END IF
2450 
2451 
2452  ! Write the climatology model flag and absorber IDs
2453  WRITE( fid,iostat=io_stat,iomsg=io_msg ) &
2454  atm%Climatology, &
2455  atm%Absorber_ID, &
2456  atm%Absorber_Units
2457  IF ( io_stat /= 0 ) THEN
2458  msg = 'Error writing atmosphere climatology and absorber IDs - '//trim(io_msg)
2459  CALL write_record_cleanup(); RETURN
2460  END IF
2461 
2462 
2463  ! Write the atmospheric profile data
2464  WRITE( fid,iostat=io_stat,iomsg=io_msg ) &
2465  atm%Level_Pressure(0:atm%n_Layers), &
2466  atm%Pressure(1:atm%n_Layers), &
2467  atm%Temperature(1:atm%n_Layers), &
2468  atm%Absorber(1:atm%n_Layers,:)
2469  IF ( io_stat /= 0 ) THEN
2470  msg = 'Error writing atmospheric profile data - '//trim(io_msg)
2471  CALL write_record_cleanup(); RETURN
2472  END IF
2473 
2474 
2475  ! Write the cloud data
2476  IF ( atm%n_Clouds > 0 ) THEN
2477  INQUIRE( unit=fid,name=fname )
2478  err_stat = crtm_cloud_writefile( fname, &
2479  atm%Cloud(1:atm%n_Clouds), &
2480  quiet = quiet, &
2481  no_close = .true., &
2482  debug = debug )
2483  IF ( err_stat /= success ) THEN
2484  msg = 'Error writing cloud data'
2485  CALL write_record_cleanup(); RETURN
2486  END IF
2487  END IF
2488 
2489 
2490  ! Write the aerosol data
2491  IF ( atm%n_Aerosols > 0 ) THEN
2492  INQUIRE( unit=fid,name=fname )
2493  err_stat = crtm_aerosol_writefile( fname, &
2494  atm%Aerosol(1:atm%n_Aerosols), &
2495  quiet = quiet, &
2496  no_close = .true., &
2497  debug = debug )
2498  IF ( err_stat /= success ) THEN
2499  msg = 'Error writing aerosol data'
2500  CALL write_record_cleanup(); RETURN
2501  END IF
2502  END IF
2503 
2504  CONTAINS
2505 
2506  SUBROUTINE write_record_cleanup()
2507  CLOSE( fid,status=write_error_status,iostat=io_stat,iomsg=io_msg )
2508  IF ( io_stat /= success ) &
2509  msg = trim(msg)//'; Error closing file during error cleanup - '//trim(io_msg)
2510  err_stat = failure
2511  CALL display_message( routine_name, msg, err_stat )
2512  END SUBROUTINE write_record_cleanup
2513 
2514  END FUNCTION write_record
2515 
2516 END MODULE crtm_atmosphere_define
crtm_cloud_define::ice_cloud
integer, parameter, public ice_cloud
Definition: CRTM_Cloud_Define.f90:108
crtm_cloud_define::n_valid_cloud_categories
integer, parameter, public n_valid_cloud_categories
Definition: CRTM_Cloud_Define.f90:105
crtm_atmosphere_define::h2o2_id
integer, parameter, public h2o2_id
Definition: CRTM_Atmosphere_Define.f90:274
crtm_atmosphere_define::n2o_id
integer, parameter, public n2o_id
Definition: CRTM_Atmosphere_Define.f90:253
crtm_atmosphere_define::crtm_atmosphere_addlayercopy
elemental type(crtm_atmosphere_type) function, public crtm_atmosphere_addlayercopy(atm, n_Added_Layers)
Definition: CRTM_Atmosphere_Define.f90:657
crtm_atmosphere_define::ph3_id
integer, parameter, public ph3_id
Definition: CRTM_Atmosphere_Define.f90:277
crtm_aerosol_define::dust_aerosol
integer, parameter, public dust_aerosol
Definition: CRTM_Aerosol_Define.f90:108
crtm_atmosphere_define::ch4_id
integer, parameter, public ch4_id
Definition: CRTM_Atmosphere_Define.f90:255
compare_float_numbers::compares_within_tolerance
Definition: Compare_Float_Numbers.f90:76
message_handler::failure
integer, parameter, public failure
Definition: Message_Handler.f90:30
crtm_cloud_define::crtm_cloud_categoryid
pure integer function, public crtm_cloud_categoryid(cloud)
Definition: CRTM_Cloud_Define.f90:172
crtm_atmosphere_define::n_valid_climatology_models
integer, parameter, public n_valid_climatology_models
Definition: CRTM_Atmosphere_Define.f90:332
crtm_aerosol_define::seasalt_sscm1_aerosol
integer, parameter, public seasalt_sscm1_aerosol
Definition: CRTM_Aerosol_Define.f90:110
crtm_atmosphere_define::hcn_id
integer, parameter, public hcn_id
Definition: CRTM_Atmosphere_Define.f90:272
crtm_cloud_define::crtm_cloud_addlayercopy
elemental type(crtm_cloud_type) function, public crtm_cloud_addlayercopy(cld, n_Added_Layers)
Definition: CRTM_Cloud_Define.f90:377
message_handler::warning
integer, parameter, public warning
Definition: Message_Handler.f90:29
crtm_atmosphere_define::ml
integer, parameter ml
Definition: CRTM_Atmosphere_Define.f90:352
crtm_aerosol_define::crtm_aerosol_create
elemental subroutine, public crtm_aerosol_create(Aerosol, n_Layers)
Definition: CRTM_Aerosol_Define.f90:309
crtm_aerosol_define::crtm_aerosol_inspect
Definition: CRTM_Aerosol_Define.f90:93
crtm_atmosphere_define::one
real(fp), parameter one
Definition: CRTM_Atmosphere_Define.f90:350
crtm_atmosphere_define::integrated_path_units
integer, parameter, public integrated_path_units
Definition: CRTM_Atmosphere_Define.f90:305
crtm_atmosphere_define::ch3l_id
integer, parameter, public ch3l_id
Definition: CRTM_Atmosphere_Define.f90:273
crtm_atmosphere_define::absorber_units_name
character(*), dimension(0:n_valid_absorber_units), parameter, public absorber_units_name
Definition: CRTM_Atmosphere_Define.f90:306
crtm_atmosphere_define::sf6_id
integer, parameter, public sf6_id
Definition: CRTM_Atmosphere_Define.f90:279
type_kinds::fp
integer, parameter, public fp
Definition: Type_Kinds.f90:124
crtm_aerosol_define::crtm_aerosol_categoryid
pure integer function, public crtm_aerosol_categoryid(aerosol)
Definition: CRTM_Aerosol_Define.f90:178
crtm_atmosphere_define::write_error_status
character(*), parameter write_error_status
Definition: CRTM_Atmosphere_Define.f90:354
crtm_atmosphere_define::mass_density_units
integer, parameter, public mass_density_units
Definition: CRTM_Atmosphere_Define.f90:299
crtm_atmosphere_define::crtm_atmosphere_destroy
elemental subroutine, public crtm_atmosphere_destroy(Atm)
Definition: CRTM_Atmosphere_Define.f90:476
crtm_atmosphere_define::number_density_units
integer, parameter, public number_density_units
Definition: CRTM_Atmosphere_Define.f90:297
crtm_cloud_define::crtm_cloud_readfile
integer function, public crtm_cloud_readfile(Filename, Cloud, Quiet, No_Close, n_Clouds, Debug)
Definition: CRTM_Cloud_Define.f90:959
crtm_atmosphere_define::specific_amount_units
integer, parameter, public specific_amount_units
Definition: CRTM_Atmosphere_Define.f90:304
binary_file_utility::readgatts_binary_file
integer function, public readgatts_binary_file(fid, Write_Module, Created_On, Title, History, Comment)
Definition: Binary_File_Utility.f90:385
crtm_cloud_define
Definition: CRTM_Cloud_Define.f90:15
crtm_atmosphere_define::co2_id
integer, parameter, public co2_id
Definition: CRTM_Atmosphere_Define.f90:251
crtm_parameters
Definition: CRTM_Parameters.f90:12
crtm_atmosphere_define::no_id
integer, parameter, public no_id
Definition: CRTM_Atmosphere_Define.f90:257
crtm_cloud_define::crtm_cloud_inspect
Definition: CRTM_Cloud_Define.f90:92
crtm_atmosphere_define::module_version_id
character(*), parameter module_version_id
Definition: CRTM_Atmosphere_Define.f90:244
crtm_atmosphere_define::crtm_atmosphere_inquirefile
integer function, public crtm_atmosphere_inquirefile(Filename, n_Channels, n_Profiles)
Definition: CRTM_Atmosphere_Define.f90:1379
crtm_atmosphere_define::h2o_id
integer, parameter, public h2o_id
Definition: CRTM_Atmosphere_Define.f90:250
crtm_cloud_define::rain_cloud
integer, parameter, public rain_cloud
Definition: CRTM_Cloud_Define.f90:109
crtm_cloud_define::crtm_cloud_create
elemental subroutine, public crtm_cloud_create(Cloud, n_Layers)
Definition: CRTM_Cloud_Define.f90:303
crtm_atmosphere_define::climatology_model_name
character(*), dimension(0:n_valid_climatology_models), parameter, public climatology_model_name
Definition: CRTM_Atmosphere_Define.f90:340
crtm_atmosphere_define::c2h2_id
integer, parameter, public c2h2_id
Definition: CRTM_Atmosphere_Define.f90:275
crtm_cloud_define::crtm_cloud_writefile
integer function, public crtm_cloud_writefile(Filename, Cloud, Quiet, No_Close, Debug)
Definition: CRTM_Cloud_Define.f90:1152
mpp_io_mod::write_record
Definition: mpp_io.F90:911
crtm_atmosphere_define::zero
real(fp), parameter zero
Definition: CRTM_Atmosphere_Define.f90:349
crtm_atmosphere_define::write_atmosphere_rank2
integer function write_atmosphere_rank2(Filename, Atmosphere, Quiet, Debug)
Definition: CRTM_Atmosphere_Define.f90:1935
crtm_atmosphere_define::crtm_atmosphere_readfile
Definition: CRTM_Atmosphere_Define.f90:230
crtm_cloud_define::crtm_cloud_compare
elemental logical function, public crtm_cloud_compare(x, y, n_SigFig)
Definition: CRTM_Cloud_Define.f90:691
crtm_atmosphere_define::dewpoint_temperature_c_units
integer, parameter, public dewpoint_temperature_c_units
Definition: CRTM_Atmosphere_Define.f90:302
crtm_atmosphere_define::crtm_atmosphere_isvalid
logical function, public crtm_atmosphere_isvalid(Atm)
Definition: CRTM_Atmosphere_Define.f90:797
crtm_aerosol_define::aerosol_category_name
character(*), dimension(0:n_valid_aerosol_categories), parameter, public aerosol_category_name
Definition: CRTM_Aerosol_Define.f90:126
crtm_aerosol_define::crtm_aerosol_destroy
elemental subroutine, public crtm_aerosol_destroy(Aerosol)
Definition: CRTM_Aerosol_Define.f90:273
crtm_atmosphere_define::hf_id
integer, parameter, public hf_id
Definition: CRTM_Atmosphere_Define.f90:263
crtm_atmosphere_define::hi_id
integer, parameter, public hi_id
Definition: CRTM_Atmosphere_Define.f90:266
crtm_atmosphere_define::h2o_only_units_flag
integer, dimension(0:n_valid_absorber_units), parameter, public h2o_only_units_flag
Definition: CRTM_Atmosphere_Define.f90:318
crtm_atmosphere_define::crtm_atmosphere_writefile
Definition: CRTM_Atmosphere_Define.f90:235
inquire_cleanup
subroutine inquire_cleanup()
Definition: ACCoeff_Binary_IO.f90:249
crtm_atmosphere_define::invalid_absorber_units
integer, parameter, public invalid_absorber_units
Definition: CRTM_Atmosphere_Define.f90:295
crtm_atmosphere_define::cof2_id
integer, parameter, public cof2_id
Definition: CRTM_Atmosphere_Define.f90:278
crtm_atmosphere_define::read_atmosphere_rank2
integer function read_atmosphere_rank2(Filename, Atmosphere, Quiet, n_Channels, n_Profiles, Debug)
Definition: CRTM_Atmosphere_Define.f90:1650
crtm_atmosphere_define::h2s_id
integer, parameter, public h2s_id
Definition: CRTM_Atmosphere_Define.f90:280
crtm_atmosphere_define::ocs_id
integer, parameter, public ocs_id
Definition: CRTM_Atmosphere_Define.f90:268
crtm_cloud_define::invalid_cloud
integer, parameter, public invalid_cloud
Definition: CRTM_Cloud_Define.f90:106
cloud
Definition: cloud.F90:1
crtm_cloud_define::cloud_category_name
character(*), dimension(0:n_valid_cloud_categories), parameter, public cloud_category_name
Definition: CRTM_Cloud_Define.f90:121
crtm_atmosphere_define::n_valid_absorber_ids
integer, parameter, public n_valid_absorber_ids
Definition: CRTM_Atmosphere_Define.f90:248
crtm_atmosphere_define::hcl_id
integer, parameter, public hcl_id
Definition: CRTM_Atmosphere_Define.f90:264
crtm_aerosol_define::black_carbon_aerosol
integer, parameter, public black_carbon_aerosol
Definition: CRTM_Aerosol_Define.f90:114
message_handler
Definition: Message_Handler.f90:4
crtm_atmosphere_define::crtm_atmosphere_compare
elemental logical function, public crtm_atmosphere_compare(x, y, n_SigFig)
Definition: CRTM_Atmosphere_Define.f90:1083
crtm_atmosphere_define::nh3_id
integer, parameter, public nh3_id
Definition: CRTM_Atmosphere_Define.f90:260
crtm_cloud_define::crtm_cloud_setlayers
elemental subroutine, public crtm_cloud_setlayers(Cloud, n_Layers)
Definition: CRTM_Cloud_Define.f90:766
read_cleanup
subroutine read_cleanup()
Definition: ACCoeff_Binary_IO.f90:469
crtm_atmosphere_define::no2_id
integer, parameter, public no2_id
Definition: CRTM_Atmosphere_Define.f90:259
crtm_atmosphere_define::hno3_id
integer, parameter, public hno3_id
Definition: CRTM_Atmosphere_Define.f90:261
crtm_atmosphere_define::tropical
integer, parameter, public tropical
Definition: CRTM_Atmosphere_Define.f90:334
binary_file_utility
Definition: Binary_File_Utility.f90:13
write_cleanup
subroutine write_cleanup()
Definition: ACCoeff_Binary_IO.f90:670
crtm_atmosphere_define::crtm_atmosphere_inspect
Definition: CRTM_Atmosphere_Define.f90:224
crtm_cloud_define::crtm_cloud_zero
elemental subroutine, public crtm_cloud_zero(Cloud)
Definition: CRTM_Cloud_Define.f90:435
crtm_atmosphere_define::volume_mixing_ratio_units
integer, parameter, public volume_mixing_ratio_units
Definition: CRTM_Atmosphere_Define.f90:296
crtm_aerosol_define::crtm_aerosol_zero
elemental subroutine, public crtm_aerosol_zero(Aerosol)
Definition: CRTM_Aerosol_Define.f90:437
crtm_atmosphere_define::invalid_model
integer, parameter, public invalid_model
Definition: CRTM_Atmosphere_Define.f90:333
crtm_aerosol_define::crtm_aerosol_type
Definition: CRTM_Aerosol_Define.f90:149
crtm_atmosphere_define::clo_id
integer, parameter, public clo_id
Definition: CRTM_Atmosphere_Define.f90:267
read_record_cleanup
subroutine read_record_cleanup()
Definition: CRTM_Aerosol_Define.f90:1491
crtm_aerosol_define::crtm_aerosol_isvalid
logical function, public crtm_aerosol_isvalid(Aerosol)
Definition: CRTM_Aerosol_Define.f90:487
compare_float_numbers
Definition: Compare_Float_Numbers.f90:13
crtm_atmosphere_define::h2co_id
integer, parameter, public h2co_id
Definition: CRTM_Atmosphere_Define.f90:269
crtm_atmosphere_define::crtm_atmosphere_add
elemental type(crtm_atmosphere_type) function crtm_atmosphere_add(atm1, atm2)
Definition: CRTM_Atmosphere_Define.f90:2150
crtm_atmosphere_define::n2_id
integer, parameter, public n2_id
Definition: CRTM_Atmosphere_Define.f90:271
crtm_atmosphere_define::write_atmosphere_rank1
integer function write_atmosphere_rank1(Filename, Atmosphere, Quiet, Debug)
Definition: CRTM_Atmosphere_Define.f90:1837
crtm_atmosphere_define::hcooh_id
integer, parameter, public hcooh_id
Definition: CRTM_Atmosphere_Define.f90:281
binary_file_utility::open_binary_file
integer function, public open_binary_file(Filename, FileID, For_Output, No_Check)
Definition: Binary_File_Utility.f90:162
crtm_cloud_define::crtm_cloud_type
Definition: CRTM_Cloud_Define.f90:142
crtm_atmosphere_define::crtm_atmosphere_create
elemental subroutine, public crtm_atmosphere_create(Atm, n_Layers, n_Absorbers, n_Clouds, n_Aerosols)
Definition: CRTM_Atmosphere_Define.f90:542
message_handler::display_message
recursive subroutine, public display_message(Routine_Name, Message, Error_State, Message_Log)
Definition: Message_Handler.f90:118
crtm_aerosol_define::crtm_aerosol_categoryname
pure character(len(aerosol_category_name(1))) function, public crtm_aerosol_categoryname(aerosol)
Definition: CRTM_Aerosol_Define.f90:185
crtm_aerosol_define
Definition: CRTM_Aerosol_Define.f90:15
crtm_atmosphere_define::c2h6_id
integer, parameter, public c2h6_id
Definition: CRTM_Atmosphere_Define.f90:276
crtm_atmosphere_define::o3_id
integer, parameter, public o3_id
Definition: CRTM_Atmosphere_Define.f90:252
crtm_cloud_define::snow_cloud
integer, parameter, public snow_cloud
Definition: CRTM_Cloud_Define.f90:110
crtm_atmosphere_define::n_valid_absorber_units
integer, parameter, public n_valid_absorber_units
Definition: CRTM_Atmosphere_Define.f90:294
crtm_atmosphere_define::us_standard_atmosphere
integer, parameter, public us_standard_atmosphere
Definition: CRTM_Atmosphere_Define.f90:339
crtm_aerosol_define::crtm_aerosol_writefile
integer function, public crtm_aerosol_writefile(Filename, Aerosol, Quiet, No_Close, Debug)
Definition: CRTM_Aerosol_Define.f90:1142
crtm_atmosphere_define::subarctic_winter
integer, parameter, public subarctic_winter
Definition: CRTM_Atmosphere_Define.f90:338
file_utility::file_open
Definition: File_Utility.f90:56
crtm_atmosphere_define::midlatitude_winter
integer, parameter, public midlatitude_winter
Definition: CRTM_Atmosphere_Define.f90:336
absorber_id_ispresent
logical function absorber_id_ispresent(Id)
Definition: CRTM_Atmosphere_Define.f90:893
crtm_atmosphere_define::crtm_atmosphere_subtract
elemental type(crtm_atmosphere_type) function crtm_atmosphere_subtract(atm1, atm2)
Definition: CRTM_Atmosphere_Define.f90:2230
file_utility::file_exists
Definition: File_Utility.f90:51
crtm_atmosphere_define::oh_id
integer, parameter, public oh_id
Definition: CRTM_Atmosphere_Define.f90:262
crtm_atmosphere_define::mass_mixing_ratio_units
integer, parameter, public mass_mixing_ratio_units
Definition: CRTM_Atmosphere_Define.f90:298
crtm_atmosphere_define::crtm_atmosphere_defineversion
subroutine, public crtm_atmosphere_defineversion(Id)
Definition: CRTM_Atmosphere_Define.f90:1038
crtm_atmosphere_define::crtm_atmosphere_equal
elemental logical function crtm_atmosphere_equal(x, y)
Definition: CRTM_Atmosphere_Define.f90:2075
crtm_atmosphere_define::invalid_absorber_id
integer, parameter, public invalid_absorber_id
Definition: CRTM_Atmosphere_Define.f90:249
compare_float_numbers::default_n_sigfig
integer, parameter, public default_n_sigfig
Definition: Compare_Float_Numbers.f90:101
crtm_cloud_define::crtm_cloud_categorylist
integer function, public crtm_cloud_categorylist(list)
Definition: CRTM_Cloud_Define.f90:187
crtm_cloud_define::hail_cloud
integer, parameter, public hail_cloud
Definition: CRTM_Cloud_Define.f90:112
crtm_atmosphere_define::co_id
integer, parameter, public co_id
Definition: CRTM_Atmosphere_Define.f90:254
crtm_atmosphere_define::subarctic_summer
integer, parameter, public subarctic_summer
Definition: CRTM_Atmosphere_Define.f90:337
crtm_atmosphere_define::read_record
integer function read_record(fid, atm, Quiet, Debug)
Definition: CRTM_Atmosphere_Define.f90:2290
crtm_parameters::max_n_layers
integer, parameter, public max_n_layers
Definition: CRTM_Parameters.f90:64
crtm_atmosphere_define::so2_id
integer, parameter, public so2_id
Definition: CRTM_Atmosphere_Define.f90:258
crtm_atmosphere_define::scalar_inspect
subroutine scalar_inspect(Atm, Unit)
Definition: CRTM_Atmosphere_Define.f90:934
crtm_aerosol_define::crtm_aerosol_defineversion
subroutine, public crtm_aerosol_defineversion(Id)
Definition: CRTM_Aerosol_Define.f90:644
binary_file_utility::writegatts_binary_file
integer function, public writegatts_binary_file(fid, Write_Module, Created_On, Title, History, Comment)
Definition: Binary_File_Utility.f90:278
crtm_cloud_define::graupel_cloud
integer, parameter, public graupel_cloud
Definition: CRTM_Cloud_Define.f90:111
write_record_cleanup
subroutine write_record_cleanup()
Definition: CRTM_Aerosol_Define.f90:1555
crtm_aerosol_define::crtm_aerosol_setlayers
elemental subroutine, public crtm_aerosol_setlayers(Aerosol, n_Layers)
Definition: CRTM_Aerosol_Define.f90:763
max
#define max(a, b)
Definition: mosaic_util.h:33
crtm_cloud_define::crtm_cloud_defineversion
subroutine, public crtm_cloud_defineversion(Id)
Definition: CRTM_Cloud_Define.f90:646
type_kinds
Definition: Type_Kinds.f90:12
crtm_atmosphere_define::read_atmosphere_rank1
integer function read_atmosphere_rank1(Filename, Atmosphere, Quiet, n_Channels, n_Profiles, Debug)
Definition: CRTM_Atmosphere_Define.f90:1530
crtm_cloud_define::crtm_cloud_destroy
elemental subroutine, public crtm_cloud_destroy(Cloud)
Definition: CRTM_Cloud_Define.f90:267
crtm_cloud_define::crtm_cloud_isvalid
logical function, public crtm_cloud_isvalid(Cloud)
Definition: CRTM_Cloud_Define.f90:486
crtm_aerosol_define::crtm_aerosol_addlayercopy
elemental type(crtm_aerosol_type) function, public crtm_aerosol_addlayercopy(aer, n_Added_Layers)
Definition: CRTM_Aerosol_Define.f90:381
crtm_aerosol_define::crtm_aerosol_compare
elemental logical function, public crtm_aerosol_compare(x, y, n_SigFig)
Definition: CRTM_Aerosol_Define.f90:689
crtm_atmosphere_define::hbr_id
integer, parameter, public hbr_id
Definition: CRTM_Atmosphere_Define.f90:265
crtm_aerosol_define::crtm_aerosol_readfile
integer function, public crtm_aerosol_readfile(Filename, Aerosol, Quiet, No_Close, n_Aerosols, Debug)
Definition: CRTM_Aerosol_Define.f90:956
crtm_aerosol_define::n_valid_aerosol_categories
integer, parameter, public n_valid_aerosol_categories
Definition: CRTM_Aerosol_Define.f90:106
crtm_atmosphere_define::crtm_atmosphere_associated
elemental logical function, public crtm_atmosphere_associated(Atm)
Definition: CRTM_Atmosphere_Define.f90:437
crtm_atmosphere_define::o2_id
integer, parameter, public o2_id
Definition: CRTM_Atmosphere_Define.f90:256
crtm_aerosol_define::invalid_aerosol
integer, parameter, public invalid_aerosol
Definition: CRTM_Aerosol_Define.f90:107
crtm_atmosphere_define::crtm_atmosphere_setlayers
elemental subroutine, public crtm_atmosphere_setlayers(Atmosphere, n_Layers)
Definition: CRTM_Atmosphere_Define.f90:1292
crtm_cloud_define::crtm_cloud_categoryname
pure character(len(cloud_category_name(1))) function, public crtm_cloud_categoryname(cloud)
Definition: CRTM_Cloud_Define.f90:179
crtm_atmosphere_define::crtm_atmosphere_type
Definition: CRTM_Atmosphere_Define.f90:361
crtm_atmosphere_define::midlatitude_summer
integer, parameter, public midlatitude_summer
Definition: CRTM_Atmosphere_Define.f90:335
crtm_aerosol_define::crtm_aerosol_categorylist
integer function, public crtm_aerosol_categorylist(list)
Definition: CRTM_Aerosol_Define.f90:193
min
#define min(a, b)
Definition: mosaic_util.h:32
crtm_atmosphere_define::crtm_get_absorberidx
integer function, public crtm_get_absorberidx(Atm, AbsorberId)
Definition: CRTM_Atmosphere_Define.f90:1177
crtm_cloud_define::water_cloud
integer, parameter, public water_cloud
Definition: CRTM_Cloud_Define.f90:107
crtm_atmosphere_define
Definition: CRTM_Atmosphere_Define.f90:13
crtm_atmosphere_define::partial_pressure_units
integer, parameter, public partial_pressure_units
Definition: CRTM_Atmosphere_Define.f90:300
crtm_aerosol_define::seasalt_sscm3_aerosol
integer, parameter, public seasalt_sscm3_aerosol
Definition: CRTM_Aerosol_Define.f90:112
crtm_atmosphere_define::rank2_inspect
subroutine rank2_inspect(Atmosphere, Unit)
Definition: CRTM_Atmosphere_Define.f90:997
crtm_aerosol_define::crtm_aerosol_associated
elemental logical function, public crtm_aerosol_associated(Aerosol)
Definition: CRTM_Aerosol_Define.f90:244
crtm_aerosol_define::organic_carbon_aerosol
integer, parameter, public organic_carbon_aerosol
Definition: CRTM_Aerosol_Define.f90:113
crtm_aerosol_define::sulfate_aerosol
integer, parameter, public sulfate_aerosol
Definition: CRTM_Aerosol_Define.f90:115
crtm_atmosphere_define::absorber_id_name
character(*), dimension(0:n_valid_absorber_ids), parameter, public absorber_id_name
Definition: CRTM_Atmosphere_Define.f90:282
crtm_aerosol_define::seasalt_ssam_aerosol
integer, parameter, public seasalt_ssam_aerosol
Definition: CRTM_Aerosol_Define.f90:109
crtm_atmosphere_define::crtm_atmosphere_zero
elemental subroutine, public crtm_atmosphere_zero(Atmosphere)
Definition: CRTM_Atmosphere_Define.f90:735
message_handler::success
integer, parameter, public success
Definition: Message_Handler.f90:27
crtm_atmosphere_define::dewpoint_temperature_k_units
integer, parameter, public dewpoint_temperature_k_units
Definition: CRTM_Atmosphere_Define.f90:301
crtm_aerosol_define::seasalt_sscm2_aerosol
integer, parameter, public seasalt_sscm2_aerosol
Definition: CRTM_Aerosol_Define.f90:111
crtm_atmosphere_define::rank1_inspect
subroutine rank1_inspect(Atmosphere, Unit)
Definition: CRTM_Atmosphere_Define.f90:982
crtm_atmosphere_define::relative_humidity_units
integer, parameter, public relative_humidity_units
Definition: CRTM_Atmosphere_Define.f90:303
crtm_cloud_define::crtm_cloud_associated
elemental logical function, public crtm_cloud_associated(Cloud)
Definition: CRTM_Cloud_Define.f90:238
file_utility
Definition: File_Utility.f90:26
message_handler::information
integer, parameter, public information
Definition: Message_Handler.f90:28
crtm_atmosphere_define::hocl_id
integer, parameter, public hocl_id
Definition: CRTM_Atmosphere_Define.f90:270
crtm_atmosphere_define::crtm_get_pressurelevelidx
integer function, public crtm_get_pressurelevelidx(Atm, Level_Pressure)
Definition: CRTM_Atmosphere_Define.f90:1236