FV3 Bundle
ODSSU_Binary_IO.f90
Go to the documentation of this file.
1 !
2 ! ODSSU_Binary_IO
3 !
4 ! Module containing routines to read and write Binary format
5 ! ODSSU files.
6 !
7 !
8 ! CREATION HISTORY:
9 ! Written by: Yong Han, NOAA/NESDIS, Oct. 6, 2009
10 !
11 ! Yong Chen, NOAA/NESDIS, 06-Nov-2009
12 ! yong.chen@noaa.gov
13 !
14 
15 MODULE odssu_binary_io
16 
17  ! ------------------
18  ! Environment set up
19  ! ------------------
20  ! Module use
21  USE type_kinds , ONLY: long, double
22  USE message_handler , ONLY: success, failure, warning, information, display_message
23  USE file_utility , ONLY: file_open, file_exists
24  USE binary_file_utility, ONLY: open_binary_file
25  USE odssu_define , ONLY: odssu_type , &
26  allocate_odssu , &
27  destroy_odssu , &
28  checkrelease_odssu , &
29  checkalgorithm_odssu, &
30  info_odssu, odas_algorithm, odps_algorithm
31 
32  USE odas_binary_io , ONLY: read_odas_data, &
33  write_odas_data
34 
35  USE odps_binary_io , ONLY: read_odps_data, &
36  write_odps_data
37 
38  ! Disable implicit typing
39  IMPLICIT NONE
40 
41 
42  ! ------------
43  ! Visibilities
44  ! ------------
45  ! Everything private by default
46  PRIVATE
47  ! Structure procedures
48  PUBLIC :: read_odssu_binary
49  PUBLIC :: write_odssu_binary
50 
51  ! -----------------
52  ! Module parameters
53  ! -----------------
54  CHARACTER(*), PARAMETER :: module_rcs_id = &
55  '$Id: ODSSU_Binary_IO.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
56  ! Keyword set value
57  INTEGER, PARAMETER :: set = 1
58  ! Message character length
59  INTEGER, PARAMETER :: ml = 512
60 
61 CONTAINS
62 
63 !--------------------------------------------------------------------------------
64 !
65 ! NAME:
66 ! Read_ODSSU_Binary
67 !
68 ! PURPOSE:
69 ! Function to read data into an ODSSU structure from a Binary format file.
70 !
71 ! CALLING SEQUENCE:
72 ! Error_Status = Read_ODSSU_Binary(Filename , & ! Input
73 ! ODSSU , & ! Output
74 ! Quiet = Quiet , & ! Optional input
75 ! Process_ID = Process_ID , & ! Optional input
76 ! Output_Process_ID = Output_Process_ID, & ! Optional input
77 ! RCS_Id = RCS_Id , & ! Revision control
78 ! Message_Log = Message_Log ) ! Error messaging
79 !
80 ! INPUT ARGUMENTS:
81 ! Filename: Character string specifying the name of the binary
82 ! format ODSSU data file to read.
83 ! UNITS: N/A
84 ! TYPE: CHARACTER(*)
85 ! DIMENSION: Scalar
86 ! ATTRIBUTES: INTENT(IN)
87 !
88 ! OUTPUT ARGUMENTS:
89 ! ODSSU: Structure containing the gas absorption coefficient
90 ! data read from the file.
91 ! UNITS: N/A
92 ! TYPE: ODSSU_type
93 ! DIMENSION: Scalar
94 ! ATTRIBUTES: INTENT(IN OUT)
95 !
96 ! OPTIONAL INPUT ARGUMENTS:
97 ! Quiet: Set this argument to suppress INFORMATION messages
98 ! being printed to standard output (or the message
99 ! log file if the Message_Log optional argument is
100 ! used.) By default, INFORMATION messages are printed.
101 ! If QUIET = 0, INFORMATION messages are OUTPUT.
102 ! QUIET = 1, INFORMATION messages are SUPPRESSED.
103 ! UNITS: N/A
104 ! TYPE: INTEGER
105 ! DIMENSION: Scalar
106 ! ATTRIBUTES: INTENT(IN), OPTIONAL
107 !
108 ! Process_ID: Set this argument to the MPI process ID that this
109 ! function call is running under. This value is used
110 ! solely for controlling INFORMATIOn message output.
111 ! If MPI is not being used, ignore this argument.
112 ! This argument is ignored if the Quiet argument is set.
113 ! UNITS: N/A
114 ! TYPE: INTEGER
115 ! DIMENSION: Scalar
116 ! ATTRIBUTES: INTENT(IN), OPTIONAL
117 !
118 ! Output_Process_ID: Set this argument to the MPI process ID, specified
119 ! via the Process_ID argument, in which all INFORMATION
120 ! messages are to be output. If the passed Process_ID
121 ! value agrees with this value the INFORMATION messages
122 ! are output. If MPI is not being used, ignore this
123 ! argument.
124 ! This argument is ignored if:
125 ! - the optional Process_ID argument is not present.
126 ! - the optional Quiet argument is set.
127 ! UNITS: N/A
128 ! TYPE: INTEGER
129 ! DIMENSION: Scalar
130 ! ATTRIBUTES: INTENT(IN), OPTIONAL
131 !
132 ! Message_Log: Character string specifying a filename in which any
133 ! Messages will be logged. If not specified, or if an
134 ! error occurs opening the log file, the default action
135 ! is to output Messages to standard output.
136 ! UNITS: N/A
137 ! TYPE: CHARACTER(*)
138 ! DIMENSION: Scalar
139 ! ATTRIBUTES: INTENT(IN), OPTIONAL
140 !
141 ! OPTIONAL OUTPUT ARGUMENTS:
142 ! RCS_Id: Character string containing the Revision Control
143 ! System Id field for the module.
144 ! UNITS: N/A
145 ! TYPE: CHARACTER(*)
146 ! DIMENSION: Scalar
147 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
148 !
149 ! FUNCTION RESULT:
150 ! Error_Status: The return value is an integer defining the error status.
151 ! The error codes are defined in the Message_Handler module.
152 ! If == SUCCESS the Binary file read was successful
153 ! == FAILURE an unrecoverable read error occurred.
154 ! UNITS: N/A
155 ! TYPE: INTEGER
156 ! DIMENSION: Scalar
157 !
158 ! SIDE EFFECTS:
159 ! If the ODSSU argument is defined upon input, it is redefined (or
160 ! reinitialised) at output.
161 !
162 ! COMMENTS:
163 ! Note the INTENT on the output ODSSU argument is IN OUT rather than
164 ! just OUT. This is necessary because the argument may be defined upon
165 ! input. To prevent memory leaks, the IN OUT INTENT is a must.
166 !
167 !------------------------------------------------------------------------------
168 
169  FUNCTION read_odssu_binary(Filename , & ! Input
170  ODSSU , & ! Output
171  Quiet , & ! Optional input
172  Process_ID , & ! Optional input
173  Output_Process_ID, & ! Optional input
174  RCS_Id , & ! Revision control
175  Message_Log ) & ! Error messaging
176  result( error_status )
177  ! Arguments
178  CHARACTER(*) , INTENT(IN) :: filename
179  TYPE(odssu_type) , INTENT(IN OUT) :: odssu
180  INTEGER , OPTIONAL, INTENT(IN) :: quiet
181  INTEGER , OPTIONAL, INTENT(IN) :: process_id
182  INTEGER , OPTIONAL, INTENT(IN) :: output_process_id
183  CHARACTER(*), OPTIONAL, INTENT(OUT) :: rcs_id
184  CHARACTER(*), OPTIONAL, INTENT(IN) :: message_log
185  ! Function result
186  INTEGER :: error_status
187  ! Function parameters
188  CHARACTER(*), PARAMETER :: routine_name = 'Read_ODSSU_Binary'
189  ! Function variables
190  CHARACTER(ML) :: message
191  CHARACTER(ML) :: process_id_tag
192  LOGICAL :: noisy
193  INTEGER :: io_status
194  INTEGER :: fileid
195  INTEGER(Long) :: version
196  INTEGER(Long) :: algorithm
197  INTEGER(Long) :: n_absorbers
198  INTEGER(Long) :: n_channels
199  INTEGER(Long) :: n_tc_cellpressures
200  INTEGER(Long) :: n_ref_cellpressures
201  INTEGER :: i
202 
203  ! Set up
204  ! ------
205  error_status = success
206  IF ( PRESENT( rcs_id ) ) rcs_id = module_rcs_id
207 
208  ! Check that the file is present
209  IF ( .NOT. file_exists( trim(filename) ) ) THEN
210  message = 'File '//trim(filename)//' not found.'
211  error_status = failure
212  RETURN
213  END IF
214 
215  ! Output informational messages....
216  noisy = .true.
217  IF ( PRESENT(quiet) ) THEN
218  ! ....unless the QUIET keyword is set
219  IF ( quiet == set ) noisy = .false.
220  ELSE
221  ! ....or the Process_ID is not selected for output
222  IF ( PRESENT(process_id) .AND. PRESENT(output_process_id) ) THEN
223  IF ( process_id /= output_process_id ) noisy = .false.
224  END IF
225  END IF
226 
227  ! Create a process ID message tag for
228  ! WARNING and FAILURE messages
229  IF ( PRESENT(process_id) ) THEN
230  WRITE( process_id_tag,'("; MPI Process ID: ",i0)' ) process_id
231  ELSE
232  process_id_tag = ' '
233  END IF
234 
235  ! Open the ODSSU file
236  ! ------------------
237  error_status = open_binary_file( filename, fileid )
238  IF ( error_status /= success ) THEN
239  message = 'Error opening '//trim(filename)
240  error_status = failure
241  RETURN
242  END IF
243 
244  ! Read the Release and Version information
245  ! ----------------------------------------
246  READ( fileid, iostat=io_status ) odssu%Release, version
247  IF ( io_status /= 0 ) THEN
248  WRITE( message,'("Error reading Release/Version values from ",a,&
249  &". IOSTAT = ",i0)' ) &
250  trim(filename), io_status
251  CALL read_cleanup(); RETURN
252  END IF
253 
254  ! Check the release
255  error_status = checkrelease_odssu( odssu,message_log=message_log )
256  IF ( error_status /= success ) THEN
257  message = 'ODSSU Release check failed for '//trim(filename)
258  CALL read_cleanup(); RETURN
259  END IF
260 
261  ! Read the Alorithm ID
262  ! --------------------
263  READ( fileid, iostat=io_status ) algorithm
264  IF ( io_status /= 0 ) THEN
265  WRITE( message,'("Error reading Algorithm ID from ",a,&
266  &". IOSTAT = ",i0)' ) &
267  trim(filename), io_status
268  CALL read_cleanup(); RETURN
269  END IF
270 
271  ! Check the algorithm id
272  error_status = checkalgorithm_odssu( odssu,message_log=message_log )
273  IF ( error_status /= success ) THEN
274  message = 'ODSSU Algorithm check failed for '//trim(filename)
275  CALL read_cleanup(); RETURN
276  END IF
277 
278  ! Read the subAlorithm ID
279  ! --------------------
280  READ( fileid, iostat=io_status ) odssu%subAlgorithm
281  IF ( io_status /= 0 ) THEN
282  WRITE( message,'("Error reading subAlgorithm ID from ",a,&
283  &". IOSTAT = ",i0)' ) &
284  trim(filename), io_status
285  CALL read_cleanup(); RETURN
286  END IF
287 
288  !--------------------------------------------
289  ! Allocate memory and read data
290  !--------------------------------------------
291 
292  ! Read the call pressure array dimensions
293  READ( fileid, iostat=io_status ) n_channels , &
294  n_absorbers , &
295  n_tc_cellpressures , &
296  n_ref_cellpressures
297  IF ( io_status /= 0 ) THEN
298  WRITE( message,'("Error reading dimension values from ",a,&
299  &". IOSTAT = ",i0)' ) &
300  trim(filename), io_status
301  CALL read_cleanup(); RETURN
302  END IF
303 
304  IF( n_channels < 1 .OR. n_tc_cellpressures < 1 .OR. n_ref_cellpressures < 1 )THEN
305  message = 'One or more dimensions of the cell pressure arrays are < or = 0.'
306  CALL read_cleanup(); RETURN
307  END IF
308 
309  error_status = allocate_odssu(n_absorbers , &
310  n_channels , &
311  n_tc_cellpressures , &
312  n_ref_cellpressures, &
313  odssu , &
314  message_log = message_log)
315  IF ( error_status /= success ) THEN
316  message = 'Error allocating memory for the ODSSU structure '
317  CALL read_cleanup(); RETURN
318  RETURN
319  END IF
320 
321  ! Read the cell pressuresa and time data
322  ! ----------------------------------------------
323  READ( fileid, iostat=io_status ) odssu%TC_CellPressure, &
324  odssu%Ref_Time, &
325  odssu%Ref_CellPressure
326  IF ( io_status /= 0 ) THEN
327  WRITE( message,'("Error reading cell pressure and time data from ",a,&
328  &". IOSTAT = ",i0)' ) &
329  trim(filename), io_status
330  CALL read_cleanup(); RETURN
331  END IF
332 
333  ! Read coefficient data and put them into the ODx structure
334  IF(odssu%subAlgorithm == odas_algorithm) THEN
335 
336  DO i = 1, n_tc_cellpressures
337 
338  error_status = read_odas_data( filename , &
339  fileid , &
340  odssu%ODAS(i) , &
341  process_id_tag , &
342  message_log = message_log)
343  IF ( error_status /= success ) THEN
344  message = 'Error reading data from '//trim(filename)
345  CALL read_cleanup(); RETURN
346  RETURN
347  END IF
348 
349  END DO
350 
351  ! assign values taken from an ODx to ODSSU
352  odssu%Sensor_Channel = odssu%ODAS(1)%Sensor_Channel
353  odssu%Absorber_ID = odssu%ODAS(1)%Absorber_ID
354  odssu%Sensor_Id = odssu%ODAS(1)%Sensor_Id
355  odssu%WMO_Satellite_ID = odssu%ODAS(1)%WMO_Satellite_ID
356  odssu%WMO_Sensor_ID = odssu%ODAS(1)%WMO_Sensor_ID
357  odssu%Sensor_Type = odssu%ODAS(1)%Sensor_Type
358 
359  ENDIF
360 
361  IF(odssu%subAlgorithm == odps_algorithm) THEN
362 
363  DO i = 1, n_tc_cellpressures
364 
365  error_status = read_odps_data( filename , &
366  fileid , &
367  odssu%ODPS(i) , &
368  process_id_tag , &
369  message_log = message_log)
370  IF ( error_status /= success ) THEN
371  message = 'Error reading data from '//trim(filename)
372  CALL read_cleanup(); RETURN
373  RETURN
374  END IF
375 
376  END DO
377  ! assign values taken from an ODx to ODSSU
378  odssu%Sensor_Channel = odssu%ODPS(1)%Sensor_Channel
379  odssu%Absorber_ID = odssu%ODPS(1)%Absorber_ID
380  odssu%Sensor_Id = odssu%ODPS(1)%Sensor_Id
381  odssu%WMO_Satellite_ID = odssu%ODPS(1)%WMO_Satellite_ID
382  odssu%WMO_Sensor_ID = odssu%ODPS(1)%WMO_Sensor_ID
383  odssu%Sensor_Type = odssu%ODPS(1)%Sensor_Type
384 
385  ENDIF
386 
387 
388  ! Close the file
389  ! --------------
390  CLOSE( fileid, iostat=io_status )
391  IF ( io_status /= 0 ) THEN
392 
393  WRITE( message,'("Error closing ",a," after read. IOSTAT = ",i0)' ) &
394  trim(filename), io_status
395  CALL display_message( routine_name, &
396  trim(message)//trim(process_id_tag), &
397  warning, &
398  message_log=message_log )
399  END IF
400 
401  ! Output an info message
402  ! ----------------------
403  IF ( noisy ) THEN
404  CALL info_odssu( odssu, message )
405  CALL display_message( routine_name, &
406  'FILE: '//trim(filename)//'; '//trim(message), &
407  information, &
408  message_log = message_log )
409  END IF
410 
411  CONTAINS
412 
413  SUBROUTINE read_cleanup()
414  CHARACTER(ML) :: Close_Message
415  INTEGER :: Destroy_Status
416  ! Close file if necessary
417  IF ( file_exists( filename ) ) THEN
418  IF ( file_open( filename ) ) THEN
419  CLOSE( fileid, iostat=io_status )
420  IF ( io_status /= 0 ) THEN
421  WRITE( close_message,'("; Error closing ",a," during error cleanup. IOSTAT=",i0)') &
422  trim(filename), io_status
423  message = trim(message)//trim(close_message)
424  END IF
425  END IF
426  END IF
427  ! Destroy the structure
428  destroy_status = destroy_odssu( odssu, message_log=message_log )
429  IF ( destroy_status /= success ) &
430  message = trim(message)//'; Error destroying ODSSU structure during error cleanup.'
431  ! Set error status and print error message
432  error_status = failure
433  CALL display_message( routine_name, &
434  trim(message)//trim(process_id_tag), &
435  error_status, &
436  message_log=message_log )
437  END SUBROUTINE read_cleanup
438 
439  END FUNCTION read_odssu_binary
440 
441 !--------------------------------------------------------------------------------
442 !
443 ! NAME:
444 ! Write_ODSSU_Binary
445 !
446 ! PURPOSE:
447 ! Function to write an ODSSU structure to a Binary format file.
448 !
449 ! CALLING SEQUENCE:
450 ! Error_Status = Write_ODSSU_Binary(Filename , & ! Input
451 ! ODSSU , & ! Input
452 ! Quiet = Quiet , & ! Optional input
453 ! RCS_Id = RCS_Id , & ! Revision control
454 ! Message_Log = Message_Log ) ! Error messaging
455 !
456 ! INPUT ARGUMENTS:
457 ! Filename: Character string specifying the name of an output
458 ! ODSSU format data file.
459 ! UNITS: N/A
460 ! TYPE: CHARACTER(*)
461 ! DIMENSION: Scalar
462 ! ATTRIBUTES: INTENT(IN)
463 !
464 ! ODSSU: Structure containing the gas absorption coefficient
465 ! data to write to the file.
466 ! UNITS: N/A
467 ! TYPE: ODSSU_type
468 ! DIMENSION: Scalar
469 ! ATTRIBUTES: INTENT(IN)
470 !
471 ! OPTIONAL INPUT ARGUMENTS:
472 ! Quiet: Set this keyword to suppress information Messages being
473 ! printed to standard output (or the Message log file if
474 ! the Message_Log optional argument is used.) By default,
475 ! information Messages are printed.
476 ! If QUIET = 0, information Messages are OUTPUT.
477 ! QUIET = 1, information Messages are SUPPRESSED.
478 ! UNITS: N/A
479 ! TYPE: INTEGER
480 ! DIMENSION: Scalar
481 ! ATTRIBUTES: INTENT(IN), OPTIONAL
482 !
483 ! Message_Log: Character string specifying a filename in which any
484 ! Messages will be logged. If not specified, or if an
485 ! error occurs opening the log file, the default action
486 ! is to output Messages to standard output.
487 ! UNITS: N/A
488 ! TYPE: CHARACTER(*)
489 ! DIMENSION: Scalar
490 ! ATTRIBUTES: INTENT(IN), OPTIONAL
491 !
492 ! OPTIONAL OUTPUT ARGUMENTS:
493 ! RCS_Id: Character string containing the Revision Control
494 ! System Id field for the module.
495 ! UNITS: N/A
496 ! TYPE: CHARACTER(*)
497 ! DIMENSION: Scalar
498 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
499 !
500 ! FUNCTION RESULT:
501 ! Error_Status: The return value is an integer defining the error status.
502 ! The error codes are defined in the Message_Handler module.
503 ! If == SUCCESS the Binary file write was successful
504 ! == FAILURE - the input ODSSU structure contains
505 ! unassociated pointer members, or
506 ! - a unrecoverable write error occurred.
507 ! UNITS: N/A
508 ! TYPE: INTEGER
509 ! DIMENSION: Scalar
510 !
511 ! SIDE EFFECTS:
512 ! - If the output file already exists, it is overwritten.
513 ! - If an error occurs, the output file is deleted.
514 !
515 !--------------------------------------------------------------------------------
516 
517  FUNCTION write_odssu_binary( Filename , &
518  ODSSU , &
519  Quiet , &
520  RCS_Id , &
521  Message_Log) &
522  result( error_status )
523  ! Arguments
524  CHARACTER(*) , INTENT(IN) :: filename
525  TYPE(odssu_type) , INTENT(IN) :: odssu
526  INTEGER , OPTIONAL, INTENT(IN) :: quiet
527  CHARACTER(*), OPTIONAL, INTENT(OUT) :: rcs_id
528  CHARACTER(*), OPTIONAL, INTENT(IN) :: message_log
529  ! Function result
530  INTEGER :: error_status
531  ! Function parameters
532  CHARACTER(*), PARAMETER :: routine_name = 'Write_ODSSU_Binary'
533  ! Function variables
534  CHARACTER(ML) :: message
535  LOGICAL :: noisy
536  INTEGER :: io_status
537  INTEGER :: fileid
538  INTEGER :: i
539 
540  ! Set up
541  ! ------
542  error_status = success
543  IF ( PRESENT( rcs_id ) ) rcs_id = module_rcs_id
544 
545  !
546  IF( odssu%n_TC_CellPressures < 1 .OR. &
547  odssu%n_Ref_CellPressures < 1 .OR. &
548  odssu%n_Channels < 1 .OR. &
549  odssu%n_Absorbers < 1) THEN
550  message = 'One or more dimensions in ODSSU are < or = 0.'
551  CALL write_cleanup(); RETURN
552  END IF
553 
554  ! Open the ODSSU data file
555  ! -----------------------
556  error_status = open_binary_file( filename, fileid, for_output = .true. )
557  IF ( error_status /= success ) THEN
558  message = 'Error opening '//trim( filename )
559  error_status = failure
560  RETURN
561  END IF
562 
563  ! Output informational messages....
564  noisy = .true.
565  ! ....unless the QUIET keyword is set.
566  IF ( PRESENT( quiet ) ) THEN
567  IF ( quiet == 1 ) noisy = .false.
568  END IF
569 
570  ! Write the Release and Version information
571  ! -----------------------------------------
572  WRITE( fileid, iostat=io_status ) odssu%Release, odssu%Version
573  IF ( io_status /= 0 ) THEN
574  WRITE( message,'("Error writing Release/Version values to ",a,&
575  &". IOSTAT = ",i0)' ) &
576  trim(filename), io_status
577  CALL write_cleanup(); RETURN
578  END IF
579 
580 
581  ! Write the Alorithm ID
582  ! ---------------------
583  WRITE( fileid, iostat=io_status ) odssu%Algorithm
584  IF ( io_status /= 0 ) THEN
585  WRITE( message,'("Error writing Algorithm ID to ",a,&
586  &". IOSTAT = ",i0)' ) &
587  trim(filename), io_status
588  CALL write_cleanup(); RETURN
589  END IF
590 
591  ! Write the subAlorithm ID
592  ! ---------------------
593  WRITE( fileid, iostat=io_status ) odssu%subAlgorithm
594  IF ( io_status /= 0 ) THEN
595  WRITE( message,'("Error writing Algorithm ID to ",a,&
596  &". IOSTAT = ",i0)' ) &
597  trim(filename), io_status
598  CALL write_cleanup(); RETURN
599  END IF
600 
601  ! Write the array dimensions
602  WRITE( fileid, iostat=io_status ) odssu%n_Channels , &
603  odssu%n_Absorbers , &
604  odssu%n_TC_CellPressures , &
605  odssu%n_Ref_CellPressures
606  IF ( io_status /= 0 ) THEN
607  WRITE( message,'("Error writing dimension values for ODSSU to ",a,&
608  &". IOSTAT = ",i0)' ) &
609  trim(filename), io_status
610  CALL write_cleanup(); RETURN
611  END IF
612 
613  ! Write the cell pressuresa and time data
614  ! ----------------------------------------------
615  WRITE( fileid, iostat=io_status ) odssu%TC_CellPressure, &
616  odssu%Ref_Time, &
617  odssu%Ref_CellPressure
618  IF ( io_status /= 0 ) THEN
619  WRITE( message,'("Error writing cell pressure and time data to ",a,&
620  &". IOSTAT = ",i0)' ) &
621  trim(filename), io_status
622  CALL write_cleanup(); RETURN
623  END IF
624 
625  ! Write coefficient data
626  IF(odssu%subAlgorithm == odas_algorithm) THEN
627 
628  DO i = 1, odssu%n_TC_CellPressures
629  error_status = write_odas_data( filename , &
630  fileid , &
631  odssu%ODAS(i) , &
632  message_log = message_log)
633  IF ( error_status /= success ) THEN
634  message = 'Error writing data to '//trim(filename)
635  error_status = failure
636  RETURN
637  END IF
638 
639  END DO
640 
641  ENDIF
642 
643  IF(odssu%subAlgorithm == odps_algorithm) THEN
644 
645  DO i = 1, odssu%n_TC_CellPressures
646  error_status = write_odps_data( filename , &
647  fileid , &
648  odssu%ODPS(i) , &
649  message_log = message_log)
650  IF ( error_status /= success ) THEN
651  message = 'Error writing data to '//trim(filename)
652  error_status = failure
653  RETURN
654  END IF
655 
656  END DO
657 
658  ENDIF
659 
660  ! Close the file
661  ! --------------
662  CLOSE( fileid, iostat=io_status )
663  IF ( io_status /= 0 ) THEN
664  WRITE( message,'("Error closing ",a," after write. IOSTAT = ",i0)' ) &
665  trim(filename), io_status
666  CALL display_message( routine_name, &
667  trim(message), &
668  warning, &
669  message_log=message_log )
670  END IF
671 
672 
673  ! Output an info message
674  ! ----------------------
675  IF ( noisy ) THEN
676  CALL info_odssu( odssu, message )
677  CALL display_message( routine_name, &
678  'FILE: '//trim(filename)//'; '//trim(message), &
679  information, &
680  message_log = message_log )
681  END IF
682 
683  CONTAINS
684 
685  SUBROUTINE write_cleanup()
686  CHARACTER(ML) :: Close_Message
687  ! Close file if necessary
688  IF ( file_exists( filename ) ) THEN
689  IF ( file_open( filename ) ) THEN
690  CLOSE( fileid, iostat=io_status, status='DELETE' )
691  IF ( io_status /= 0 ) THEN
692  WRITE( close_message,'("; Error deleting ",a," during error cleanup. IOSTAT=",i0)') &
693  trim(filename), io_status
694  message = trim(message)//trim(close_message)
695  END IF
696  END IF
697  END IF
698  ! Set error status and print error message
699  error_status = failure
700  CALL display_message( routine_name, &
701  trim(message), &
702  error_status, &
703  message_log=message_log )
704  END SUBROUTINE write_cleanup
705 
706  END FUNCTION write_odssu_binary
707 
708 END MODULE odssu_binary_io
odssu_binary_io::write_odssu_binary
integer function, public write_odssu_binary(Filename, ODSSU, Quiet, RCS_Id, Message_Log)
Definition: ODSSU_Binary_IO.f90:523
message_handler::failure
integer, parameter, public failure
Definition: Message_Handler.f90:30
crtm_parameters::set
integer, parameter, public set
Definition: CRTM_Parameters.f90:113
message_handler::warning
integer, parameter, public warning
Definition: Message_Handler.f90:29
odssu_binary_io::ml
integer, parameter ml
Definition: ODSSU_Binary_IO.f90:59
type_kinds::long
integer, parameter, public long
Definition: Type_Kinds.f90:76
odas_binary_io
Definition: ODAS_Binary_IO.f90:13
odps_binary_io
Definition: ODPS_Binary_IO.f90:16
odssu_define
Definition: ODSSU_Define.f90:14
odssu_define::checkalgorithm_odssu
integer function, public checkalgorithm_odssu(ODSSU, RCS_Id, Message_Log)
Definition: ODSSU_Define.f90:798
odps_binary_io::write_odps_data
integer function, public write_odps_data(Filename, FileID, ODPS, Message_Log)
Definition: ODPS_Binary_IO.f90:996
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
odssu_define::odssu_type
Definition: ODSSU_Define.f90:89
odssu_binary_io::read_odssu_binary
integer function, public read_odssu_binary(Filename, ODSSU, Quiet, Process_ID, Output_Process_ID, RCS_Id, Message_Log)
Definition: ODSSU_Binary_IO.f90:177
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
binary_file_utility
Definition: Binary_File_Utility.f90:13
write_cleanup
subroutine write_cleanup()
Definition: ACCoeff_Binary_IO.f90:670
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
odssu_define::destroy_odssu
integer function, public destroy_odssu(ODSSU, No_Clear, RCS_Id, Message_Log)
Definition: ODSSU_Define.f90:313
odssu_binary_io
Definition: ODSSU_Binary_IO.f90:15
odssu_define::info_odssu
subroutine, public info_odssu(ODSSU, Info, RCS_Id)
Definition: ODSSU_Define.f90:869
file_utility::file_open
Definition: File_Utility.f90:56
file_utility::file_exists
Definition: File_Utility.f90:51
crtm_parameters::odps_algorithm
integer, parameter, public odps_algorithm
Definition: CRTM_Parameters.f90:125
odssu_define::allocate_odssu
integer function, public allocate_odssu(n_Absorbers, n_Channels, n_TC_CellPressures, n_Ref_CellPressures, ODSSU, RCS_Id, Message_Log)
Definition: ODSSU_Define.f90:535
crtm_parameters::odas_algorithm
integer, parameter, public odas_algorithm
Definition: CRTM_Parameters.f90:124
odps_binary_io::read_odps_data
integer function, public read_odps_data(Filename, FileID, ODPS, Process_ID_Tag, Message_Log)
Definition: ODPS_Binary_IO.f90:594
odssu_define::checkrelease_odssu
integer function, public checkrelease_odssu(ODSSU, RCS_Id, Message_Log)
Definition: ODSSU_Define.f90:695
type_kinds
Definition: Type_Kinds.f90:12
odssu_binary_io::module_rcs_id
character(*), parameter module_rcs_id
Definition: ODSSU_Binary_IO.f90:54
message_handler::success
integer, parameter, public success
Definition: Message_Handler.f90:27
file_utility
Definition: File_Utility.f90:26
message_handler::information
integer, parameter, public information
Definition: Message_Handler.f90:28