FV3 Bundle
NLTECoeff_Binary_IO.f90
Go to the documentation of this file.
1 !
2 ! NLTECoeff_Binary_IO
3 !
4 ! Module containing routines to inquire, read, and write Binary
5 ! NLTECoeff object datafiles.
6 !
7 !
8 ! CREATION HISTORY:
9 ! Written by: Yong Han, 08-05-2010
10 ! yong.han@noaa.gov
11 !
12 ! Refactored by: Paul van Delst, 20-Jan-2011
13 ! paul.vandelst@noaa.gov
14 !
15 
16 MODULE nltecoeff_binary_io
17 
18  ! ------------------
19  ! Environment set up
20  ! ------------------
21  ! Module use
22  USE type_kinds , ONLY: long, double
23  USE file_utility , ONLY: file_open, file_exists
24  USE message_handler , ONLY: success, failure, information, display_message
25  USE binary_file_utility, ONLY: open_binary_file
26  USE nltecoeff_define , ONLY: nltecoeff_type , &
27  nltecoeff_associated , &
28  nltecoeff_destroy , &
29  nltecoeff_create , &
30  nltecoeff_validrelease, &
31  nltecoeff_info
32  ! Disable implicit typing
33  IMPLICIT NONE
34 
35 
36  ! ------------
37  ! Visibilities
38  ! ------------
39  PRIVATE
40  PUBLIC :: nltecoeff_binary_inquirefile
41  PUBLIC :: nltecoeff_binary_readfile
42  PUBLIC :: nltecoeff_binary_writefile
43  PUBLIC :: nltecoeff_binary_ioversion
44 
45 
46  ! -----------------
47  ! Module parameters
48  ! -----------------
49  CHARACTER(*), PRIVATE, PARAMETER :: module_version_id = &
50  '$Id: NLTECoeff_Binary_IO.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
51  CHARACTER(*), PARAMETER :: write_error_status = 'DELETE'
52  ! Default message length
53  INTEGER, PARAMETER :: ml = 256
54 
55 
56 CONTAINS
57 
58 
59 !################################################################################
60 !################################################################################
61 !## ##
62 !## ## PUBLIC MODULE ROUTINES ## ##
63 !## ##
64 !################################################################################
65 !################################################################################
66 
67 !------------------------------------------------------------------------------
68 !:sdoc+:
69 !
70 ! NAME:
71 ! NLTECoeff_Binary_InquireFile
72 !
73 ! PURPOSE:
74 ! Function to inquire a Binary format NLTE file.
75 !
76 ! CALLING SEQUENCE:
77 ! Error_Status = NLTECoeff_Binary_InquireFile( &
78 ! Filename , &
79 ! n_Predictors = n_Predictors , &
80 ! n_Sensor_Angles = n_Sensor_Angles , &
81 ! n_Solar_Angles = n_Solar_Angles , &
82 ! n_NLTE_Channels = n_NLTE_Channels , &
83 ! n_Channels = n_Channels , &
84 ! Release = Release , &
85 ! Version = Version , &
86 ! Sensor_Id = Sensor_Id , &
87 ! WMO_Satellite_Id = WMO_Satellite_Id, &
88 ! WMO_Sensor_Id = WMO_Sensor_Id )
89 !
90 ! INPUTS:
91 ! Filename: Character string specifying the name of the binary
92 ! NLTE data file to inquire.
93 ! UNITS: N/A
94 ! TYPE: CHARACTER(*)
95 ! DIMENSION: Scalar
96 ! ATTRIBUTES: INTENT(IN)
97 !
98 ! OPTIONAL OUTPUTS:
99 ! n_Predictors: The number of predictor functions used in generating
100 ! the NLTE correction coefficients.
101 ! UNITS: N/A
102 ! TYPE: INTEGER
103 ! DIMENSION: Scalar
104 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
105 !
106 ! n_Sensor_Angles: Number of sensor zenith angles.
107 ! UNITS: N/A
108 ! TYPE: INTEGER
109 ! DIMENSION: Scalar
110 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
111 !
112 ! n_Solar_Angles: Number of solar zenith angles.
113 ! UNITS: N/A
114 ! TYPE: INTEGER
115 ! DIMENSION: Scalar
116 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
117 !
118 ! n_NLTE_Channels: Number of NLTE channels for the sensor.
119 ! UNITS: N/A
120 ! TYPE: INTEGER
121 ! DIMENSION: Scalar
122 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
123 !
124 ! n_Channels: Total number of sensor channels.
125 ! UNITS: N/A
126 ! TYPE: INTEGER
127 ! DIMENSION: Scalar
128 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
129 !
130 ! Release: The data/file release number. Used to check
131 ! for data/software mismatch.
132 ! UNITS: N/A
133 ! TYPE: INTEGER
134 ! DIMENSION: Scalar
135 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
136 !
137 ! Version: The data/file version number. Used for
138 ! purposes only in identifying the dataset for
139 ! a particular release.
140 ! UNITS: N/A
141 ! TYPE: INTEGER
142 ! DIMENSION: Scalar
143 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
144 !
145 ! Sensor_Id: Character string sensor/platform identifier.
146 ! UNITS: N/A
147 ! TYPE: CHARACTER(*)
148 ! DIMENSION: Scalar
149 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
150 !
151 ! WMO_Satellite_Id: The WMO code used to identify satellite platforms.
152 ! UNITS: N/A
153 ! TYPE: INTEGER
154 ! DIMENSION: Scalar
155 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
156 !
157 ! WMO_Sensor_Id: The WMO code used to identify sensors.
158 ! UNITS: N/A
159 ! TYPE: INTEGER
160 ! DIMENSION: Scalar
161 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
162 !
163 ! FUNCTION RESULT:
164 ! Error_Status: The return value is an integer defining the error
165 ! status. The error codes are defined in the
166 ! Message_Handler module.
167 ! If == SUCCESS the file inquire was successful
168 ! == FAILURE an unrecoverable error occurred.
169 ! UNITS: N/A
170 ! TYPE: INTEGER
171 ! DIMENSION: Scalar
172 !
173 !:sdoc-:
174 !------------------------------------------------------------------------------
175 
176  FUNCTION nltecoeff_binary_inquirefile( &
177  Filename , & ! Input
178  n_Predictors , & ! Optional output
179  n_Sensor_Angles , & ! Optional output
180  n_Solar_Angles , & ! Optional output
181  n_NLTE_Channels , & ! Optional output
182  n_Channels , & ! Optional output
183  Release , & ! Optional Output
184  Version , & ! Optional Output
185  Sensor_Id , & ! Optional Output
186  WMO_Satellite_Id, & ! Optional Output
187  WMO_Sensor_Id ) & ! Optional Output
188  result( err_stat )
189  ! Arguments
190  CHARACTER(*), INTENT(IN) :: filename
191  INTEGER , OPTIONAL, INTENT(OUT) :: n_predictors
192  INTEGER , OPTIONAL, INTENT(OUT) :: n_sensor_angles
193  INTEGER , OPTIONAL, INTENT(OUT) :: n_solar_angles
194  INTEGER , OPTIONAL, INTENT(OUT) :: n_nlte_channels
195  INTEGER , OPTIONAL, INTENT(OUT) :: n_channels
196  INTEGER , OPTIONAL, INTENT(OUT) :: release
197  INTEGER , OPTIONAL, INTENT(OUT) :: version
198  CHARACTER(*), OPTIONAL, INTENT(OUT) :: sensor_id
199  INTEGER , OPTIONAL, INTENT(OUT) :: wmo_satellite_id
200  INTEGER , OPTIONAL, INTENT(OUT) :: wmo_sensor_id
201  ! Function result
202  INTEGER :: err_stat
203  ! Function parameters
204  CHARACTER(*), PARAMETER :: routine_name = 'NLTECoeff_Binary_InquireFile'
205  ! Function variables
206  CHARACTER(ML) :: msg
207  INTEGER :: io_stat
208  INTEGER :: fid
209  TYPE(nltecoeff_type) :: nltecoeff
210 
211 
212  ! Setup
213  err_stat = success
214  ! ...Check that the file exists
215  IF ( .NOT. file_exists( filename ) ) THEN
216  msg = 'File '//trim(filename)//' not found.'
217  CALL inquire_cleanup(); RETURN
218  END IF
219 
220 
221  ! Open the file
222  err_stat = open_binary_file( filename, fid )
223  IF ( err_stat /= success ) THEN
224  msg = 'Error opening '//trim(filename)
225  CALL inquire_cleanup(); RETURN
226  END IF
227 
228 
229  ! Read the release and version
230  READ( fid,iostat=io_stat ) nltecoeff%Release, nltecoeff%Version
231  IF ( io_stat /= 0 ) THEN
232  WRITE( msg,'("Error reading Release/Version. IOSTAT = ",i0)' ) io_stat
233  CALL inquire_cleanup(); RETURN
234  END IF
235 
236 
237  ! Read the dimensions
238  READ( fid, iostat=io_stat ) &
239  nltecoeff%n_Predictors , &
240  nltecoeff%n_Sensor_Angles , &
241  nltecoeff%n_Solar_Angles , &
242  nltecoeff%n_NLTE_Channels , &
243  nltecoeff%n_Channels
244  IF ( io_stat /= 0 ) THEN
245  WRITE( msg,'("Error reading dimension values from ",a,". IOSTAT = ",i0)' ) &
246  trim(filename), io_stat
247  CALL inquire_cleanup(); RETURN
248  END IF
249 
250 
251  ! Read the sensor ids
252  READ( fid, iostat=io_stat ) &
253  nltecoeff%Sensor_Id , &
254  nltecoeff%WMO_Satellite_Id, &
255  nltecoeff%WMO_Sensor_Id
256  IF ( io_stat /= 0 ) THEN
257  WRITE( msg, '("Error reading sensor information from ",a,". IOSTAT = ",i0)' ) &
258  trim(filename), io_stat
259  CALL inquire_cleanup(); RETURN
260  END IF
261 
262 
263  ! Close the file
264  CLOSE( fid, iostat=io_stat )
265  IF ( io_stat /= 0 ) THEN
266  WRITE( msg,'("Error closing ",a,". IOSTAT = ",i0)' ) trim(filename), io_stat
267  CALL inquire_cleanup(); RETURN
268  END IF
269 
270 
271  ! Assign the return arguments
272  IF ( PRESENT(n_predictors ) ) n_predictors = nltecoeff%n_Predictors
273  IF ( PRESENT(n_sensor_angles ) ) n_sensor_angles = nltecoeff%n_Sensor_Angles
274  IF ( PRESENT(n_solar_angles ) ) n_solar_angles = nltecoeff%n_Solar_Angles
275  IF ( PRESENT(n_nlte_channels ) ) n_nlte_channels = nltecoeff%n_NLTE_Channels
276  IF ( PRESENT(n_channels ) ) n_channels = nltecoeff%n_Channels
277  IF ( PRESENT(release ) ) release = nltecoeff%Release
278  IF ( PRESENT(version ) ) version = nltecoeff%Version
279  IF ( PRESENT(sensor_id ) ) sensor_id = trim(nltecoeff%Sensor_Id)
280  IF ( PRESENT(wmo_satellite_id) ) wmo_satellite_id = nltecoeff%WMO_Satellite_Id
281  IF ( PRESENT(wmo_sensor_id ) ) wmo_sensor_id = nltecoeff%WMO_Sensor_Id
282 
283  CONTAINS
284 
285  SUBROUTINE inquire_cleanup()
286  ! Close file if necessary
287  IF ( file_open(fid) ) THEN
288  CLOSE( fid,iostat=io_stat )
289  IF ( io_stat /= 0 ) &
290  msg = trim(msg)//'; Error closing input file during error cleanup'
291  END IF
292  ! Set error status and print error message
293  err_stat = failure
294  CALL display_message( routine_name, msg, err_stat )
295  END SUBROUTINE inquire_cleanup
296 
297  END FUNCTION nltecoeff_binary_inquirefile
298 
299 
300 !--------------------------------------------------------------------------------
301 !:sdoc+:
302 !
303 ! NAME:
304 ! NLTECoeff_Binary_ReadFile
305 !
306 ! PURPOSE:
307 ! Function to read NLTECoeff object files in Binary format.
308 !
309 ! CALLING SEQUENCE:
310 ! Error_Status = NLTECoeff_Binary_ReadFile( &
311 ! Filename , &
312 ! NLTECoeff , &
313 ! No_Close = No_Close, &
314 ! Quiet = Quiet )
315 !
316 ! INPUTS:
317 ! Filename: Character string specifying the name of a
318 ! NLTECoeff format data file to read.
319 ! UNITS: N/A
320 ! TYPE: CHARACTER(*)
321 ! DIMENSION: Scalar
322 ! ATTRIBUTES: INTENT(IN)
323 !
324 ! OUTPUTS:
325 ! NLTECoeff: NLTECoeff object containing the NLTE correction
326 ! coefficient data.
327 ! UNITS: N/A
328 ! TYPE: NLTECoeff_type
329 ! DIMENSION: Scalar
330 ! ATTRIBUTES: INTENT(OUT)
331 !
332 ! OPTIONAL INPUTS:
333 ! No_Close: Set this logical argument to *NOT* close the datafile
334 ! upon exiting this routine. This option is required if
335 ! the NLTECoeff data is embedded within another file
336 ! (e.g. SpcCoeff file.)
337 ! If == .FALSE., File is closed upon function exit [DEFAULT].
338 ! == .TRUE., File is NOT closed upon function exit
339 ! If not specified, default is .FALSE.
340 ! UNITS: N/A
341 ! TYPE: LOGICAL
342 ! DIMENSION: Scalar
343 ! ATTRIBUTES: INTENT(IN), OPTIONAL
344 !
345 ! Quiet: Set this logical argument to suppress INFORMATION
346 ! messages being printed to stdout
347 ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
348 ! == .TRUE., INFORMATION messages are SUPPRESSED.
349 ! If not specified, default is .FALSE.
350 ! UNITS: N/A
351 ! TYPE: LOGICAL
352 ! DIMENSION: Scalar
353 ! ATTRIBUTES: INTENT(IN), OPTIONAL
354 !
355 ! FUNCTION RESULT:
356 ! Error_Status: The return value is an integer defining the error status.
357 ! The error codes are defined in the Message_Handler module.
358 ! If == SUCCESS, the file read was successful
359 ! == FAILURE, an unrecoverable error occurred.
360 ! UNITS: N/A
361 ! TYPE: INTEGER
362 ! DIMENSION: Scalar
363 !
364 !:sdoc-:
365 !------------------------------------------------------------------------------
366 
367  FUNCTION nltecoeff_binary_readfile( &
368  Filename , & ! Input
369  NLTECoeff, & ! Output
370  No_Close , & ! Optional input
371  Quiet , & ! Optional input
372  Debug ) & ! Optional input (Debug output control)
373  result( err_stat )
374  ! Arguments
375  CHARACTER(*), INTENT(IN) :: filename
376  TYPE(nltecoeff_type), INTENT(OUT) :: nltecoeff
377  LOGICAL, OPTIONAL, INTENT(IN) :: no_close
378  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
379  LOGICAL, OPTIONAL, INTENT(IN) :: debug
380  ! Function result
381  INTEGER :: err_stat
382  ! Function parameters
383  CHARACTER(*), PARAMETER :: routine_name = 'NLTECoeff_ReadFile(Binary)'
384  ! Function variables
385  CHARACTER(ML) :: msg
386  LOGICAL :: close_file
387  LOGICAL :: noisy
388  INTEGER :: io_stat
389  INTEGER :: fid
390  TYPE(nltecoeff_type) :: dummy
391 
392 
393  ! Setup
394  err_stat = success
395  ! ...Check No_Close argument
396  close_file = .true.
397  IF ( PRESENT(no_close) ) close_file = .NOT. no_close
398  ! ...Check Quiet argument
399  noisy = .true.
400  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
401  ! ...Override Quiet settings if debug set.
402  IF ( PRESENT(debug) ) THEN
403  IF ( debug ) noisy = .true.
404  END IF
405 
406 
407  ! Check if the file is open.
408  IF ( file_open( filename ) ) THEN
409  ! ...Inquire for the logical unit number
410  INQUIRE( file=filename, number=fid )
411  ! ...Ensure it's valid
412  IF ( fid < 0 ) THEN
413  msg = 'Error inquiring '//trim(filename)//' for its FileID'
414  CALL read_cleanup(); RETURN
415  END IF
416  ELSE
417  ! ...Open the file if it exists
418  IF ( file_exists( filename ) ) THEN
419  err_stat = open_binary_file( filename, fid )
420  IF ( err_stat /= success ) THEN
421  msg = 'Error opening '//trim(filename)
422  CALL read_cleanup(); RETURN
423  END IF
424  ELSE
425  msg = 'File '//trim(filename)//' not found.'
426  CALL read_cleanup(); RETURN
427  END IF
428  END IF
429 
430 
431  ! Read and check the release and version
432  READ( fid,iostat=io_stat ) dummy%Release, dummy%Version
433  IF ( io_stat /= 0 ) THEN
434  WRITE( msg,'("Error reading Release/Version. IOSTAT = ",i0)' ) io_stat
435  CALL read_cleanup(); RETURN
436  END IF
437  IF ( .NOT. nltecoeff_validrelease( dummy ) ) THEN
438  msg = 'NLTECoeff Release check failed.'
439  CALL read_cleanup(); RETURN
440  END IF
441 
442 
443  ! Read the NLTE correction coefficient data
444  ! ...Read the dimensions
445  READ( fid, iostat=io_stat ) dummy%n_Predictors , &
446  dummy%n_Sensor_Angles , &
447  dummy%n_Solar_Angles , &
448  dummy%n_NLTE_Channels , &
449  dummy%n_Channels
450  IF ( io_stat /= 0 ) THEN
451  WRITE( msg,'("Error reading data dimensions. IOSTAT = ",i0)' ) io_stat
452  CALL read_cleanup(); RETURN
453  END IF
454  ! ...Allocate the object
455  CALL nltecoeff_create( nltecoeff , &
456  dummy%n_Predictors , &
457  dummy%n_Sensor_Angles , &
458  dummy%n_Solar_Angles , &
459  dummy%n_NLTE_Channels , &
460  dummy%n_Channels )
461  IF ( .NOT. nltecoeff_associated( nltecoeff ) ) THEN
462  msg = 'NLTECoeff object allocation failed.'
463  CALL read_cleanup(); RETURN
464  END IF
465  ! ...Read the sensor info
466  READ( fid, iostat=io_stat ) nltecoeff%Sensor_Id , &
467  nltecoeff%WMO_Satellite_Id, &
468  nltecoeff%WMO_Sensor_Id , &
469  nltecoeff%Sensor_Channel
470  IF ( io_stat /= 0 ) THEN
471  WRITE( msg,'("Error reading sensor information. IOSTAT = ",i0)' ) io_stat
472  CALL read_cleanup(); RETURN
473  END IF
474  ! ...Read the upper and lower pressure levels
475  READ( fid, iostat=io_stat ) nltecoeff%Upper_Plevel, &
476  nltecoeff%Lower_Plevel
477  IF ( io_stat /= 0 ) THEN
478  WRITE( msg,'("Error reading pressure level data. IOSTAT = ",i0)' ) io_stat
479  CALL read_cleanup(); RETURN
480  END IF
481  ! ...Read the min/max/mean layer temperatures
482  READ( fid, iostat=io_stat ) nltecoeff%Min_Tm , &
483  nltecoeff%Max_Tm , &
484  nltecoeff%Mean_Tm
485  IF ( io_stat /= 0 ) THEN
486  WRITE( msg,'("Error reading min/max/mean temperature data. IOSTAT = ",i0)' ) io_stat
487  CALL read_cleanup(); RETURN
488  END IF
489  ! ...Read the NLTE channel numbers
490  READ( fid, iostat=io_stat ) nltecoeff%NLTE_Channel
491  IF ( io_stat /= 0 ) THEN
492  WRITE( msg,'("Error reading NLTE channel numbers. IOSTAT = ",i0)' ) io_stat
493  CALL read_cleanup(); RETURN
494  END IF
495  ! ...Read sensor and solar angle values
496  READ( fid, iostat=io_stat ) nltecoeff%Secant_Sensor_Zenith, &
497  nltecoeff%Secant_Solar_Zenith
498  IF ( io_stat /= 0 ) THEN
499  WRITE( msg,'("Error reading sensor and solar angle data. IOSTAT = ",i0)' ) io_stat
500  CALL read_cleanup(); RETURN
501  END IF
502  ! ...Read the NLTE correction coefficients
503  READ( fid, iostat=io_stat ) nltecoeff%C_Index, nltecoeff%C
504  IF ( io_stat /= 0 ) THEN
505  WRITE( msg,'("Error reading NLTE correction coefficients. IOSTAT = ",i0)' ) io_stat
506  CALL read_cleanup(); RETURN
507  END IF
508 
509 
510  ! Explicitly assign the version number
511  nltecoeff%Version = dummy%Version
512 
513 
514  ! Set the logical flag based on the C_Index values
515  WHERE( nltecoeff%C_Index > 0 ) nltecoeff%Is_NLTE_Channel = .true.
516 
517 
518  ! Close the file
519  IF ( close_file ) THEN
520  CLOSE( fid,iostat=io_stat )
521  IF ( io_stat /= 0 ) THEN
522  WRITE( msg,'("Error closing ",a,". IOSTAT = ",i0)' ) trim(filename), io_stat
523  CALL read_cleanup(); RETURN
524  END IF
525  END IF
526 
527 
528  ! Output an info message
529  IF ( noisy ) THEN
530  CALL nltecoeff_info( nltecoeff, msg )
531  CALL display_message( routine_name, 'FILE: '//trim(filename)//'; '//trim(msg), information )
532  END IF
533 
534  CONTAINS
535 
536  SUBROUTINE read_cleanup()
537  IF ( file_open(filename) ) THEN
538  CLOSE( fid,iostat=io_stat )
539  IF ( io_stat /= 0 ) &
540  msg = trim(msg)//'; Error closing input file during error cleanup.'
541  END IF
542  CALL nltecoeff_destroy( nltecoeff )
543  err_stat = failure
544  CALL display_message( routine_name, msg, err_stat )
545  END SUBROUTINE read_cleanup
546 
547  END FUNCTION nltecoeff_binary_readfile
548 
549 
550 !--------------------------------------------------------------------------------
551 !:sdoc+:
552 !
553 ! NAME:
554 ! NLTECoeff_Binary_WriteFile
555 !
556 ! PURPOSE:
557 ! Function to write NLTECoeff object files in Binary format.
558 !
559 ! CALLING SEQUENCE:
560 ! Error_Status = NLTECoeff_Binary_WriteFile( &
561 ! Filename , &
562 ! NLTECoeff , &
563 ! No_Close = No_Close, &
564 ! Quiet = Quiet )
565 !
566 ! INPUTS:
567 ! Filename: Character string specifying the name of a
568 ! NLTECoeff format data file to read.
569 ! UNITS: N/A
570 ! TYPE: CHARACTER(*)
571 ! DIMENSION: Scalar
572 ! ATTRIBUTES: INTENT(IN)
573 !
574 ! NLTECoeff: NLTECoeff object containing the NLTE correction
575 ! coefficient data.
576 ! UNITS: N/A
577 ! TYPE: NLTECoeff_type
578 ! DIMENSION: Scalar
579 ! ATTRIBUTES: INTENT(OUT)
580 !
581 ! OPTIONAL INPUTS:
582 ! No_Close: Set this logical argument to *NOT* close the datafile
583 ! upon exiting this routine. This option is required if
584 ! the NLTECoeff data is to be embedded within another file
585 ! (e.g. SpcCoeff file.)
586 ! If == .FALSE., File is closed upon function exit [DEFAULT].
587 ! == .TRUE., File is NOT closed upon function exit
588 ! If not specified, default is .FALSE.
589 ! UNITS: N/A
590 ! TYPE: LOGICAL
591 ! DIMENSION: Scalar
592 ! ATTRIBUTES: INTENT(IN), OPTIONAL
593 !
594 ! Quiet: Set this logical argument to suppress INFORMATION
595 ! messages being printed to stdout
596 ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
597 ! == .TRUE., INFORMATION messages are SUPPRESSED.
598 ! If not specified, default is .FALSE.
599 ! UNITS: N/A
600 ! TYPE: LOGICAL
601 ! DIMENSION: Scalar
602 ! ATTRIBUTES: INTENT(IN), OPTIONAL
603 !
604 ! FUNCTION RESULT:
605 ! Error_Status: The return value is an integer defining the error status.
606 ! The error codes are defined in the Message_Handler module.
607 ! If == SUCCESS, the file write was successful
608 ! == FAILURE, an unrecoverable error occurred.
609 ! UNITS: N/A
610 ! TYPE: INTEGER
611 ! DIMENSION: Scalar
612 !
613 !:sdoc-:
614 !------------------------------------------------------------------------------
615 
616  FUNCTION nltecoeff_binary_writefile( &
617  Filename , & ! Input
618  NLTECoeff, & ! Input
619  No_Close , & ! Optional input
620  Quiet , & ! Optional input
621  Debug ) & ! Optional input (Debug output control)
622  result( err_stat )
623  ! Arguments
624  CHARACTER(*), INTENT(IN) :: filename
625  TYPE(nltecoeff_type), INTENT(IN) :: nltecoeff
626  LOGICAL, OPTIONAL, INTENT(IN) :: no_close
627  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
628  LOGICAL, OPTIONAL, INTENT(IN) :: debug
629  ! Function result
630  INTEGER :: err_stat
631  ! Function parameters
632  CHARACTER(*), PARAMETER :: routine_name = 'NLTECoeff_WriteFile(Binary)'
633  ! Function variables
634  CHARACTER(ML) :: msg
635  LOGICAL :: close_file
636  LOGICAL :: noisy
637  INTEGER :: io_stat
638  INTEGER :: fid
639 
640 
641  ! Setup
642  err_stat = success
643  ! ...Check No_Close argument
644  close_file = .true.
645  IF ( PRESENT(no_close) ) close_file = .NOT. no_close
646  ! ...Check Quiet argument
647  noisy = .true.
648  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
649  ! ...Override Quiet settings if debug set.
650  IF ( PRESENT(debug) ) THEN
651  IF ( debug ) noisy = .true.
652  END IF
653  ! ...Check there is data to write
654  IF ( .NOT. nltecoeff_associated( nltecoeff ) ) THEN
655  msg = 'NLTECoeff object is empty.'
656  CALL write_cleanup(); RETURN
657  END IF
658 
659 
660  ! Check if the file is open.
661  IF ( file_open( filename ) ) THEN
662  ! ...Inquire for the logical unit number
663  INQUIRE( file=filename, number=fid )
664  ! ...Ensure it's valid
665  IF ( fid < 0 ) THEN
666  msg = 'Error inquiring '//trim(filename)//' for its FileID'
667  CALL write_cleanup(); RETURN
668  END IF
669  ELSE
670  ! ...Open the file for output
671  err_stat = open_binary_file( filename, fid, for_output=.true. )
672  IF ( err_stat /= success ) THEN
673  msg = 'Error opening '//trim(filename)
674  CALL write_cleanup(); RETURN
675  END IF
676  END IF
677 
678 
679  ! Write the release and version
680  WRITE( fid,iostat=io_stat ) nltecoeff%Release, nltecoeff%Version
681  IF ( io_stat /= 0 ) THEN
682  WRITE( msg,'("Error writing Release/Version. IOSTAT = ",i0)' ) io_stat
683  CALL write_cleanup(); RETURN
684  END IF
685 
686 
687  ! Write the NLTE correction coefficient data
688  ! ...Write the dimensions
689  WRITE( fid, iostat=io_stat ) nltecoeff%n_Predictors , &
690  nltecoeff%n_Sensor_Angles , &
691  nltecoeff%n_Solar_Angles , &
692  nltecoeff%n_NLTE_Channels , &
693  nltecoeff%n_Channels
694  IF ( io_stat /= 0 ) THEN
695  WRITE( msg,'("Error writing data dimensions. IOSTAT = ",i0)' ) io_stat
696  CALL write_cleanup(); RETURN
697  END IF
698  ! ...Write the sensor info
699  WRITE( fid, iostat=io_stat ) nltecoeff%Sensor_Id , &
700  nltecoeff%WMO_Satellite_Id, &
701  nltecoeff%WMO_Sensor_Id , &
702  nltecoeff%Sensor_Channel
703  IF ( io_stat /= 0 ) THEN
704  WRITE( msg,'("Error writing sensor information. IOSTAT = ",i0)' ) io_stat
705  CALL write_cleanup(); RETURN
706  END IF
707  ! ...Write the upper and lower pressure levels
708  WRITE( fid, iostat=io_stat ) nltecoeff%Upper_Plevel, &
709  nltecoeff%Lower_Plevel
710  IF ( io_stat /= 0 ) THEN
711  WRITE( msg,'("Error writing pressure level data. IOSTAT = ",i0)' ) io_stat
712  CALL write_cleanup(); RETURN
713  END IF
714  ! ...Write the min/max/mean layer temperatures
715  WRITE( fid, iostat=io_stat ) nltecoeff%Min_Tm , &
716  nltecoeff%Max_Tm , &
717  nltecoeff%Mean_Tm
718  IF ( io_stat /= 0 ) THEN
719  WRITE( msg,'("Error writing min/max/mean temperature data. IOSTAT = ",i0)' ) io_stat
720  CALL write_cleanup(); RETURN
721  END IF
722  ! ...Write the NLTE channel numbers
723  WRITE( fid, iostat=io_stat ) nltecoeff%NLTE_Channel
724  IF ( io_stat /= 0 ) THEN
725  WRITE( msg,'("Error writing NLTE channel numbers. IOSTAT = ",i0)' ) io_stat
726  CALL write_cleanup(); RETURN
727  END IF
728  ! ...Write sensor and solar angle values
729  WRITE( fid, iostat=io_stat ) nltecoeff%Secant_Sensor_Zenith, &
730  nltecoeff%Secant_Solar_Zenith
731 
732  IF ( io_stat /= 0 ) THEN
733  WRITE( msg,'("Error writing sensor and solar angle data. IOSTAT = ",i0)' ) io_stat
734  CALL write_cleanup(); RETURN
735  END IF
736  ! ...Write the NLTE correction coefficients
737  WRITE( fid, iostat=io_stat ) nltecoeff%C_Index, nltecoeff%C
738  IF ( io_stat /= 0 ) THEN
739  WRITE( msg,'("Error writing NLTE correction coefficients. IOSTAT = ",i0)' ) io_stat
740  CALL write_cleanup(); RETURN
741  END IF
742 
743 
744  ! Close the file
745  IF ( close_file ) THEN
746  CLOSE( fid,iostat=io_stat )
747  IF ( io_stat /= 0 ) THEN
748  WRITE( msg,'("Error closing ",a,". IOSTAT = ",i0)' ) trim(filename), io_stat
749  CALL write_cleanup(); RETURN
750  END IF
751  END IF
752 
753 
754  ! Output an info message
755  IF ( noisy ) THEN
756  CALL nltecoeff_info( nltecoeff, msg )
757  CALL display_message( routine_name, 'FILE: '//trim(filename)//'; '//trim(msg), information )
758  END IF
759 
760  CONTAINS
761 
762  SUBROUTINE write_cleanup()
763  IF ( file_open(filename) ) THEN
764  CLOSE( fid,iostat=io_stat )
765  IF ( io_stat /= 0 ) &
766  msg = trim(msg)//'; Error closing input file during error cleanup.'
767  END IF
768  err_stat = failure
769  CALL display_message( routine_name, msg, err_stat )
770  END SUBROUTINE write_cleanup
771 
772  END FUNCTION nltecoeff_binary_writefile
773 
774 
775 !--------------------------------------------------------------------------------
776 !:sdoc+:
777 !
778 ! NAME:
779 ! NLTECoeff_Binary_IOVersion
780 !
781 ! PURPOSE:
782 ! Subroutine to return the module version information.
783 !
784 ! CALLING SEQUENCE:
785 ! CALL NLTECoeff_Binary_IOVersion( Id )
786 !
787 ! OUTPUT ARGUMENTS:
788 ! Id: Character string containing the version Id information
789 ! for the module.
790 ! UNITS: N/A
791 ! TYPE: CHARACTER(*)
792 ! DIMENSION: Scalar
793 ! ATTRIBUTES: INTENT(OUT)
794 !
795 !:sdoc-:
796 !--------------------------------------------------------------------------------
797 
798  SUBROUTINE nltecoeff_binary_ioversion( Id )
799  CHARACTER(*), INTENT(OUT) :: id
800  id = module_version_id
801  END SUBROUTINE nltecoeff_binary_ioversion
802 
803 END MODULE nltecoeff_binary_io
message_handler::failure
integer, parameter, public failure
Definition: Message_Handler.f90:30
nltecoeff_define::nltecoeff_create
elemental subroutine, public nltecoeff_create(NLTECoeff, n_Predictors, n_Sensor_Angles, n_Solar_Angles, n_NLTE_Channels, n_Channels)
Definition: NLTECoeff_Define.f90:286
type_kinds::long
integer, parameter, public long
Definition: Type_Kinds.f90:76
type_kinds::double
integer, parameter, public double
Definition: Type_Kinds.f90:106
nltecoeff_define::nltecoeff_validrelease
logical function, public nltecoeff_validrelease(NLTECoeff)
Definition: NLTECoeff_Define.f90:446
nltecoeff_binary_io::nltecoeff_binary_readfile
integer function, public nltecoeff_binary_readfile(Filename, NLTECoeff, No_Close, Quiet, Debug)
Definition: NLTECoeff_Binary_IO.f90:374
inquire_cleanup
subroutine inquire_cleanup()
Definition: ACCoeff_Binary_IO.f90:249
nltecoeff_binary_io::nltecoeff_binary_writefile
integer function, public nltecoeff_binary_writefile(Filename, NLTECoeff, No_Close, Quiet, Debug)
Definition: NLTECoeff_Binary_IO.f90:623
message_handler
Definition: Message_Handler.f90:4
nltecoeff_define::nltecoeff_type
Definition: NLTECoeff_Define.f90:91
read_cleanup
subroutine read_cleanup()
Definition: ACCoeff_Binary_IO.f90:469
binary_file_utility
Definition: Binary_File_Utility.f90:13
nltecoeff_binary_io::nltecoeff_binary_inquirefile
integer function, public nltecoeff_binary_inquirefile(Filename, n_Predictors, n_Sensor_Angles, n_Solar_Angles, n_NLTE_Channels, n_Channels, Release, Version, Sensor_Id, WMO_Satellite_Id, WMO_Sensor_Id)
Definition: NLTECoeff_Binary_IO.f90:189
nltecoeff_binary_io::module_version_id
character(*), parameter, private module_version_id
Definition: NLTECoeff_Binary_IO.f90:49
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
nltecoeff_binary_io::write_error_status
character(*), parameter write_error_status
Definition: NLTECoeff_Binary_IO.f90:51
file_utility::file_open
Definition: File_Utility.f90:56
nltecoeff_define
Definition: NLTECoeff_Define.f90:16
file_utility::file_exists
Definition: File_Utility.f90:51
nltecoeff_define::nltecoeff_info
subroutine, public nltecoeff_info(NLTECoeff, Info)
Definition: NLTECoeff_Define.f90:515
type_kinds
Definition: Type_Kinds.f90:12
nltecoeff_define::nltecoeff_destroy
elemental subroutine, public nltecoeff_destroy(NLTECoeff)
Definition: NLTECoeff_Define.f90:203
nltecoeff_binary_io::nltecoeff_binary_ioversion
subroutine, public nltecoeff_binary_ioversion(Id)
Definition: NLTECoeff_Binary_IO.f90:799
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
nltecoeff_binary_io
Definition: NLTECoeff_Binary_IO.f90:16
nltecoeff_define::nltecoeff_associated
elemental logical function, public nltecoeff_associated(NLTECoeff)
Definition: NLTECoeff_Define.f90:174
nltecoeff_binary_io::ml
integer, parameter ml
Definition: NLTECoeff_Binary_IO.f90:53