FV3 Bundle
CRTM_Surface_Define.f90
Go to the documentation of this file.
1 !
2 ! CRTM_Surface_Define
3 !
4 ! Module defining the CRTM Surface structure and containing routines
5 ! to manipulate it.
6 !
7 !
8 ! CREATION HISTORY:
9 ! Written by: Yong Han, yong.han@noaa.gov
10 ! Quanhua Liu, quanhua.liu@noaa.gov
11 ! Paul van Delst, paul.vandelst@noaa.gov
12 ! 07-May-2004
13 !
14 
15 MODULE crtm_surface_define
16 
17  ! -----------------
18  ! Environment setup
19  ! -----------------
20  ! Intrinsic modules
21  USE iso_fortran_env , ONLY: output_unit
22  ! Module use
23  USE type_kinds , ONLY: fp
24  USE message_handler , ONLY: success, failure, warning, information, display_message
25  USE compare_float_numbers , ONLY: default_n_sigfig, &
26  OPERATOR(.equalto.), &
27  compares_within_tolerance
28  USE file_utility , ONLY: file_open, file_exists
29  USE binary_file_utility , ONLY: open_binary_file , &
30  writegatts_binary_file, &
31  readgatts_binary_file
32  USE crtm_sensordata_define, ONLY: crtm_sensordata_type, &
33  OPERATOR(==), &
34  OPERATOR(+), &
35  OPERATOR(-), &
36  crtm_sensordata_associated, &
37  crtm_sensordata_destroy, &
38  crtm_sensordata_create, &
39  crtm_sensordata_zero, &
40  crtm_sensordata_isvalid, &
41  crtm_sensordata_inspect, &
42  crtm_sensordata_defineversion, &
43  crtm_sensordata_compare, &
44  crtm_sensordata_readfile, &
45  crtm_sensordata_writefile
46  ! Disable implicit typing
47  IMPLICIT NONE
48 
49 
50  ! ------------
51  ! Visibilities
52  ! ------------
53  ! Everything private by default
54  PRIVATE
55  ! Operators
56  PUBLIC :: OPERATOR(==)
57  PUBLIC :: OPERATOR(+)
58  PUBLIC :: OPERATOR(-)
59  ! SensorData enitities
60  ! ...Structures
61  PUBLIC :: crtm_sensordata_type
62  ! ...Procedures
63  PUBLIC :: crtm_sensordata_associated
64  PUBLIC :: crtm_sensordata_destroy
65  PUBLIC :: crtm_sensordata_create
66  PUBLIC :: crtm_sensordata_zero
67  PUBLIC :: crtm_sensordata_isvalid
68  PUBLIC :: crtm_sensordata_inspect
69  PUBLIC :: crtm_sensordata_defineversion
70  PUBLIC :: crtm_sensordata_compare
71  ! Surface entities
72  ! ...Gross surface parameters
73  PUBLIC :: invalid_surface
74  PUBLIC :: land_surface
75  PUBLIC :: water_surface
76  PUBLIC :: snow_surface
77  PUBLIC :: ice_surface
78  PUBLIC :: n_valid_surface_types
79  PUBLIC :: surface_type_name
80  ! ...Structures
81  PUBLIC :: crtm_surface_type
82  ! ...Procedures
83  PUBLIC :: crtm_surface_associated
84  PUBLIC :: crtm_surface_destroy
85  PUBLIC :: crtm_surface_create
86  PUBLIC :: crtm_surface_zero
87  PUBLIC :: crtm_surface_isvalid
88  PUBLIC :: crtm_surface_inspect
89  PUBLIC :: crtm_surface_iscoveragevalid
90  PUBLIC :: crtm_surface_coveragetype
91  PUBLIC :: crtm_surface_defineversion
92  PUBLIC :: crtm_surface_compare
93  PUBLIC :: crtm_surface_inquirefile
94  PUBLIC :: crtm_surface_readfile
95  PUBLIC :: crtm_surface_writefile
96 
97 
98  ! ---------------------
99  ! Procedure overloading
100  ! ---------------------
101  INTERFACE OPERATOR(==)
102  MODULE PROCEDURE crtm_surface_equal
103  END INTERFACE OPERATOR(==)
104 
105  INTERFACE OPERATOR(+)
106  MODULE PROCEDURE crtm_surface_add
107  END INTERFACE OPERATOR(+)
108 
109  INTERFACE OPERATOR(-)
110  MODULE PROCEDURE crtm_surface_subtract
111  END INTERFACE OPERATOR(-)
112 
113  INTERFACE crtm_surface_readfile
114  MODULE PROCEDURE read_surface_rank1
115  MODULE PROCEDURE read_surface_rank2
116  END INTERFACE crtm_surface_readfile
117 
118  INTERFACE crtm_surface_writefile
119  MODULE PROCEDURE write_surface_rank1
120  MODULE PROCEDURE write_surface_rank2
121  END INTERFACE crtm_surface_writefile
122 
123 
124  ! -----------------
125  ! Module parameters
126  ! -----------------
127  CHARACTER(*), PARAMETER :: module_version_id = &
128  '$Id: CRTM_Surface_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
129  ! Literal constants
130  REAL(fp), PARAMETER :: zero = 0.0_fp
131  REAL(fp), PARAMETER :: one = 1.0_fp
132  ! Message string length
133  INTEGER, PARAMETER :: ml = 256
134  ! File status on close after write error
135  CHARACTER(*), PARAMETER :: write_error_status = 'DELETE'
136 
137  ! The gross surface types. These are used for
138  ! cross-checking with the coverage fractions
139  ! of each gross surface types.
140  INTEGER, PARAMETER :: invalid_surface = 0
141  INTEGER, PARAMETER :: land_surface = 1
142  INTEGER, PARAMETER :: water_surface = 2
143  INTEGER, PARAMETER :: snow_surface = 4
144  INTEGER, PARAMETER :: ice_surface = 8
145  INTEGER, PARAMETER :: n_valid_surface_types = land_surface + &
146  water_surface + &
147  snow_surface + &
148  ice_surface
149  CHARACTER(*), PARAMETER, DIMENSION( 0:N_VALID_SURFACE_TYPES ) :: &
150  surface_type_name = (/ 'Invalid surface type ', &
151  'Land ', &
152  'Water ', &
153  'Land + water ', &
154  'Snow ', &
155  'Land + snow ', &
156  'Water + snow ', &
157  'Land + water + snow ', &
158  'Ice ', &
159  'Land + ice ', &
160  'Water + ice ', &
161  'Land + water + ice ', &
162  'Snow + ice ', &
163  'Land + snow + ice ', &
164  'Water + snow + ice ', &
165  'Land + water + snow + ice' /)
166 
167  ! Default value parameters
168  ! ...Land surface type data
169  INTEGER, PARAMETER :: default_land_type = 1 ! First item in list
170  REAL(fp), PARAMETER :: default_land_temperature = 283.0_fp ! K
171  REAL(fp), PARAMETER :: default_soil_moisture_content = 0.05_fp ! g/cm^3
172  REAL(fp), PARAMETER :: default_canopy_water_content = 0.05_fp ! g/cm^3
173  REAL(fp), PARAMETER :: default_vegetation_fraction = 0.3_fp ! 30%
174  REAL(fp), PARAMETER :: default_soil_temperature = 283.0_fp ! K
175  REAL(fp), PARAMETER :: default_lai = 3.5
176  INTEGER, PARAMETER :: default_soil_type = 1 ! First item in list
177  INTEGER, PARAMETER :: default_vegetation_type = 1 ! First item in list
178  ! ...Water type data
179  INTEGER, PARAMETER :: default_water_type = 1 ! First item in list
180  REAL(fp), PARAMETER :: default_water_temperature = 283.0_fp ! K
181  REAL(fp), PARAMETER :: default_wind_speed = 5.0_fp ! m/s
182  REAL(fp), PARAMETER :: default_wind_direction = 0.0_fp ! Southerly wind, i.e. FROM the south. Opposite from met. defn.
183  REAL(fp), PARAMETER :: default_salinity = 33.0_fp ! ppmv
184  ! ...Snow surface type data
185  INTEGER, PARAMETER :: default_snow_type = 1 ! First item in list
186  REAL(fp), PARAMETER :: default_snow_temperature = 263.0_fp ! K
187  REAL(fp), PARAMETER :: default_snow_depth = 50.0_fp ! mm
188  REAL(fp), PARAMETER :: default_snow_density = 0.2_fp ! g/cm^3
189  REAL(fp), PARAMETER :: default_snow_grain_size = 2.0_fp ! mm
190  ! ...Ice surface type data
191  INTEGER, PARAMETER :: default_ice_type = 1 ! First item in list
192  REAL(fp), PARAMETER :: default_ice_temperature = 263.0_fp ! K
193  REAL(fp), PARAMETER :: default_ice_thickness = 10.0_fp ! mm
194  REAL(fp), PARAMETER :: default_ice_density = 0.9_fp ! g/cm^3
195  REAL(fp), PARAMETER :: default_ice_roughness = zero
196 
197 
198  ! ----------------------------
199  ! Surface structure definition
200  ! ----------------------------
201  !:tdoc+:
202  TYPE :: crtm_surface_type
203  ! Allocation indicator
204  LOGICAL :: is_allocated = .true. ! Placeholder for future expansion
205  ! Dimension values
206  ! ...None yet
207  ! Gross type of surface determined by coverage
208  REAL(fp) :: land_coverage = zero
209  REAL(fp) :: water_coverage = zero
210  REAL(fp) :: snow_coverage = zero
211  REAL(fp) :: ice_coverage = zero
212  ! Land surface type data
213  INTEGER :: land_type = default_land_type
214  REAL(fp) :: land_temperature = default_land_temperature
215  REAL(fp) :: soil_moisture_content = default_soil_moisture_content
216  REAL(fp) :: canopy_water_content = default_canopy_water_content
217  REAL(fp) :: vegetation_fraction = default_vegetation_fraction
218  REAL(fp) :: soil_temperature = default_soil_temperature
219  REAL(fp) :: lai = default_lai
220  INTEGER :: soil_type = default_soil_type
221  INTEGER :: vegetation_type = default_vegetation_type
222  ! Water type data
223  INTEGER :: water_type = default_water_type
224  REAL(fp) :: water_temperature = default_water_temperature
225  REAL(fp) :: wind_speed = default_wind_speed
226  REAL(fp) :: wind_direction = default_wind_direction
227  REAL(fp) :: salinity = default_salinity
228  ! Snow surface type data
229  INTEGER :: snow_type = default_snow_type
230  REAL(fp) :: snow_temperature = default_snow_temperature
231  REAL(fp) :: snow_depth = default_snow_depth
232  REAL(fp) :: snow_density = default_snow_density
233  REAL(fp) :: snow_grain_size = default_snow_grain_size
234  ! Ice surface type data
235  INTEGER :: ice_type = default_ice_type
236  REAL(fp) :: ice_temperature = default_ice_temperature
237  REAL(fp) :: ice_thickness = default_ice_thickness
238  REAL(fp) :: ice_density = default_ice_density
239  REAL(fp) :: ice_roughness = default_ice_roughness
240  ! SensorData containing channel brightness temperatures
241  TYPE(crtm_sensordata_type) :: sensordata
242  END TYPE crtm_surface_type
243  !:tdoc-:
244 
245 
246 CONTAINS
247 
248 
249 !################################################################################
250 !################################################################################
251 !## ##
252 !## ## PUBLIC MODULE ROUTINES ## ##
253 !## ##
254 !################################################################################
255 !################################################################################
256 
257 !--------------------------------------------------------------------------------
258 !:sdoc+:
259 !
260 ! NAME:
261 ! CRTM_Surface_Associated
262 !
263 ! PURPOSE:
264 ! Elemental function to test the status of the allocatable components
265 ! of a CRTM Surface object.
266 !
267 ! CALLING SEQUENCE:
268 ! Status = CRTM_Surface_Associated( Sfc )
269 !
270 ! OBJECTS:
271 ! Sfc: Surface structure which is to have its member's
272 ! status tested.
273 ! UNITS: N/A
274 ! TYPE: CRTM_Surface_type
275 ! DIMENSION: Scalar or any rank
276 ! ATTRIBUTES: INTENT(IN)
277 !
278 ! FUNCTION RESULT:
279 ! Status: The return value is a logical value indicating the
280 ! status of the Surface members.
281 ! .TRUE. - if the array components are allocated.
282 ! .FALSE. - if the array components are not allocated.
283 ! UNITS: N/A
284 ! TYPE: LOGICAL
285 ! DIMENSION: Same as input
286 !
287 !:sdoc-:
288 !--------------------------------------------------------------------------------
289 
290  ELEMENTAL FUNCTION crtm_surface_associated( Sfc ) RESULT( Status )
291  TYPE(crtm_surface_type), INTENT(IN) :: sfc
292  LOGICAL :: status
293 
294  status = sfc%Is_Allocated
295  ! ...SensorData
296  status = status .AND. crtm_sensordata_associated(sfc%SensorData)
297 
298  END FUNCTION crtm_surface_associated
299 
300 
301 !--------------------------------------------------------------------------------
302 !:sdoc+:
303 !
304 ! NAME:
305 ! CRTM_Surface_Destroy
306 !
307 ! PURPOSE:
308 ! Elemental subroutine to re-initialize CRTM Surface objects.
309 !
310 ! CALLING SEQUENCE:
311 ! CALL CRTM_Surface_Destroy( Sfc )
312 !
313 ! OBJECTS:
314 ! Sfc: Re-initialized Surface structure.
315 ! UNITS: N/A
316 ! TYPE: CRTM_Surface_type
317 ! DIMENSION: Scalar or any rank
318 ! ATTRIBUTES: INTENT(OUT)
319 !
320 !:sdoc-:
321 !--------------------------------------------------------------------------------
322 
323  ELEMENTAL SUBROUTINE crtm_surface_destroy( Sfc )
324  TYPE(crtm_surface_type), INTENT(OUT) :: sfc
325  sfc%Is_Allocated = .true. ! Placeholder for future expansion
326  END SUBROUTINE crtm_surface_destroy
327 
328 
329 !--------------------------------------------------------------------------------
330 !:sdoc+:
331 !
332 ! NAME:
333 ! CRTM_Surface_Create
334 !
335 ! PURPOSE:
336 ! Elemental subroutine to create an instance of the CRTM Surface object.
337 !
338 ! CALLING SEQUENCE:
339 ! CALL CRTM_Surface_Create( Sfc , &
340 ! n_Channels )
341 !
342 ! OBJECTS:
343 ! Sfc: Surface structure.
344 ! UNITS: N/A
345 ! TYPE: CRTM_Surface_type
346 ! DIMENSION: Scalar or any rank
347 ! ATTRIBUTES: INTENT(OUT)
348 !
349 ! INPUT ARGUMENTS:
350 ! n_Channels: Number of channels dimension of SensorData
351 ! substructure
352 ! ** Note: Can be = 0 (i.e. no sensor data). **
353 ! UNITS: N/A
354 ! TYPE: INTEGER
355 ! DIMENSION: Same as Surface object
356 ! ATTRIBUTES: INTENT(IN)
357 !
358 !:sdoc-:
359 !--------------------------------------------------------------------------------
360 
361  ELEMENTAL SUBROUTINE crtm_surface_create( &
362  Sfc , & ! Output
363  n_Channels ) ! Input
364  ! Arguments
365  TYPE(crtm_surface_type), INTENT(OUT) :: sfc
366  INTEGER , INTENT(IN) :: n_channels
367 
368  ! Check input
369  IF ( n_channels < 0 ) RETURN
370 
371  ! Perform the substructure allocation
372  ! ...SensorData
373  IF ( n_channels > 0 ) CALL crtm_sensordata_create( sfc%SensorData, n_channels )
374 
375  ! Set allocation indicator
376  sfc%Is_Allocated = .true.
377 
378  END SUBROUTINE crtm_surface_create
379 
380 
381 !--------------------------------------------------------------------------------
382 !:sdoc+:
383 !
384 ! NAME:
385 ! CRTM_Surface_Zero
386 !
387 ! PURPOSE:
388 ! Elemental subroutine to zero out the data arrays
389 ! in a CRTM Surface object.
390 !
391 ! CALLING SEQUENCE:
392 ! CALL CRTM_Surface_Zero( Sfc )
393 !
394 ! OUTPUT ARGUMENTS:
395 ! Sfc: CRTM Surface structure in which the data arrays
396 ! are to be zeroed out.
397 ! UNITS: N/A
398 ! TYPE: CRTM_Surface_type
399 ! DIMENSION: Scalar or any rank
400 ! ATTRIBUTES: INTENT(IN OUT)
401 !
402 ! COMMENTS:
403 ! - The various surface type indicator flags are
404 ! *NOT* reset in this routine.
405 !
406 !:sdoc-:
407 !--------------------------------------------------------------------------------
408 
409  ELEMENTAL SUBROUTINE crtm_surface_zero( Sfc )
410  TYPE(crtm_surface_type), INTENT(IN OUT) :: sfc
411 
412  ! Zero the components
413  ! ...Coverage fractions
414  sfc%Land_Coverage = zero
415  sfc%Water_Coverage = zero
416  sfc%Snow_Coverage = zero
417  sfc%Ice_Coverage = zero
418  ! ...The various surface types
419  CALL crtm_landsurface_zero(sfc)
420  CALL crtm_watersurface_zero(sfc)
421  CALL crtm_snowsurface_zero(sfc)
422  CALL crtm_icesurface_zero(sfc)
423 
424  ! Reset the structure components
425  IF ( crtm_sensordata_associated(sfc%SensorData) ) CALL crtm_sensordata_zero(sfc%SensorData)
426 
427  END SUBROUTINE crtm_surface_zero
428 
429 
430 !--------------------------------------------------------------------------------
431 !:sdoc+:
432 !
433 ! NAME:
434 ! CRTM_Surface_IsValid
435 !
436 ! PURPOSE:
437 ! Non-pure function to perform some simple validity checks on a
438 ! CRTM Surface object.
439 !
440 ! If invalid data is found, a message is printed to stdout.
441 !
442 ! CALLING SEQUENCE:
443 ! result = CRTM_Surface_IsValid( Sfc )
444 !
445 ! or
446 !
447 ! IF ( CRTM_Surface_IsValid( Sfc ) ) THEN....
448 !
449 ! OBJECTS:
450 ! Sfc: CRTM Surface object which is to have its
451 ! contents checked.
452 ! UNITS: N/A
453 ! TYPE: CRTM_Surface_type
454 ! DIMENSION: Scalar
455 ! ATTRIBUTES: INTENT(IN)
456 !
457 ! FUNCTION RESULT:
458 ! result: Logical variable indicating whether or not the input
459 ! passed the check.
460 ! If == .FALSE., Surface object is unused or contains
461 ! invalid data.
462 ! == .TRUE., Surface object can be used in CRTM.
463 ! UNITS: N/A
464 ! TYPE: LOGICAL
465 ! DIMENSION: Scalar
466 !
467 !:sdoc-:
468 !--------------------------------------------------------------------------------
469 
470  FUNCTION crtm_surface_isvalid( Sfc ) RESULT( IsValid )
471  TYPE(crtm_surface_type), INTENT(IN) :: sfc
472  LOGICAL :: isvalid
473  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Surface_IsValid'
474  CHARACTER(ML) :: msg
475 
476  ! Check the gross surface type indicators
477  isvalid = crtm_surface_iscoveragevalid(sfc)
478  IF ( .NOT. isvalid ) THEN
479  msg = 'Invalid surface coverage fraction(s) found'
480  CALL display_message( routine_name, trim(msg), information )
481  ENDIF
482 
483  ! Check the various surface types
484  IF ( sfc%Land_Coverage > zero ) isvalid = crtm_landsurface_isvalid(sfc) .AND. isvalid
485  IF ( sfc%Water_Coverage > zero ) isvalid = crtm_watersurface_isvalid(sfc) .AND. isvalid
486  IF ( sfc%Snow_Coverage > zero ) isvalid = crtm_snowsurface_isvalid(sfc) .AND. isvalid
487  IF ( sfc%Ice_Coverage > zero ) isvalid = crtm_icesurface_isvalid(sfc) .AND. isvalid
488 
489  ! Structure components
490  IF ( crtm_sensordata_associated(sfc%SensorData) ) &
491  isvalid = crtm_sensordata_isvalid( sfc%SensorData ) .AND. isvalid
492 
493  END FUNCTION crtm_surface_isvalid
494 
495 
496 
497 !--------------------------------------------------------------------------------
498 !:sdoc+:
499 !
500 ! NAME:
501 ! CRTM_Surface_Inspect
502 !
503 ! PURPOSE:
504 ! Subroutine to print the contents of a CRTM Surface object to stdout.
505 !
506 ! CALLING SEQUENCE:
507 ! CALL CRTM_Surface_Inspect( Sfc, Unit=unit )
508 !
509 ! INPUTS:
510 ! Sfc: CRTM Surface object to display.
511 ! UNITS: N/A
512 ! TYPE: CRTM_Surface_type
513 ! DIMENSION: Scalar
514 ! ATTRIBUTES: INTENT(IN)
515 !
516 ! OPTIONAL INPUTS:
517 ! Unit: Unit number for an already open file to which the output
518 ! will be written.
519 ! If the argument is specified and the file unit is not
520 ! connected, the output goes to stdout.
521 ! UNITS: N/A
522 ! TYPE: INTEGER
523 ! DIMENSION: Scalar
524 ! ATTRIBUTES: INTENT(IN), OPTIONAL
525 !
526 !:sdoc-:
527 !--------------------------------------------------------------------------------
528 
529  SUBROUTINE crtm_surface_inspect( Sfc, Unit )
530  ! Arguments
531  TYPE(crtm_surface_type), INTENT(IN) :: sfc
532  INTEGER, OPTIONAL, INTENT(IN) :: unit
533  ! Local variables
534  INTEGER :: fid
535 
536  ! Setup
537  fid = output_unit
538  IF ( PRESENT(unit) ) THEN
539  IF ( file_open(unit) ) fid = unit
540  END IF
541 
542 
543  WRITE(fid,'(1x,"Surface OBJECT")')
544  ! Surface coverage
545  WRITE(fid,'(3x,"Land Coverage :",1x,f6.3)') sfc%Land_Coverage
546  WRITE(fid,'(3x,"Water Coverage:",1x,f6.3)') sfc%Water_Coverage
547  WRITE(fid,'(3x,"Snow Coverage :",1x,f6.3)') sfc%Snow_Coverage
548  WRITE(fid,'(3x,"Ice Coverage :",1x,f6.3)') sfc%Ice_Coverage
549  ! The various surface types
550  IF ( sfc%Land_Coverage > zero ) CALL crtm_landsurface_inspect(sfc, unit=unit)
551  IF ( sfc%Water_Coverage > zero ) CALL crtm_watersurface_inspect(sfc, unit=unit)
552  IF ( sfc%Snow_Coverage > zero ) CALL crtm_snowsurface_inspect(sfc, unit=unit)
553  IF ( sfc%Ice_Coverage > zero ) CALL crtm_icesurface_inspect(sfc, unit=unit)
554  ! SensorData information
555  IF ( crtm_sensordata_associated(sfc%SensorData) ) &
556  CALL crtm_sensordata_inspect(sfc%SensorData, unit=unit)
557 
558  END SUBROUTINE crtm_surface_inspect
559 
560 
561 !--------------------------------------------------------------------------------
562 !:sdoc+:
563 !
564 ! NAME:
565 ! CRTM_Surface_IsCoverageValid
566 !
567 ! PURPOSE:
568 ! Function to determine if the coverage fractions are valid
569 ! for a CRTM Surface object.
570 !
571 ! CALLING SEQUENCE:
572 ! result = CRTM_Surface_IsCoverageValid( Sfc )
573 !
574 ! OBJECTS:
575 ! Sfc: CRTM Surface object which is to have its
576 ! coverage fractions checked.
577 ! UNITS: N/A
578 ! TYPE: CRTM_Surface_type
579 ! DIMENSION: Scalar
580 ! ATTRIBUTES: INTENT(IN)
581 !
582 ! FUNCTION RESULT:
583 ! result: Logical variable indicating whether or not the input
584 ! passed the check.
585 ! If == .FALSE., Surface object coverage fractions are invalid.
586 ! == .TRUE., Surface object coverage fractions are valid.
587 ! UNITS: N/A
588 ! TYPE: LOGICAL
589 ! DIMENSION: Scalar
590 !
591 !:sdoc-:
592 !--------------------------------------------------------------------------------
593 
594  FUNCTION crtm_surface_iscoveragevalid( Sfc ) RESULT( IsValid )
595  TYPE(crtm_surface_type), INTENT(IN) :: sfc
596  LOGICAL :: isvalid
597  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Surface_IsCoverageValid'
598  REAL(fp) , PARAMETER :: tolerance = 1.0e-6_fp
599  CHARACTER(ML) :: msg
600  REAL(fp) :: total_coverage
601 
602  ! Compute the total coverage
603  total_coverage = sfc%Land_Coverage + sfc%Water_Coverage + &
604  sfc%Snow_Coverage + sfc%Ice_Coverage
605 
606  ! Check coverage fractions for < 0 and > 1
607  isvalid = iscoveragevalid(sfc%Land_Coverage, 'Land')
608  isvalid = isvalid .AND. iscoveragevalid(sfc%Water_Coverage, 'Water')
609  isvalid = isvalid .AND. iscoveragevalid(sfc%Snow_Coverage, 'Snow')
610  isvalid = isvalid .AND. iscoveragevalid(sfc%Ice_Coverage, 'Ice')
611 
612  ! Check total coverage sums to 1
613  IF ( abs(total_coverage-one) > tolerance ) THEN
614  WRITE( msg,'("Total coverage fraction does not sum to 1 +/- ",2es13.6)' ) tolerance, total_coverage-one
615  CALL display_message( routine_name,msg,information )
616  isvalid = .false.
617  END IF
618 
619  CONTAINS
620 
621  FUNCTION iscoveragevalid( Coverage, Name ) RESULT( IsValid )
622  REAL(fp) , INTENT(IN) :: coverage
623  CHARACTER(*), INTENT(IN) :: name
624  LOGICAL :: isvalid
625 
626  isvalid = .true.
627 
628  ! Check for coverage < -TOLERANCE
629  IF ( coverage < -tolerance ) THEN
630  WRITE( msg,'(a," coverage fraction is < ",es13.6)' ) trim(name), -tolerance
631  CALL display_message( routine_name,msg,information )
632  isvalid = .false.
633  END IF
634 
635  ! Check for coverage > 1+TOLERANCE
636  IF ( coverage > one+tolerance ) THEN
637  WRITE( msg,'(a," coverage fraction is > 1 +",es13.6)' ) trim(name), tolerance
638  CALL display_message( routine_name,msg,information )
639  isvalid = .false.
640  END IF
641 
642  END FUNCTION iscoveragevalid
643 
644  END FUNCTION crtm_surface_iscoveragevalid
645 
646 
647 
648 !--------------------------------------------------------------------------------
649 !:sdoc+:
650 !
651 ! NAME:
652 ! CRTM_Surface_CoverageType
653 !
654 ! PURPOSE:
655 ! Elemental function to return the gross surface type based on coverage.
656 !
657 ! CALLING SEQUENCE:
658 ! type = CRTM_Surface_CoverageType( sfc )
659 !
660 ! INPUTS:
661 ! Sfc: CRTM Surface object for which the gross surface type is required.
662 ! UNITS: N/A
663 ! TYPE: CRTM_Surface_type
664 ! DIMENSION: Scalar or any rank
665 ! ATTRIBUTES: INTENT(IN)
666 !
667 ! FUNCTION:
668 ! type: Surface type indicator for the passed CRTM Surface object.
669 ! UNITS: N/A
670 ! TYPE: INTEGER
671 ! DIMENSION: Same as input
672 !
673 ! COMMENTS:
674 ! For a scalar Surface object, this function result can be used to
675 ! determine what gross surface types are included by using it to
676 ! index the SURFACE_TYPE_NAME parameter arrays, e.g.
677 !
678 ! WRITE(*,*) SURFACE_TYPE_NAME(CRTM_Surface_CoverageType(sfc))
679 !:sdoc-:
680 !--------------------------------------------------------------------------------
681 
682  ELEMENTAL FUNCTION crtm_surface_coveragetype( sfc ) RESULT( Coverage_Type )
683  TYPE(crtm_surface_type), INTENT(IN) :: sfc
684  INTEGER :: coverage_type
685  coverage_type = 0
686  IF ( sfc%Land_Coverage > zero ) coverage_type = land_surface
687  IF ( sfc%Water_Coverage > zero ) coverage_type = coverage_type + water_surface
688  IF ( sfc%Snow_Coverage > zero ) coverage_type = coverage_type + snow_surface
689  IF ( sfc%Ice_Coverage > zero ) coverage_type = coverage_type + ice_surface
690  END FUNCTION crtm_surface_coveragetype
691 
692 
693 !--------------------------------------------------------------------------------
694 !:sdoc+:
695 !
696 ! NAME:
697 ! CRTM_Surface_DefineVersion
698 !
699 ! PURPOSE:
700 ! Subroutine to return the module version information.
701 !
702 ! CALLING SEQUENCE:
703 ! CALL CRTM_Surface_DefineVersion( Id )
704 !
705 ! OUTPUT ARGUMENTS:
706 ! Id: Character string containing the version Id information
707 ! for the module.
708 ! UNITS: N/A
709 ! TYPE: CHARACTER(*)
710 ! DIMENSION: Scalar
711 ! ATTRIBUTES: INTENT(OUT)
712 !
713 !:sdoc-:
714 !--------------------------------------------------------------------------------
715 
716  SUBROUTINE crtm_surface_defineversion( Id )
717  CHARACTER(*), INTENT(OUT) :: id
718  id = module_version_id
719  END SUBROUTINE crtm_surface_defineversion
720 
721 
722 !------------------------------------------------------------------------------
723 !:sdoc+:
724 ! NAME:
725 ! CRTM_Surface_Compare
726 !
727 ! PURPOSE:
728 ! Elemental function to compare two CRTM_Surface objects to within
729 ! a user specified number of significant figures.
730 !
731 ! CALLING SEQUENCE:
732 ! is_comparable = CRTM_Surface_Compare( x, y, n_SigFig=n_SigFig )
733 !
734 ! OBJECTS:
735 ! x, y: Two CRTM Surface objects to be compared.
736 ! UNITS: N/A
737 ! TYPE: CRTM_Surface_type
738 ! DIMENSION: Scalar or any rank
739 ! ATTRIBUTES: INTENT(IN)
740 !
741 ! OPTIONAL INPUTS:
742 ! n_SigFig: Number of significant figure to compare floating point
743 ! components.
744 ! UNITS: N/A
745 ! TYPE: INTEGER
746 ! DIMENSION: Scalar or same as input
747 ! ATTRIBUTES: INTENT(IN), OPTIONAL
748 !
749 ! FUNCTION RESULT:
750 ! is_equal: Logical value indicating whether the inputs are equal.
751 ! UNITS: N/A
752 ! TYPE: LOGICAL
753 ! DIMENSION: Same as inputs.
754 !:sdoc-:
755 !------------------------------------------------------------------------------
756 
757  ELEMENTAL FUNCTION crtm_surface_compare( &
758  x, &
759  y, &
760  n_SigFig ) &
761  result( is_comparable )
762  TYPE(crtm_surface_type), INTENT(IN) :: x, y
763  INTEGER, OPTIONAL, INTENT(IN) :: n_sigfig
764  LOGICAL :: is_comparable
765  ! Variables
766  INTEGER :: n
767 
768  ! Set up
769  is_comparable = .false.
770  IF ( PRESENT(n_sigfig) ) THEN
771  n = abs(n_sigfig)
772  ELSE
773  n = default_n_sigfig
774  END IF
775 
776  ! Compare gross surface type coverage
777  IF ( (.NOT. compares_within_tolerance(x%Land_Coverage ,y%Land_Coverage ,n)) .OR. &
778  (.NOT. compares_within_tolerance(x%Water_Coverage,y%Water_Coverage,n)) .OR. &
779  (.NOT. compares_within_tolerance(x%Snow_Coverage ,y%Snow_Coverage ,n)) .OR. &
780  (.NOT. compares_within_tolerance(x%Ice_Coverage ,y%Ice_Coverage ,n)) ) RETURN
781 
782  ! Compare the land surface type data
783  IF ( .NOT. crtm_landsurface_compare(x,y,n_sigfig=n) ) RETURN
784 
785  ! Compare the water surface type data
786  IF ( .NOT. crtm_watersurface_compare(x,y,n_sigfig=n) ) RETURN
787 
788  ! Compare the snow surface type data
789  IF ( .NOT. crtm_snowsurface_compare(x,y,n_sigfig=n) ) RETURN
790 
791  ! Compare the ice surface type data
792  IF ( .NOT. crtm_icesurface_compare(x,y,n_sigfig=n) ) RETURN
793 
794  ! Check the SensorData
795  IF ( crtm_sensordata_associated(x%SensorData) .AND. &
796  crtm_sensordata_associated(y%SensorData) ) THEN
797  IF ( .NOT. crtm_sensordata_compare(x%SensorData,y%SensorData,n_sigfig=n) ) RETURN
798  END IF
799 
800  ! If we get here, the structures are comparable
801  is_comparable = .true.
802 
803  END FUNCTION crtm_surface_compare
804 
805 
806 !------------------------------------------------------------------------------
807 !:sdoc+:
808 !
809 ! NAME:
810 ! CRTM_Surface_InquireFile
811 !
812 ! PURPOSE:
813 ! Function to inquire CRTM Surface object files.
814 !
815 ! CALLING SEQUENCE:
816 ! Error_Status = CRTM_Surface_InquireFile( Filename , &
817 ! n_Channels = n_Channels, &
818 ! n_Profiles = n_Profiles )
819 !
820 ! INPUTS:
821 ! Filename: Character string specifying the name of a
822 ! CRTM Surface data file to read.
823 ! UNITS: N/A
824 ! TYPE: CHARACTER(*)
825 ! DIMENSION: Scalar
826 ! ATTRIBUTES: INTENT(IN)
827 !
828 ! OPTIONAL OUTPUTS:
829 ! n_Channels: The number of spectral channels for which there is
830 ! data in the file. Note that this value will always
831 ! be 0 for a profile-only dataset-- it only has meaning
832 ! for K-matrix data.
833 ! UNITS: N/A
834 ! TYPE: INTEGER
835 ! DIMENSION: Scalar
836 ! ATTRIBUTES: OPTIONAL, INTENT(OUT)
837 !
838 ! n_Profiles: The number of profiles in the data file.
839 ! UNITS: N/A
840 ! TYPE: INTEGER
841 ! DIMENSION: Scalar
842 ! ATTRIBUTES: OPTIONAL, INTENT(OUT)
843 !
844 ! FUNCTION RESULT:
845 ! Error_Status: The return value is an integer defining the error status.
846 ! The error codes are defined in the Message_Handler module.
847 ! If == SUCCESS, the file inquire was successful
848 ! == FAILURE, an unrecoverable error occurred.
849 ! UNITS: N/A
850 ! TYPE: INTEGER
851 ! DIMENSION: Scalar
852 !
853 !:sdoc-:
854 !------------------------------------------------------------------------------
855 
856  FUNCTION crtm_surface_inquirefile( &
857  Filename , & ! Input
858  n_Channels , & ! Optional output
859  n_Profiles ) & ! Optional output
860  result( err_stat )
861  ! Arguments
862  CHARACTER(*), INTENT(IN) :: filename
863  INTEGER , OPTIONAL, INTENT(OUT) :: n_channels
864  INTEGER , OPTIONAL, INTENT(OUT) :: n_profiles
865  ! Function result
866  INTEGER :: err_stat
867  ! Function parameters
868  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Surface_InquireFile'
869  ! Function variables
870  CHARACTER(ML) :: msg
871  CHARACTER(ML) :: io_msg
872  INTEGER :: io_stat
873  INTEGER :: fid
874  INTEGER :: l, m
875 
876  ! Set up
877  err_stat = success
878  ! Check that the file exists
879  IF ( .NOT. file_exists( trim(filename) ) ) THEN
880  msg = 'File '//trim(filename)//' not found.'
881  CALL inquire_cleanup(); RETURN
882  END IF
883 
884  ! Open the file
885  err_stat = open_binary_file( filename, fid )
886  IF ( err_stat /= success ) THEN
887  msg = 'Error opening '//trim(filename)
888  CALL inquire_cleanup(); RETURN
889  END IF
890 
891  ! Read the number of channels,profiles
892  READ( fid, iostat=io_stat,iomsg=io_msg ) l, m
893  IF ( io_stat /= 0 ) THEN
894  msg = 'Error reading dimensions from '//trim(filename)//' - '//trim(io_msg)
895  CALL inquire_cleanup(); RETURN
896  END IF
897 
898  ! Close the file
899  CLOSE( fid, iostat=io_stat,iomsg=io_msg )
900  IF ( io_stat /= 0 ) THEN
901  msg = 'Error closing '//trim(filename)//' - '//trim(io_msg)
902  CALL inquire_cleanup(); RETURN
903  END IF
904 
905  ! Set the return arguments
906  IF ( PRESENT(n_channels) ) n_channels = l
907  IF ( PRESENT(n_profiles) ) n_profiles = m
908 
909  CONTAINS
910 
911  SUBROUTINE inquire_cleanup()
912  IF ( file_open(fid) ) THEN
913  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
914  IF ( io_stat /= success ) &
915  msg = trim(msg)//'; Error closing input file during error cleanup - '//trim(io_msg)
916  END IF
917  err_stat = failure
918  CALL display_message( routine_name, msg, err_stat )
919  END SUBROUTINE inquire_cleanup
920 
921  END FUNCTION crtm_surface_inquirefile
922 
923 
924 !------------------------------------------------------------------------------
925 !:sdoc+:
926 !
927 ! NAME:
928 ! CRTM_Surface_ReadFile
929 !
930 ! PURPOSE:
931 ! Function to read CRTM Surface object files.
932 !
933 ! CALLING SEQUENCE:
934 ! Error_Status = CRTM_Surface_ReadFile( Filename , &
935 ! Surface , &
936 ! Quiet = Quiet , &
937 ! n_Channels = n_Channels, &
938 ! n_Profiles = n_Profiles )
939 !
940 ! INPUTS:
941 ! Filename: Character string specifying the name of an
942 ! Surface format data file to read.
943 ! UNITS: N/A
944 ! TYPE: CHARACTER(*)
945 ! DIMENSION: Scalar
946 ! ATTRIBUTES: INTENT(IN)
947 !
948 ! OUTPUTS:
949 ! Surface: CRTM Surface object array containing the Surface
950 ! data. Note the following meanings attributed to the
951 ! dimensions of the object array:
952 ! Rank-1: Only profile data are to be read in. The file
953 ! does not contain channel information. The
954 ! dimension of the structure is understood to
955 ! be the PROFILE dimension.
956 ! Rank-2: Channel and profile data are to be read in.
957 ! The file contains both channel and profile
958 ! information. The first dimension of the
959 ! structure is the CHANNEL dimension, the second
960 ! is the PROFILE dimension. This is to allow
961 ! K-matrix structures to be read in with the
962 ! same function.
963 ! UNITS: N/A
964 ! TYPE: CRTM_Surface_type
965 ! DIMENSION: Rank-1 or Rank-2
966 ! ATTRIBUTES: INTENT(OUT), ALLOCATABLE
967 !
968 ! OPTIONAL INPUTS:
969 ! Quiet: Set this logical argument to suppress INFORMATION
970 ! messages being printed to stdout
971 ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
972 ! == .TRUE., INFORMATION messages are SUPPRESSED.
973 ! If not specified, default is .FALSE.
974 ! UNITS: N/A
975 ! TYPE: LOGICAL
976 ! DIMENSION: Scalar
977 ! ATTRIBUTES: INTENT(IN), OPTIONAL
978 !
979 ! OPTIONAL OUTPUTS:
980 ! n_Channels: The number of channels for which data was read. Note that
981 ! this value will always be 0 for a profile-only dataset--
982 ! it only has meaning for K-matrix data.
983 ! UNITS: N/A
984 ! TYPE: INTEGER
985 ! DIMENSION: Scalar
986 ! ATTRIBUTES: OPTIONAL, INTENT(OUT)
987 !
988 ! n_Profiles: The number of profiles for which data was read.
989 ! UNITS: N/A
990 ! TYPE: INTEGER
991 ! DIMENSION: Scalar
992 ! ATTRIBUTES: OPTIONAL, INTENT(OUT)
993 !
994 !
995 ! FUNCTION RESULT:
996 ! Error_Status: The return value is an integer defining the error status.
997 ! The error codes are defined in the Message_Handler module.
998 ! If == SUCCESS, the file read was successful
999 ! == FAILURE, an unrecoverable error occurred.
1000 ! UNITS: N/A
1001 ! TYPE: INTEGER
1002 ! DIMENSION: Scalar
1003 !
1004 !:sdoc-:
1005 !------------------------------------------------------------------------------
1006 
1007  FUNCTION read_surface_rank1( &
1008  Filename , & ! Input
1009  Surface , & ! Output
1010  Quiet , & ! Optional input
1011  n_Channels, & ! Optional output
1012  n_Profiles, & ! Optional output
1013  Debug ) & ! Optional input (Debug output control)
1014  result( err_stat )
1015  ! Arguments
1016  CHARACTER(*), INTENT(IN) :: filename
1017  TYPE(crtm_surface_type), ALLOCATABLE, INTENT(OUT) :: surface(:) ! M
1018  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
1019  INTEGER, OPTIONAL, INTENT(OUT) :: n_channels
1020  INTEGER, OPTIONAL, INTENT(OUT) :: n_profiles
1021  LOGICAL, OPTIONAL, INTENT(IN) :: debug
1022  ! Function result
1023  INTEGER :: err_stat
1024  ! Function parameters
1025  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Surface_ReadFile(M)'
1026  ! Function variables
1027  CHARACTER(ML) :: msg
1028  CHARACTER(ML) :: io_msg
1029  CHARACTER(ML) :: alloc_msg
1030  INTEGER :: io_stat
1031  INTEGER :: alloc_stat
1032  LOGICAL :: noisy
1033  INTEGER :: fid
1034  INTEGER :: n_input_channels
1035  INTEGER :: m, n_input_profiles
1036 
1037 
1038  ! Set up
1039  err_stat = success
1040  ! ...Check Quiet argument
1041  noisy = .true.
1042  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
1043  ! ...Override Quiet settings if debug set.
1044  IF ( PRESENT(debug) ) noisy = debug
1045 
1046 
1047  ! Open the file
1048  err_stat = open_binary_file( filename, fid )
1049  IF ( err_stat /= success ) THEN
1050  msg = 'Error opening '//trim(filename)
1051  CALL read_cleanup(); RETURN
1052  END IF
1053 
1054 
1055  ! Read the dimensions
1056  READ( fid,iostat=io_stat,iomsg=io_msg ) n_input_channels, n_input_profiles
1057  IF ( io_stat /= 0 ) THEN
1058  msg = 'Error reading dimensions from '//trim(filename)//' - '//trim(io_msg)
1059  CALL read_cleanup(); RETURN
1060  END IF
1061  ! ...Check that n_Channels is zero
1062  IF ( n_input_channels /= 0 ) THEN
1063  msg = 'n_Channels dimensions in '//trim(filename)//' is not zero for a rank-1 '//&
1064  '(i.e. profiles only) Surface read.'
1065  CALL read_cleanup(); RETURN
1066  END IF
1067  ! ...Allocate the return structure array
1068  ALLOCATE(surface(n_input_profiles), stat=alloc_stat, errmsg=alloc_msg)
1069  IF ( alloc_stat /= 0 ) THEN
1070  msg = 'Error allocating Surface array - '//trim(alloc_msg)
1071  CALL read_cleanup(); RETURN
1072  END IF
1073 
1074 
1075  ! Loop over all the profiles
1076  profile_loop: DO m = 1, n_input_profiles
1077  err_stat = read_record( fid, surface(m), &
1078  quiet = quiet, &
1079  debug = debug )
1080  IF ( err_stat /= success ) THEN
1081  WRITE( msg,'("Error reading Surface element (",i0,") from ",a)' ) m, trim(filename)
1082  CALL read_cleanup(); RETURN
1083  END IF
1084  END DO profile_loop
1085 
1086 
1087  ! Close the file
1088  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
1089  IF ( io_stat /= 0 ) THEN
1090  msg = 'Error closing '//trim(filename)//' - '//trim(io_msg)
1091  CALL read_cleanup(); RETURN
1092  END IF
1093 
1094 
1095  ! Set the return values
1096  IF ( PRESENT(n_channels) ) n_channels = 0
1097  IF ( PRESENT(n_profiles) ) n_profiles = n_input_profiles
1098 
1099 
1100  ! Output an info message
1101  IF ( noisy ) THEN
1102  WRITE( msg,'("Number of profiles read from ",a,": ",i0)' ) trim(filename), n_input_profiles
1103  CALL display_message( routine_name, msg, information )
1104  END IF
1105 
1106  CONTAINS
1107 
1108  SUBROUTINE read_cleanup()
1109  IF ( file_open( filename ) ) THEN
1110  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
1111  IF ( io_stat /= 0 ) &
1112  msg = trim(msg)//'; Error closing input file during error cleanup - '//trim(io_msg)
1113  END IF
1114  IF ( ALLOCATED(surface) ) THEN
1115  DEALLOCATE(surface, stat=alloc_stat, errmsg=alloc_msg)
1116  IF ( alloc_stat /= 0 ) &
1117  msg = trim(msg)//'; Error deallocating Surface array during error cleanup - '//&
1118  trim(alloc_msg)
1119  END IF
1120  err_stat = failure
1121  CALL display_message( routine_name, msg, err_stat )
1122  END SUBROUTINE read_cleanup
1123 
1124  END FUNCTION read_surface_rank1
1125 
1126 
1127  FUNCTION read_surface_rank2( &
1128  Filename , & ! Input
1129  Surface , & ! Output
1130  Quiet , & ! Optional input
1131  n_Channels, & ! Optional output
1132  n_Profiles, & ! Optional output
1133  Debug ) & ! Optional input (Debug output control)
1134  result( err_stat )
1135  ! Arguments
1136  CHARACTER(*), INTENT(IN) :: filename
1137  TYPE(crtm_surface_type), ALLOCATABLE, INTENT(OUT) :: surface(:,:) ! L x M
1138  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
1139  INTEGER, OPTIONAL, INTENT(OUT) :: n_channels
1140  INTEGER, OPTIONAL, INTENT(OUT) :: n_profiles
1141  LOGICAL, OPTIONAL, INTENT(IN) :: debug
1142  ! Function result
1143  INTEGER :: err_stat
1144  ! Function parameters
1145  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Surface_ReadFile(L x M)'
1146  ! Function variables
1147  CHARACTER(ML) :: msg
1148  CHARACTER(ML) :: io_msg
1149  CHARACTER(ML) :: alloc_msg
1150  INTEGER :: io_stat
1151  INTEGER :: alloc_stat
1152  LOGICAL :: noisy
1153  INTEGER :: fid
1154  INTEGER :: l, n_input_channels
1155  INTEGER :: m, n_input_profiles
1156 
1157 
1158  ! Set up
1159  err_stat = success
1160  ! ...Check Quiet argument
1161  noisy = .true.
1162  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
1163  ! ...Override Quiet settings if debug set.
1164  IF ( PRESENT(debug) ) noisy = debug
1165 
1166 
1167  ! Open the file
1168  err_stat = open_binary_file( filename, fid )
1169  IF ( err_stat /= success ) THEN
1170  msg = 'Error opening '//trim(filename)
1171  CALL read_cleanup(); RETURN
1172  END IF
1173 
1174 
1175  ! Read the dimensions
1176  READ( fid,iostat=io_stat,iomsg=io_msg ) n_input_channels, n_input_profiles
1177  IF ( io_stat /= 0 ) THEN
1178  msg = 'Error reading dimensions from '//trim(filename)//' - '//trim(io_msg)
1179  CALL read_cleanup(); RETURN
1180  END IF
1181  ! ...Allocate the return structure array
1182  ALLOCATE(surface(n_input_channels, n_input_profiles), stat=alloc_stat, errmsg=alloc_msg)
1183  IF ( alloc_stat /= 0 ) THEN
1184  msg = 'Error allocating Surface array - '//trim(alloc_msg)
1185  CALL read_cleanup(); RETURN
1186  END IF
1187 
1188 
1189  ! Loop over all the profiles and channels
1190  profile_loop: DO m = 1, n_input_profiles
1191  channel_loop: DO l = 1, n_input_channels
1192  err_stat = read_record( fid, surface(l,m), &
1193  quiet = quiet, &
1194  debug = debug )
1195  IF ( err_stat /= success ) THEN
1196  WRITE( msg,'("Error reading Surface element (",i0,",",i0,") from ",a)' ) &
1197  l, m, trim(filename)
1198  CALL read_cleanup(); RETURN
1199  END IF
1200  END DO channel_loop
1201  END DO profile_loop
1202 
1203 
1204  ! Close the file
1205  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
1206  IF ( io_stat /= 0 ) THEN
1207  msg = 'Error closing '//trim(filename)//' - '//trim(io_msg)
1208  CALL read_cleanup(); RETURN
1209  END IF
1210 
1211 
1212  ! Set the return values
1213  IF ( PRESENT(n_channels) ) n_channels = n_input_channels
1214  IF ( PRESENT(n_profiles) ) n_profiles = n_input_profiles
1215 
1216 
1217  ! Output an info message
1218  IF ( noisy ) THEN
1219  WRITE( msg,'("Number of channels and profiles read from ",a,": ",i0,1x,i0)' ) &
1220  trim(filename), n_input_channels, n_input_profiles
1221  CALL display_message( routine_name, msg, information )
1222  END IF
1223 
1224  CONTAINS
1225 
1226  SUBROUTINE read_cleanup()
1227  IF ( file_open( filename ) ) THEN
1228  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
1229  IF ( io_stat /= 0 ) &
1230  msg = trim(msg)//'; Error closing input file during error cleanup - '//trim(io_msg)
1231  END IF
1232  IF ( ALLOCATED(surface) ) THEN
1233  DEALLOCATE(surface, stat=alloc_stat, errmsg=alloc_msg)
1234  IF ( alloc_stat /= 0 ) &
1235  msg = trim(msg)//'; Error deallocating Surface array during error cleanup - '//&
1236  trim(alloc_msg)
1237  END IF
1238  err_stat = failure
1239  CALL display_message( routine_name, msg, err_stat )
1240  END SUBROUTINE read_cleanup
1241 
1242  END FUNCTION read_surface_rank2
1243 
1244 
1245 !------------------------------------------------------------------------------
1246 !:sdoc+:
1247 !
1248 ! NAME:
1249 ! CRTM_Surface_WriteFile
1250 !
1251 ! PURPOSE:
1252 ! Function to write CRTM Surface object files.
1253 !
1254 ! CALLING SEQUENCE:
1255 ! Error_Status = CRTM_Surface_WriteFile( Filename , &
1256 ! Surface , &
1257 ! Quiet = Quiet )
1258 !
1259 ! INPUTS:
1260 ! Filename: Character string specifying the name of the
1261 ! Surface format data file to write.
1262 ! UNITS: N/A
1263 ! TYPE: CHARACTER(*)
1264 ! DIMENSION: Scalar
1265 ! ATTRIBUTES: INTENT(IN)
1266 !
1267 ! Surface: CRTM Surface object array containing the Surface
1268 ! data. Note the following meanings attributed to the
1269 ! dimensions of the Surface array:
1270 ! Rank-1: M profiles.
1271 ! Only profile data are to be read in. The file
1272 ! does not contain channel information. The
1273 ! dimension of the array is understood to
1274 ! be the PROFILE dimension.
1275 ! Rank-2: L channels x M profiles
1276 ! Channel and profile data are to be read in.
1277 ! The file contains both channel and profile
1278 ! information. The first dimension of the
1279 ! array is the CHANNEL dimension, the second
1280 ! is the PROFILE dimension. This is to allow
1281 ! K-matrix structures to be read in with the
1282 ! same function.
1283 ! UNITS: N/A
1284 ! TYPE: CRTM_Surface_type
1285 ! DIMENSION: Rank-1 (M) or Rank-2 (L x M)
1286 ! ATTRIBUTES: INTENT(IN)
1287 !
1288 ! OPTIONAL INPUTS:
1289 ! Quiet: Set this logical argument to suppress INFORMATION
1290 ! messages being printed to stdout
1291 ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
1292 ! == .TRUE., INFORMATION messages are SUPPRESSED.
1293 ! If not specified, default is .FALSE.
1294 ! UNITS: N/A
1295 ! TYPE: LOGICAL
1296 ! DIMENSION: Scalar
1297 ! ATTRIBUTES: INTENT(IN), OPTIONAL
1298 !
1299 ! FUNCTION RESULT:
1300 ! Error_Status: The return value is an integer defining the error status.
1301 ! The error codes are defined in the Message_Handler module.
1302 ! If == SUCCESS, the file write was successful
1303 ! == FAILURE, an unrecoverable error occurred.
1304 ! UNITS: N/A
1305 ! TYPE: INTEGER
1306 ! DIMENSION: Scalar
1307 !
1308 ! SIDE EFFECTS:
1309 ! - If the output file already exists, it is overwritten.
1310 ! - If an error occurs during *writing*, the output file is deleted before
1311 ! returning to the calling routine.
1312 !
1313 !:sdoc-:
1314 !------------------------------------------------------------------------------
1315 
1316  FUNCTION write_surface_rank1( &
1317  Filename, & ! Input
1318  Surface , & ! Input
1319  Quiet , & ! Optional input
1320  Debug ) & ! Optional input (Debug output control)
1321  result( err_stat )
1322  ! Arguments
1323  CHARACTER(*), INTENT(IN) :: filename
1324  TYPE(crtm_surface_type), INTENT(IN) :: surface(:) ! M
1325  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
1326  LOGICAL, OPTIONAL, INTENT(IN) :: debug
1327  ! Function result
1328  INTEGER :: err_stat
1329  ! Function parameters
1330  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Surface_WriteFile(M)'
1331  ! Function variables
1332  CHARACTER(ML) :: msg
1333  CHARACTER(ML) :: io_msg
1334  LOGICAL :: noisy
1335  INTEGER :: io_stat
1336  INTEGER :: fid
1337  INTEGER :: m, n_output_profiles
1338 
1339  ! Setup
1340  err_stat = success
1341  ! ...Check Quiet argument
1342  noisy = .true.
1343  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
1344  ! ...Override Quiet settings if debug set.
1345  IF ( PRESENT(debug) ) THEN
1346  IF ( debug ) noisy = .true.
1347  END IF
1348  ! Dimensions
1349  n_output_profiles = SIZE(surface)
1350 
1351 
1352  ! Open the file
1353  err_stat = open_binary_file( filename, fid, for_output = .true. )
1354  IF ( err_stat /= success ) THEN
1355  msg = 'Error opening '//trim(filename)
1356  CALL write_cleanup(); RETURN
1357  END IF
1358 
1359 
1360  ! Write the dimensions
1361  WRITE( fid,iostat=io_stat,iomsg=io_msg ) 0, n_output_profiles
1362  IF ( io_stat /= 0 ) THEN
1363  msg = 'Error writing dimensions to '//trim(filename)//'- '//trim(io_msg)
1364  CALL write_cleanup(); RETURN
1365  END IF
1366 
1367 
1368  ! Write the data
1369  profile_loop: DO m = 1, n_output_profiles
1370  err_stat = write_record( fid, surface(m), &
1371  quiet = quiet, &
1372  debug = debug )
1373  IF ( err_stat /= success ) THEN
1374  WRITE( msg,'("Error writing Surface element (",i0,") to ",a)' ) m, trim(filename)
1375  CALL write_cleanup(); RETURN
1376  END IF
1377  END DO profile_loop
1378 
1379 
1380  ! Close the file (if error, no delete)
1381  CLOSE( fid,status='KEEP',iostat=io_stat,iomsg=io_msg )
1382  IF ( io_stat /= 0 ) THEN
1383  msg = 'Error closing '//trim(filename)//'- '//trim(io_msg)
1384  CALL write_cleanup(); RETURN
1385  END IF
1386 
1387 
1388  ! Output an info message
1389  IF ( noisy ) THEN
1390  WRITE( msg,'("Number of profiles written to ",a,": ",i0)' ) &
1391  trim(filename), n_output_profiles
1392  CALL display_message( routine_name, msg, information )
1393  END IF
1394 
1395  CONTAINS
1396 
1397  SUBROUTINE write_cleanup()
1398  IF ( file_open( filename ) ) THEN
1399  CLOSE( fid,status=write_error_status,iostat=io_stat,iomsg=io_msg )
1400  IF ( io_stat /= 0 ) &
1401  msg = trim(msg)//'; Error deleting output file during error cleanup - '//trim(io_msg)
1402  END IF
1403  err_stat = failure
1404  CALL display_message( routine_name, msg, err_stat )
1405  END SUBROUTINE write_cleanup
1406 
1407  END FUNCTION write_surface_rank1
1408 
1409 
1410  FUNCTION write_surface_rank2( &
1411  Filename, & ! Input
1412  Surface , & ! Input
1413  Quiet , & ! Optional input
1414  Debug ) & ! Optional input (Debug output control)
1415  result( err_stat )
1416  ! Arguments
1417  CHARACTER(*), INTENT(IN) :: filename
1418  TYPE(crtm_surface_type), INTENT(IN) :: surface(:,:) ! L x M
1419  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
1420  LOGICAL, OPTIONAL, INTENT(IN) :: debug
1421  ! Function result
1422  INTEGER :: err_stat
1423  ! Function parameters
1424  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Surface_WriteFile(L x M)'
1425  ! Function variables
1426  CHARACTER(ML) :: msg
1427  CHARACTER(ML) :: io_msg
1428  LOGICAL :: noisy
1429  INTEGER :: io_stat
1430  INTEGER :: fid
1431  INTEGER :: l, n_output_channels
1432  INTEGER :: m, n_output_profiles
1433 
1434  ! Set up
1435  err_stat = success
1436  ! ...Check Quiet argument
1437  noisy = .true.
1438  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
1439  ! ...Override Quiet settings if debug set.
1440  IF ( PRESENT(debug) ) THEN
1441  IF ( debug ) noisy = .true.
1442  END IF
1443  ! Dimensions
1444  n_output_channels = SIZE(surface,dim=1)
1445  n_output_profiles = SIZE(surface,dim=2)
1446 
1447 
1448  ! Open the file
1449  err_stat = open_binary_file( filename, fid, for_output = .true. )
1450  IF ( err_stat /= success ) THEN
1451  msg = 'Error opening '//trim(filename)
1452  CALL write_cleanup(); RETURN
1453  END IF
1454 
1455 
1456  ! Write the dimensions
1457  WRITE( fid,iostat=io_stat,iomsg=io_msg ) n_output_channels, n_output_profiles
1458  IF ( io_stat /= 0 ) THEN
1459  msg = 'Error writing dimensions to '//trim(filename)//'- '//trim(io_msg)
1460  CALL write_cleanup(); RETURN
1461  END IF
1462 
1463 
1464  ! Write the data
1465  profile_loop: DO m = 1, n_output_profiles
1466  channel_loop: DO l = 1, n_output_channels
1467  err_stat = write_record( fid, surface(l,m), &
1468  quiet = quiet, &
1469  debug = debug )
1470  IF ( err_stat /= success ) THEN
1471  WRITE( msg,'("Error writing Surface element (",i0,",",i0,") to ",a)' ) &
1472  l, m, trim(filename)
1473  CALL write_cleanup(); RETURN
1474  END IF
1475  END DO channel_loop
1476  END DO profile_loop
1477 
1478 
1479  ! Close the file (if error, no delete)
1480  CLOSE( fid,status='KEEP',iostat=io_stat,iomsg=io_msg )
1481  IF ( io_stat /= 0 ) THEN
1482  msg = 'Error closing '//trim(filename)//'- '//trim(io_msg)
1483  CALL write_cleanup(); RETURN
1484  END IF
1485 
1486 
1487  ! Output an info message
1488  IF ( noisy ) THEN
1489  WRITE( msg,'("Number of channels and profiles written to ",a,": ",i0,1x,i0 )' ) &
1490  trim(filename), n_output_channels, n_output_profiles
1491  CALL display_message( routine_name, msg, information )
1492  END IF
1493 
1494  CONTAINS
1495 
1496  SUBROUTINE write_cleanup()
1497  IF ( file_open( filename ) ) THEN
1498  CLOSE( fid,status=write_error_status,iostat=io_stat,iomsg=io_msg )
1499  IF ( io_stat /= 0 ) &
1500  msg = trim(msg)//'; Error deleting output file during error cleanup - '//trim(io_msg)
1501  END IF
1502  err_stat = failure
1503  CALL display_message( routine_name, msg, err_stat )
1504  END SUBROUTINE write_cleanup
1505 
1506  END FUNCTION write_surface_rank2
1507 
1508 
1509 
1510 !##################################################################################
1511 !##################################################################################
1512 !## ##
1513 !## ## PRIVATE MODULE ROUTINES ## ##
1514 !## ##
1515 !##################################################################################
1516 !##################################################################################
1517 
1518 !--------------------------------------------------------------------------------
1519 !
1520 ! NAME:
1521 ! CRTM_Surface_Equal
1522 !
1523 ! PURPOSE:
1524 ! Elemental function to test the equality of two CRTM_Surface objects.
1525 ! Used in OPERATOR(==) interface block.
1526 !
1527 ! CALLING SEQUENCE:
1528 ! is_equal = CRTM_Surface_Equal( x, y )
1529 !
1530 ! or
1531 !
1532 ! IF ( x == y ) THEN
1533 ! ...
1534 ! END IF
1535 !
1536 ! OBJECTS:
1537 ! x, y: Two CRTM Surface objects to be compared.
1538 ! UNITS: N/A
1539 ! TYPE: CRTM_Surface_type
1540 ! DIMENSION: Scalar or any rank
1541 ! ATTRIBUTES: INTENT(IN)
1542 !
1543 ! FUNCTION RESULT:
1544 ! is_equal: Logical value indicating whether the inputs are equal.
1545 ! UNITS: N/A
1546 ! TYPE: LOGICAL
1547 ! DIMENSION: Same as inputs.
1548 !
1549 !--------------------------------------------------------------------------------
1550 
1551  ELEMENTAL FUNCTION crtm_surface_equal( x, y ) RESULT( is_equal )
1552  TYPE(crtm_surface_type) , INTENT(IN) :: x, y
1553  LOGICAL :: is_equal
1554 
1555  ! Check the gross surface type coverage
1556  is_equal = ( (x%Land_Coverage .equalto. y%Land_Coverage ) .AND. &
1557  (x%Water_Coverage .equalto. y%Water_Coverage) .AND. &
1558  (x%Snow_Coverage .equalto. y%Snow_Coverage ) .AND. &
1559  (x%Ice_Coverage .equalto. y%Ice_Coverage ) )
1560  IF ( .NOT. is_equal ) RETURN
1561 
1562  ! Check the land surface type data
1563  is_equal = is_equal .AND. crtm_landsurface_equal(x,y)
1564  IF ( .NOT. is_equal ) RETURN
1565 
1566  ! Check the water surface type data
1567  is_equal = is_equal .AND. crtm_watersurface_equal(x,y)
1568  IF ( .NOT. is_equal ) RETURN
1569 
1570  ! Check the snow surface type data
1571  is_equal = is_equal .AND. crtm_snowsurface_equal(x,y)
1572  IF ( .NOT. is_equal ) RETURN
1573 
1574  ! Check the ice surface type data
1575  is_equal = is_equal .AND. crtm_icesurface_equal(x,y)
1576  IF ( .NOT. is_equal ) RETURN
1577 
1578  ! Check the SensorData
1579  IF ( crtm_sensordata_associated(x%SensorData) .AND. &
1580  crtm_sensordata_associated(y%SensorData) ) THEN
1581  is_equal = is_equal .AND. (x%SensorData == y%SensorData)
1582  END IF
1583 
1584  END FUNCTION crtm_surface_equal
1585 
1586 
1587 !--------------------------------------------------------------------------------
1588 !
1589 ! NAME:
1590 ! CRTM_Surface_Add
1591 !
1592 ! PURPOSE:
1593 ! Pure function to add two CRTM Surface objects.
1594 ! Used in OPERATOR(+) interface block.
1595 !
1596 ! CALLING SEQUENCE:
1597 ! sfcsum = CRTM_Surface_Add( sfc1, sfc2 )
1598 !
1599 ! or
1600 !
1601 ! sfcsum = sfc1 + sfc2
1602 !
1603 !
1604 ! INPUTS:
1605 ! sfc1, sfc2: The Surface objects to add.
1606 ! UNITS: N/A
1607 ! TYPE: CRTM_Surface_type
1608 ! DIMENSION: Scalar
1609 ! ATTRIBUTES: INTENT(IN OUT)
1610 !
1611 ! RESULT:
1612 ! sfcsum: Surface structure containing the added components.
1613 ! UNITS: N/A
1614 ! TYPE: CRTM_Surface_type
1615 ! DIMENSION: Scalar
1616 !
1617 !--------------------------------------------------------------------------------
1618 
1619  ELEMENTAL FUNCTION crtm_surface_add( sfc1, sfc2 ) RESULT( sfcsum )
1620  TYPE(crtm_surface_type), INTENT(IN) :: sfc1, sfc2
1621  TYPE(crtm_surface_type) :: sfcsum
1622 
1623  ! Copy the first structure
1624  sfcsum = sfc1
1625 
1626  ! And add its components to the second one
1627  sfcsum%Land_Temperature = sfcsum%Land_Temperature + sfc2%Land_Temperature
1628  sfcsum%Soil_Moisture_Content = sfcsum%Soil_Moisture_Content + sfc2%Soil_Moisture_Content
1629  sfcsum%Canopy_Water_Content = sfcsum%Canopy_Water_Content + sfc2%Canopy_Water_Content
1630  sfcsum%Vegetation_Fraction = sfcsum%Vegetation_Fraction + sfc2%Vegetation_Fraction
1631  sfcsum%Soil_Temperature = sfcsum%Soil_Temperature + sfc2%Soil_Temperature
1632  sfcsum%LAI = sfcsum%LAI + sfc2%LAI
1633  sfcsum%Water_Temperature = sfcsum%Water_Temperature + sfc2%Water_Temperature
1634  sfcsum%Wind_Speed = sfcsum%Wind_Speed + sfc2%Wind_Speed
1635  sfcsum%Wind_Direction = sfcsum%Wind_Direction + sfc2%Wind_Direction
1636  sfcsum%Salinity = sfcsum%Salinity + sfc2%Salinity
1637  sfcsum%Snow_Temperature = sfcsum%Snow_Temperature + sfc2%Snow_Temperature
1638  sfcsum%Snow_Depth = sfcsum%Snow_Depth + sfc2%Snow_Depth
1639  sfcsum%Snow_Density = sfcsum%Snow_Density + sfc2%Snow_Density
1640  sfcsum%Snow_Grain_Size = sfcsum%Snow_Grain_Size + sfc2%Snow_Grain_Size
1641  sfcsum%Ice_Temperature = sfcsum%Ice_Temperature + sfc2%Ice_Temperature
1642  sfcsum%Ice_Thickness = sfcsum%Ice_Thickness + sfc2%Ice_Thickness
1643  sfcsum%Ice_Density = sfcsum%Ice_Density + sfc2%Ice_Density
1644  sfcsum%Ice_Roughness = sfcsum%Ice_Roughness + sfc2%Ice_Roughness
1645  ! ...SensorData component
1646  IF ( crtm_sensordata_associated(sfc1%SensorData) .AND. &
1647  crtm_sensordata_associated(sfc2%SensorData) ) THEN
1648  sfcsum%SensorData = sfcsum%SensorData + sfc2%SensorData
1649  END IF
1650 
1651  END FUNCTION crtm_surface_add
1652 
1653 
1654 !--------------------------------------------------------------------------------
1655 !
1656 ! NAME:
1657 ! CRTM_Surface_Subtract
1658 !
1659 ! PURPOSE:
1660 ! Pure function to subtract two CRTM Surface objects.
1661 ! Used in OPERATOR(-) interface block.
1662 !
1663 ! CALLING SEQUENCE:
1664 ! sfcdiff = CRTM_Surface_Subtract( sfc1, sfc2 )
1665 !
1666 ! or
1667 !
1668 ! sfcdiff = sfc1 - sfc2
1669 !
1670 !
1671 ! INPUTS:
1672 ! sfc1, sfc2: The Surface objects to subtract.
1673 ! UNITS: N/A
1674 ! TYPE: CRTM_Surface_type
1675 ! DIMENSION: Scalar
1676 ! ATTRIBUTES: INTENT(IN OUT)
1677 !
1678 ! RESULT:
1679 ! sfcdiff: Surface structure containing the differenced components.
1680 ! UNITS: N/A
1681 ! TYPE: CRTM_Surface_type
1682 ! DIMENSION: Scalar
1683 !
1684 !--------------------------------------------------------------------------------
1685 
1686  ELEMENTAL FUNCTION crtm_surface_subtract( sfc1, sfc2 ) RESULT( sfcdiff )
1687  TYPE(crtm_surface_type), INTENT(IN) :: sfc1, sfc2
1688  TYPE(crtm_surface_type) :: sfcdiff
1689 
1690  ! Copy the first structure
1691  sfcdiff = sfc1
1692 
1693  ! And subtract the second one's components from it.
1694  sfcdiff%Land_Temperature = sfcdiff%Land_Temperature - sfc2%Land_Temperature
1695  sfcdiff%Soil_Moisture_Content = sfcdiff%Soil_Moisture_Content - sfc2%Soil_Moisture_Content
1696  sfcdiff%Canopy_Water_Content = sfcdiff%Canopy_Water_Content - sfc2%Canopy_Water_Content
1697  sfcdiff%Vegetation_Fraction = sfcdiff%Vegetation_Fraction - sfc2%Vegetation_Fraction
1698  sfcdiff%Soil_Temperature = sfcdiff%Soil_Temperature - sfc2%Soil_Temperature
1699  sfcdiff%LAI = sfcdiff%LAI - sfc2%LAI
1700  sfcdiff%Water_Temperature = sfcdiff%Water_Temperature - sfc2%Water_Temperature
1701  sfcdiff%Wind_Speed = sfcdiff%Wind_Speed - sfc2%Wind_Speed
1702  sfcdiff%Wind_Direction = sfcdiff%Wind_Direction - sfc2%Wind_Direction
1703  sfcdiff%Salinity = sfcdiff%Salinity - sfc2%Salinity
1704  sfcdiff%Snow_Temperature = sfcdiff%Snow_Temperature - sfc2%Snow_Temperature
1705  sfcdiff%Snow_Depth = sfcdiff%Snow_Depth - sfc2%Snow_Depth
1706  sfcdiff%Snow_Density = sfcdiff%Snow_Density - sfc2%Snow_Density
1707  sfcdiff%Snow_Grain_Size = sfcdiff%Snow_Grain_Size - sfc2%Snow_Grain_Size
1708  sfcdiff%Ice_Temperature = sfcdiff%Ice_Temperature - sfc2%Ice_Temperature
1709  sfcdiff%Ice_Thickness = sfcdiff%Ice_Thickness - sfc2%Ice_Thickness
1710  sfcdiff%Ice_Density = sfcdiff%Ice_Density - sfc2%Ice_Density
1711  sfcdiff%Ice_Roughness = sfcdiff%Ice_Roughness - sfc2%Ice_Roughness
1712  ! ...SensorData component
1713  IF ( crtm_sensordata_associated(sfc1%SensorData) .AND. &
1714  crtm_sensordata_associated(sfc2%SensorData) ) THEN
1715  sfcdiff%SensorData = sfcdiff%SensorData - sfc2%SensorData
1716  END IF
1717 
1718  END FUNCTION crtm_surface_subtract
1719 
1720 
1721 
1722 !##################################################################################
1723 !##################################################################################
1724 !## ##
1725 !## ## PROCEDURES BELOW WILL EVENTUALLY BE MOVED TO THEIR OWN MODULE ## ##
1726 !## ##
1727 !##################################################################################
1728 !##################################################################################
1729 
1730 ! =============================
1731 ! LAND TYPE SPECIFIC PROCEDURES
1732 ! =============================
1733  ELEMENTAL SUBROUTINE crtm_landsurface_zero( Sfc )
1734  TYPE(crtm_surface_type), INTENT(IN OUT) :: sfc
1735  ! Zero land surface type data
1736  sfc%Land_Temperature = zero
1737  sfc%Soil_Moisture_Content = zero
1738  sfc%Canopy_Water_Content = zero
1739  sfc%Vegetation_Fraction = zero
1740  sfc%Soil_Temperature = zero
1741  sfc%LAI = zero
1742  END SUBROUTINE crtm_landsurface_zero
1743 
1744 
1745  FUNCTION crtm_landsurface_isvalid( Sfc ) RESULT( IsValid )
1746  TYPE(crtm_surface_type), INTENT(IN) :: sfc
1747  LOGICAL :: isvalid
1748  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_LandSurface_IsValid'
1749  CHARACTER(ML) :: msg
1750 
1751  ! Setup
1752  isvalid = .true.
1753 
1754  ! Check the data
1755  IF ( sfc%Land_Type < 1 ) THEN
1756  msg = 'Invalid Land Surface type'
1757  CALL display_message( routine_name, trim(msg), information )
1758  isvalid = .false.
1759  ENDIF
1760  IF ( sfc%Land_Temperature < zero .OR. &
1761  sfc%Soil_Moisture_Content < zero .OR. &
1762  sfc%Canopy_Water_Content < zero .OR. &
1763  sfc%Vegetation_Fraction < zero .OR. &
1764  sfc%Soil_Temperature < zero .OR. &
1765  sfc%LAI < zero ) THEN
1766  msg = 'Invalid Land Surface data'
1767  CALL display_message( routine_name, trim(msg), information )
1768  isvalid = .false.
1769  ENDIF
1770 
1771  END FUNCTION crtm_landsurface_isvalid
1772 
1773 
1774  SUBROUTINE crtm_landsurface_inspect( Sfc, Unit )
1775  TYPE(CRTM_Surface_type), INTENT(IN) :: Sfc
1776  INTEGER, OPTIONAL, INTENT(IN) :: Unit
1777  INTEGER :: fid
1778  fid = output_unit
1779  IF ( PRESENT(unit) ) THEN
1780  IF ( file_open(unit) ) fid = unit
1781  END IF
1782  WRITE(fid,'(3x,"Land type index :",1x,i0)') sfc%Land_Type
1783  WRITE(fid,'(3x,"Land Temperature :",1x,es13.6)') sfc%Land_Temperature
1784  WRITE(fid,'(3x,"Soil Moisture Content:",1x,es13.6)') sfc%Soil_Moisture_Content
1785  WRITE(fid,'(3x,"Canopy Water Content :",1x,es13.6)') sfc%Canopy_Water_Content
1786  WRITE(fid,'(3x,"Vegetation Fraction :",1x,es13.6)') sfc%Vegetation_Fraction
1787  WRITE(fid,'(3x,"Soil Temperature :",1x,es13.6)') sfc%Soil_Temperature
1788  WRITE(fid,'(3x,"Leaf Area Index :",1x,es13.6)') sfc%LAI
1789  WRITE(fid,'(3x,"Soil type index :",1x,i0)') sfc%Soil_Type
1790  WRITE(fid,'(3x,"Vegetation type index:",1x,i0)') sfc%Vegetation_Type
1791  END SUBROUTINE crtm_landsurface_inspect
1792 
1793 
1794  ELEMENTAL FUNCTION crtm_landsurface_compare( x, y, n_SigFig ) RESULT( is_comparable )
1795  TYPE(crtm_surface_type), INTENT(IN) :: x, y
1796  INTEGER, OPTIONAL, INTENT(IN) :: n_sigfig
1797  LOGICAL :: is_comparable
1798  ! Variables
1799  INTEGER :: n
1800 
1801  ! Set up
1802  is_comparable = .false.
1803  IF ( PRESENT(n_sigfig) ) THEN
1804  n = abs(n_sigfig)
1805  ELSE
1806  n = default_n_sigfig
1807  END IF
1808 
1809  ! Check integers
1810  IF ( x%Land_Type /= y%Land_Type .OR. &
1811  x%Soil_Type /= y%Soil_Type .OR. &
1812  x%Vegetation_Type /= y%Vegetation_Type ) RETURN
1813 
1814  ! Check floats
1815  IF ( (.NOT. compares_within_tolerance(x%Land_Temperature ,y%Land_Temperature ,n)) .OR. &
1816  (.NOT. compares_within_tolerance(x%Soil_Moisture_Content,y%Soil_Moisture_Content,n)) .OR. &
1817  (.NOT. compares_within_tolerance(x%Canopy_Water_Content ,y%Canopy_Water_Content ,n)) .OR. &
1818  (.NOT. compares_within_tolerance(x%Vegetation_Fraction ,y%Vegetation_Fraction ,n)) .OR. &
1819  (.NOT. compares_within_tolerance(x%Soil_Temperature ,y%Soil_Temperature ,n)) .OR. &
1820  (.NOT. compares_within_tolerance(x%LAI ,y%LAI ,n)) ) RETURN
1821 
1822  ! If we get here, the structures are comparable
1823  is_comparable = .true.
1824 
1825  END FUNCTION crtm_landsurface_compare
1826 
1827 
1828  ELEMENTAL FUNCTION crtm_landsurface_equal( x, y ) RESULT( is_equal )
1829  TYPE(crtm_surface_type) , INTENT(IN) :: x, y
1830  LOGICAL :: is_equal
1831  is_equal = ( (x%Land_Type == y%Land_Type ) .AND. &
1832  (x%Land_Temperature .equalto. y%Land_Temperature ) .AND. &
1833  (x%Soil_Moisture_Content .equalto. y%Soil_Moisture_Content) .AND. &
1834  (x%Canopy_Water_Content .equalto. y%Canopy_Water_Content ) .AND. &
1835  (x%Vegetation_Fraction .equalto. y%Vegetation_Fraction ) .AND. &
1836  (x%Soil_Temperature .equalto. y%Soil_Temperature ) .AND. &
1837  (x%LAI .equalto. y%LAI ) .AND. &
1838  (x%Soil_Type == y%Soil_Type ) .AND. &
1839  (x%Vegetation_Type == y%Vegetation_Type ) )
1840  END FUNCTION crtm_landsurface_equal
1841 
1842 
1843 ! ==============================
1844 ! WATER TYPE SPECIFIC PROCEDURES
1845 ! ==============================
1846  ELEMENTAL SUBROUTINE crtm_watersurface_zero( Sfc )
1847  TYPE(crtm_surface_type), INTENT(IN OUT) :: sfc
1848  ! Zero the water surface type data
1849  sfc%Water_Temperature = zero
1850  sfc%Wind_Speed = zero
1851  sfc%Wind_Direction = zero
1852  sfc%Salinity = zero
1853  END SUBROUTINE crtm_watersurface_zero
1854 
1855 
1856  FUNCTION crtm_watersurface_isvalid( Sfc ) RESULT( IsValid )
1857  TYPE(crtm_surface_type), INTENT(IN) :: sfc
1858  LOGICAL :: isvalid
1859  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_WaterSurface_IsValid'
1860  CHARACTER(ML) :: msg
1861 
1862  ! Setup
1863  isvalid = .true.
1864 
1865  ! Check the data
1866  IF ( sfc%Water_Type < 1 ) THEN
1867  msg = 'Invalid Water Surface type'
1868  CALL display_message( routine_name, trim(msg), information )
1869  isvalid = .false.
1870  ENDIF
1871  IF ( sfc%Water_Temperature < zero .OR. &
1872  sfc%Wind_Speed < zero .OR. &
1873  sfc%Wind_Direction < zero .OR. &
1874  sfc%Salinity < zero ) THEN
1875  msg = 'Invalid Water Surface data'
1876  CALL display_message( routine_name, trim(msg), information )
1877  isvalid = .false.
1878  END IF
1879 
1880  END FUNCTION crtm_watersurface_isvalid
1881 
1882 
1883  SUBROUTINE crtm_watersurface_inspect( Sfc, Unit )
1884  TYPE(CRTM_Surface_type), INTENT(IN) :: Sfc
1885  INTEGER, OPTIONAL, INTENT(IN) :: Unit
1886  INTEGER :: fid
1887  fid = output_unit
1888  IF ( PRESENT(unit) ) THEN
1889  IF ( file_open(unit) ) fid = unit
1890  END IF
1891  WRITE(fid,'(3x,"Water Type index :",1x,i0)') sfc%Water_Type
1892  WRITE(fid,'(3x,"Water Temperature:",1x,es13.6)') sfc%Water_Temperature
1893  WRITE(fid,'(3x,"Wind Speed :",1x,es13.6)') sfc%Wind_Speed
1894  WRITE(fid,'(3x,"Wind Direction :",1x,es13.6)') sfc%Wind_Direction
1895  WRITE(fid,'(3x,"Salinity :",1x,es13.6)') sfc%Salinity
1896  END SUBROUTINE crtm_watersurface_inspect
1897 
1898 
1899  ELEMENTAL FUNCTION crtm_watersurface_compare( x, y, n_SigFig ) RESULT( is_comparable )
1900  TYPE(crtm_surface_type), INTENT(IN) :: x, y
1901  INTEGER, OPTIONAL, INTENT(IN) :: n_sigfig
1902  LOGICAL :: is_comparable
1903  ! Variables
1904  INTEGER :: n
1905 
1906  ! Set up
1907  is_comparable = .false.
1908  IF ( PRESENT(n_sigfig) ) THEN
1909  n = abs(n_sigfig)
1910  ELSE
1911  n = default_n_sigfig
1912  END IF
1913 
1914  ! Check integers
1915  IF ( x%Water_Type /= y%Water_Type ) RETURN
1916 
1917  ! Check floats
1918  IF ( (.NOT. compares_within_tolerance(x%Water_Temperature,y%Water_Temperature,n)) .OR. &
1919  (.NOT. compares_within_tolerance(x%Wind_Speed ,y%Wind_Speed ,n)) .OR. &
1920  (.NOT. compares_within_tolerance(x%Wind_Direction ,y%Wind_Direction ,n)) .OR. &
1921  (.NOT. compares_within_tolerance(x%Salinity ,y%Salinity ,n)) ) RETURN
1922 
1923  ! If we get here, the structures are comparable
1924  is_comparable = .true.
1925 
1926  END FUNCTION crtm_watersurface_compare
1927 
1928 
1929  ELEMENTAL FUNCTION crtm_watersurface_equal( x, y ) RESULT( is_equal )
1930  TYPE(crtm_surface_type) , INTENT(IN) :: x, y
1931  LOGICAL :: is_equal
1932  is_equal = ( (x%Water_Type == y%Water_Type ) .AND. &
1933  (x%Water_Temperature .equalto. y%Water_Temperature) .AND. &
1934  (x%Wind_Speed .equalto. y%Wind_Speed ) .AND. &
1935  (x%Wind_Direction .equalto. y%Wind_Direction ) .AND. &
1936  (x%Salinity .equalto. y%Salinity ) )
1937  END FUNCTION crtm_watersurface_equal
1938 
1939 
1940 ! =============================
1941 ! SNOW TYPE SPECIFIC PROCEDURES
1942 ! =============================
1943  ELEMENTAL SUBROUTINE crtm_snowsurface_zero( Sfc )
1944  TYPE(crtm_surface_type), INTENT(IN OUT) :: sfc
1945  ! Zero the snow surface type data
1946  sfc%Snow_Temperature = zero
1947  sfc%Snow_Depth = zero
1948  sfc%Snow_Density = zero
1949  sfc%Snow_Grain_Size = zero
1950  END SUBROUTINE crtm_snowsurface_zero
1951 
1952 
1953  FUNCTION crtm_snowsurface_isvalid( Sfc ) RESULT( IsValid )
1954  TYPE(crtm_surface_type), INTENT(IN) :: sfc
1955  LOGICAL :: isvalid
1956  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_SnowSurface_IsValid'
1957  CHARACTER(ML) :: msg
1958 
1959  ! Setup
1960  isvalid = .true.
1961 
1962  ! Check the data
1963  IF ( sfc%Snow_Type < 1 ) THEN
1964  msg = 'Invalid Snow Surface type'
1965  CALL display_message( routine_name, trim(msg), information )
1966  isvalid = .false.
1967  ENDIF
1968  IF ( sfc%Snow_Temperature < zero .OR. &
1969  sfc%Snow_Depth < zero .OR. &
1970  sfc%Snow_Density < zero .OR. &
1971  sfc%Snow_Grain_Size < zero ) THEN
1972  msg = 'Invalid Snow Surface data'
1973  CALL display_message( routine_name, trim(msg), information )
1974  isvalid = .false.
1975  END IF
1976 
1977  END FUNCTION crtm_snowsurface_isvalid
1978 
1979 
1980  SUBROUTINE crtm_snowsurface_inspect( Sfc, Unit )
1981  TYPE(CRTM_Surface_type), INTENT(IN) :: Sfc
1982  INTEGER, OPTIONAL, INTENT(IN) :: Unit
1983  INTEGER :: fid
1984  fid = output_unit
1985  IF ( PRESENT(unit) ) THEN
1986  IF ( file_open(unit) ) fid = unit
1987  END IF
1988  WRITE(fid,'(3x,"Snow Type index :",1x,i0)') sfc%Snow_Type
1989  WRITE(fid,'(3x,"Snow Temperature:",1x,es13.6)') sfc%Snow_Temperature
1990  WRITE(fid,'(3x,"Snow Depth :",1x,es13.6)') sfc%Snow_Depth
1991  WRITE(fid,'(3x,"Snow Density :",1x,es13.6)') sfc%Snow_Density
1992  WRITE(fid,'(3x,"Snow Grain_Size :",1x,es13.6)') sfc%Snow_Grain_Size
1993  END SUBROUTINE crtm_snowsurface_inspect
1994 
1995 
1996  ELEMENTAL FUNCTION crtm_snowsurface_compare( x, y, n_SigFig ) RESULT( is_comparable )
1997  TYPE(crtm_surface_type), INTENT(IN) :: x, y
1998  INTEGER, OPTIONAL, INTENT(IN) :: n_sigfig
1999  LOGICAL :: is_comparable
2000  ! Variables
2001  INTEGER :: n
2002 
2003  ! Set up
2004  is_comparable = .false.
2005  IF ( PRESENT(n_sigfig) ) THEN
2006  n = abs(n_sigfig)
2007  ELSE
2008  n = default_n_sigfig
2009  END IF
2010 
2011  ! Check integers
2012  IF ( x%Snow_Type /= y%Snow_Type ) RETURN
2013 
2014  ! Check floats
2015  IF ( (.NOT. compares_within_tolerance(x%Snow_Temperature,y%Snow_Temperature,n)) .OR. &
2016  (.NOT. compares_within_tolerance(x%Snow_Depth ,y%Snow_Depth ,n)) .OR. &
2017  (.NOT. compares_within_tolerance(x%Snow_Density ,y%Snow_Density ,n)) .OR. &
2018  (.NOT. compares_within_tolerance(x%Snow_Grain_Size ,y%Snow_Grain_Size ,n)) ) RETURN
2019 
2020  ! If we get here, the structures are comparable
2021  is_comparable = .true.
2022 
2023  END FUNCTION crtm_snowsurface_compare
2024 
2025 
2026  ELEMENTAL FUNCTION crtm_snowsurface_equal( x, y ) RESULT( is_equal )
2027  TYPE(crtm_surface_type) , INTENT(IN) :: x, y
2028  LOGICAL :: is_equal
2029  is_equal = ( (x%Snow_Type == y%Snow_Type ) .AND. &
2030  (x%Snow_Temperature .equalto. y%Snow_Temperature) .AND. &
2031  (x%Snow_Depth .equalto. y%Snow_Depth ) .AND. &
2032  (x%Snow_Density .equalto. y%Snow_Density ) .AND. &
2033  (x%Snow_Grain_Size .equalto. y%Snow_Grain_Size ) )
2034  END FUNCTION crtm_snowsurface_equal
2035 
2036 
2037 ! ============================
2038 ! ICE TYPE SPECIFIC PROCEDURES
2039 ! ============================
2040  ELEMENTAL SUBROUTINE crtm_icesurface_zero( Sfc )
2041  TYPE(crtm_surface_type), INTENT(IN OUT) :: sfc
2042  ! Zero the ice surface type data
2043  sfc%Ice_Temperature = zero
2044  sfc%Ice_Thickness = zero
2045  sfc%Ice_Density = zero
2046  sfc%Ice_Roughness = zero
2047  END SUBROUTINE crtm_icesurface_zero
2048 
2049 
2050  FUNCTION crtm_icesurface_isvalid( Sfc ) RESULT( IsValid )
2051  TYPE(crtm_surface_type), INTENT(IN) :: sfc
2052  LOGICAL :: isvalid
2053  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_IceSurface_IsValid'
2054  CHARACTER(ML) :: msg
2055 
2056  ! Setup
2057  isvalid = .true.
2058 
2059  ! Check the data
2060  IF ( sfc%Ice_Type < 1 ) THEN
2061  msg = 'Invalid Ice Surface type'
2062  CALL display_message( routine_name, trim(msg), information )
2063  isvalid = .false.
2064  ENDIF
2065  IF ( sfc%Ice_Temperature < zero .OR. &
2066  sfc%Ice_Thickness < zero .OR. &
2067  sfc%Ice_Density < zero .OR. &
2068  sfc%Ice_Roughness < zero ) THEN
2069  msg = 'Invalid Ice Surface data'
2070  CALL display_message( routine_name, trim(msg), information )
2071  isvalid = .false.
2072  END IF
2073 
2074  END FUNCTION crtm_icesurface_isvalid
2075 
2076 
2077  SUBROUTINE crtm_icesurface_inspect( Sfc, Unit )
2078  TYPE(CRTM_Surface_type), INTENT(IN) :: Sfc
2079  INTEGER, OPTIONAL, INTENT(IN) :: Unit
2080  INTEGER :: fid
2081  fid = output_unit
2082  IF ( PRESENT(unit) ) THEN
2083  IF ( file_open(unit) ) fid = unit
2084  END IF
2085  WRITE(fid,'(3x,"Ice Type index :",1x,i0)') sfc%Ice_Type
2086  WRITE(fid,'(3x,"Ice Temperature:",1x,es13.6)') sfc%Ice_Temperature
2087  WRITE(fid,'(3x,"Ice Thickness :",1x,es13.6)') sfc%Ice_Thickness
2088  WRITE(fid,'(3x,"Ice Density :",1x,es13.6)') sfc%Ice_Density
2089  WRITE(fid,'(3x,"Ice Roughness :",1x,es13.6)') sfc%Ice_Roughness
2090  END SUBROUTINE crtm_icesurface_inspect
2091 
2092 
2093  ELEMENTAL FUNCTION crtm_icesurface_compare( x, y, n_SigFig ) RESULT( is_comparable )
2094  TYPE(crtm_surface_type), INTENT(IN) :: x, y
2095  INTEGER, OPTIONAL, INTENT(IN) :: n_sigfig
2096  LOGICAL :: is_comparable
2097  ! Variables
2098  INTEGER :: n
2099 
2100  ! Set up
2101  is_comparable = .false.
2102  IF ( PRESENT(n_sigfig) ) THEN
2103  n = abs(n_sigfig)
2104  ELSE
2105  n = default_n_sigfig
2106  END IF
2107 
2108  ! Check integers
2109  IF ( x%Ice_Type /= y%Ice_Type ) RETURN
2110 
2111  ! Check floats
2112  IF ( (.NOT. compares_within_tolerance(x%Ice_Temperature,y%Ice_Temperature,n)) .OR. &
2113  (.NOT. compares_within_tolerance(x%Ice_Thickness ,y%Ice_Thickness ,n)) .OR. &
2114  (.NOT. compares_within_tolerance(x%Ice_Density ,y%Ice_Density ,n)) .OR. &
2115  (.NOT. compares_within_tolerance(x%Ice_Roughness ,y%Ice_Roughness ,n)) ) RETURN
2116 
2117  ! If we get here, the structures are comparable
2118  is_comparable = .true.
2119 
2120  END FUNCTION crtm_icesurface_compare
2121 
2122 
2123  ELEMENTAL FUNCTION crtm_icesurface_equal( x, y ) RESULT( is_equal )
2124  TYPE(crtm_surface_type) , INTENT(IN) :: x, y
2125  LOGICAL :: is_equal
2126  is_equal = ( (x%Ice_Type == y%Ice_Type ) .AND. &
2127  (x%Ice_Temperature .equalto. y%Ice_Temperature) .AND. &
2128  (x%Ice_Thickness .equalto. y%Ice_Thickness ) .AND. &
2129  (x%Ice_Density .equalto. y%Ice_Density ) .AND. &
2130  (x%Ice_Roughness .equalto. y%Ice_Roughness ) )
2131  END FUNCTION crtm_icesurface_equal
2132 
2133 
2134 !
2135 ! NAME:
2136 ! Read_Record
2137 !
2138 ! PURPOSE:
2139 ! Utility function to read a single surface data record
2140 !
2141 
2142  FUNCTION read_record( &
2143  fid , & ! Input
2144  sfc , & ! Output
2145  Quiet , & ! Optional input
2146  Debug ) & ! Optional input (Debug output control)
2147  result( err_stat )
2148  ! Arguments
2149  INTEGER, INTENT(IN) :: fid
2150  TYPE(crtm_surface_type), INTENT(OUT) :: sfc
2151  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
2152  LOGICAL, OPTIONAL, INTENT(IN) :: debug
2153  ! Function result
2154  INTEGER :: err_stat
2155  ! Function parameters
2156  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Surface_ReadFile(Record)'
2157  ! Function variables
2158  CHARACTER(ML) :: msg
2159  CHARACTER(ML) :: io_msg
2160  LOGICAL :: noisy
2161  INTEGER :: io_stat
2162  INTEGER :: coverage_type
2163  INTEGER :: n_channels
2164 
2165  ! Set up
2166  err_stat = success
2167  ! ...Check Quiet argument
2168  noisy = .true.
2169  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
2170  ! ...Override Quiet settings if debug set.
2171  IF ( PRESENT(debug) ) THEN
2172  IF ( debug ) noisy = .true.
2173  END IF
2174 
2175 
2176  ! Read the gross surface type coverage
2177  READ( fid,iostat=io_stat,iomsg=io_msg ) &
2178  coverage_type, &
2179  sfc%Land_Coverage, &
2180  sfc%Water_Coverage, &
2181  sfc%Snow_Coverage, &
2182  sfc%Ice_Coverage
2183  IF ( io_stat /= 0 ) THEN
2184  msg = 'Error reading gross surface type data - '//trim(io_msg)
2185  CALL read_record_cleanup(); RETURN
2186  END IF
2187  ! ...Check the coverage fractions
2188  IF ( .NOT. crtm_surface_iscoveragevalid(sfc) ) THEN
2189  msg = 'Invalid surface coverage fraction(s) found'
2190  CALL read_record_cleanup(); RETURN
2191  END IF
2192  ! ...Check the coverge surface type
2193  IF ( crtm_surface_coveragetype( sfc ) /= coverage_type ) THEN
2194  msg = 'Coverage surface type, '//&
2195  trim(surface_type_name(crtm_surface_coveragetype(sfc)))//&
2196  ', inconsistent with that specified in file.'
2197  CALL read_record_cleanup(); RETURN
2198  END IF
2199 
2200 
2201  ! Read the surface type independent data
2202  READ( fid,iostat=io_stat,iomsg=io_msg ) sfc%Wind_Speed
2203  IF ( io_stat /= 0 ) THEN
2204  msg = 'Error reading surface type independent data - '//trim(io_msg)
2205  CALL read_record_cleanup(); RETURN
2206  END IF
2207 
2208 
2209  ! Read the land surface type data
2210  READ( fid,iostat=io_stat,iomsg=io_msg ) &
2211  sfc%Land_Type, &
2212  sfc%Land_Temperature, &
2213  sfc%Soil_Moisture_Content, &
2214  sfc%Canopy_Water_Content , &
2215  sfc%Vegetation_Fraction, &
2216  sfc%Soil_Temperature, &
2217  sfc%Lai
2218  IF ( io_stat /= 0 ) THEN
2219  msg = 'Error reading land surface type data - '//trim(io_msg)
2220  CALL read_record_cleanup(); RETURN
2221  END IF
2222 
2223 
2224  ! Read the water surface type data
2225  READ( fid,iostat=io_stat,iomsg=io_msg ) &
2226  sfc%Water_Type, &
2227  sfc%Water_Temperature, &
2228  sfc%Wind_Direction, &
2229  sfc%Salinity
2230  IF ( io_stat /= 0 ) THEN
2231  msg = 'Error reading water surface type data - '//trim(io_msg)
2232  CALL read_record_cleanup(); RETURN
2233  END IF
2234 
2235 
2236  ! Read the snow surface type data
2237  READ( fid,iostat=io_stat,iomsg=io_msg ) &
2238  sfc%Snow_Type, &
2239  sfc%Snow_Temperature, &
2240  sfc%Snow_Depth, &
2241  sfc%Snow_Density, &
2242  sfc%Snow_Grain_Size
2243  IF ( io_stat /= 0 ) THEN
2244  msg = 'Error reading snow surface type data - '//trim(io_msg)
2245  CALL read_record_cleanup(); RETURN
2246  END IF
2247 
2248 
2249  ! Read the ice surface type data
2250  READ( fid,iostat=io_stat,iomsg=io_msg ) &
2251  sfc%Ice_Type, &
2252  sfc%Ice_Temperature, &
2253  sfc%Ice_Thickness, &
2254  sfc%Ice_Density, &
2255  sfc%Ice_Roughness
2256  IF ( io_stat /= 0 ) THEN
2257  msg = 'Error reading ice surface type data - '//trim(io_msg)
2258  CALL read_record_cleanup(); RETURN
2259  END IF
2260 
2261 
2262  ! Read the SensorData
2263  ! ...The dimensions
2264  READ( fid,iostat=io_stat,iomsg=io_msg ) n_channels
2265  IF ( io_stat /= 0 ) THEN
2266  msg = 'Error reading SensorData dimensions - '//trim(io_msg)
2267  CALL read_record_cleanup(); RETURN
2268  END IF
2269  ! ...The data
2270  IF ( n_channels > 0 ) THEN
2271  CALL crtm_sensordata_create(sfc%SensorData, n_channels )
2272  IF ( .NOT. crtm_sensordata_associated(sfc%SensorData) ) THEN
2273  msg = 'Error creating SensorData object.'
2274  CALL read_record_cleanup(); RETURN
2275  END IF
2276  READ( fid,iostat=io_stat,iomsg=io_msg ) &
2277  sfc%SensorData%Sensor_ID , &
2278  sfc%SensorData%WMO_Satellite_ID, &
2279  sfc%SensorData%WMO_Sensor_ID , &
2280  sfc%SensorData%Sensor_Channel , &
2281  sfc%SensorData%Tb
2282  IF ( io_stat /= 0 ) THEN
2283  msg = 'Error reading SensorData - '//trim(io_msg)
2284  CALL read_record_cleanup(); RETURN
2285  END IF
2286  END IF
2287 
2288  CONTAINS
2289 
2290  SUBROUTINE read_record_cleanup()
2291  CALL crtm_surface_destroy( sfc )
2292  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
2293  IF ( io_stat /= success ) &
2294  msg = trim(msg)//'; Error closing file during error cleanup - '//trim(io_msg)
2295  err_stat = failure
2296  CALL display_message( routine_name, msg, err_stat )
2297  END SUBROUTINE read_record_cleanup
2298 
2299  END FUNCTION read_record
2300 
2301 
2302 !
2303 ! NAME:
2304 ! Write_Record
2305 !
2306 ! PURPOSE:
2307 ! Utility function to write a single surface data record
2308 !
2309 
2310  FUNCTION write_record( &
2311  fid , & ! Input
2312  sfc , & ! Input
2313  Quiet, & ! Optional input
2314  Debug) & ! Optional input (Debug output control)
2315  result( err_stat )
2316  ! Arguments
2317  INTEGER, INTENT(IN) :: fid
2318  TYPE(crtm_surface_type), INTENT(IN) :: sfc
2319  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
2320  LOGICAL, OPTIONAL, INTENT(IN) :: debug
2321  ! Function result
2322  INTEGER :: err_stat
2323  ! Function parameters
2324  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Surface_WriteFile(Record)'
2325  ! Function variables
2326  CHARACTER(ML) :: msg
2327  CHARACTER(ML) :: io_msg
2328  LOGICAL :: noisy
2329  INTEGER :: io_stat
2330 
2331 
2332  ! Set up
2333  err_stat = success
2334  ! ...Check Quiet argument
2335  noisy = .true.
2336  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
2337  ! ...Override Quiet settings if debug set.
2338  IF ( PRESENT(debug) ) THEN
2339  IF ( debug ) noisy = .true.
2340  END IF
2341 
2342 
2343  ! Write the gross surface type coverage
2344  WRITE( fid,iostat=io_stat,iomsg=io_msg ) &
2345  crtm_surface_coveragetype(sfc), &
2346  sfc%Land_Coverage, &
2347  sfc%Water_Coverage, &
2348  sfc%Snow_Coverage, &
2349  sfc%Ice_Coverage
2350  IF ( io_stat /= 0 ) THEN
2351  msg = 'Error writing gross surface type data - '//trim(io_msg)
2352  CALL write_record_cleanup(); RETURN
2353  END IF
2354 
2355 
2356  ! Write the surface type independent data
2357  WRITE( fid,iostat=io_stat,iomsg=io_msg ) sfc%Wind_Speed
2358  IF ( io_stat /= 0 ) THEN
2359  msg = 'Error writing surface type independent data - '//trim(io_msg)
2360  CALL write_record_cleanup(); RETURN
2361  END IF
2362 
2363 
2364  ! Write the land surface type data
2365  WRITE( fid,iostat=io_stat,iomsg=io_msg ) &
2366  sfc%Land_Type, &
2367  sfc%Land_Temperature, &
2368  sfc%Soil_Moisture_Content, &
2369  sfc%Canopy_Water_Content, &
2370  sfc%Vegetation_Fraction, &
2371  sfc%Soil_Temperature, &
2372  sfc%Lai
2373  IF ( io_stat /= 0 ) THEN
2374  msg = 'Error writing land surface type data - '//trim(io_msg)
2375  CALL write_record_cleanup(); RETURN
2376  END IF
2377 
2378 
2379  ! Write the water surface type data
2380  WRITE( fid,iostat=io_stat,iomsg=io_msg ) &
2381  sfc%Water_Type, &
2382  sfc%Water_Temperature, &
2383  sfc%Wind_Direction, &
2384  sfc%Salinity
2385  IF ( io_stat /= 0 ) THEN
2386  msg = 'Error writing water surface type data - '//trim(io_msg)
2387  CALL write_record_cleanup(); RETURN
2388  END IF
2389 
2390 
2391  ! Write the snow surface type data
2392  WRITE( fid,iostat=io_stat,iomsg=io_msg ) &
2393  sfc%Snow_Type, &
2394  sfc%Snow_Temperature, &
2395  sfc%Snow_Depth, &
2396  sfc%Snow_Density, &
2397  sfc%Snow_Grain_Size
2398  IF ( io_stat /= 0 ) THEN
2399  msg = 'Error writing snow surface type data - '//trim(io_msg)
2400  CALL write_record_cleanup(); RETURN
2401  END IF
2402 
2403 
2404  ! Write the ice surface type data
2405  WRITE( fid,iostat=io_stat,iomsg=io_msg ) &
2406  sfc%Ice_Type, &
2407  sfc%Ice_Temperature, &
2408  sfc%Ice_Thickness, &
2409  sfc%Ice_Density, &
2410  sfc%Ice_Roughness
2411  IF ( io_stat /= 0 ) THEN
2412  msg = 'Error writing ice surface type data - '//trim(io_msg)
2413  CALL write_record_cleanup(); RETURN
2414  END IF
2415 
2416 
2417  ! Write the SensorData object
2418  ! ...The dimensions
2419  WRITE( fid,iostat=io_stat,iomsg=io_msg ) sfc%SensorData%n_Channels
2420  IF ( io_stat /= 0 ) THEN
2421  msg = 'Error writing SensorData dimensions - '//trim(io_msg)
2422  CALL write_record_cleanup(); RETURN
2423  END IF
2424  ! ...The data
2425  IF ( sfc%SensorData%n_Channels > 0 ) THEN
2426  WRITE( fid,iostat=io_stat,iomsg=io_msg ) &
2427  sfc%SensorData%Sensor_ID , &
2428  sfc%SensorData%WMO_Satellite_ID, &
2429  sfc%SensorData%WMO_Sensor_ID , &
2430  sfc%SensorData%Sensor_Channel , &
2431  sfc%SensorData%Tb
2432  IF ( io_stat /= 0 ) THEN
2433  msg = 'Error writing SensorData - '//trim(io_msg)
2434  CALL write_record_cleanup(); RETURN
2435  END IF
2436  END IF
2437 
2438  CONTAINS
2439 
2440  SUBROUTINE write_record_cleanup()
2441  CLOSE( fid,status=write_error_status,iostat=io_stat,iomsg=io_msg )
2442  IF ( io_stat /= success ) &
2443  msg = trim(msg)//'; Error closing file during error cleanup - '//trim(io_msg)
2444  err_stat = failure
2445  CALL display_message( routine_name, msg, err_stat )
2446  END SUBROUTINE write_record_cleanup
2447 
2448  END FUNCTION write_record
2449 
2450 END MODULE crtm_surface_define
crtm_surface_define::crtm_watersurface_isvalid
logical function crtm_watersurface_isvalid(Sfc)
Definition: CRTM_Surface_Define.f90:1857
crtm_surface_define::default_vegetation_type
integer, parameter default_vegetation_type
Definition: CRTM_Surface_Define.f90:177
crtm_surface_define::default_vegetation_fraction
real(fp), parameter default_vegetation_fraction
Definition: CRTM_Surface_Define.f90:173
crtm_sensordata_define::crtm_sensordata_create
elemental subroutine, public crtm_sensordata_create(SensorData, n_Channels)
Definition: CRTM_SensorData_Define.f90:225
crtm_surface_define::crtm_landsurface_zero
elemental subroutine crtm_landsurface_zero(Sfc)
Definition: CRTM_Surface_Define.f90:1734
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_surface_define::crtm_surface_inspect
subroutine, public crtm_surface_inspect(Sfc, Unit)
Definition: CRTM_Surface_Define.f90:530
crtm_sensordata_define::crtm_sensordata_inspect
subroutine, public crtm_sensordata_inspect(SensorData, Unit)
Definition: CRTM_SensorData_Define.f90:416
crtm_sensordata_define
Definition: CRTM_SensorData_Define.f90:13
crtm_surface_define::crtm_surface_coveragetype
elemental integer function, public crtm_surface_coveragetype(sfc)
Definition: CRTM_Surface_Define.f90:683
message_handler::warning
integer, parameter, public warning
Definition: Message_Handler.f90:29
crtm_surface_define::default_snow_temperature
real(fp), parameter default_snow_temperature
Definition: CRTM_Surface_Define.f90:186
crtm_surface_define::crtm_watersurface_equal
elemental logical function crtm_watersurface_equal(x, y)
Definition: CRTM_Surface_Define.f90:1930
crtm_surface_define::default_ice_roughness
real(fp), parameter default_ice_roughness
Definition: CRTM_Surface_Define.f90:195
crtm_surface_define::crtm_icesurface_isvalid
logical function crtm_icesurface_isvalid(Sfc)
Definition: CRTM_Surface_Define.f90:2051
type_kinds::fp
integer, parameter, public fp
Definition: Type_Kinds.f90:124
crtm_sensordata_define::crtm_sensordata_associated
elemental logical function, public crtm_sensordata_associated(SensorData)
Definition: CRTM_SensorData_Define.f90:160
crtm_surface_define::module_version_id
character(*), parameter module_version_id
Definition: CRTM_Surface_Define.f90:127
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_surface_define::crtm_icesurface_equal
elemental logical function crtm_icesurface_equal(x, y)
Definition: CRTM_Surface_Define.f90:2124
crtm_surface_define::crtm_watersurface_inspect
subroutine crtm_watersurface_inspect(Sfc, Unit)
Definition: CRTM_Surface_Define.f90:1884
crtm_sensordata_define::crtm_sensordata_compare
elemental logical function, public crtm_sensordata_compare(x, y, n_SigFig)
Definition: CRTM_SensorData_Define.f90:514
crtm_surface_define::default_land_type
integer, parameter default_land_type
Definition: CRTM_Surface_Define.f90:169
crtm_surface_define::zero
real(fp), parameter zero
Definition: CRTM_Surface_Define.f90:130
crtm_sensordata_define::crtm_sensordata_writefile
integer function, public crtm_sensordata_writefile(Filename, SensorData, Quiet, No_Close, Debug)
Definition: CRTM_SensorData_Define.f90:937
crtm_surface_define::crtm_surface_inquirefile
integer function, public crtm_surface_inquirefile(Filename, n_Channels, n_Profiles)
Definition: CRTM_Surface_Define.f90:861
crtm_surface_define::default_land_temperature
real(fp), parameter default_land_temperature
Definition: CRTM_Surface_Define.f90:170
crtm_surface_define::default_snow_grain_size
real(fp), parameter default_snow_grain_size
Definition: CRTM_Surface_Define.f90:189
crtm_surface_define::ice_surface
integer, parameter, public ice_surface
Definition: CRTM_Surface_Define.f90:144
crtm_surface_define::crtm_surface_equal
elemental logical function crtm_surface_equal(x, y)
Definition: CRTM_Surface_Define.f90:1552
mpp_io_mod::write_record
Definition: mpp_io.F90:911
crtm_surface_define::crtm_surface_type
Definition: CRTM_Surface_Define.f90:202
crtm_sensordata_define::crtm_sensordata_type
Definition: CRTM_SensorData_Define.f90:99
crtm_surface_define::default_soil_temperature
real(fp), parameter default_soil_temperature
Definition: CRTM_Surface_Define.f90:174
crtm_surface_define::one
real(fp), parameter one
Definition: CRTM_Surface_Define.f90:131
crtm_surface_define::default_wind_speed
real(fp), parameter default_wind_speed
Definition: CRTM_Surface_Define.f90:181
crtm_surface_define::crtm_snowsurface_compare
elemental logical function crtm_snowsurface_compare(x, y, n_SigFig)
Definition: CRTM_Surface_Define.f90:1997
inquire_cleanup
subroutine inquire_cleanup()
Definition: ACCoeff_Binary_IO.f90:249
crtm_surface_define::crtm_landsurface_compare
elemental logical function crtm_landsurface_compare(x, y, n_SigFig)
Definition: CRTM_Surface_Define.f90:1795
crtm_surface_define::read_record
integer function read_record(fid, sfc, Quiet, Debug)
Definition: CRTM_Surface_Define.f90:2148
crtm_sensordata_define::crtm_sensordata_isvalid
logical function, public crtm_sensordata_isvalid(SensorData)
Definition: CRTM_SensorData_Define.f90:331
crtm_surface_define::n_valid_surface_types
integer, parameter, public n_valid_surface_types
Definition: CRTM_Surface_Define.f90:145
crtm_surface_define::surface_type_name
character(*), dimension(0:n_valid_surface_types), parameter, public surface_type_name
Definition: CRTM_Surface_Define.f90:149
crtm_surface_define::crtm_watersurface_zero
elemental subroutine crtm_watersurface_zero(Sfc)
Definition: CRTM_Surface_Define.f90:1847
crtm_surface_define::default_ice_temperature
real(fp), parameter default_ice_temperature
Definition: CRTM_Surface_Define.f90:192
message_handler
Definition: Message_Handler.f90:4
crtm_surface_define::write_error_status
character(*), parameter write_error_status
Definition: CRTM_Surface_Define.f90:135
read_cleanup
subroutine read_cleanup()
Definition: ACCoeff_Binary_IO.f90:469
crtm_sensordata_define::crtm_sensordata_destroy
elemental subroutine, public crtm_sensordata_destroy(SensorData)
Definition: CRTM_SensorData_Define.f90:189
crtm_surface_define
Definition: CRTM_Surface_Define.f90:15
crtm_surface_define::invalid_surface
integer, parameter, public invalid_surface
Definition: CRTM_Surface_Define.f90:140
binary_file_utility
Definition: Binary_File_Utility.f90:13
write_cleanup
subroutine write_cleanup()
Definition: ACCoeff_Binary_IO.f90:670
crtm_surface_define::default_snow_depth
real(fp), parameter default_snow_depth
Definition: CRTM_Surface_Define.f90:187
crtm_sensordata_define::crtm_sensordata_zero
elemental subroutine, public crtm_sensordata_zero(SensorData)
Definition: CRTM_SensorData_Define.f90:282
read_record_cleanup
subroutine read_record_cleanup()
Definition: CRTM_Aerosol_Define.f90:1491
compare_float_numbers
Definition: Compare_Float_Numbers.f90:13
crtm_surface_define::crtm_icesurface_compare
elemental logical function crtm_icesurface_compare(x, y, n_SigFig)
Definition: CRTM_Surface_Define.f90:2094
crtm_surface_define::crtm_snowsurface_zero
elemental subroutine crtm_snowsurface_zero(Sfc)
Definition: CRTM_Surface_Define.f90:1944
crtm_surface_define::crtm_surface_destroy
elemental subroutine, public crtm_surface_destroy(Sfc)
Definition: CRTM_Surface_Define.f90:324
crtm_surface_define::crtm_surface_associated
elemental logical function, public crtm_surface_associated(Sfc)
Definition: CRTM_Surface_Define.f90:291
crtm_surface_define::default_wind_direction
real(fp), parameter default_wind_direction
Definition: CRTM_Surface_Define.f90:182
crtm_surface_define::default_soil_moisture_content
real(fp), parameter default_soil_moisture_content
Definition: CRTM_Surface_Define.f90:171
binary_file_utility::open_binary_file
integer function, public open_binary_file(Filename, FileID, For_Output, No_Check)
Definition: Binary_File_Utility.f90:162
message_handler::display_message
recursive subroutine, public display_message(Routine_Name, Message, Error_State, Message_Log)
Definition: Message_Handler.f90:118
crtm_surface_define::default_water_temperature
real(fp), parameter default_water_temperature
Definition: CRTM_Surface_Define.f90:180
crtm_surface_define::default_soil_type
integer, parameter default_soil_type
Definition: CRTM_Surface_Define.f90:176
crtm_surface_define::crtm_icesurface_zero
elemental subroutine crtm_icesurface_zero(Sfc)
Definition: CRTM_Surface_Define.f90:2041
crtm_surface_define::crtm_surface_iscoveragevalid
logical function, public crtm_surface_iscoveragevalid(Sfc)
Definition: CRTM_Surface_Define.f90:595
crtm_surface_define::crtm_surface_zero
elemental subroutine, public crtm_surface_zero(Sfc)
Definition: CRTM_Surface_Define.f90:410
crtm_surface_define::crtm_snowsurface_equal
elemental logical function crtm_snowsurface_equal(x, y)
Definition: CRTM_Surface_Define.f90:2027
crtm_surface_define::default_water_type
integer, parameter default_water_type
Definition: CRTM_Surface_Define.f90:179
crtm_surface_define::default_ice_type
integer, parameter default_ice_type
Definition: CRTM_Surface_Define.f90:191
file_utility::file_open
Definition: File_Utility.f90:56
crtm_surface_define::crtm_surface_isvalid
logical function, public crtm_surface_isvalid(Sfc)
Definition: CRTM_Surface_Define.f90:471
crtm_surface_define::write_surface_rank1
integer function write_surface_rank1(Filename, Surface, Quiet, Debug)
Definition: CRTM_Surface_Define.f90:1322
crtm_surface_define::land_surface
integer, parameter, public land_surface
Definition: CRTM_Surface_Define.f90:141
file_utility::file_exists
Definition: File_Utility.f90:51
crtm_surface_define::crtm_watersurface_compare
elemental logical function crtm_watersurface_compare(x, y, n_SigFig)
Definition: CRTM_Surface_Define.f90:1900
compare_float_numbers::default_n_sigfig
integer, parameter, public default_n_sigfig
Definition: Compare_Float_Numbers.f90:101
iscoveragevalid
logical function iscoveragevalid(Coverage, Name)
Definition: CRTM_Surface_Define.f90:622
crtm_surface_define::default_canopy_water_content
real(fp), parameter default_canopy_water_content
Definition: CRTM_Surface_Define.f90:172
crtm_surface_define::crtm_snowsurface_inspect
subroutine crtm_snowsurface_inspect(Sfc, Unit)
Definition: CRTM_Surface_Define.f90:1981
crtm_surface_define::crtm_landsurface_equal
elemental logical function crtm_landsurface_equal(x, y)
Definition: CRTM_Surface_Define.f90:1829
crtm_surface_define::crtm_surface_readfile
Definition: CRTM_Surface_Define.f90:113
crtm_surface_define::crtm_surface_subtract
elemental type(crtm_surface_type) function crtm_surface_subtract(sfc1, sfc2)
Definition: CRTM_Surface_Define.f90:1687
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_sensordata_define::crtm_sensordata_defineversion
subroutine, public crtm_sensordata_defineversion(Id)
Definition: CRTM_SensorData_Define.f90:469
crtm_surface_define::write_surface_rank2
integer function write_surface_rank2(Filename, Surface, Quiet, Debug)
Definition: CRTM_Surface_Define.f90:1416
write_record_cleanup
subroutine write_record_cleanup()
Definition: CRTM_Aerosol_Define.f90:1555
crtm_surface_define::default_snow_density
real(fp), parameter default_snow_density
Definition: CRTM_Surface_Define.f90:188
crtm_surface_define::read_surface_rank2
integer function read_surface_rank2(Filename, Surface, Quiet, n_Channels, n_Profiles, Debug)
Definition: CRTM_Surface_Define.f90:1135
type_kinds
Definition: Type_Kinds.f90:12
crtm_surface_define::default_ice_density
real(fp), parameter default_ice_density
Definition: CRTM_Surface_Define.f90:194
crtm_surface_define::read_surface_rank1
integer function read_surface_rank1(Filename, Surface, Quiet, n_Channels, n_Profiles, Debug)
Definition: CRTM_Surface_Define.f90:1015
crtm_surface_define::default_snow_type
integer, parameter default_snow_type
Definition: CRTM_Surface_Define.f90:185
crtm_surface_define::crtm_surface_defineversion
subroutine, public crtm_surface_defineversion(Id)
Definition: CRTM_Surface_Define.f90:717
crtm_surface_define::crtm_surface_writefile
Definition: CRTM_Surface_Define.f90:118
crtm_sensordata_define::crtm_sensordata_readfile
integer function, public crtm_sensordata_readfile(Filename, SensorData, Quiet, No_Close, n_DataSets, Debug)
Definition: CRTM_SensorData_Define.f90:737
crtm_surface_define::crtm_landsurface_isvalid
logical function crtm_landsurface_isvalid(Sfc)
Definition: CRTM_Surface_Define.f90:1746
crtm_surface_define::crtm_icesurface_inspect
subroutine crtm_icesurface_inspect(Sfc, Unit)
Definition: CRTM_Surface_Define.f90:2078
crtm_surface_define::crtm_surface_compare
elemental logical function, public crtm_surface_compare(x, y, n_SigFig)
Definition: CRTM_Surface_Define.f90:762
crtm_surface_define::crtm_landsurface_inspect
subroutine crtm_landsurface_inspect(Sfc, Unit)
Definition: CRTM_Surface_Define.f90:1775
crtm_surface_define::default_ice_thickness
real(fp), parameter default_ice_thickness
Definition: CRTM_Surface_Define.f90:193
crtm_surface_define::crtm_surface_add
elemental type(crtm_surface_type) function crtm_surface_add(sfc1, sfc2)
Definition: CRTM_Surface_Define.f90:1620
crtm_surface_define::crtm_snowsurface_isvalid
logical function crtm_snowsurface_isvalid(Sfc)
Definition: CRTM_Surface_Define.f90:1954
crtm_surface_define::default_salinity
real(fp), parameter default_salinity
Definition: CRTM_Surface_Define.f90:183
crtm_surface_define::water_surface
integer, parameter, public water_surface
Definition: CRTM_Surface_Define.f90:142
crtm_surface_define::crtm_surface_create
elemental subroutine, public crtm_surface_create(Sfc, n_Channels)
Definition: CRTM_Surface_Define.f90:364
crtm_surface_define::default_lai
real(fp), parameter default_lai
Definition: CRTM_Surface_Define.f90:175
message_handler::success
integer, parameter, public success
Definition: Message_Handler.f90:27
compare_float_numbers::tolerance
Definition: Compare_Float_Numbers.f90:69
file_utility
Definition: File_Utility.f90:26
crtm_surface_define::snow_surface
integer, parameter, public snow_surface
Definition: CRTM_Surface_Define.f90:143
message_handler::information
integer, parameter, public information
Definition: Message_Handler.f90:28
crtm_surface_define::ml
integer, parameter ml
Definition: CRTM_Surface_Define.f90:133