FV3 Bundle
CRTM_GeometryInfo_Define.f90
Go to the documentation of this file.
1 !
2 ! CRTM_GeometryInfo_Define
3 !
4 ! Module defining the CRTM GeometryInfo container object.
5 !
6 !
7 !
8 ! CREATION HISTORY:
9 ! Written by: Paul van Delst, 19-May-2004
10 ! paul.vandelst@noaa.gov
11 !
12 
13 MODULE crtm_geometryinfo_define
14 
15  ! ------------------
16  ! Environment set up
17  ! ------------------
18  ! Intrinsic modules
19  USE iso_fortran_env , ONLY: output_unit
20  ! Module use
21  USE type_kinds , ONLY: fp
22  USE message_handler , ONLY: success, failure, warning, information, display_message
23  USE compare_float_numbers, ONLY: default_n_sigfig, &
24  OPERATOR(.equalto.), &
25  compares_within_tolerance
26  USE file_utility , ONLY: file_open, file_exists
27  USE binary_file_utility , ONLY: open_binary_file , &
28  writegatts_binary_file, &
29  readgatts_binary_file
30  USE crtm_parameters , ONLY: earth_radius , &
31  satellite_height , &
32  diffusivity_radian, &
33  secant_diffusivity
34  USE crtm_geometry_define , ONLY: crtm_geometry_type, &
35  OPERATOR(==), &
36  OPERATOR(-) , &
37  crtm_geometry_destroy , &
38  crtm_geometry_setvalue , &
39  crtm_geometry_getvalue , &
40  crtm_geometry_isvalid , &
41  crtm_geometry_inspect , &
42  crtm_geometry_readrecord , &
43  crtm_geometry_writerecord
44  ! Disable implicit typing
45  IMPLICIT NONE
46 
47 
48  ! ------------
49  ! Visibilities
50  ! ------------
51  ! Everything private by default
52  PRIVATE
53  ! Operators
54  PUBLIC :: OPERATOR(==)
55  PUBLIC :: OPERATOR(-)
56  ! Geometry entities
57  ! ...Structures
58  PUBLIC :: crtm_geometry_type
59  ! GeometryInfo enitities
60  ! ...Structures
61  PUBLIC :: crtm_geometryinfo_type
62  ! ...Procedures
63  PUBLIC :: crtm_geometryinfo_destroy
64  PUBLIC :: crtm_geometryinfo_setvalue
65  PUBLIC :: crtm_geometryinfo_getvalue
66  PUBLIC :: crtm_geometryinfo_isvalid
67  PUBLIC :: crtm_geometryinfo_inspect
68  PUBLIC :: crtm_geometryinfo_defineversion
69  PUBLIC :: crtm_geometryinfo_inquirefile
70  PUBLIC :: crtm_geometryinfo_readfile
71  PUBLIC :: crtm_geometryinfo_writefile
72 
73 
74  ! ---------------------
75  ! Procedure overloading
76  ! ---------------------
77  INTERFACE OPERATOR(==)
78  MODULE PROCEDURE crtm_geometryinfo_equal
79  END INTERFACE OPERATOR(==)
80 
81  INTERFACE OPERATOR(-)
82  MODULE PROCEDURE crtm_geometryinfo_subtract
83  END INTERFACE OPERATOR(-)
84 
85 
86  ! -----------------
87  ! Module parameters
88  ! -----------------
89  CHARACTER(*), PARAMETER :: module_version_id = &
90  '$Id: CRTM_GeometryInfo_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
91  ! Literal constants
92  REAL(fp), PARAMETER :: zero = 0.0_fp
93  REAL(fp), PARAMETER :: one = 1.0_fp
94  ! Message string length
95  INTEGER, PARAMETER :: ml = 256
96  ! File status on close after write error
97  CHARACTER(*), PARAMETER :: write_error_status = 'DELETE'
98 
99 
100  ! ---------------------------------
101  ! GeometryInfo data type definition
102  ! ---------------------------------
103  !:tdoc+:
104  TYPE :: crtm_geometryinfo_type
105  ! Structure for user Input
106  TYPE(crtm_geometry_type) :: user
107  ! Derived from User Input
108  ! ...Default distance ratio
109  REAL(fp) :: distance_ratio = earth_radius/(earth_radius + satellite_height)
110  ! ...Sensor angle information
111  REAL(fp) :: sensor_scan_radian = zero
112  REAL(fp) :: sensor_zenith_radian = zero
113  REAL(fp) :: sensor_azimuth_radian = zero
114  REAL(fp) :: secant_sensor_zenith = zero
115  REAL(fp) :: cosine_sensor_zenith = zero
116  ! ...Zenith angle used in the transmittance algorithms
117  REAL(fp) :: trans_zenith_radian = zero
118  REAL(fp) :: secant_trans_zenith = zero
119  ! ...Source angle information
120  REAL(fp) :: source_zenith_radian = zero
121  REAL(fp) :: source_azimuth_radian = zero
122  REAL(fp) :: secant_source_zenith = zero
123  ! ...Flux angle information
124  REAL(fp) :: flux_zenith_radian = diffusivity_radian
125  REAL(fp) :: secant_flux_zenith = secant_diffusivity
126  ! ...Square of ratio between mean and actual sun-earth (AU) distances
127  REAL(fp) :: au_ratio2 = one
128  END TYPE crtm_geometryinfo_type
129  !:tdoc-:
130 
131 
132 CONTAINS
133 
134 
135 !##################################################################################
136 !##################################################################################
137 !## ##
138 !## ## PUBLIC MODULE ROUTINES ## ##
139 !## ##
140 !##################################################################################
141 !##################################################################################
142 
143 !--------------------------------------------------------------------------------
144 !:sdoc+:
145 !
146 ! NAME:
147 ! CRTM_GeometryInfo_Destroy
148 !
149 ! PURPOSE:
150 ! Elemental subroutine to re-initialize a CRTM GeometryInfo objects.
151 !
152 ! CALLING SEQUENCE:
153 ! CALL CRTM_GeometryInfo_Destroy( gInfo )
154 !
155 ! OBJECTS:
156 ! gInfo: Re-initialized GeometryInfo structure.
157 ! UNITS: N/A
158 ! TYPE: CRTM_GeometryInfo_type
159 ! DIMENSION: Scalar or any rank
160 ! ATTRIBUTES: INTENT(OUT)
161 !
162 !:sdoc-:
163 !--------------------------------------------------------------------------------
164 
165  ELEMENTAL SUBROUTINE crtm_geometryinfo_destroy( gInfo )
166  TYPE(crtm_geometryinfo_type), INTENT(OUT) :: ginfo
167  CALL crtm_geometry_destroy(ginfo%user)
168  END SUBROUTINE crtm_geometryinfo_destroy
169 
170 
171 !--------------------------------------------------------------------------------
172 !:sdoc+:
173 !
174 ! NAME:
175 ! CRTM_GeometryInfo_SetValue
176 !
177 ! PURPOSE:
178 ! Elemental subroutine to set the values of CRTM GeometryInfo
179 ! object components.
180 !
181 ! CALLING SEQUENCE:
182 ! CALL CRTM_GeometryInfo_SetValue( gInfo, &
183 ! Geometry = Geometry , &
184 ! iFOV = iFOV , &
185 ! Longitude = Longitude , &
186 ! Latitude = Latitude , &
187 ! Surface_Altitude = Surface_Altitude , &
188 ! Sensor_Scan_Angle = Sensor_Scan_Angle , &
189 ! Sensor_Zenith_Angle = Sensor_Zenith_Angle , &
190 ! Sensor_Azimuth_Angle = Sensor_Azimuth_Angle , &
191 ! Source_Zenith_Angle = Source_Zenith_Angle , &
192 ! Source_Azimuth_Angle = Source_Azimuth_Angle , &
193 ! Flux_Zenith_Angle = Flux_Zenith_Angle , &
194 ! Year = Year , &
195 ! Month = Month , &
196 ! Day = Day , &
197 ! Distance_Ratio = Distance_Ratio , &
198 ! Sensor_Scan_Radian = Sensor_Scan_Radian , &
199 ! Sensor_Zenith_Radian = Sensor_Zenith_Radian , &
200 ! Sensor_Azimuth_Radian = Sensor_Azimuth_Radian, &
201 ! Secant_Sensor_Zenith = Secant_Sensor_Zenith , &
202 ! Cosine_Sensor_Zenith = Cosine_Sensor_Zenith , &
203 ! Source_Zenith_Radian = Source_Zenith_Radian , &
204 ! Source_Azimuth_Radian = Source_Azimuth_Radian, &
205 ! Secant_Source_Zenith = Secant_Source_Zenith , &
206 ! Flux_Zenith_Radian = Flux_Zenith_Radian , &
207 ! Secant_Flux_Zenith = Secant_Flux_Zenith , &
208 ! Trans_Zenith_Radian = Trans_Zenith_Radian , &
209 ! Secant_Trans_Zenith = Secant_Trans_Zenith , &
210 ! AU_ratio2 = AU_ratio2 )
211 !
212 ! OBJECTS:
213 ! gInfo: GeometryInfo object from which component values
214 ! are to be retrieved.
215 ! UNITS: N/A
216 ! TYPE: CRTM_Geometry_type
217 ! DIMENSION: Scalar or any rank
218 ! ATTRIBUTES: INTENT(IN OUT)
219 !
220 ! OPTIONAL INPUTS:
221 ! Geometry: Geometry object.
222 ! UNITS: N/A
223 ! TYPE: CRTM_Geometry_type
224 ! DIMENSION: Scalar or same as gInfo input
225 ! ATTRIBUTES: INTENT(IN)
226 !
227 ! All other gInfo components as listed in the calling sequence.
228 ! NOTE: If the Geometry argument as well as any of the arguments iFOV to
229 ! Flux_Zenith_Angle are specified, the latter values override any
230 ! contained in the passed Geometry object.
231 !
232 !:sdoc-:
233 !--------------------------------------------------------------------------------
234 
235  ELEMENTAL SUBROUTINE crtm_geometryinfo_setvalue( &
236  gInfo , & ! Input
237  Geometry , & ! Optional input
238  iFOV , & ! Optional input
239  Longitude , & ! Optional input
240  Latitude , & ! Optional input
241  Surface_Altitude , & ! Optional input
242  Sensor_Scan_Angle , & ! Optional input
243  Sensor_Zenith_Angle , & ! Optional input
244  Sensor_Azimuth_Angle , & ! Optional input
245  Source_Zenith_Angle , & ! Optional input
246  Source_Azimuth_Angle , & ! Optional input
247  Flux_Zenith_Angle , & ! Optional input
248  Year , & ! Optional input
249  Month , & ! Optional input
250  Day , & ! Optional input
251  Distance_Ratio , & ! Optional input
252  Sensor_Scan_Radian , & ! Optional input
253  Sensor_Zenith_Radian , & ! Optional input
254  Sensor_Azimuth_Radian, & ! Optional input
255  Secant_Sensor_Zenith , & ! Optional input
256  Cosine_Sensor_Zenith , & ! Optional input
257  Source_Zenith_Radian , & ! Optional input
258  Source_Azimuth_Radian, & ! Optional input
259  Secant_Source_Zenith , & ! Optional input
260  Flux_Zenith_Radian , & ! Optional input
261  Secant_Flux_Zenith , & ! Optional input
262  Trans_Zenith_Radian , & ! Optional input
263  Secant_Trans_Zenith , & ! Optional input
264  AU_ratio2 ) ! Optional input
265  ! Arguments
266  TYPE(crtm_geometryinfo_type), INTENT(IN OUT) :: ginfo
267  TYPE(crtm_geometry_type), OPTIONAL, INTENT(IN) :: geometry
268  INTEGER , OPTIONAL, INTENT(IN) :: ifov
269  REAL(fp), OPTIONAL, INTENT(IN) :: longitude
270  REAL(fp), OPTIONAL, INTENT(IN) :: latitude
271  REAL(fp), OPTIONAL, INTENT(IN) :: surface_altitude
272  REAL(fp), OPTIONAL, INTENT(IN) :: sensor_scan_angle
273  REAL(fp), OPTIONAL, INTENT(IN) :: sensor_zenith_angle
274  REAL(fp), OPTIONAL, INTENT(IN) :: sensor_azimuth_angle
275  REAL(fp), OPTIONAL, INTENT(IN) :: source_zenith_angle
276  REAL(fp), OPTIONAL, INTENT(IN) :: source_azimuth_angle
277  REAL(fp), OPTIONAL, INTENT(IN) :: flux_zenith_angle
278  INTEGER, OPTIONAL, INTENT(IN) :: year
279  INTEGER, OPTIONAL, INTENT(IN) :: month
280  INTEGER, OPTIONAL, INTENT(IN) :: day
281  REAL(fp), OPTIONAL, INTENT(IN) :: distance_ratio
282  REAL(fp), OPTIONAL, INTENT(IN) :: sensor_scan_radian
283  REAL(fp), OPTIONAL, INTENT(IN) :: sensor_zenith_radian
284  REAL(fp), OPTIONAL, INTENT(IN) :: sensor_azimuth_radian
285  REAL(fp), OPTIONAL, INTENT(IN) :: secant_sensor_zenith
286  REAL(fp), OPTIONAL, INTENT(IN) :: cosine_sensor_zenith
287  REAL(fp), OPTIONAL, INTENT(IN) :: source_zenith_radian
288  REAL(fp), OPTIONAL, INTENT(IN) :: source_azimuth_radian
289  REAL(fp), OPTIONAL, INTENT(IN) :: secant_source_zenith
290  REAL(fp), OPTIONAL, INTENT(IN) :: flux_zenith_radian
291  REAL(fp), OPTIONAL, INTENT(IN) :: secant_flux_zenith
292  REAL(fp), OPTIONAL, INTENT(IN) :: trans_zenith_radian
293  REAL(fp), OPTIONAL, INTENT(IN) :: secant_trans_zenith
294  REAL(fp), OPTIONAL, INTENT(IN) :: au_ratio2
295 
296  ! Get values
297  IF ( PRESENT(geometry) ) ginfo%user = geometry
298  CALL crtm_geometry_setvalue( ginfo%user, &
299  ifov = ifov , &
300  longitude = longitude , &
301  latitude = latitude , &
302  surface_altitude = surface_altitude , &
303  sensor_scan_angle = sensor_scan_angle , &
304  sensor_zenith_angle = sensor_zenith_angle , &
305  sensor_azimuth_angle = sensor_azimuth_angle, &
306  source_zenith_angle = source_zenith_angle , &
307  source_azimuth_angle = source_azimuth_angle, &
308  flux_zenith_angle = flux_zenith_angle , &
309  year = year , &
310  month = month , &
311  day = day )
312 
313  IF ( PRESENT(distance_ratio ) ) ginfo%Distance_Ratio = distance_ratio
314  IF ( PRESENT(sensor_scan_radian ) ) ginfo%Sensor_Scan_Radian = sensor_scan_radian
315  IF ( PRESENT(sensor_zenith_radian ) ) ginfo%Sensor_Zenith_Radian = sensor_zenith_radian
316  IF ( PRESENT(sensor_azimuth_radian) ) ginfo%Sensor_Azimuth_Radian = sensor_azimuth_radian
317  IF ( PRESENT(secant_sensor_zenith ) ) ginfo%Secant_Sensor_Zenith = secant_sensor_zenith
318  IF ( PRESENT(cosine_sensor_zenith ) ) ginfo%Cosine_Sensor_Zenith = cosine_sensor_zenith
319  IF ( PRESENT(source_zenith_radian ) ) ginfo%Source_Zenith_Radian = source_zenith_radian
320  IF ( PRESENT(source_azimuth_radian) ) ginfo%Source_Azimuth_Radian = source_azimuth_radian
321  IF ( PRESENT(secant_source_zenith ) ) ginfo%Secant_Source_Zenith = secant_source_zenith
322  IF ( PRESENT(flux_zenith_radian ) ) ginfo%Flux_Zenith_Radian = flux_zenith_radian
323  IF ( PRESENT(secant_flux_zenith ) ) ginfo%Secant_Flux_Zenith = secant_flux_zenith
324  IF ( PRESENT(trans_zenith_radian ) ) ginfo%Trans_Zenith_Radian = trans_zenith_radian
325  IF ( PRESENT(secant_trans_zenith ) ) ginfo%Secant_Trans_Zenith = secant_trans_zenith
326  IF ( PRESENT(au_ratio2 ) ) ginfo%AU_ratio2 = au_ratio2
327 
328  END SUBROUTINE crtm_geometryinfo_setvalue
329 
330 
331 !--------------------------------------------------------------------------------
332 !:sdoc+:
333 !
334 ! NAME:
335 ! CRTM_GeometryInfo_GetValue
336 !
337 ! PURPOSE:
338 ! Elemental subroutine to get the values of CRTM GeometryInfo
339 ! object components.
340 !
341 ! CALLING SEQUENCE:
342 ! CALL CRTM_GeometryInfo_GetValue( gInfo, &
343 ! Geometry = Geometry , &
344 ! iFOV = iFOV , &
345 ! Longitude = Longitude , &
346 ! Latitude = Latitude , &
347 ! Surface_Altitude = Surface_Altitude , &
348 ! Sensor_Scan_Angle = Sensor_Scan_Angle , &
349 ! Sensor_Zenith_Angle = Sensor_Zenith_Angle , &
350 ! Sensor_Azimuth_Angle = Sensor_Azimuth_Angle , &
351 ! Source_Zenith_Angle = Source_Zenith_Angle , &
352 ! Source_Azimuth_Angle = Source_Azimuth_Angle , &
353 ! Flux_Zenith_Angle = Flux_Zenith_Angle , &
354 ! Year = Year , &
355 ! Month = Month , &
356 ! Day = Day , &
357 ! Distance_Ratio = Distance_Ratio , &
358 ! Sensor_Scan_Radian = Sensor_Scan_Radian , &
359 ! Sensor_Zenith_Radian = Sensor_Zenith_Radian , &
360 ! Sensor_Azimuth_Radian = Sensor_Azimuth_Radian, &
361 ! Secant_Sensor_Zenith = Secant_Sensor_Zenith , &
362 ! Cosine_Sensor_Zenith = Cosine_Sensor_Zenith , &
363 ! Source_Zenith_Radian = Source_Zenith_Radian , &
364 ! Source_Azimuth_Radian = Source_Azimuth_Radian, &
365 ! Secant_Source_Zenith = Secant_Source_Zenith , &
366 ! Flux_Zenith_Radian = Flux_Zenith_Radian , &
367 ! Secant_Flux_Zenith = Secant_Flux_Zenith , &
368 ! Trans_Zenith_Radian = Trans_Zenith_Radian , &
369 ! Secant_Trans_Zenith = Secant_Trans_Zenith , &
370 ! AU_ratio2 = AU_ratio2 )
371 ! OBJECTS:
372 ! gInfo: Geometry object from which component values
373 ! are to be retrieved.
374 ! UNITS: N/A
375 ! TYPE: CRTM_Geometry_type
376 ! DIMENSION: Scalar or any rank
377 ! ATTRIBUTES: INTENT(IN OUT)
378 !
379 ! OPTIONAL OUTPUTS:
380 ! Geometry: Geometry object.
381 ! UNITS: N/A
382 ! TYPE: CRTM_Geometry_type
383 ! DIMENSION: Scalar or same as gInfo input
384 ! ATTRIBUTES: INTENT(OUT)
385 !
386 ! All other gInfo components as listed in the calling sequence.
387 !
388 !:sdoc-:
389 !--------------------------------------------------------------------------------
390 
391  ELEMENTAL SUBROUTINE crtm_geometryinfo_getvalue( &
392  gInfo , & ! Input
393  Geometry , & ! Optional output
394  iFOV , & ! Optional output
395  Longitude , & ! Optional output
396  Latitude , & ! Optional output
397  Surface_Altitude , & ! Optional output
398  Sensor_Scan_Angle , & ! Optional output
399  Sensor_Zenith_Angle , & ! Optional output
400  Sensor_Azimuth_Angle , & ! Optional output
401  Source_Zenith_Angle , & ! Optional output
402  Source_Azimuth_Angle , & ! Optional output
403  Flux_Zenith_Angle , & ! Optional output
404  Year , & ! Optional output
405  Month , & ! Optional output
406  Day , & ! Optional output
407  Distance_Ratio , & ! Optional output
408  Sensor_Scan_Radian , & ! Optional output
409  Sensor_Zenith_Radian , & ! Optional output
410  Sensor_Azimuth_Radian, & ! Optional output
411  Secant_Sensor_Zenith , & ! Optional output
412  Cosine_Sensor_Zenith , & ! Optional output
413  Source_Zenith_Radian , & ! Optional output
414  Source_Azimuth_Radian, & ! Optional output
415  Secant_Source_Zenith , & ! Optional output
416  Flux_Zenith_Radian , & ! Optional output
417  Secant_Flux_Zenith , & ! Optional output
418  Trans_Zenith_Radian , & ! Optional output
419  Secant_Trans_Zenith , & ! Optional output
420  AU_ratio2 ) ! Optional output
421  ! Arguments
422  TYPE(crtm_geometryinfo_type), INTENT(IN) :: ginfo
423  TYPE(crtm_geometry_type), OPTIONAL, INTENT(OUT) :: geometry
424  INTEGER , OPTIONAL, INTENT(OUT) :: ifov
425  REAL(fp), OPTIONAL, INTENT(OUT) :: longitude
426  REAL(fp), OPTIONAL, INTENT(OUT) :: latitude
427  REAL(fp), OPTIONAL, INTENT(OUT) :: surface_altitude
428  REAL(fp), OPTIONAL, INTENT(OUT) :: sensor_scan_angle
429  REAL(fp), OPTIONAL, INTENT(OUT) :: sensor_zenith_angle
430  REAL(fp), OPTIONAL, INTENT(OUT) :: sensor_azimuth_angle
431  REAL(fp), OPTIONAL, INTENT(OUT) :: source_zenith_angle
432  REAL(fp), OPTIONAL, INTENT(OUT) :: source_azimuth_angle
433  REAL(fp), OPTIONAL, INTENT(OUT) :: flux_zenith_angle
434  INTEGER, OPTIONAL, INTENT(OUT) :: year
435  INTEGER, OPTIONAL, INTENT(OUT) :: month
436  INTEGER, OPTIONAL, INTENT(OUT) :: day
437  REAL(fp), OPTIONAL, INTENT(OUT) :: distance_ratio
438  REAL(fp), OPTIONAL, INTENT(OUT) :: sensor_scan_radian
439  REAL(fp), OPTIONAL, INTENT(OUT) :: sensor_zenith_radian
440  REAL(fp), OPTIONAL, INTENT(OUT) :: sensor_azimuth_radian
441  REAL(fp), OPTIONAL, INTENT(OUT) :: secant_sensor_zenith
442  REAL(fp), OPTIONAL, INTENT(OUT) :: cosine_sensor_zenith
443  REAL(fp), OPTIONAL, INTENT(OUT) :: source_zenith_radian
444  REAL(fp), OPTIONAL, INTENT(OUT) :: source_azimuth_radian
445  REAL(fp), OPTIONAL, INTENT(OUT) :: secant_source_zenith
446  REAL(fp), OPTIONAL, INTENT(OUT) :: flux_zenith_radian
447  REAL(fp), OPTIONAL, INTENT(OUT) :: secant_flux_zenith
448  REAL(fp), OPTIONAL, INTENT(OUT) :: trans_zenith_radian
449  REAL(fp), OPTIONAL, INTENT(OUT) :: secant_trans_zenith
450  REAL(fp), OPTIONAL, INTENT(OUT) :: au_ratio2
451 
452  ! Get values
453  IF ( PRESENT(geometry) ) geometry = ginfo%user
454  CALL crtm_geometry_getvalue( ginfo%user, &
455  ifov = ifov , &
456  longitude = longitude , &
457  latitude = latitude , &
458  surface_altitude = surface_altitude , &
459  sensor_scan_angle = sensor_scan_angle , &
460  sensor_zenith_angle = sensor_zenith_angle , &
461  sensor_azimuth_angle = sensor_azimuth_angle, &
462  source_zenith_angle = source_zenith_angle , &
463  source_azimuth_angle = source_azimuth_angle, &
464  flux_zenith_angle = flux_zenith_angle , &
465  year = year , &
466  month = month , &
467  day = day )
468 
469  IF ( PRESENT(distance_ratio ) ) distance_ratio = ginfo%Distance_Ratio
470  IF ( PRESENT(sensor_scan_radian ) ) sensor_scan_radian = ginfo%Sensor_Scan_Radian
471  IF ( PRESENT(sensor_zenith_radian ) ) sensor_zenith_radian = ginfo%Sensor_Zenith_Radian
472  IF ( PRESENT(sensor_azimuth_radian) ) sensor_azimuth_radian = ginfo%Sensor_Azimuth_Radian
473  IF ( PRESENT(secant_sensor_zenith ) ) secant_sensor_zenith = ginfo%Secant_Sensor_Zenith
474  IF ( PRESENT(cosine_sensor_zenith ) ) cosine_sensor_zenith = ginfo%Cosine_Sensor_Zenith
475  IF ( PRESENT(source_zenith_radian ) ) source_zenith_radian = ginfo%Source_Zenith_Radian
476  IF ( PRESENT(source_azimuth_radian) ) source_azimuth_radian = ginfo%Source_Azimuth_Radian
477  IF ( PRESENT(secant_source_zenith ) ) secant_source_zenith = ginfo%Secant_Source_Zenith
478  IF ( PRESENT(flux_zenith_radian ) ) flux_zenith_radian = ginfo%Flux_Zenith_Radian
479  IF ( PRESENT(secant_flux_zenith ) ) secant_flux_zenith = ginfo%Secant_Flux_Zenith
480  IF ( PRESENT(trans_zenith_radian ) ) trans_zenith_radian = ginfo%Trans_Zenith_Radian
481  IF ( PRESENT(secant_trans_zenith ) ) secant_trans_zenith = ginfo%Secant_Trans_Zenith
482  IF ( PRESENT(au_ratio2 ) ) au_ratio2 = ginfo%AU_ratio2
483 
484  END SUBROUTINE crtm_geometryinfo_getvalue
485 
486 
487 !--------------------------------------------------------------------------------
488 !:sdoc+:
489 !
490 ! NAME:
491 ! CRTM_GeometryInfo_IsValid
492 !
493 ! PURPOSE:
494 ! Non-pure function to perform some simple validity checks on a
495 ! CRTM GeometryInfo container object.
496 !
497 ! If invalid data is found, a message is printed to stdout.
498 !
499 ! CALLING SEQUENCE:
500 ! result = CRTM_GeometryInfo_IsValid( gInfo )
501 !
502 ! or
503 !
504 ! IF ( CRTM_GeometryInfo_IsValid( gInfo ) ) THEN....
505 !
506 ! OBJECTS:
507 ! gInfo: CRTM GeometryInfo object which is to have its
508 ! contents checked.
509 ! UNITS: N/A
510 ! TYPE: CRTM_GeometryInfo_type
511 ! DIMENSION: Scalar
512 ! ATTRIBUTES: INTENT(IN)
513 !
514 ! FUNCTION RESULT:
515 ! result: Logical variable indicating whether or not the input
516 ! passed the check.
517 ! If == .FALSE., GeometryInfo object is unused or contains
518 ! invalid data.
519 ! == .TRUE., GeometryInfo object can be used in CRTM.
520 ! UNITS: N/A
521 ! TYPE: LOGICAL
522 ! DIMENSION: Scalar
523 !
524 !:sdoc-:
525 !--------------------------------------------------------------------------------
526 
527  FUNCTION crtm_geometryinfo_isvalid( gInfo ) RESULT( IsValid )
528  TYPE(crtm_geometryinfo_type), INTENT(IN) :: ginfo
529  LOGICAL :: isvalid
530 
531  isvalid = crtm_geometry_isvalid( ginfo%user )
532 
533  END FUNCTION crtm_geometryinfo_isvalid
534 
535 
536 !--------------------------------------------------------------------------------
537 !:sdoc+:
538 !
539 ! NAME:
540 ! CRTM_GeometryInfo_Inspect
541 !
542 ! PURPOSE:
543 ! Subroutine to print the contents of a CRTM GeometryInfo container object
544 ! to stdout.
545 !
546 ! CALLING SEQUENCE:
547 ! CALL CRTM_GeometryInfo_Inspect( gInfo, Unit=unit )
548 !
549 ! INPUTS:
550 ! gInfo: CRTM GeometryInfo object to display.
551 ! UNITS: N/A
552 ! TYPE: CRTM_GeometryInfo_type
553 ! DIMENSION: Scalar
554 ! ATTRIBUTES: INTENT(IN)
555 !
556 ! OPTIONAL INPUTS:
557 ! Unit: Unit number for an already open file to which the output
558 ! will be written.
559 ! If the argument is specified and the file unit is not
560 ! connected, the output goes to stdout.
561 ! UNITS: N/A
562 ! TYPE: INTEGER
563 ! DIMENSION: Scalar
564 ! ATTRIBUTES: INTENT(IN), OPTIONAL
565 !
566 !:sdoc-:
567 !--------------------------------------------------------------------------------
568 
569  SUBROUTINE crtm_geometryinfo_inspect( gInfo, Unit )
570  ! Arguments
571  TYPE(crtm_geometryinfo_type), INTENT(IN) :: ginfo
572  INTEGER, OPTIONAL, INTENT(IN) :: unit
573  ! Local parameters
574  CHARACTER(*), PARAMETER :: rfmt = 'es13.6'
575  ! Local variables
576  INTEGER :: fid
577 
578  ! Setup
579  fid = output_unit
580  IF ( PRESENT(unit) ) THEN
581  IF ( file_open(unit) ) fid = unit
582  END IF
583 
584 
585  WRITE(fid, '(1x,"GeometryInfo OBJECT")')
586  WRITE(fid, '(3x,"Distance ratio :",1x,'//rfmt//')') ginfo%Distance_Ratio
587  ! ...Sensor angle information
588  WRITE(fid, '(3x,"Sensor scan radian :",1x,'//rfmt//')') ginfo%Sensor_Scan_Radian
589  WRITE(fid, '(3x,"Sensor zenith radian :",1x,'//rfmt//')') ginfo%Sensor_Zenith_Radian
590  WRITE(fid, '(3x,"Sensor azimuth radian :",1x,'//rfmt//')') ginfo%Sensor_Azimuth_Radian
591  WRITE(fid, '(3x,"Secant sensor zenith :",1x,'//rfmt//')') ginfo%Secant_Sensor_Zenith
592  WRITE(fid, '(3x,"Cosine sensor zenith :",1x,'//rfmt//')') ginfo%Cosine_Sensor_Zenith
593  ! ...Transmittance algorithm sensor angle information
594  WRITE(fid, '(3x,"Trans zenith radian :",1x,'//rfmt//')') ginfo%Trans_Zenith_Radian
595  WRITE(fid, '(3x,"Secant trans zenith :",1x,'//rfmt//')') ginfo%Secant_Trans_Zenith
596  ! ...Source angle information
597  WRITE(fid, '(3x,"Source zenith radian :",1x,'//rfmt//')') ginfo%Source_Zenith_Radian
598  WRITE(fid, '(3x,"Source azimuth radian :",1x,'//rfmt//')') ginfo%Source_Azimuth_Radian
599  WRITE(fid, '(3x,"Secant source zenith :",1x,'//rfmt//')') ginfo%Secant_Source_Zenith
600  ! ...Flux angle information
601  WRITE(fid, '(3x,"Flux zenith radian :",1x,'//rfmt//')') ginfo%Flux_Zenith_Radian
602  WRITE(fid, '(3x,"Secant flux zenith :",1x,'//rfmt//')') ginfo%Secant_Flux_Zenith
603  ! ...AU ratio information
604  WRITE(fid, '(3x,"AU ratio^2 :",1x,'//rfmt//')') ginfo%AU_ratio2
605 
606  ! The contained object
607  CALL crtm_geometry_inspect(ginfo%user, unit=unit)
608 
609  END SUBROUTINE crtm_geometryinfo_inspect
610 
611 
612 !--------------------------------------------------------------------------------
613 !:sdoc+:
614 !
615 ! NAME:
616 ! CRTM_GeometryInfo_DefineVersion
617 !
618 ! PURPOSE:
619 ! Subroutine to return the module version information.
620 !
621 ! CALLING SEQUENCE:
622 ! CALL CRTM_GeometryInfo_DefineVersion( Id )
623 !
624 ! OUTPUT ARGUMENTS:
625 ! Id: Character string containing the version Id information
626 ! for the module.
627 ! UNITS: N/A
628 ! TYPE: CHARACTER(*)
629 ! DIMENSION: Scalar
630 ! ATTRIBUTES: INTENT(OUT)
631 !
632 !:sdoc-:
633 !--------------------------------------------------------------------------------
634 
635  SUBROUTINE crtm_geometryinfo_defineversion( Id )
636  CHARACTER(*), INTENT(OUT) :: id
637  id = module_version_id
638  END SUBROUTINE crtm_geometryinfo_defineversion
639 
640 
641 !------------------------------------------------------------------------------
642 !:sdoc+:
643 !
644 ! NAME:
645 ! CRTM_GeometryInfo_InquireFile
646 !
647 ! PURPOSE:
648 ! Function to inquire CRTM GeometryInfo object files.
649 !
650 ! CALLING SEQUENCE:
651 ! Error_Status = CRTM_GeometryInfo_InquireFile( &
652 ! Filename , &
653 ! n_Profiles = n_Profiles )
654 !
655 ! INPUTS:
656 ! Filename: Character string specifying the name of a
657 ! CRTM GeometryInfo data file to read.
658 ! UNITS: N/A
659 ! TYPE: CHARACTER(*)
660 ! DIMENSION: Scalar
661 ! ATTRIBUTES: INTENT(IN)
662 !
663 ! OPTIONAL OUTPUTS:
664 ! n_Profiles: The number of profiles for which there is geometry
665 ! information in the data file.
666 ! UNITS: N/A
667 ! TYPE: INTEGER
668 ! DIMENSION: Scalar
669 ! ATTRIBUTES: OPTIONAL, INTENT(OUT)
670 !
671 ! FUNCTION RESULT:
672 ! Error_Status: The return value is an integer defining the error status.
673 ! The error codes are defined in the Message_Handler module.
674 ! If == SUCCESS, the file inquire was successful
675 ! == FAILURE, an unrecoverable error occurred.
676 ! UNITS: N/A
677 ! TYPE: INTEGER
678 ! DIMENSION: Scalar
679 !
680 !:sdoc-:
681 !------------------------------------------------------------------------------
682 
683  FUNCTION crtm_geometryinfo_inquirefile( &
684  Filename , & ! Input
685  n_Profiles) & ! Optional output
686  result( err_stat )
687  ! Arguments
688  CHARACTER(*), INTENT(IN) :: filename
689  INTEGER , OPTIONAL, INTENT(OUT) :: n_profiles
690  ! Function result
691  INTEGER :: err_stat
692  ! Function parameters
693  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_GeometryInfo_InquireFile'
694  ! Function variables
695  CHARACTER(ML) :: msg
696  CHARACTER(ML) :: io_msg
697  INTEGER :: io_stat
698  INTEGER :: fid
699  INTEGER :: m
700 
701  ! Set up
702  err_stat = success
703  ! ...Check that the file exists
704  IF ( .NOT. file_exists( trim(filename) ) ) THEN
705  msg = 'File '//trim(filename)//' not found.'
706  CALL inquire_cleanup(); RETURN
707  END IF
708 
709 
710  ! Open the file
711  err_stat = open_binary_file( filename, fid )
712  IF ( err_stat /= success ) THEN
713  msg = 'Error opening '//trim(filename)
714  CALL inquire_cleanup(); RETURN
715  END IF
716 
717 
718  ! Read the number of profiles
719  READ( fid,iostat=io_stat,iomsg=io_msg ) m
720  IF ( io_stat /= 0 ) THEN
721  msg = 'Error reading dimensions from '//trim(filename)//' - '//trim(io_msg)
722  CALL inquire_cleanup(); RETURN
723  END IF
724 
725  ! Close the file
726  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
727  IF ( io_stat /= 0 ) THEN
728  msg = 'Error closing '//trim(filename)//' - '//trim(io_msg)
729  CALL inquire_cleanup(); RETURN
730  END IF
731 
732 
733  ! Set the return arguments
734  IF ( PRESENT(n_profiles) ) n_profiles = m
735 
736  CONTAINS
737 
738  SUBROUTINE inquire_cleanup()
739  IF ( file_open(fid) ) THEN
740  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
741  IF ( io_stat /= success ) &
742  msg = trim(msg)//'; Error closing input file during error cleanup - '//trim(io_msg)
743  END IF
744  err_stat = failure
745  CALL display_message( routine_name, msg, err_stat )
746  END SUBROUTINE inquire_cleanup
747 
748  END FUNCTION crtm_geometryinfo_inquirefile
749 
750 
751 !------------------------------------------------------------------------------
752 !:sdoc+:
753 !
754 ! NAME:
755 ! CRTM_GeometryInfo_ReadFile
756 !
757 ! PURPOSE:
758 ! Function to read CRTM GeometryInfo object files.
759 !
760 ! CALLING SEQUENCE:
761 ! Error_Status = CRTM_GeometryInfo_ReadFile( &
762 ! Filename , &
763 ! GeometryInfo , &
764 ! Quiet = Quiet , &
765 ! n_Profiles = n_Profiles )
766 !
767 ! INPUTS:
768 ! Filename: Character string specifying the name of an
769 ! a GeometryInfo data file to read.
770 ! UNITS: N/A
771 ! TYPE: CHARACTER(*)
772 ! DIMENSION: Scalar
773 ! ATTRIBUTES: INTENT(IN)
774 !
775 ! OUTPUTS:
776 ! GeometryInfo: CRTM GeometryInfo object array containing the
777 ! data read from file.
778 ! UNITS: N/A
779 ! TYPE: CRTM_Geometry_type
780 ! DIMENSION: Rank-1
781 ! ATTRIBUTES: INTENT(OUT), ALLOCATABLE
782 !
783 ! OPTIONAL INPUTS:
784 ! Quiet: Set this logical argument to suppress INFORMATION
785 ! messages being printed to stdout
786 ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
787 ! == .TRUE., INFORMATION messages are SUPPRESSED.
788 ! If not specified, default is .FALSE.
789 ! UNITS: N/A
790 ! TYPE: LOGICAL
791 ! DIMENSION: Scalar
792 ! ATTRIBUTES: INTENT(IN), OPTIONAL
793 !
794 ! OPTIONAL OUTPUTS:
795 ! n_Profiles: The number of profiles for which data was read.
796 ! UNITS: N/A
797 ! TYPE: INTEGER
798 ! DIMENSION: Scalar
799 ! ATTRIBUTES: OPTIONAL, INTENT(OUT)
800 !
801 ! FUNCTION RESULT:
802 ! Error_Status: The return value is an integer defining the error status.
803 ! The error codes are defined in the Message_Handler module.
804 ! If == SUCCESS, the file read was successful
805 ! == FAILURE, an unrecoverable error occurred.
806 ! UNITS: N/A
807 ! TYPE: INTEGER
808 ! DIMENSION: Scalar
809 !
810 !:sdoc-:
811 !------------------------------------------------------------------------------
812 
813  FUNCTION crtm_geometryinfo_readfile( &
814  Filename , & ! Input
815  GeometryInfo, & ! Output
816  Quiet , & ! Optional input
817  n_Profiles , & ! Optional output
818  Debug ) & ! Optional input (Debug output control)
819  result( err_stat )
820  ! Arguments
821  CHARACTER(*), INTENT(IN) :: filename
822  TYPE(crtm_geometryinfo_type), ALLOCATABLE, INTENT(OUT) :: geometryinfo(:)
823  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
824  INTEGER, OPTIONAL, INTENT(OUT) :: n_profiles
825  LOGICAL, OPTIONAL, INTENT(IN) :: debug
826  ! Function result
827  INTEGER :: err_stat
828  ! Function parameters
829  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_Geometry_ReadFile'
830  ! Function variables
831  CHARACTER(ML) :: msg
832  CHARACTER(ML) :: io_msg
833  CHARACTER(ML) :: alloc_msg
834  INTEGER :: io_stat
835  INTEGER :: alloc_stat
836  LOGICAL :: noisy
837  INTEGER :: fid
838  INTEGER :: m, n_input_profiles
839 
840 
841  ! Set up
842  err_stat = success
843  ! ...Check Quiet argument
844  noisy = .true.
845  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
846  ! ...Override Quiet settings if debug set.
847  IF ( PRESENT(debug) ) noisy = debug
848 
849 
850  ! Open the file
851  err_stat = open_binary_file( filename, fid )
852  IF ( err_stat /= success ) THEN
853  msg = 'Error opening '//trim(filename)
854  CALL read_cleanup(); RETURN
855  END IF
856 
857 
858  ! Read the dimensions
859  READ( fid,iostat=io_stat,iomsg=io_msg ) n_input_profiles
860  IF ( io_stat /= 0 ) THEN
861  msg = 'Error reading dimension from '//trim(filename)//' - '//trim(io_msg)
862  CALL read_cleanup(); RETURN
863  END IF
864  ! ...Allocate the return structure array
865  ALLOCATE(geometryinfo(n_input_profiles), stat=alloc_stat, errmsg=alloc_msg)
866  IF ( alloc_stat /= 0 ) THEN
867  msg = 'Error allocating GeometryInfo array - '//trim(alloc_msg)
868  CALL read_cleanup(); RETURN
869  END IF
870 
871 
872  ! Loop over all the profiles
873  geometryinfo_loop: DO m = 1, n_input_profiles
874  err_stat = read_record( fid, geometryinfo(m) )
875  IF ( err_stat /= success ) THEN
876  WRITE( msg,'("Error reading GeometryInfo element #",i0," from ",a)' ) m, trim(filename)
877  CALL read_cleanup(); RETURN
878  END IF
879  END DO geometryinfo_loop
880 
881 
882  ! Close the file
883  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
884  IF ( io_stat /= 0 ) THEN
885  msg = 'Error closing '//trim(filename)//' - '//trim(io_msg)
886  CALL read_cleanup(); RETURN
887  END IF
888 
889 
890  ! Set the return values
891  IF ( PRESENT(n_profiles) ) n_profiles = n_input_profiles
892 
893 
894  ! Output an info message
895  IF ( noisy ) THEN
896  WRITE( msg,'("Number of profiles read from ",a,": ",i0)' ) &
897  trim(filename), n_input_profiles
898  CALL display_message( routine_name, msg, information )
899  END IF
900 
901  CONTAINS
902 
903  SUBROUTINE read_cleanup()
904  IF ( file_open(fid) ) THEN
905  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
906  IF ( io_stat /= 0 ) &
907  msg = trim(msg)//'; Error closing input file during error cleanup - '//trim(io_msg)
908  END IF
909  IF ( ALLOCATED(geometryinfo) ) THEN
910  DEALLOCATE(geometryinfo, stat=alloc_stat, errmsg=alloc_msg)
911  IF ( alloc_stat /= 0 ) &
912  msg = trim(msg)//'; Error deallocating GeometryInfo array during error cleanup - '//&
913  trim(alloc_msg)
914  END IF
915  err_stat = failure
916  CALL display_message( routine_name, msg, err_stat )
917  END SUBROUTINE read_cleanup
918 
919  END FUNCTION crtm_geometryinfo_readfile
920 
921 
922 !------------------------------------------------------------------------------
923 !:sdoc+:
924 !
925 ! NAME:
926 ! CRTM_GeometryInfo_WriteFile
927 !
928 ! PURPOSE:
929 ! Function to write CRTM GeometryInfo object files.
930 !
931 ! CALLING SEQUENCE:
932 ! Error_Status = CRTM_GeometryInfo_WriteFile( &
933 ! Filename , &
934 ! Geometry , &
935 ! Quiet = Quiet )
936 !
937 ! INPUTS:
938 ! Filename: Character string specifying the name of the
939 ! GeometryInfo format data file to write.
940 ! UNITS: N/A
941 ! TYPE: CHARACTER(*)
942 ! DIMENSION: Scalar
943 ! ATTRIBUTES: INTENT(IN)
944 !
945 ! GeometryInfo: CRTM GeometryInfo object array containing the
946 ! data to write.
947 ! UNITS: N/A
948 ! TYPE: CRTM_Geometry_type
949 ! DIMENSION: Rank-1
950 ! ATTRIBUTES: INTENT(IN)
951 !
952 ! OPTIONAL INPUTS:
953 ! Quiet: Set this logical argument to suppress INFORMATION
954 ! messages being printed to stdout
955 ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
956 ! == .TRUE., INFORMATION messages are SUPPRESSED.
957 ! If not specified, default is .FALSE.
958 ! UNITS: N/A
959 ! TYPE: LOGICAL
960 ! DIMENSION: Scalar
961 ! ATTRIBUTES: INTENT(IN), OPTIONAL
962 !
963 ! FUNCTION RESULT:
964 ! Error_Status: The return value is an integer defining the error status.
965 ! The error codes are defined in the Message_Handler module.
966 ! If == SUCCESS, the file write was successful
967 ! == FAILURE, an unrecoverable error occurred.
968 ! UNITS: N/A
969 ! TYPE: INTEGER
970 ! DIMENSION: Scalar
971 !
972 ! SIDE EFFECTS:
973 ! - If the output file already exists, it is overwritten.
974 ! - If an error occurs during *writing*, the output file is deleted before
975 ! returning to the calling routine.
976 !
977 !:sdoc-:
978 !------------------------------------------------------------------------------
979 
980  FUNCTION crtm_geometryinfo_writefile( &
981  Filename , & ! Input
982  GeometryInfo, & ! Input
983  Quiet , & ! Optional input
984  Debug ) & ! Optional input (Debug output control)
985  result( err_stat )
986  ! Arguments
987  CHARACTER(*), INTENT(IN) :: filename
988  TYPE(crtm_geometryinfo_type), INTENT(IN) :: geometryinfo(:)
989  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
990  LOGICAL, OPTIONAL, INTENT(IN) :: debug
991  ! Function result
992  INTEGER :: err_stat
993  ! Function parameters
994  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_GeometryInfo_WriteFile'
995  ! Function variables
996  CHARACTER(ML) :: msg
997  CHARACTER(ML) :: io_msg
998  LOGICAL :: noisy
999  INTEGER :: io_stat
1000  INTEGER :: fid
1001  INTEGER :: m, n_profiles
1002 
1003  ! Set up
1004  err_stat = success
1005  ! ...Check Quiet argument
1006  noisy = .true.
1007  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
1008  ! ...Override Quiet settings if debug set.
1009  IF ( PRESENT(debug) ) noisy = debug
1010 
1011 
1012  ! Open the file
1013  err_stat = open_binary_file( filename, fid, for_output = .true. )
1014  IF ( err_stat /= success ) THEN
1015  msg = 'Error opening '//trim(filename)
1016  CALL write_cleanup(); RETURN
1017  END IF
1018 
1019 
1020  ! Write the dimensions
1021  n_profiles = SIZE(geometryinfo)
1022  WRITE( fid, iostat=io_stat ) n_profiles
1023  IF ( io_stat /= 0 ) THEN
1024  msg = 'Error writing data dimension to '//trim(filename)//'- '//trim(io_msg)
1025  CALL write_cleanup(); RETURN
1026  END IF
1027 
1028 
1029  ! Write the data
1030  geometryinfo_loop: DO m = 1, n_profiles
1031  err_stat = write_record( fid, geometryinfo(m) )
1032  IF ( err_stat /= success ) THEN
1033  WRITE( msg,'("Error writing GeometryInfo element #",i0," to ",a)' ) m, trim(filename)
1034  CALL write_cleanup(); RETURN
1035  END IF
1036  END DO geometryinfo_loop
1037 
1038 
1039  ! Close the file (if error, no delete)
1040  CLOSE( fid,status='KEEP',iostat=io_stat,iomsg=io_msg )
1041  IF ( io_stat /= 0 ) THEN
1042  msg = 'Error closing '//trim(filename)//'- '//trim(io_msg)
1043  CALL write_cleanup(); RETURN
1044  END IF
1045 
1046 
1047  ! Output an info message
1048  IF ( noisy ) THEN
1049  WRITE( msg,'("Number of profiles written to ",a,": ",i0)' ) trim(filename), n_profiles
1050  CALL display_message( routine_name, msg, information )
1051  END IF
1052 
1053  CONTAINS
1054 
1055  SUBROUTINE write_cleanup()
1056  IF ( file_open(fid) ) THEN
1057  CLOSE( fid,status=write_error_status,iostat=io_stat,iomsg=io_msg )
1058  IF ( io_stat /= 0 ) &
1059  msg = trim(msg)//'; Error deleting output file during error cleanup - '//trim(io_msg)
1060  END IF
1061  err_stat = failure
1062  CALL display_message( routine_name, msg, err_stat )
1063  END SUBROUTINE write_cleanup
1064 
1065  END FUNCTION crtm_geometryinfo_writefile
1066 
1067 
1068 !##################################################################################
1069 !##################################################################################
1070 !## ##
1071 !## ## PRIVATE MODULE ROUTINES ## ##
1072 !## ##
1073 !##################################################################################
1074 !##################################################################################
1075 
1076 !--------------------------------------------------------------------------------
1077 !
1078 ! NAME:
1079 ! CRTM_GeometryInfo_Equal
1080 !
1081 ! PURPOSE:
1082 ! Elemental function to test the equality of two CRTM_GeometryInfo objects.
1083 ! Used in OPERATOR(==) interface block.
1084 !
1085 ! CALLING SEQUENCE:
1086 ! is_equal = CRTM_GeometryInfo_Equal( x, y )
1087 !
1088 ! or
1089 !
1090 ! IF ( x == y ) THEN
1091 ! ...
1092 ! END IF
1093 !
1094 ! OBJECTS:
1095 ! x, y: Two CRTM GeometryInfo objects to be compared.
1096 ! UNITS: N/A
1097 ! TYPE: CRTM_GeometryInfo_type
1098 ! DIMENSION: Scalar or any rank
1099 ! ATTRIBUTES: INTENT(IN)
1100 !
1101 ! FUNCTION RESULT:
1102 ! is_equal: Logical value indicating whether the inputs are equal.
1103 ! UNITS: N/A
1104 ! TYPE: LOGICAL
1105 ! DIMENSION: Same as inputs.
1106 !
1107 !--------------------------------------------------------------------------------
1108 
1109  ELEMENTAL FUNCTION crtm_geometryinfo_equal( x, y ) RESULT( is_equal )
1110  TYPE(crtm_geometryinfo_type) , INTENT(IN) :: x, y
1111  LOGICAL :: is_equal
1112 
1113  is_equal = ( (x%user == y%user ) .AND. &
1114  (x%Distance_Ratio .equalto. y%Distance_Ratio ) .AND. &
1115  (x%Sensor_Scan_Radian .equalto. y%Sensor_Scan_Radian ) .AND. &
1116  (x%Sensor_Zenith_Radian .equalto. y%Sensor_Zenith_Radian ) .AND. &
1117  (x%Sensor_Azimuth_Radian .equalto. y%Sensor_Azimuth_Radian) .AND. &
1118  (x%Secant_Sensor_Zenith .equalto. y%Secant_Sensor_Zenith ) .AND. &
1119  (x%Trans_Zenith_Radian .equalto. y%Trans_Zenith_Radian ) .AND. &
1120  (x%Secant_Trans_Zenith .equalto. y%Secant_Trans_Zenith ) .AND. &
1121  (x%Cosine_Sensor_Zenith .equalto. y%Cosine_Sensor_Zenith ) .AND. &
1122  (x%Source_Zenith_Radian .equalto. y%Source_Zenith_Radian ) .AND. &
1123  (x%Source_Azimuth_Radian .equalto. y%Source_Azimuth_Radian) .AND. &
1124  (x%Secant_Source_Zenith .equalto. y%Secant_Source_Zenith ) .AND. &
1125  (x%Flux_Zenith_Radian .equalto. y%Flux_Zenith_Radian ) .AND. &
1126  (x%Secant_Flux_Zenith .equalto. y%Secant_Flux_Zenith ) .AND. &
1127  (x%AU_ratio2 .equalto. y%AU_ratio2 ) )
1128 
1129  END FUNCTION crtm_geometryinfo_equal
1130 
1131 !--------------------------------------------------------------------------------
1132 !
1133 ! NAME:
1134 ! CRTM_GeometryInfo_Subtract
1135 !
1136 ! PURPOSE:
1137 ! Pure function to subtract two CRTM GeometryInfo objects.
1138 ! Used in OPERATOR(-) interface block.
1139 !
1140 ! CALLING SEQUENCE:
1141 ! gidiff = CRTM_GeometryInfo_Subtract( gi1, gi2 )
1142 !
1143 ! or
1144 !
1145 ! gidiff = gi1 - gi2
1146 !
1147 !
1148 ! INPUTS:
1149 ! gi1, gi2: The GeometryInfo objects to difference.
1150 ! UNITS: N/A
1151 ! TYPE: CRTM_GeometryInfo_type
1152 ! DIMENSION: Scalar
1153 ! ATTRIBUTES: INTENT(IN OUT)
1154 !
1155 ! RESULT:
1156 ! gidiff: GeometryInfo object containing the differenced components.
1157 ! UNITS: N/A
1158 ! TYPE: CRTM_GeometryInfo_type
1159 ! DIMENSION: Scalar
1160 !
1161 !--------------------------------------------------------------------------------
1162 
1163  ELEMENTAL FUNCTION crtm_geometryinfo_subtract( gi1, gi2 ) RESULT( gidiff )
1164  TYPE(crtm_geometryinfo_type), INTENT(IN) :: gi1, gi2
1165  TYPE(crtm_geometryinfo_type) :: gidiff
1166 
1167  ! Copy the first structure
1168  gidiff = gi1
1169 
1170  ! And subtract the second one's components from it
1171  ! ...Contained objects
1172  gidiff%user = gidiff%user - gi2%user
1173  ! ...Individual components
1174  gidiff%Distance_Ratio = gidiff%Distance_Ratio - gi2%Distance_Ratio
1175  gidiff%Sensor_Scan_Radian = gidiff%Sensor_Scan_Radian - gi2%Sensor_Scan_Radian
1176  gidiff%Sensor_Zenith_Radian = gidiff%Sensor_Zenith_Radian - gi2%Sensor_Zenith_Radian
1177  gidiff%Sensor_Azimuth_Radian = gidiff%Sensor_Azimuth_Radian - gi2%Sensor_Azimuth_Radian
1178  gidiff%Secant_Sensor_Zenith = gidiff%Secant_Sensor_Zenith - gi2%Secant_Sensor_Zenith
1179  gidiff%Cosine_Sensor_Zenith = gidiff%Cosine_Sensor_Zenith - gi2%Cosine_Sensor_Zenith
1180  gidiff%Trans_Zenith_Radian = gidiff%Trans_Zenith_Radian - gi2%Trans_Zenith_Radian
1181  gidiff%Secant_Trans_Zenith = gidiff%Secant_Trans_Zenith - gi2%Secant_Trans_Zenith
1182  gidiff%Source_Zenith_Radian = gidiff%Source_Zenith_Radian - gi2%Source_Zenith_Radian
1183  gidiff%Source_Azimuth_Radian = gidiff%Source_Azimuth_Radian - gi2%Source_Azimuth_Radian
1184  gidiff%Secant_Source_Zenith = gidiff%Secant_Source_Zenith - gi2%Secant_Source_Zenith
1185  gidiff%Flux_Zenith_Radian = gidiff%Flux_Zenith_Radian - gi2%Flux_Zenith_Radian
1186  gidiff%Secant_Flux_Zenith = gidiff%Secant_Flux_Zenith - gi2%Secant_Flux_Zenith
1187  gidiff%AU_ratio2 = gidiff%AU_ratio2 - gi2%AU_ratio2
1188 
1189  END FUNCTION crtm_geometryinfo_subtract
1190 
1191 
1192 !----------------------------------------------------------------------------------
1193 !
1194 ! NAME:
1195 ! Read_Record
1196 !
1197 ! PURPOSE:
1198 ! Utility function to read a single GeometryInfo data record
1199 !
1200 ! CALLING SEQUENCE:
1201 ! Error_Status = Read_Record( FileID, GeometryInfo )
1202 !
1203 ! INPUTS:
1204 ! FileID: Logical unit number from which to read data.
1205 ! UNITS: N/A
1206 ! TYPE: INTEGER
1207 ! DIMENSION: Scalar
1208 ! ATTRIBUTES: INTENT(IN)
1209 !
1210 ! OUTPUTS:
1211 ! GeometryInfo: CRTM GeometryInfo object containing the data read in.
1212 ! UNITS: N/A
1213 ! TYPE: CRTM_GeometryInfo_type
1214 ! DIMENSION: Scalar
1215 ! ATTRIBUTES: INTENT(OUT)
1216 !
1217 ! FUNCTION RESULT:
1218 ! Error_Status: The return value is an integer defining the error status.
1219 ! The error codes are defined in the Message_Handler module.
1220 ! If == SUCCESS, the read was successful
1221 ! == FAILURE, an unrecoverable error occurred.
1222 ! UNITS: N/A
1223 ! TYPE: INTEGER
1224 ! DIMENSION: Scalar
1225 !
1226 !----------------------------------------------------------------------------------
1227 
1228  FUNCTION read_record( fid, ginfo ) RESULT( err_stat )
1229  ! Arguments
1230  INTEGER, INTENT(IN) :: fid
1231  TYPE(crtm_geometryinfo_type), INTENT(OUT) :: ginfo
1232  ! Function result
1233  INTEGER :: err_stat
1234  ! Function parameters
1235  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_GeometryInfo_ReadFile(Record)'
1236  ! Function variables
1237  CHARACTER(ML) :: msg
1238  CHARACTER(ML) :: io_msg
1239  INTEGER :: io_stat
1240 
1241  ! Set up
1242  err_stat = success
1243 
1244 
1245  ! Read the embedded Geometry structure
1246  err_stat = crtm_geometry_readrecord( fid, ginfo%user )
1247  IF ( err_stat /= success ) THEN
1248  msg = 'Error reading embedded Geometry data'
1249  CALL read_record_cleanup(); RETURN
1250  END IF
1251 
1252 
1253  ! Read the data record
1254  READ( fid, iostat=io_stat,iomsg=io_msg ) &
1255  ginfo%Distance_Ratio , &
1256  ginfo%Sensor_Scan_Radian , &
1257  ginfo%Sensor_Zenith_Radian , &
1258  ginfo%Sensor_Azimuth_Radian, &
1259  ginfo%Secant_Sensor_Zenith , &
1260  ginfo%Cosine_Sensor_Zenith , &
1261  ginfo%Trans_Zenith_Radian , &
1262  ginfo%Secant_Trans_Zenith , &
1263  ginfo%Source_Zenith_Radian , &
1264  ginfo%Source_Azimuth_Radian, &
1265  ginfo%Secant_Source_Zenith , &
1266  ginfo%Flux_Zenith_Radian , &
1267  ginfo%Secant_Flux_Zenith , &
1268  ginfo%AU_ratio2
1269  IF ( io_stat /= 0 ) THEN
1270  msg = 'Error reading GeometryInfo data - '//trim(io_msg)
1271  CALL read_record_cleanup(); RETURN
1272  END IF
1273 
1274  CONTAINS
1275 
1276  SUBROUTINE read_record_cleanup()
1277  CALL crtm_geometryinfo_destroy( ginfo )
1278  CLOSE( fid,iostat=io_stat,iomsg=io_msg )
1279  IF ( io_stat /= success ) &
1280  msg = trim(msg)//'; Error closing file during error cleanup - '//trim(io_msg)
1281  err_stat = failure
1282  CALL display_message( routine_name, msg, err_stat )
1283  END SUBROUTINE read_record_cleanup
1284 
1285  END FUNCTION read_record
1286 
1287 
1288 !----------------------------------------------------------------------------------
1289 !
1290 ! NAME:
1291 ! Write_Record
1292 !
1293 ! PURPOSE:
1294 ! Function to write a single GeometryInfo data record
1295 !
1296 ! CALLING SEQUENCE:
1297 ! Error_Status = Write_Record( FileID, GeometryInfo )
1298 !
1299 ! INPUTS:
1300 ! FileID: Logical unit number to which data is written
1301 ! UNITS: N/A
1302 ! TYPE: INTEGER
1303 ! DIMENSION: Scalar
1304 ! ATTRIBUTES: INTENT(IN)
1305 !
1306 ! GeometryInfo: CRTM GeometryInfo object containing the data to write.
1307 ! UNITS: N/A
1308 ! TYPE: CRTM_GeometryInfo_type
1309 ! DIMENSION: Scalar
1310 ! ATTRIBUTES: INTENT(IN)
1311 !
1312 ! FUNCTION RESULT:
1313 ! Error_Status: The return value is an integer defining the error status.
1314 ! The error codes are defined in the Message_Handler module.
1315 ! If == SUCCESS the record write was successful
1316 ! == FAILURE an unrecoverable error occurred.
1317 ! UNITS: N/A
1318 ! TYPE: INTEGER
1319 ! DIMENSION: Scalar
1320 !
1321 !----------------------------------------------------------------------------------
1322 
1323  FUNCTION write_record( fid, ginfo ) RESULT( err_stat )
1324  ! Arguments
1325  INTEGER, INTENT(IN) :: fid
1326  TYPE(crtm_geometryinfo_type), INTENT(IN) :: ginfo
1327  ! Function result
1328  INTEGER :: err_stat
1329  ! Function parameters
1330  CHARACTER(*), PARAMETER :: routine_name = 'CRTM_GeometryInfo_WriteFile(Record)'
1331  ! Function variables
1332  CHARACTER(ML) :: msg
1333  CHARACTER(ML) :: io_msg
1334  INTEGER :: io_stat
1335 
1336  ! Set up
1337  err_stat = success
1338 
1339 
1340  ! Write the embedded Geometry structure
1341  err_stat = crtm_geometry_writerecord( fid, ginfo%user )
1342  IF ( err_stat /= success ) THEN
1343  msg = 'Error writing embedded Geometry data'
1344  CALL write_record_cleanup(); RETURN
1345  END IF
1346 
1347 
1348  ! Write the data record
1349  WRITE( fid,iostat=io_stat,iomsg=io_msg ) &
1350  ginfo%Distance_Ratio , &
1351  ginfo%Sensor_Scan_Radian , &
1352  ginfo%Sensor_Zenith_Radian , &
1353  ginfo%Sensor_Azimuth_Radian, &
1354  ginfo%Secant_Sensor_Zenith , &
1355  ginfo%Cosine_Sensor_Zenith , &
1356  ginfo%Trans_Zenith_Radian , &
1357  ginfo%Secant_Trans_Zenith , &
1358  ginfo%Source_Zenith_Radian , &
1359  ginfo%Source_Azimuth_Radian, &
1360  ginfo%Secant_Source_Zenith , &
1361  ginfo%Flux_Zenith_Radian , &
1362  ginfo%Secant_Flux_Zenith , &
1363  ginfo%AU_ratio2
1364  IF ( io_stat /= 0 ) THEN
1365  msg = 'Error writing GeometryInfo data - '//trim(io_msg)
1366  CALL write_record_cleanup(); RETURN
1367  END IF
1368 
1369  CONTAINS
1370 
1371  SUBROUTINE write_record_cleanup()
1372  CLOSE( fid,status=write_error_status,iostat=io_stat,iomsg=io_msg )
1373  IF ( io_stat /= success ) &
1374  msg = trim(msg)//'; Error closing file during error cleanup'
1375  err_stat = failure
1376  CALL display_message( routine_name, trim(msg), err_stat )
1377  END SUBROUTINE write_record_cleanup
1378 
1379  END FUNCTION write_record
1380 
1381 END MODULE crtm_geometryinfo_define
crtm_geometryinfo_define::write_error_status
character(*), parameter write_error_status
Definition: CRTM_GeometryInfo_Define.f90:97
crtm_geometryinfo_define::crtm_geometryinfo_inquirefile
integer function, public crtm_geometryinfo_inquirefile(Filename, n_Profiles)
Definition: CRTM_GeometryInfo_Define.f90:687
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_geometryinfo_define::ml
integer, parameter ml
Definition: CRTM_GeometryInfo_Define.f90:95
message_handler::warning
integer, parameter, public warning
Definition: Message_Handler.f90:29
crtm_geometryinfo_define::crtm_geometryinfo_readfile
integer function, public crtm_geometryinfo_readfile(Filename, GeometryInfo, Quiet, n_Profiles, Debug)
Definition: CRTM_GeometryInfo_Define.f90:820
crtm_geometryinfo_define::crtm_geometryinfo_isvalid
logical function, public crtm_geometryinfo_isvalid(gInfo)
Definition: CRTM_GeometryInfo_Define.f90:528
type_kinds::fp
integer, parameter, public fp
Definition: Type_Kinds.f90:124
crtm_geometry_define::crtm_geometry_getvalue
elemental subroutine, public crtm_geometry_getvalue(geo, iFOV, Longitude, Latitude, Surface_Altitude, Sensor_Scan_Angle, Sensor_Zenith_Angle, Sensor_Azimuth_Angle, Source_Zenith_Angle, Source_Azimuth_Angle, Flux_Zenith_Angle, Year, Month, Day)
Definition: CRTM_Geometry_Define.f90:558
crtm_geometryinfo_define::one
real(fp), parameter one
Definition: CRTM_GeometryInfo_Define.f90:93
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_parameters
Definition: CRTM_Parameters.f90:12
crtm_geometry_define::crtm_geometry_destroy
elemental subroutine, public crtm_geometry_destroy(geo)
Definition: CRTM_Geometry_Define.f90:203
mpp_io_mod::write_record
Definition: mpp_io.F90:911
crtm_geometry_define::crtm_geometry_type
Definition: CRTM_Geometry_Define.f90:102
crtm_geometryinfo_define::crtm_geometryinfo_setvalue
elemental subroutine, public crtm_geometryinfo_setvalue(gInfo, Geometry, iFOV, Longitude, Latitude, Surface_Altitude, Sensor_Scan_Angle, Sensor_Zenith_Angle, Sensor_Azimuth_Angle, Source_Zenith_Angle, Source_Azimuth_Angle, Flux_Zenith_Angle, Year, Month, Day, Distance_Ratio, Sensor_Scan_Radian, Sensor_Zenith_Radian, Sensor_Azimuth_Radian, Secant_Sensor_Zenith, Cosine_Sensor_Zenith, Source_Zenith_Radian, Source_Azimuth_Radian, Secant_Source_Zenith, Flux_Zenith_Radian, Secant_Flux_Zenith, Trans_Zenith_Radian, Secant_Trans_Zenith, AU_ratio2)
Definition: CRTM_GeometryInfo_Define.f90:265
crtm_geometryinfo_define::crtm_geometryinfo_type
Definition: CRTM_GeometryInfo_Define.f90:104
inquire_cleanup
subroutine inquire_cleanup()
Definition: ACCoeff_Binary_IO.f90:249
crtm_parameters::diffusivity_radian
real(fp), parameter, public diffusivity_radian
Definition: CRTM_Parameters.f90:226
crtm_parameters::earth_radius
real(fp), parameter, public earth_radius
Definition: CRTM_Parameters.f90:181
crtm_geometryinfo_define::crtm_geometryinfo_subtract
elemental type(crtm_geometryinfo_type) function crtm_geometryinfo_subtract(gi1, gi2)
Definition: CRTM_GeometryInfo_Define.f90:1164
message_handler
Definition: Message_Handler.f90:4
crtm_parameters::secant_diffusivity
real(fp), parameter, public secant_diffusivity
Definition: CRTM_Parameters.f90:227
read_cleanup
subroutine read_cleanup()
Definition: ACCoeff_Binary_IO.f90:469
binary_file_utility
Definition: Binary_File_Utility.f90:13
write_cleanup
subroutine write_cleanup()
Definition: ACCoeff_Binary_IO.f90:670
read_record_cleanup
subroutine read_record_cleanup()
Definition: CRTM_Aerosol_Define.f90:1491
crtm_geometry_define
Definition: CRTM_Geometry_Define.f90:12
crtm_geometry_define::crtm_geometry_readrecord
integer function, public crtm_geometry_readrecord(fid, geo)
Definition: CRTM_Geometry_Define.f90:1439
compare_float_numbers
Definition: Compare_Float_Numbers.f90:13
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_geometryinfo_define::zero
real(fp), parameter zero
Definition: CRTM_GeometryInfo_Define.f90:92
crtm_geometryinfo_define::crtm_geometryinfo_destroy
elemental subroutine, public crtm_geometryinfo_destroy(gInfo)
Definition: CRTM_GeometryInfo_Define.f90:166
crtm_geometry_define::crtm_geometry_inspect
subroutine, public crtm_geometry_inspect(geo, Unit)
Definition: CRTM_Geometry_Define.f90:764
crtm_geometryinfo_define::crtm_geometryinfo_equal
elemental logical function crtm_geometryinfo_equal(x, y)
Definition: CRTM_GeometryInfo_Define.f90:1110
crtm_geometryinfo_define::module_version_id
character(*), parameter module_version_id
Definition: CRTM_GeometryInfo_Define.f90:89
file_utility::file_open
Definition: File_Utility.f90:56
crtm_geometry_define::crtm_geometry_isvalid
logical function, public crtm_geometry_isvalid(geo)
Definition: CRTM_Geometry_Define.f90:633
crtm_geometry_define::crtm_geometry_setvalue
elemental subroutine, public crtm_geometry_setvalue(geo, iFOV, Longitude, Latitude, Surface_Altitude, Sensor_Scan_Angle, Sensor_Zenith_Angle, Sensor_Azimuth_Angle, Source_Zenith_Angle, Source_Azimuth_Angle, Flux_Zenith_Angle, Year, Month, Day)
Definition: CRTM_Geometry_Define.f90:383
file_utility::file_exists
Definition: File_Utility.f90:51
crtm_geometryinfo_define::crtm_geometryinfo_inspect
subroutine, public crtm_geometryinfo_inspect(gInfo, Unit)
Definition: CRTM_GeometryInfo_Define.f90:570
compare_float_numbers::default_n_sigfig
integer, parameter, public default_n_sigfig
Definition: Compare_Float_Numbers.f90:101
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
write_record_cleanup
subroutine write_record_cleanup()
Definition: CRTM_Aerosol_Define.f90:1555
crtm_geometryinfo_define::read_record
integer function read_record(fid, ginfo)
Definition: CRTM_GeometryInfo_Define.f90:1229
type_kinds
Definition: Type_Kinds.f90:12
crtm_geometryinfo_define::crtm_geometryinfo_writefile
integer function, public crtm_geometryinfo_writefile(Filename, GeometryInfo, Quiet, Debug)
Definition: CRTM_GeometryInfo_Define.f90:986
crtm_parameters::satellite_height
real(fp), parameter, public satellite_height
Definition: CRTM_Parameters.f90:182
crtm_geometry_define::crtm_geometry_writerecord
integer function, public crtm_geometry_writerecord(fid, geo)
Definition: CRTM_Geometry_Define.f90:1526
crtm_geometryinfo_define::crtm_geometryinfo_defineversion
subroutine, public crtm_geometryinfo_defineversion(Id)
Definition: CRTM_GeometryInfo_Define.f90:636
crtm_geometryinfo_define
Definition: CRTM_GeometryInfo_Define.f90:13
message_handler::success
integer, parameter, public success
Definition: Message_Handler.f90:27
file_utility
Definition: File_Utility.f90:26
crtm_geometryinfo_define::crtm_geometryinfo_getvalue
elemental subroutine, public crtm_geometryinfo_getvalue(gInfo, Geometry, iFOV, Longitude, Latitude, Surface_Altitude, Sensor_Scan_Angle, Sensor_Zenith_Angle, Sensor_Azimuth_Angle, Source_Zenith_Angle, Source_Azimuth_Angle, Flux_Zenith_Angle, Year, Month, Day, Distance_Ratio, Sensor_Scan_Radian, Sensor_Zenith_Radian, Sensor_Azimuth_Radian, Secant_Sensor_Zenith, Cosine_Sensor_Zenith, Source_Zenith_Radian, Source_Azimuth_Radian, Secant_Source_Zenith, Flux_Zenith_Radian, Secant_Flux_Zenith, Trans_Zenith_Radian, Secant_Trans_Zenith, AU_ratio2)
Definition: CRTM_GeometryInfo_Define.f90:421
message_handler::information
integer, parameter, public information
Definition: Message_Handler.f90:28