FV3 Bundle
ODAS_Binary_IO.f90
Go to the documentation of this file.
1 !
2 ! ODAS_Binary_IO
3 !
4 ! Module containing routines to read and write Binary format
5 ! ODAS files.
6 !
7 !
8 ! CREATION HISTORY:
9 ! Written by: Paul van Delst, CIMSS/SSEC 02-Jan-2003
10 ! paul.vandelst@ssec.wisc.edu
11 !
12 
13 MODULE odas_binary_io
14 
15  ! ------------------
16  ! Environment set up
17  ! ------------------
18  ! Module use
19  USE type_kinds , ONLY: long, double
20  USE message_handler , ONLY: success, failure, warning, information, display_message
21  USE file_utility , ONLY: file_open, file_exists
22  USE binary_file_utility, ONLY: open_binary_file
23  USE odas_define , ONLY: odas_type , &
24  associated_odas , &
25  allocate_odas , &
26  destroy_odas , &
27  checkrelease_odas , &
28  checkalgorithm_odas, &
29  info_odas
30  ! Disable implicit typing
31  IMPLICIT NONE
32 
33 
34  ! ------------
35  ! Visibilities
36  ! ------------
37  ! Everything private by default
38  PRIVATE
39  ! Structure procedures
40  PUBLIC :: inquire_odas_binary
41  PUBLIC :: read_odas_binary
42  PUBLIC :: write_odas_binary
43  PUBLIC :: read_odas_data
44  PUBLIC :: write_odas_data
45 
46  ! -----------------
47  ! Module parameters
48  ! -----------------
49  CHARACTER(*), PARAMETER :: module_rcs_id = &
50  '$Id: ODAS_Binary_IO.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
51  ! Message character length
52  INTEGER, PARAMETER :: ml = 512
53  ! Keyword set value
54  INTEGER, PARAMETER :: set = 1
55 
56 
57 CONTAINS
58 
59 
60 !################################################################################
61 !################################################################################
62 !## ##
63 !## ## PUBLIC MODULE ROUTINES ## ##
64 !## ##
65 !################################################################################
66 !################################################################################
67 
68 !------------------------------------------------------------------------------
69 !
70 ! NAME:
71 ! Inquire_ODAS_Binary
72 !
73 ! PURPOSE:
74 ! Function to inquire a Binary format ODAS file.
75 !
76 ! CALLING SEQUENCE:
77 ! Error_Status = Inquire_ODAS_Binary( Filename , & ! Input
78 ! n_Predictors = n_Predictors , & ! Optional output
79 ! n_Absorbers = n_Absorbers , & ! Optional output
80 ! n_Channels = n_Channels , & ! Optional output
81 ! n_Alphas = n_Alphas , & ! Optional output
82 ! n_Coeffs = n_Coeffs , & ! Optional output
83 ! Release = Release , & ! Optional Output
84 ! Version = Version , & ! Optional Output
85 ! Sensor_Id = Sensor_Id , & ! Optional output
86 ! WMO_Satellite_Id = WMO_Satellite_Id, & ! Optional output
87 ! WMO_Sensor_Id = WMO_Sensor_Id , & ! Optional output
88 ! RCS_Id = RCS_Id , & ! Revision control
89 ! Message_Log = Message_Log ) ! Error messaging
90 !
91 ! INPUT ARGUMENTS:
92 ! Filename: Character string specifying the name of the binary
93 ! ODAS data file to inquire.
94 ! UNITS: N/A
95 ! TYPE: CHARACTER(*)
96 ! DIMENSION: Scalar
97 ! ATTRIBUTES: INTENT(IN)
98 !
99 ! OPTIONAL INPUT ARGUMENTS:
100 ! Message_Log: Character string specifying a filename in which any
101 ! Messages will be logged. If not specified, or if an
102 ! error occurs opening the log file, the default action
103 ! is to output Messages to standard output.
104 ! UNITS: N/A
105 ! TYPE: CHARACTER(*)
106 ! DIMENSION: Scalar
107 ! ATTRIBUTES: INTENT(IN), OPTIONAL
108 !
109 ! OPTIONAL OUTPUT ARGUMENTS:
110 ! n_Predictors: The number of predictor functions used in generating
111 ! the ODAS data.
112 ! NOTE: The data arrays using this dimension value are
113 ! dimensioned as 0:n_Predictors, where the 0'th
114 ! term is the offset. Therefore the actual number
115 ! of array elements along this dimension is
116 ! n_Predictors+1
117 ! UNITS: N/A
118 ! TYPE: INTEGER
119 ! DIMENSION: Scalar
120 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
121 !
122 ! n_Absorbers: The number of absorbers dimension of the ODAS data.
123 ! UNITS: N/A
124 ! TYPE: INTEGER
125 ! DIMENSION: Scalar
126 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
127 !
128 ! n_Channels: The number of channels dimension of the ODAS data.
129 ! UNITS: N/A
130 ! TYPE: INTEGER
131 ! DIMENSION: Scalar
132 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
133 !
134 ! n_Alphas: The number of alpha coefficients used to compute the absorber level.
135 ! UNITS: N/A
136 ! TYPE: INTEGER
137 ! DIMENSION: Scalar
138 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
139 !
140 ! n_Coeffs: The number of the C coeffcients.
141 ! UNITS: N/A
142 ! TYPE: INTEGER
143 ! DIMENSION: Scalar
144 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
145 !
146 ! Release: The ODAS data/file release number. Used to check
147 ! for data/software mismatch.
148 ! UNITS: N/A
149 ! TYPE: INTEGER
150 ! DIMENSION: Scalar
151 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
152 !
153 ! Version: The ODAS data/file version number. Used for
154 ! purposes only in identifying the dataset for
155 ! a particular release.
156 ! UNITS: N/A
157 ! TYPE: INTEGER
158 ! DIMENSION: Scalar
159 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
160 !
161 ! Sensor_Id: Character string sensor/platform identifier.
162 ! UNITS: N/A
163 ! TYPE: CHARACTER(*)
164 ! DIMENSION: Scalar
165 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
166 !
167 ! WMO_Satellite_Id: The WMO code used to identify satellite platforms.
168 ! UNITS: N/A
169 ! TYPE: INTEGER
170 ! DIMENSION: Scalar
171 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
172 !
173 ! WMO_Sensor_Id: The WMO code used to identify sensors.
174 ! UNITS: N/A
175 ! TYPE: INTEGER
176 ! DIMENSION: Scalar
177 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
178 !
179 ! RCS_Id: Character string containing the Revision Control
180 ! System Id field for the module.
181 ! UNITS: N/A
182 ! TYPE: CHARACTER(*)
183 ! DIMENSION: Scalar
184 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
185 !
186 ! FUNCTION RESULT:
187 ! Error_Status: The return value is an integer defining the error status.
188 ! The error codes are defined in the Message_Handler module.
189 ! If == SUCCESS the Binary file inquiry was successful
190 ! == FAILURE an unrecoverable error occurred.
191 ! UNITS: N/A
192 ! TYPE: INTEGER
193 ! DIMENSION: Scalar
194 !
195 !------------------------------------------------------------------------------
196 
197  FUNCTION inquire_odas_binary( Filename , & ! Input
198  n_Predictors , & ! Optional output
199  n_Absorbers , & ! Optional output
200  n_Channels , & ! Optional output
201  n_Alphas , & ! Optional output
202  n_Coeffs , & ! Optional output
203  Release , & ! Optional Output
204  Version , & ! Optional Output
205  Sensor_Id , & ! Optional Output
206  WMO_Satellite_Id, & ! Optional Output
207  WMO_Sensor_Id , & ! Optional Output
208  RCS_Id , & ! Revision control
209  Message_Log ) & ! Error messaging
210  result( error_status )
211  ! Arguments
212  CHARACTER(*), INTENT(IN) :: filename
213  INTEGER , OPTIONAL, INTENT(OUT) :: n_predictors
214  INTEGER , OPTIONAL, INTENT(OUT) :: n_absorbers
215  INTEGER , OPTIONAL, INTENT(OUT) :: n_channels
216  INTEGER, OPTIONAL, INTENT(OUT) :: n_alphas
217  INTEGER, OPTIONAL, INTENT(OUT) :: n_coeffs
218  INTEGER , OPTIONAL, INTENT(OUT) :: release
219  INTEGER , OPTIONAL, INTENT(OUT) :: version
220  CHARACTER(*), OPTIONAL, INTENT(OUT) :: sensor_id
221  INTEGER , OPTIONAL, INTENT(OUT) :: wmo_satellite_id
222  INTEGER , OPTIONAL, INTENT(OUT) :: wmo_sensor_id
223  CHARACTER(*), OPTIONAL, INTENT(OUT) :: rcs_id
224  CHARACTER(*), OPTIONAL, INTENT(IN) :: message_log
225  ! Function result
226  INTEGER :: error_status
227  ! Function parameters
228  CHARACTER(*), PARAMETER :: routine_name = 'Inquire_ODAS_Binary'
229  ! Function variables
230  CHARACTER(ML) :: message
231  INTEGER :: io_status
232  INTEGER :: fileid
233  TYPE(odas_type) :: odas
234 
235 
236  ! Set up
237  ! ------
238  error_status = success
239  IF ( PRESENT( rcs_id ) ) rcs_id = module_rcs_id
240 
241  ! Check that the file exists
242  IF ( .NOT. file_exists( trim(filename) ) ) THEN
243  message = 'File '//trim(filename)//' not found.'
244  CALL inquire_cleanup(); RETURN
245  END IF
246 
247 
248  ! Open the file
249  ! -------------
250  error_status = open_binary_file( filename, fileid )
251  IF ( error_status /= success ) THEN
252  message = 'Error opening ODAS Binary file '//trim(filename)
253  CALL inquire_cleanup(); RETURN
254  END IF
255 
256 
257  ! Read the Release and Version information
258  ! ----------------------------------------
259  READ( fileid, iostat=io_status ) odas%Release, odas%Version
260  IF ( io_status /= 0 ) THEN
261  WRITE( message,'("Error reading Release/Version values from ",a,&
262  &". IOSTAT = ",i0)' ) &
263  trim(filename), io_status
264  CALL inquire_cleanup(close_file=set); RETURN
265  END IF
266 
267 
268  ! Read the Alorithm ID
269  ! --------------------
270  READ( fileid, iostat=io_status ) odas%Algorithm
271  IF ( io_status /= 0 ) THEN
272  WRITE( message,'("Error reading Algorithm ID from ",a,&
273  &". IOSTAT = ",i0)' ) &
274  trim(filename), io_status
275  CALL inquire_cleanup(close_file=set); RETURN
276  END IF
277 
278 
279  ! Read the data dimensions
280  ! ------------------------
281  READ( fileid, iostat=io_status ) odas%n_Predictors, &
282  odas%n_Absorbers , &
283  odas%n_Channels , &
284  odas%n_Alphas , &
285  odas%n_Coeffs
286  IF ( io_status /= 0 ) THEN
287  WRITE( message,'("Error reading dimension values from ",a,&
288  &". IOSTAT = ",i0)' ) &
289  trim(filename), io_status
290  CALL inquire_cleanup(close_file=set); RETURN
291  END IF
292 
293 
294  ! Read the sensor ids
295  ! -------------------
296  READ( fileid, iostat=io_status ) odas%Sensor_Id , &
297  odas%WMO_Satellite_Id, &
298  odas%WMO_Sensor_Id
299  IF ( io_status /= 0 ) THEN
300  WRITE( message, '("Error reading sensor information from ",a,&
301  &". IOSTAT = ",i0)' ) &
302  trim(filename), io_status
303  CALL inquire_cleanup(close_file=set); RETURN
304  END IF
305 
306 
307  ! Close the file
308  ! --------------
309  CLOSE( fileid, iostat=io_status )
310  IF ( io_status /= 0 ) THEN
311  WRITE( message,'("Error closing ",a,". IOSTAT = ",i0)' ) &
312  trim(filename), io_status
313  CALL inquire_cleanup(); RETURN
314  END IF
315 
316 
317  ! Assign the return arguments
318  ! ---------------------------
319  ! Dimensions
320  IF ( PRESENT(n_predictors) ) n_predictors = odas%n_Predictors
321  IF ( PRESENT(n_absorbers ) ) n_absorbers = odas%n_Absorbers
322  IF ( PRESENT(n_channels ) ) n_channels = odas%n_Channels
323  IF ( PRESENT(n_alphas ) ) n_alphas = odas%n_Alphas
324  IF ( PRESENT(n_coeffs ) ) n_coeffs = odas%n_Coeffs
325 
326  ! Release/Version information
327  IF ( PRESENT(release) ) release = odas%Release
328  IF ( PRESENT(version) ) version = odas%Version
329 
330  ! Sensor ids
331  IF ( PRESENT(sensor_id ) ) sensor_id = odas%Sensor_Id(1:min(len(sensor_id),len_trim(odas%Sensor_Id)))
332  IF ( PRESENT(wmo_satellite_id) ) wmo_satellite_id = odas%WMO_Satellite_Id
333  IF ( PRESENT(wmo_sensor_id ) ) wmo_sensor_id = odas%WMO_Sensor_Id
334 
335  CONTAINS
336 
337  SUBROUTINE inquire_cleanup( Close_File )
338  INTEGER, OPTIONAL, INTENT(IN) :: Close_File
339  CHARACTER(256) :: Close_Message
340  ! Close file if necessary
341  IF ( PRESENT(close_file) ) THEN
342  IF ( close_file == set ) THEN
343  CLOSE( fileid, iostat=io_status )
344  IF ( io_status /= 0 ) THEN
345  WRITE( close_message,'("; Error closing input file during error cleanup. IOSTAT=",i0)') &
346  io_status
347  message = trim(message)//trim(close_message)
348  END IF
349  END IF
350  END IF
351  ! Set error status and print error message
352  error_status = failure
353  CALL display_message( routine_name, &
354  trim(message), &
355  error_status, &
356  message_log=message_log )
357  END SUBROUTINE inquire_cleanup
358 
359  END FUNCTION inquire_odas_binary
360 
361 
362 !--------------------------------------------------------------------------------
363 !
364 ! NAME:
365 ! Read_ODAS_Binary
366 !
367 ! PURPOSE:
368 ! Function to read data into an ODAS structure from a Binary format file.
369 !
370 ! CALLING SEQUENCE:
371 ! Error_Status = Read_ODAS_Binary( Filename , & ! Input
372 ! ODAS , & ! Output
373 ! Quiet = Quiet , & ! Optional input
374 ! Process_ID = Process_ID , & ! Optional input
375 ! Output_Process_ID = Output_Process_ID, & ! Optional input
376 ! RCS_Id = RCS_Id , & ! Revision control
377 ! Message_Log = Message_Log ) ! Error messaging
378 !
379 ! INPUT ARGUMENTS:
380 ! Filename: Character string specifying the name of the binary
381 ! format ODAS data file to read.
382 ! UNITS: N/A
383 ! TYPE: CHARACTER(*)
384 ! DIMENSION: Scalar
385 ! ATTRIBUTES: INTENT(IN)
386 !
387 ! OUTPUT ARGUMENTS:
388 ! ODAS: Structure containing the gas absorption coefficient
389 ! data read from the file.
390 ! UNITS: N/A
391 ! TYPE: ODAS_type
392 ! DIMENSION: Scalar
393 ! ATTRIBUTES: INTENT(IN OUT)
394 !
395 ! OPTIONAL INPUT ARGUMENTS:
396 ! Quiet: Set this argument to suppress INFORMATION messages
397 ! being printed to standard output (or the message
398 ! log file if the Message_Log optional argument is
399 ! used.) By default, INFORMATION messages are printed.
400 ! If QUIET = 0, INFORMATION messages are OUTPUT.
401 ! QUIET = 1, INFORMATION messages are SUPPRESSED.
402 ! UNITS: N/A
403 ! TYPE: INTEGER
404 ! DIMENSION: Scalar
405 ! ATTRIBUTES: INTENT(IN), OPTIONAL
406 !
407 ! Process_ID: Set this argument to the MPI process ID that this
408 ! function call is running under. This value is used
409 ! solely for controlling INFORMATIOn message output.
410 ! If MPI is not being used, ignore this argument.
411 ! This argument is ignored if the Quiet argument is set.
412 ! UNITS: N/A
413 ! TYPE: INTEGER
414 ! DIMENSION: Scalar
415 ! ATTRIBUTES: INTENT(IN), OPTIONAL
416 !
417 ! Output_Process_ID: Set this argument to the MPI process ID, specified
418 ! via the Process_ID argument, in which all INFORMATION
419 ! messages are to be output. If the passed Process_ID
420 ! value agrees with this value the INFORMATION messages
421 ! are output. If MPI is not being used, ignore this
422 ! argument.
423 ! This argument is ignored if:
424 ! - the optional Process_ID argument is not present.
425 ! - the optional Quiet argument is set.
426 ! UNITS: N/A
427 ! TYPE: INTEGER
428 ! DIMENSION: Scalar
429 ! ATTRIBUTES: INTENT(IN), OPTIONAL
430 !
431 ! Message_Log: Character string specifying a filename in which any
432 ! Messages will be logged. If not specified, or if an
433 ! error occurs opening the log file, the default action
434 ! is to output Messages to standard output.
435 ! UNITS: N/A
436 ! TYPE: CHARACTER(*)
437 ! DIMENSION: Scalar
438 ! ATTRIBUTES: INTENT(IN), OPTIONAL
439 !
440 ! OPTIONAL OUTPUT ARGUMENTS:
441 ! RCS_Id: Character string containing the Revision Control
442 ! System Id field for the module.
443 ! UNITS: N/A
444 ! TYPE: CHARACTER(*)
445 ! DIMENSION: Scalar
446 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
447 !
448 ! FUNCTION RESULT:
449 ! Error_Status: The return value is an integer defining the error status.
450 ! The error codes are defined in the Message_Handler module.
451 ! If == SUCCESS the Binary file read was successful
452 ! == FAILURE an unrecoverable read error occurred.
453 ! UNITS: N/A
454 ! TYPE: INTEGER
455 ! DIMENSION: Scalar
456 !
457 ! SIDE EFFECTS:
458 ! If the ODAS argument is defined upon input, it is redefined (or
459 ! reinitialised) at output.
460 !
461 ! COMMENTS:
462 ! Note the INTENT on the output ODAS argument is IN OUT rather than
463 ! just OUT. This is necessary because the argument may be defined upon
464 ! input. To prevent memory leaks, the IN OUT INTENT is a must.
465 !
466 !------------------------------------------------------------------------------
467 
468  FUNCTION read_odas_binary( Filename , & ! Input
469  ODAS , & ! Output
470  Quiet , & ! Optional input
471  Process_ID , & ! Optional input
472  Output_Process_ID, & ! Optional input
473  RCS_Id , & ! Revision control
474  Message_Log ) & ! Error messaging
475  result( error_status )
476  ! Arguments
477  CHARACTER(*) , INTENT(IN) :: filename
478  TYPE(odas_type) , INTENT(IN OUT) :: odas
479  INTEGER , OPTIONAL, INTENT(IN) :: quiet
480  INTEGER , OPTIONAL, INTENT(IN) :: process_id
481  INTEGER , OPTIONAL, INTENT(IN) :: output_process_id
482  CHARACTER(*), OPTIONAL, INTENT(OUT) :: rcs_id
483  CHARACTER(*), OPTIONAL, INTENT(IN) :: message_log
484  ! Function result
485  INTEGER :: error_status
486  ! Function parameters
487  CHARACTER(*), PARAMETER :: routine_name = 'Read_ODAS_Binary'
488  ! Function variables
489  CHARACTER(ML) :: message
490  CHARACTER(ML) :: process_id_tag
491  LOGICAL :: noisy
492  INTEGER :: io_status
493  INTEGER :: fileid
494 
495  ! Set up
496  ! ------
497  error_status = success
498  IF ( PRESENT( rcs_id ) ) rcs_id = module_rcs_id
499 
500  ! Check that the file is present
501  IF ( .NOT. file_exists( trim(filename) ) ) THEN
502  message = 'File '//trim(filename)//' not found.'
503  error_status = failure
504  RETURN
505  END IF
506 
507  ! Output informational messages....
508  noisy = .true.
509  ! ....unless....
510  IF ( PRESENT(quiet) ) THEN
511  IF ( quiet == set ) noisy = .false.
512  END IF
513  IF ( noisy .AND. PRESENT(process_id) .AND. PRESENT(output_process_id) ) THEN
514  IF ( process_id /= output_process_id ) noisy = .false.
515  END IF
516 
517  ! Create a process ID message tag for
518  ! WARNING and FAILURE messages
519  IF ( PRESENT(process_id) ) THEN
520  WRITE( process_id_tag,'("; MPI Process ID: ",i0)' ) process_id
521  ELSE
522  process_id_tag = ' '
523  END IF
524 
525  ! Open the ODAS file
526  ! ------------------
527  error_status = open_binary_file( filename, fileid )
528  IF ( error_status /= success ) THEN
529  message = 'Error opening '//trim(filename)
530  error_status = failure
531  RETURN
532  END IF
533 
534  ! Read data and put them in ODAS
535  ! --------------------------------------------
536  error_status = read_odas_data( filename , &
537  fileid , &
538  odas , &
539  process_id_tag , &
540  message_log = message_log )
541  IF ( error_status /= success ) THEN
542  message = 'Error reading data from '//trim(filename)
543  error_status = failure
544  RETURN
545  END IF
546 
547  ! Close the file
548  ! --------------
549  CLOSE( fileid, iostat=io_status )
550  IF ( io_status /= 0 ) THEN
551  WRITE( message,'("Error closing ",a," after read. IOSTAT = ",i0)' ) &
552  trim(filename), io_status
553  CALL display_message( routine_name, &
554  trim(message)//trim(process_id_tag), &
555  warning, &
556  message_log=message_log )
557  END IF
558 
559  ! Output an info message
560  ! ----------------------
561  IF ( noisy ) THEN
562  CALL info_odas( odas, message )
563  CALL display_message( routine_name, &
564  'FILE: '//trim(filename)//'; '//trim(message), &
565  information, &
566  message_log = message_log )
567  END IF
568 
569 
570  END FUNCTION read_odas_binary
571 
572  FUNCTION read_odas_data( Filename , &
573  FileID , &
574  ODAS , &
575  Process_ID_Tag , &
576  Message_Log ) &
577  result( error_status )
578 
579  ! Arguments
580  CHARACTER(*) , INTENT(IN) :: filename
581  INTEGER , INTENT(IN) :: fileid
582  TYPE(odas_type) , INTENT(IN OUT) :: odas
583  CHARACTER(*) , INTENT(IN) :: process_id_tag
584  CHARACTER(*), OPTIONAL, INTENT(IN) :: message_log
585  ! Function result
586  INTEGER :: error_status
587  ! Function parameters
588  CHARACTER(*), PARAMETER :: routine_name = 'Read_ODAS_Data'
589  ! Function variables
590  CHARACTER(ML) :: message
591  INTEGER :: io_status
592  INTEGER(Long) :: version
593  INTEGER(Long) :: algorithm
594  INTEGER(Long) :: n_predictors
595  INTEGER(Long) :: n_absorbers
596  INTEGER(Long) :: n_channels
597  INTEGER(Long) :: n_alphas
598  INTEGER(Long) :: n_coeffs
599 
600  ! Read the Release and Version information
601  ! ----------------------------------------
602  READ( fileid, iostat=io_status ) odas%Release, version
603  IF ( io_status /= 0 ) THEN
604  WRITE( message,'("Error reading Release/Version values from ",a,&
605  &". IOSTAT = ",i0)' ) &
606  trim(filename), io_status
607  CALL read_cleanup(); RETURN
608  END IF
609 
610  ! Check the release
611  error_status = checkrelease_odas( odas,message_log=message_log )
612  IF ( error_status /= success ) THEN
613  message = 'ODAS Release check failed for '//trim(filename)
614  CALL read_cleanup(); RETURN
615  END IF
616 
617  ! Read the Alorithm ID
618  ! --------------------
619  READ( fileid, iostat=io_status ) algorithm
620  IF ( io_status /= 0 ) THEN
621  WRITE( message,'("Error reading Algorithm ID from ",a,&
622  &". IOSTAT = ",i0)' ) &
623  trim(filename), io_status
624  CALL read_cleanup(); RETURN
625  END IF
626 
627  ! Check the algorithm id
628  error_status = checkalgorithm_odas( odas,message_log=message_log )
629  IF ( error_status /= success ) THEN
630  message = 'ODAS Algorithm check failed for '//trim(filename)
631  CALL read_cleanup(); RETURN
632  END IF
633 
634 
635  ! Read the data dimensions
636  ! ------------------------
637  READ( fileid, iostat=io_status ) n_predictors, &
638  n_absorbers , &
639  n_channels , &
640  n_alphas , &
641  n_coeffs
642  IF ( io_status /= 0 ) THEN
643  WRITE( message,'("Error reading dimension values from ",a,&
644  &". IOSTAT = ",i0)' ) &
645  trim(filename), io_status
646  CALL read_cleanup(); RETURN
647  END IF
648 
649 
650  ! Allocate the output structure
651  ! -----------------------------
652  error_status = allocate_odas( n_predictors, &
653  n_absorbers , &
654  n_channels , &
655  n_alphas , &
656  n_coeffs , &
657  odas , &
658  message_log=message_log)
659  IF ( error_status /= success ) THEN
660  message = 'ODAS allocation failed'
661  CALL read_cleanup(); RETURN
662  END IF
663 
664  ! Assign the version number (which may be different)
665  odas%Version = version
666 
667 
668  ! Read the sensor info
669  ! --------------------
670  READ( fileid, iostat=io_status ) odas%Sensor_Id , &
671  odas%WMO_Satellite_Id, &
672  odas%WMO_Sensor_Id , &
673  odas%Sensor_Type
674  IF ( io_status /= 0 ) THEN
675  WRITE( message,'("Error reading sensor information from ",a,&
676  &". IOSTAT = ",i0)' ) &
677  trim(filename), io_status
678  CALL read_cleanup(); RETURN
679  END IF
680 
681 
682  ! Read the sensor channel numbers
683  ! -------------------------------
684  READ( fileid, iostat=io_status ) odas%Sensor_Channel
685  IF ( io_status /= 0 ) THEN
686  WRITE( message,'("Error reading sensor channel data from ",a,&
687  &". IOSTAT = ",i0)' ) &
688  trim(filename), io_status
689  CALL read_cleanup(); RETURN
690  END IF
691 
692 
693  ! Read the max order, absorber ID and absorber space values
694  ! ----------------------------------------------
695  READ( fileid, iostat=io_status ) odas%Absorber_ID, &
696  odas%Max_Order, &
697  odas%Alpha
698  IF ( io_status /= 0 ) THEN
699  WRITE( message,'("Error reading absorber information from ",a,&
700  &". IOSTAT = ",i0)' ) &
701  trim(filename), io_status
702  CALL read_cleanup(); RETURN
703  END IF
704 
705 
706  ! Read the polynomial order, predictor index and position index arrays
707  ! --------------------------------------------------------------------
708  READ( fileid, iostat=io_status ) odas%Order, &
709  odas%Pre_Index, &
710  odas%Pos_Index
711  IF ( io_status /= 0 ) THEN
712  WRITE( message,'("Error reading order and index arrays from ",a,&
713  &". IOSTAT = ",i0)' ) &
714  trim(filename), io_status
715  CALL read_cleanup(); RETURN
716  END IF
717 
718 
719  ! Read the regression coefficients
720  ! --------------------------------
721  READ( fileid, iostat=io_status ) odas%C
722  IF ( io_status /= 0 ) THEN
723  WRITE( message,'("Error reading regression coefficients from ",a,&
724  &". IOSTAT = ",i0)' ) &
725  trim(filename), io_status
726  CALL read_cleanup(); RETURN
727  END IF
728 
729  CONTAINS
730 
731  SUBROUTINE read_cleanup()
732  CHARACTER(ML) :: Close_Message
733  INTEGER :: Destroy_Status
734  ! Close file if necessary
735  IF ( file_exists( filename ) ) THEN
736  IF ( file_open( filename ) ) THEN
737  CLOSE( fileid, iostat=io_status )
738  IF ( io_status /= 0 ) THEN
739  WRITE( close_message,'("; Error closing ",a," during error cleanup. IOSTAT=",i0)') &
740  trim(filename), io_status
741  message = trim(message)//trim(close_message)
742  END IF
743  END IF
744  END IF
745  ! Destroy the structure
746  destroy_status = destroy_odas( odas, message_log=message_log )
747  IF ( destroy_status /= success ) &
748  message = trim(message)//'; Error destroying ODAS structure during error cleanup.'
749  ! Set error status and print error message
750  error_status = failure
751  CALL display_message( routine_name, &
752  trim(message)//trim(process_id_tag), &
753  error_status, &
754  message_log=message_log )
755  END SUBROUTINE read_cleanup
756 
757  END FUNCTION read_odas_data
758 
759 
760 !--------------------------------------------------------------------------------
761 !
762 ! NAME:
763 ! Write_ODAS_Binary
764 !
765 ! PURPOSE:
766 ! Function to write an ODAS structure to a Binary format file.
767 !
768 ! CALLING SEQUENCE:
769 ! Error_Status = Write_ODAS_Binary( Filename , & ! Input
770 ! ODAS , & ! Input
771 ! Quiet = Quiet , & ! Optional input
772 ! RCS_Id = RCS_Id , & ! Revision control
773 ! Message_Log = Message_Log ) ! Error messaging
774 !
775 ! INPUT ARGUMENTS:
776 ! Filename: Character string specifying the name of an output
777 ! ODAS format data file.
778 ! UNITS: N/A
779 ! TYPE: CHARACTER(*)
780 ! DIMENSION: Scalar
781 ! ATTRIBUTES: INTENT(IN)
782 !
783 ! ODAS: Structure containing the gas absorption coefficient
784 ! data to write to the file.
785 ! UNITS: N/A
786 ! TYPE: ODAS_type
787 ! DIMENSION: Scalar
788 ! ATTRIBUTES: INTENT(IN)
789 !
790 ! OPTIONAL INPUT ARGUMENTS:
791 ! Quiet: Set this keyword to suppress information Messages being
792 ! printed to standard output (or the Message log file if
793 ! the Message_Log optional argument is used.) By default,
794 ! information Messages are printed.
795 ! If QUIET = 0, information Messages are OUTPUT.
796 ! QUIET = 1, information Messages are SUPPRESSED.
797 ! UNITS: N/A
798 ! TYPE: INTEGER
799 ! DIMENSION: Scalar
800 ! ATTRIBUTES: INTENT(IN), OPTIONAL
801 !
802 ! Message_Log: Character string specifying a filename in which any
803 ! Messages will be logged. If not specified, or if an
804 ! error occurs opening the log file, the default action
805 ! is to output Messages to standard output.
806 ! UNITS: N/A
807 ! TYPE: CHARACTER(*)
808 ! DIMENSION: Scalar
809 ! ATTRIBUTES: INTENT(IN), OPTIONAL
810 !
811 ! OPTIONAL OUTPUT ARGUMENTS:
812 ! RCS_Id: Character string containing the Revision Control
813 ! System Id field for the module.
814 ! UNITS: N/A
815 ! TYPE: CHARACTER(*)
816 ! DIMENSION: Scalar
817 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
818 !
819 ! FUNCTION RESULT:
820 ! Error_Status: The return value is an integer defining the error status.
821 ! The error codes are defined in the Message_Handler module.
822 ! If == SUCCESS the Binary file write was successful
823 ! == FAILURE - the input ODAS structure contains
824 ! unassociated pointer members, or
825 ! - a unrecoverable write error occurred.
826 ! UNITS: N/A
827 ! TYPE: INTEGER
828 ! DIMENSION: Scalar
829 !
830 ! SIDE EFFECTS:
831 ! - If the output file already exists, it is overwritten.
832 ! - If an error occurs, the output file is deleted.
833 !
834 !--------------------------------------------------------------------------------
835 
836  FUNCTION write_odas_binary( Filename , & ! Input
837  ODAS , & ! Input
838  Quiet , & ! Optional input
839  RCS_Id , & ! Revision control
840  Message_Log) & ! Error messaging
841  result( error_status )
842  ! Arguments
843  CHARACTER(*) , INTENT(IN) :: filename
844  TYPE(odas_type) , INTENT(IN) :: odas
845  INTEGER , OPTIONAL, INTENT(IN) :: quiet
846  CHARACTER(*), OPTIONAL, INTENT(OUT) :: rcs_id
847  CHARACTER(*), OPTIONAL, INTENT(IN) :: message_log
848  ! Function result
849  INTEGER :: error_status
850  ! Function parameters
851  CHARACTER(*), PARAMETER :: routine_name = 'Write_ODAS_Binary'
852  ! Function variables
853  CHARACTER(ML) :: message
854  LOGICAL :: noisy
855  INTEGER :: io_status
856  INTEGER :: fileid
857 
858  ! Set up
859  ! ------
860  error_status = success
861  IF ( PRESENT( rcs_id ) ) rcs_id = module_rcs_id
862 
863  ! Open the ODAS data file
864  ! -----------------------
865  error_status = open_binary_file( filename, fileid, for_output = .true. )
866  IF ( error_status /= success ) THEN
867  message = 'Error opening '//trim( filename )
868  error_status = failure
869  RETURN
870  END IF
871 
872  ! Output informational messages....
873  noisy = .true.
874  ! ....unless the QUIET keyword is set.
875  IF ( PRESENT( quiet ) ) THEN
876  IF ( quiet == 1 ) noisy = .false.
877  END IF
878 
879  error_status = write_odas_data( filename, &
880  fileid, &
881  odas, &
882  message_log=message_log )
883 
884  IF ( error_status /= success ) THEN
885  message = 'Error writing data to '//trim( filename )
886  error_status = failure
887  RETURN
888  END IF
889 
890 
891  ! Close the file
892  ! --------------
893  CLOSE( fileid, iostat=io_status )
894  IF ( io_status /= 0 ) THEN
895  WRITE( message,'("Error closing ",a," after write. IOSTAT = ",i0)' ) &
896  trim(filename), io_status
897  CALL display_message( routine_name, &
898  trim(message), &
899  warning, &
900  message_log=message_log )
901  END IF
902 
903 
904  ! Output an info message
905  ! ----------------------
906  IF ( noisy ) THEN
907  CALL info_odas( odas, message )
908  CALL display_message( routine_name, &
909  'FILE: '//trim(filename)//'; '//trim(message), &
910  information, &
911  message_log = message_log )
912  END IF
913 
914  END FUNCTION write_odas_binary
915 
916  FUNCTION write_odas_data( Filename , &
917  FileID , &
918  ODAS , &
919  Message_Log) &
920  result( error_status )
921 
922  CHARACTER(*) , INTENT(IN) :: filename
923  INTEGER , INTENT(IN) :: fileid
924  TYPE(odas_type) , INTENT(IN) :: odas
925  CHARACTER(*), OPTIONAL, INTENT(IN) :: message_log
926  CHARACTER(*), PARAMETER :: routine_name = 'Write_ODAS_Data'
927  ! Function result
928  INTEGER :: error_status
929  ! Function variables
930  CHARACTER(ML) :: message
931  INTEGER :: io_status
932 
933  ! Check structure association status
934  IF ( .NOT. associated_odas( odas ) ) THEN
935  message = 'Some or all INPUT ODAS pointer members are NOT associated.'
936  CALL write_cleanup(); RETURN
937  END IF
938 
939  ! Check the release
940  error_status = checkrelease_odas( odas, message_log=message_log)
941  IF ( error_status /= success ) THEN
942  message = 'ODAS structure Release check failed.'
943  CALL write_cleanup(); RETURN
944  END IF
945 
946  ! Check the algorithm id
947  error_status = checkalgorithm_odas( odas, message_log=message_log )
948  IF ( error_status /= success ) THEN
949  message = 'ODAS Algorithm check failed'
950  CALL write_cleanup(); RETURN
951  END IF
952 
953  ! Check the ODAS structure dimensions
954  IF ( odas%n_Predictors < 1 .OR. &
955  odas%n_Absorbers < 1 .OR. &
956  odas%n_Channels < 1 .OR. &
957  odas%n_Alphas < 1 .OR. &
958  odas%n_Coeffs < 1 ) THEN
959  message = 'One or more dimensions of ODAS structure are < or = 0.'
960  CALL write_cleanup(); RETURN
961  END IF
962 
963  ! Write the Release and Version information
964  ! -----------------------------------------
965  WRITE( fileid, iostat=io_status ) odas%Release, odas%Version
966  IF ( io_status /= 0 ) THEN
967  WRITE( message,'("Error writing Release/Version values to ",a,&
968  &". IOSTAT = ",i0)' ) &
969  trim(filename), io_status
970  CALL write_cleanup(); RETURN
971  END IF
972 
973 
974  ! Write the Alorithm ID
975  ! ---------------------
976  WRITE( fileid, iostat=io_status ) odas%Algorithm
977  IF ( io_status /= 0 ) THEN
978  WRITE( message,'("Error writing Algorithm ID to ",a,&
979  &". IOSTAT = ",i0)' ) &
980  trim(filename), io_status
981  CALL write_cleanup(); RETURN
982  END IF
983 
984 
985  ! Write the data dimensions
986  ! -------------------------
987  WRITE( fileid, iostat=io_status ) odas%n_Predictors, &
988  odas%n_Absorbers , &
989  odas%n_Channels , &
990  odas%n_Alphas , &
991  odas%n_Coeffs
992  IF ( io_status /= 0 ) THEN
993  WRITE( message,'("Error writing dimension values to ",a,&
994  &". IOSTAT = ",i0)' ) &
995  trim(filename), io_status
996  CALL write_cleanup(); RETURN
997  END IF
998 
999 
1000  ! Write the sensor info
1001  ! ---------------------
1002  WRITE( fileid, iostat=io_status ) odas%Sensor_Id , &
1003  odas%WMO_Satellite_Id, &
1004  odas%WMO_Sensor_Id , &
1005  odas%Sensor_Type
1006  IF ( io_status /= 0 ) THEN
1007  WRITE( message,'("Error writing sensor information to ",a,&
1008  &". IOSTAT = ",i0)' ) &
1009  trim(filename), io_status
1010  CALL write_cleanup(); RETURN
1011  END IF
1012 
1013 
1014  ! Write the sensor channel numbers
1015  ! --------------------------------
1016  WRITE( fileid, iostat=io_status ) odas%Sensor_Channel
1017  IF ( io_status /= 0 ) THEN
1018  WRITE( message,'("Error writing sensor channel data to ",a,&
1019  &". IOSTAT = ",i0)' ) &
1020  trim(filename), io_status
1021  CALL write_cleanup(); RETURN
1022  END IF
1023 
1024 
1025  ! Write the absorber ID and absorber space values
1026  ! -----------------------------------------------
1027  WRITE( fileid, iostat=io_status ) odas%Absorber_ID, &
1028  odas%Max_Order , &
1029  odas%Alpha
1030  IF ( io_status /= 0 ) THEN
1031  WRITE( message,'("Error writing absorber information to ",a,&
1032  &". IOSTAT = ",i0)' ) &
1033  trim(filename), io_status
1034  CALL write_cleanup(); RETURN
1035  END IF
1036 
1037 
1038  ! Write the polynomial order, predictor index and position index arrays
1039  ! ----------------------------------------------------------------------
1040  WRITE( fileid, iostat=io_status ) odas%Order , &
1041  odas%Pre_Index, &
1042  odas%Pos_Index
1043  IF ( io_status /= 0 ) THEN
1044  WRITE( message,'("Error writing order and index arrays to ",a,&
1045  &". IOSTAT = ",i0)' ) &
1046  trim(filename), io_status
1047  CALL write_cleanup(); RETURN
1048  END IF
1049 
1050 
1051  ! Write the regression coefficients
1052  ! ---------------------------------
1053  WRITE( fileid, iostat=io_status ) odas%C
1054  IF ( io_status /= 0 ) THEN
1055  WRITE( message,'("Error writing regression coefficients to ",a,&
1056  &". IOSTAT = ",i0)' ) &
1057  trim(filename), io_status
1058  CALL write_cleanup(); RETURN
1059  END IF
1060 
1061  CONTAINS
1062 
1063  SUBROUTINE write_cleanup()
1064  CHARACTER(ML) :: Close_Message
1065  ! Close file if necessary
1066  IF ( file_exists( filename ) ) THEN
1067  IF ( file_open( filename ) ) THEN
1068  CLOSE( fileid, iostat=io_status, status='DELETE' )
1069  IF ( io_status /= 0 ) THEN
1070  WRITE( close_message,'("; Error deleting ",a," during error cleanup. IOSTAT=",i0)') &
1071  trim(filename), io_status
1072  message = trim(message)//trim(close_message)
1073  END IF
1074  END IF
1075  END IF
1076  ! Set error status and print error message
1077  error_status = failure
1078  CALL display_message( routine_name, &
1079  trim(message), &
1080  error_status, &
1081  message_log=message_log )
1082  END SUBROUTINE write_cleanup
1083 
1084 
1085  END FUNCTION write_odas_data
1086 
1087 END MODULE odas_binary_io
message_handler::failure
integer, parameter, public failure
Definition: Message_Handler.f90:30
crtm_parameters::set
integer, parameter, public set
Definition: CRTM_Parameters.f90:113
odas_binary_io::inquire_odas_binary
integer function, public inquire_odas_binary(Filename, n_Predictors, n_Absorbers, n_Channels, n_Alphas, n_Coeffs, Release, Version, Sensor_Id, WMO_Satellite_Id, WMO_Sensor_Id, RCS_Id, Message_Log)
Definition: ODAS_Binary_IO.f90:211
message_handler::warning
integer, parameter, public warning
Definition: Message_Handler.f90:29
odas_binary_io::write_odas_binary
integer function, public write_odas_binary(Filename, ODAS, Quiet, RCS_Id, Message_Log)
Definition: ODAS_Binary_IO.f90:842
type_kinds::long
integer, parameter, public long
Definition: Type_Kinds.f90:76
odas_binary_io
Definition: ODAS_Binary_IO.f90:13
odas_binary_io::module_rcs_id
character(*), parameter module_rcs_id
Definition: ODAS_Binary_IO.f90:49
odas_binary_io::read_odas_data
integer function, public read_odas_data(Filename, FileID, ODAS, Process_ID_Tag, Message_Log)
Definition: ODAS_Binary_IO.f90:578
type_kinds::double
integer, parameter, public double
Definition: Type_Kinds.f90:106
inquire_cleanup
subroutine inquire_cleanup()
Definition: ACCoeff_Binary_IO.f90:249
odas_binary_io::write_odas_data
integer function, public write_odas_data(Filename, FileID, ODAS, Message_Log)
Definition: ODAS_Binary_IO.f90:921
message_handler
Definition: Message_Handler.f90:4
read_cleanup
subroutine read_cleanup()
Definition: ACCoeff_Binary_IO.f90:469
odas_define::odas_type
Definition: ODAS_Define.f90:109
binary_file_utility
Definition: Binary_File_Utility.f90:13
write_cleanup
subroutine write_cleanup()
Definition: ACCoeff_Binary_IO.f90:670
odas_binary_io::ml
integer, parameter ml
Definition: ODAS_Binary_IO.f90:52
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
odas_define::destroy_odas
integer function, public destroy_odas(ODAS, No_Clear, RCS_Id, Message_Log)
Definition: ODAS_Define.f90:340
file_utility::file_open
Definition: File_Utility.f90:56
file_utility::file_exists
Definition: File_Utility.f90:51
odas_define::associated_odas
logical function, public associated_odas(ODAS, ANY_Test)
Definition: ODAS_Define.f90:227
odas_define::info_odas
subroutine, public info_odas(ODAS, Info, RCS_Id)
Definition: ODAS_Define.f90:1401
odas_define::allocate_odas
integer function, public allocate_odas(n_Predictors, n_Absorbers, n_Channels, n_Alphas, n_Coeffs, ODAS, RCS_Id, Message_Log)
Definition: ODAS_Define.f90:528
type_kinds
Definition: Type_Kinds.f90:12
odas_define::checkalgorithm_odas
integer function, public checkalgorithm_odas(ODAS, RCS_Id, Message_Log)
Definition: ODAS_Define.f90:1329
min
#define min(a, b)
Definition: mosaic_util.h:32
odas_define::checkrelease_odas
integer function, public checkrelease_odas(ODAS, RCS_Id, Message_Log)
Definition: ODAS_Define.f90:1226
odas_define
Definition: ODAS_Define.f90:13
message_handler::success
integer, parameter, public success
Definition: Message_Handler.f90:27
odas_binary_io::read_odas_binary
integer function, public read_odas_binary(Filename, ODAS, Quiet, Process_ID, Output_Process_ID, RCS_Id, Message_Log)
Definition: ODAS_Binary_IO.f90:476
file_utility
Definition: File_Utility.f90:26
message_handler::information
integer, parameter, public information
Definition: Message_Handler.f90:28