FV3 Bundle
LSEatlas_Define.f90
Go to the documentation of this file.
1 !
2 ! LSEatlas_Define
3 !
4 ! Module defining the LSEatlas object.
5 !
6 !
7 ! CREATION HISTORY:
8 ! Written by: Paul van Delst, 17-Aug-2011
9 ! paul.vandelst@noaa.gov
10 
12 
13  ! -----------------
14  ! Environment setup
15  ! -----------------
16  ! Module use
17  USE type_kinds , ONLY: fp, long, double
19  USE compare_float_numbers, ONLY: OPERATOR(.equalto.)
24  ! Disable implicit typing
25  IMPLICIT NONE
26 
27 
28  ! ------------
29  ! Visibilities
30  ! ------------
31  ! Everything private by default
32  PRIVATE
33  ! Parameters
34  PUBLIC :: lseatlas_datatype
35  ! Datatypes
36  PUBLIC :: lseatlas_type
37  ! Operators
38  PUBLIC :: OPERATOR(==)
39  ! Procedures
40  PUBLIC :: lseatlas_associated
41  PUBLIC :: lseatlas_destroy
42  PUBLIC :: lseatlas_create
43  PUBLIC :: lseatlas_inspect
44  PUBLIC :: lseatlas_validrelease
45  PUBLIC :: lseatlas_info
46  PUBLIC :: lseatlas_name
47  PUBLIC :: lseatlas_defineversion
48  PUBLIC :: lseatlas_setvalue
49  PUBLIC :: lseatlas_getvalue
50  PUBLIC :: lseatlas_inquirefile
51  PUBLIC :: lseatlas_readfile
52  PUBLIC :: lseatlas_writefile
53 
54 
55  ! ---------------------
56  ! Procedure overloading
57  ! ---------------------
58  INTERFACE OPERATOR(==)
59  MODULE PROCEDURE lseatlas_equal
60  END INTERFACE OPERATOR(==)
61 
62 
63  ! -----------------
64  ! Module parameters
65  ! -----------------
66  CHARACTER(*), PARAMETER :: module_version_id = &
67  '$Id: LSEatlas_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $'
68  ! Datatype information
69  CHARACTER(*), PARAMETER :: lseatlas_datatype = 'LSEatlas'
70  ! Current valid release and version
71  INTEGER, PARAMETER :: lseatlas_release = 1 ! This determines structure and file formats.
72  INTEGER, PARAMETER :: lseatlas_version = 1 ! This is just the default data version.
73  ! Close status for write errors
74  CHARACTER(*), PARAMETER :: write_error_status = 'DELETE'
75  ! Literal constants
76  REAL(fp), PARAMETER :: zero = 0.0_fp
77  REAL(fp), PARAMETER :: one = 1.0_fp
78  ! String lengths
79  INTEGER, PARAMETER :: ml = 256 ! Message length
80  INTEGER, PARAMETER :: sl = 80 ! String length
81 
82 
83  ! ----------------------------------
84  ! LSEatlas data type definitions
85  ! ----------------------------------
86  !:tdoc+:
87  TYPE :: lseatlas_type
88  PRIVATE
89  ! Allocation indicator
90  LOGICAL :: is_allocated = .false.
91  ! Datatype information
92  CHARACTER(SL) :: datatype_name = lseatlas_datatype
93  ! Release and version information
94  INTEGER(Long) :: release = lseatlas_release
95  INTEGER(Long) :: version = lseatlas_version
96  ! Dimensions
97  INTEGER(Long) :: n_frequencies = 0 ! I dim.
98  INTEGER(Long) :: n_latitudes = 0 ! J dim.
99  INTEGER(Long) :: n_longitudes = 0 ! K dim.
100  ! Dimensional vectors
101  REAL(Double), ALLOCATABLE :: frequency(:) ! Ix1
102  REAL(Double), ALLOCATABLE :: latitude(:) ! Jx1
103  REAL(Double), ALLOCATABLE :: longitude(:) ! Kx1
104  ! Emissivity LUT data
105  REAL(Double), ALLOCATABLE :: emissivity(:,:,:) ! IxJxK
106  END TYPE lseatlas_type
107  !:tdoc-:
108 
109 
110 CONTAINS
111 
112 
113 !################################################################################
114 !################################################################################
115 !## ##
116 !## ## PUBLIC PROCEDURES ## ##
117 !## ##
118 !################################################################################
119 !################################################################################
120 
121 !--------------------------------------------------------------------------------
122 !:sdoc+:
123 !
124 ! NAME:
125 ! LSEatlas_Associated
126 !
127 ! PURPOSE:
128 ! Elemental function to test the status of the allocatable components
129 ! of the LSEatlas structure.
130 !
131 ! CALLING SEQUENCE:
132 ! Status = LSEatlas_Associated( LSEatlas )
133 !
134 ! OBJECTS:
135 ! LSEatlas: Structure which is to have its member's
136 ! status tested.
137 ! UNITS: N/A
138 ! TYPE: LSEatlas_type
139 ! DIMENSION: Scalar or any rank
140 ! ATTRIBUTES: INTENT(IN)
141 !
142 ! FUNCTION RESULT:
143 ! Status: The return value is a logical value indicating the
144 ! status of the members.
145 ! .TRUE. - if ANY of the allocatable members
146 ! are in use.
147 ! .FALSE. - if ALL of the allocatable members
148 ! are not in use.
149 ! UNITS: N/A
150 ! TYPE: LOGICAL
151 ! DIMENSION: Same as input
152 !
153 !:sdoc-:
154 !--------------------------------------------------------------------------------
155 
156  ELEMENTAL FUNCTION lseatlas_associated( self ) RESULT( Status )
157  TYPE(lseatlas_type), INTENT(IN) :: self
158  LOGICAL :: status
159  status = self%Is_Allocated
160  END FUNCTION lseatlas_associated
161 
162 
163 !--------------------------------------------------------------------------------
164 !:sdoc+:
165 !
166 ! NAME:
167 ! LSEatlas_Destroy
168 !
169 ! PURPOSE:
170 ! Elemental subroutine to re-initialize LSEatlas objects.
171 !
172 ! CALLING SEQUENCE:
173 ! CALL LSEatlas_Destroy( LSEatlas )
174 !
175 ! OBJECTS:
176 ! LSEatlas: Re-initialized LSEatlas structure.
177 ! UNITS: N/A
178 ! TYPE: LSEatlas_type
179 ! DIMENSION: Scalar or any rank
180 ! ATTRIBUTES: INTENT(OUT)
181 !
182 !:sdoc-:
183 !--------------------------------------------------------------------------------
184 
185  ELEMENTAL SUBROUTINE lseatlas_destroy( self )
186  TYPE(lseatlas_type), INTENT(OUT) :: self
187  self%Is_Allocated = .false.
188  self%n_Frequencies = 0
189  self%n_Latitudes = 0
190  self%n_Longitudes = 0
191  END SUBROUTINE lseatlas_destroy
192 
193 
194 !--------------------------------------------------------------------------------
195 !:sdoc+:
196 !
197 ! NAME:
198 ! LSEatlas_Create
199 !
200 ! PURPOSE:
201 ! Elemental subroutine to create an instance of an LSEatlas object.
202 !
203 ! CALLING SEQUENCE:
204 ! CALL LSEatlas_Create( LSEatlas , &
205 ! n_Frequencies, &
206 ! n_Latitudes , &
207 ! n_Longitudes )
208 !
209 ! OBJECTS:
210 ! LSEatlas: LSEatlas object structure.
211 ! UNITS: N/A
212 ! TYPE: LSEatlas_type
213 ! DIMENSION: Scalar or any rank
214 ! ATTRIBUTES: INTENT(OUT)
215 !
216 ! INPUTS:
217 ! n_Frequencies: Number of spectral frequencies for which there are
218 ! data.
219 ! Must be > 0.
220 ! UNITS: N/A
221 ! TYPE: INTEGER
222 ! DIMENSION: Conformable with the LSEatlas object
223 ! ATTRIBUTES: INTENT(IN)
224 !
225 ! n_Latitudes: Number of latitude values for which there are
226 ! data.
227 ! Must be > 0.
228 ! UNITS: N/A
229 ! TYPE: INTEGER
230 ! DIMENSION: Conformable with the LSEatlas object
231 ! ATTRIBUTES: INTENT(IN)
232 !
233 ! n_Longitudes: Number of longitude values for which there are
234 ! data.
235 ! Must be > 0.
236 ! UNITS: N/A
237 ! TYPE: INTEGER
238 ! DIMENSION: Conformable with the LSEatlas object
239 ! ATTRIBUTES: INTENT(IN)
240 !
241 !:sdoc-:
242 !--------------------------------------------------------------------------------
243 
244  ELEMENTAL SUBROUTINE lseatlas_create( &
245  self , & ! Output
246  n_Frequencies, & ! Input
247  n_Latitudes , & ! Input
248  n_Longitudes ) ! Input
249  ! Arguments
250  TYPE(lseatlas_type), INTENT(OUT) :: self
251  INTEGER , INTENT(IN) :: n_frequencies
252  INTEGER , INTENT(IN) :: n_latitudes
253  INTEGER , INTENT(IN) :: n_longitudes
254  ! Local variables
255  INTEGER :: alloc_stat
256 
257  ! Check input
258  IF ( n_frequencies < 1 .OR. &
259  n_latitudes < 1 .OR. &
260  n_longitudes < 1 ) RETURN
261 
262 
263  ! Perform the allocation
264  ALLOCATE( self%Frequency( n_frequencies ), &
265  self%Latitude( n_latitudes ), &
266  self%Longitude( n_longitudes ), &
267  self%Emissivity( n_frequencies, n_latitudes, n_longitudes ), &
268  stat = alloc_stat )
269  IF ( alloc_stat /= 0 ) RETURN
270 
271 
272  ! Initialise
273  ! ...Dimensions
274  self%n_Frequencies = n_frequencies
275  self%n_Latitudes = n_latitudes
276  self%n_Longitudes = n_longitudes
277  ! ...Arrays
278  self%Frequency = zero
279  self%Latitude = zero
280  self%Longitude = zero
281  self%Emissivity = zero
282 
283  ! Set allocation indicator
284  self%Is_Allocated = .true.
285 
286  END SUBROUTINE lseatlas_create
287 
288 
289 !--------------------------------------------------------------------------------
290 !:sdoc+:
291 !
292 ! NAME:
293 ! LSEatlas_Inspect
294 !
295 ! PURPOSE:
296 ! Subroutine to print the contents of a LSEatlas object to stdout.
297 !
298 ! CALLING SEQUENCE:
299 ! CALL LSEatlas_Inspect( LSEatlas )
300 !
301 ! OBJECTS:
302 ! LSEatlas: LSEatlas object to display.
303 ! UNITS: N/A
304 ! TYPE: LSEatlas_type
305 ! DIMENSION: Scalar
306 ! ATTRIBUTES: INTENT(IN)
307 !
308 !:sdoc-:
309 !--------------------------------------------------------------------------------
310 
311  SUBROUTINE lseatlas_inspect( self)
312  TYPE(lseatlas_type), INTENT(IN) :: self
313  WRITE(*,'(1x,"LSEatlas OBJECT")')
314  ! Release/version info
315  WRITE(*,'(3x,"Release.Version :",1x,i0,".",i0)') self%Release, self%Version
316  ! Dimensions
317  WRITE(*,'(3x,"n_Frequencies :",1x,i0)') self%n_Frequencies
318  WRITE(*,'(3x,"n_Latitudes :",1x,i0)') self%n_Latitudes
319  WRITE(*,'(3x,"n_Longitudes :",1x,i0)') self%n_Longitudes
320  IF ( .NOT. lseatlas_associated(self) ) RETURN
321  ! Dimension arrays
322  WRITE(*,'(3x,"Frequency :")')
323  WRITE(*,'(5(1x,es13.6,:))') self%Frequency
324  WRITE(*,'(3x,"Latitude :")')
325  WRITE(*,'(5(1x,es13.6,:))') self%Latitude
326  WRITE(*,'(3x,"Longitude :")')
327  WRITE(*,'(5(1x,es13.6,:))') self%Longitude
328  ! Emissivity array
329  WRITE(*,'(3x,"Emissivity :")')
330  WRITE(*,'(5(1x,es13.6,:))') self%Emissivity
331  END SUBROUTINE lseatlas_inspect
332 
333 
334 
335 !----------------------------------------------------------------------------------
336 !:sdoc+:
337 !
338 ! NAME:
339 ! LSEatlas_ValidRelease
340 !
341 ! PURPOSE:
342 ! Function to check the LSEatlas Release value.
343 !
344 ! CALLING SEQUENCE:
345 ! IsValid = LSEatlas_ValidRelease( LSEatlas )
346 !
347 ! INPUTS:
348 ! LSEatlas: LSEatlas object for which the Release component
349 ! is to be checked.
350 ! UNITS: N/A
351 ! TYPE: LSEatlas_type
352 ! DIMENSION: Scalar
353 ! ATTRIBUTES: INTENT(IN)
354 !
355 ! FUNCTION RESULT:
356 ! IsValid: Logical value defining the release validity.
357 ! UNITS: N/A
358 ! TYPE: LOGICAL
359 ! DIMENSION: Scalar
360 !
361 !:sdoc-:
362 !----------------------------------------------------------------------------------
363 
364  FUNCTION lseatlas_validrelease( self ) RESULT( IsValid )
365  ! Arguments
366  TYPE(lseatlas_type), INTENT(IN) :: self
367  ! Function result
368  LOGICAL :: isvalid
369  ! Local parameters
370  CHARACTER(*), PARAMETER :: routine_name = 'LSEatlas_ValidRelease'
371  ! Local variables
372  CHARACTER(ML) :: msg
373 
374  ! Set up
375  isvalid = .true.
376 
377 
378  ! Check release is not too old
379  IF ( self%Release < lseatlas_release ) THEN
380  isvalid = .false.
381  WRITE( msg,'("An LSEatlas data update is needed. ", &
382  &"LSEatlas release is ",i0,". Valid release is ",i0,"." )' ) &
383  self%Release, lseatlas_release
384  CALL display_message( routine_name, msg, information ); RETURN
385  END IF
386 
387 
388  ! Check release is not too new
389  IF ( self%Release > lseatlas_release ) THEN
390  isvalid = .false.
391  WRITE( msg,'("An LSEatlas software update is needed. ", &
392  &"LSEatlas release is ",i0,". Valid release is ",i0,"." )' ) &
393  self%Release, lseatlas_release
394  CALL display_message( routine_name, msg, information ); RETURN
395  END IF
396 
397  END FUNCTION lseatlas_validrelease
398 
399 
400 !--------------------------------------------------------------------------------
401 !:sdoc+:
402 !
403 ! NAME:
404 ! LSEatlas_Info
405 !
406 ! PURPOSE:
407 ! Subroutine to return a string containing version and dimension
408 ! information about a LSEatlas object.
409 !
410 ! CALLING SEQUENCE:
411 ! CALL LSEatlas_Info( LSEatlas, Info )
412 !
413 ! OBJECTS:
414 ! LSEatlas: LSEatlas object about which info is required.
415 ! UNITS: N/A
416 ! TYPE: LSEatlas_type
417 ! DIMENSION: Scalar
418 ! ATTRIBUTES: INTENT(IN)
419 !
420 ! OUTPUTS:
421 ! Info: String containing version and dimension information
422 ! about the LSEatlas object.
423 ! UNITS: N/A
424 ! TYPE: CHARACTER(*)
425 ! DIMENSION: Scalar
426 ! ATTRIBUTES: INTENT(OUT)
427 !
428 !:sdoc-:
429 !--------------------------------------------------------------------------------
430 
431  SUBROUTINE lseatlas_info( self, Info )
432  ! Arguments
433  TYPE(lseatlas_type), INTENT(IN) :: self
434  CHARACTER(*), INTENT(OUT) :: info
435  ! Parameters
436  INTEGER, PARAMETER :: carriage_return = 13
437  INTEGER, PARAMETER :: linefeed = 10
438  ! Local variables
439  CHARACTER(2000) :: long_string
440 
441  ! Write the required data to the local string
442  WRITE( long_string, &
443  '(a,1x,"LSEatlas RELEASE.VERSION: ",i2,".",i2.2,a,3x, &
444  &"N_FREQUENCIES=",i0,2x,&
445  &"N_LATITUDES=",i0,2x,&
446  &"N_LONGITUDES=",i0 )' ) &
447  achar(carriage_return)//achar(linefeed), &
448  self%Release, self%Version, &
449  achar(carriage_return)//achar(linefeed), &
450  self%n_Frequencies, &
451  self%n_Latitudes , &
452  self%n_Longitudes
453 
454  ! Trim the output based on the
455  ! dummy argument string length
456  info = long_string(1:min(len(info), len_trim(long_string)))
457 
458  END SUBROUTINE lseatlas_info
459 
460 
461 !--------------------------------------------------------------------------------
462 !:sdoc+:
463 !
464 ! NAME:
465 ! LSEatlas_Name
466 !
467 ! PURPOSE:
468 ! Function to return the datatype name of an LSEatlas object.
469 !
470 ! CALLING SEQUENCE:
471 ! datatype_name = LSEatlas_Name( LSEatlas )
472 !
473 ! OBJECTS:
474 ! LSEatlas: LSEatlas object structure.
475 ! UNITS: N/A
476 ! TYPE: LSEatlas_type
477 ! DIMENSION: Scalar
478 ! ATTRIBUTES: INTENT(IN)
479 !
480 ! FUNCTION RESULT:
481 ! Status: The return value is a the character string containing
482 ! the datatype name of the structure.
483 ! UNITS: N/A
484 ! TYPE: CHARACTER
485 ! DIMENSION: Scalar
486 !
487 !:sdoc-:
488 !--------------------------------------------------------------------------------
489 
490  FUNCTION lseatlas_name( self ) RESULT( datatype_name )
491  ! Arguments
492  TYPE(lseatlas_type), INTENT(OUT) :: self
493  ! Function result
494  CHARACTER(LEN(self%Datatype_Name)) :: datatype_name
495 
496  datatype_name = self%Datatype_Name
497 
498  END FUNCTION lseatlas_name
499 
500 
501 !--------------------------------------------------------------------------------
502 !:sdoc+:
503 !
504 ! NAME:
505 ! LSEatlas_DefineVersion
506 !
507 ! PURPOSE:
508 ! Subroutine to return the module version information.
509 !
510 ! CALLING SEQUENCE:
511 ! CALL LSEatlas_DefineVersion( Id )
512 !
513 ! OUTPUTS:
514 ! Id: Character string containing the version Id information
515 ! for the module.
516 ! UNITS: N/A
517 ! TYPE: CHARACTER(*)
518 ! DIMENSION: Scalar
519 ! ATTRIBUTES: INTENT(OUT)
520 !
521 !:sdoc-:
522 !--------------------------------------------------------------------------------
523 
524  SUBROUTINE lseatlas_defineversion( Id )
525  CHARACTER(*), INTENT(OUT) :: id
526  id = module_version_id
527  END SUBROUTINE lseatlas_defineversion
528 
529 
530 
531 !--------------------------------------------------------------------------------
532 !:sdoc+:
533 !
534 ! NAME:
535 ! LSEatlas_SetValue
536 !
537 ! PURPOSE:
538 ! Subroutine to set the contents of a valid LSEatlas object.
539 !
540 ! CALLING SEQUENCE:
541 ! CALL LSEatlas_SetValue( LSEatlas, &
542 ! Version = Version , &
543 ! Frequency = Frequency , &
544 ! Latitude = Latitude , &
545 ! Longitude = Longitude , &
546 ! Emissivity = Emissivity )
547 !
548 ! OBJECTS:
549 ! LSEatlas: Valid, allocated LSEatlas object for which
550 ! values are to be set.
551 ! UNITS: N/A
552 ! TYPE: LSEatlas_type
553 ! DIMENSION: Scalar
554 ! ATTRIBUTES: INTENT(IN OUT)
555 !
556 ! OPTIONAL INPUTS:
557 ! Version: Integer indicating the data version. If not specified
558 ! the value of the module parameter LSEatlas_VERSION
559 ! is used.
560 ! UNITS: N/A
561 ! TYPE: INTEGER
562 ! DIMENSION: Scalar
563 ! ATTRIBUTES: INTENT(IN), OPTIONAL
564 !
565 ! Frequency: Real array to which the Frequency component of the
566 ! LSEatlas object is to be set. The size of the
567 ! input must match the allocated size of the component,
568 ! otherwise all the component values are set to zero.
569 ! UNITS: N/A
570 ! TYPE: REAL(fp)
571 ! DIMENSION: Rank-1 (L)
572 ! ATTRIBUTES: INTENT(IN), OPTIONAL
573 !
574 ! Latitude: Real array to which the Latitude component of the
575 ! LSEatlas object is to be set. The size of the
576 ! input must match the allocated size of the component,
577 ! otherwise all the component values are set to zero.
578 ! UNITS: N/A
579 ! TYPE: REAL(fp)
580 ! DIMENSION: Rank-1 (I)
581 ! ATTRIBUTES: INTENT(IN), OPTIONAL
582 !
583 ! Longitude: Real array to which the Longitude component of the
584 ! LSEatlas object is to be set. The size of the
585 ! input must match the allocated size of the component,
586 ! otherwise all the component values are set to zero.
587 ! UNITS: N/A
588 ! TYPE: REAL(fp)
589 ! DIMENSION: Rank-1 (J)
590 ! ATTRIBUTES: INTENT(IN), OPTIONAL
591 !
592 ! Emissivity: Real array to which the Emissivity component of the
593 ! LSEatlas object is to be set. The size of the
594 ! input must match the allocated size of the component,
595 ! otherwise all the component values are set to zero.
596 ! UNITS: N/A
597 ! TYPE: REAL(fp)
598 ! DIMENSION: Rank-3 (L x I x J)
599 ! ATTRIBUTES: INTENT(IN), OPTIONAL
600 !
601 !:sdoc-:
602 !--------------------------------------------------------------------------------
603 
604  SUBROUTINE lseatlas_setvalue( &
605  self , & ! Input
606  Version , & ! Optional input
607  Frequency , & ! Optional input
608  Latitude , & ! Optional input
609  Longitude , & ! Optional input
610  Emissivity ) ! Optional input
611  ! Arguments
612  TYPE(lseatlas_type), INTENT(IN OUT) :: self
613  INTEGER , OPTIONAL, INTENT(IN) :: version
614  REAL(fp), OPTIONAL, INTENT(IN) :: frequency(:)
615  REAL(fp), OPTIONAL, INTENT(IN) :: latitude(:)
616  REAL(fp), OPTIONAL, INTENT(IN) :: longitude(:)
617  REAL(fp), OPTIONAL, INTENT(IN) :: emissivity(:,:,:)
618 
619  IF ( .NOT. lseatlas_associated(self) ) RETURN
620 
621  IF ( PRESENT(version) ) self%Version = version
622 
623  IF ( PRESENT(frequency) ) THEN
624  IF ( SIZE(frequency) == self%n_Frequencies ) THEN
625  self%Frequency = frequency
626  ELSE
627  self%Frequency = zero
628  END IF
629  END IF
630 
631  IF ( PRESENT(latitude) ) THEN
632  IF ( SIZE(latitude) == self%n_Latitudes ) THEN
633  self%Latitude = latitude
634  ELSE
635  self%Latitude = zero
636  END IF
637  END IF
638 
639  IF ( PRESENT(longitude) ) THEN
640  IF ( SIZE(longitude) == self%n_Longitudes ) THEN
641  self%Longitude = longitude
642  ELSE
643  self%Longitude = zero
644  END IF
645  END IF
646 
647  IF ( PRESENT(emissivity) ) THEN
648  IF ( SIZE(emissivity,dim=1) == self%n_Frequencies .AND. &
649  SIZE(emissivity,dim=2) == self%n_Latitudes .AND. &
650  SIZE(emissivity,dim=3) == self%n_Longitudes ) THEN
651  self%Emissivity = emissivity
652  ELSE
653  self%Emissivity = zero
654  END IF
655  END IF
656 
657  END SUBROUTINE lseatlas_setvalue
658 
659 
660 !--------------------------------------------------------------------------------
661 !:sdoc+:
662 !
663 ! NAME:
664 ! LSEatlas_GetValue
665 !
666 ! PURPOSE:
667 ! Subroutine to get the contents of a valid LSEatlas object.
668 !
669 ! CALLING SEQUENCE:
670 ! CALL LSEatlas_GetValue( LSEatlas, &
671 ! Version = Version , &
672 ! n_Frequencies = n_Frequencies, &
673 ! n_Latitudes = n_Latitudes , &
674 ! n_Longitudes = n_Longitudes , &
675 ! Frequency = Frequency , &
676 ! Latitude = Latitude , &
677 ! Longitude = Longitude , &
678 ! Emissivity = Emissivity )
679 !
680 ! OBJECTS:
681 ! LSEatlas: Valid, allocated LSEatlas object from which
682 ! values are to be retrieved.
683 ! UNITS: N/A
684 ! TYPE: LSEatlas_type
685 ! DIMENSION: Scalar
686 ! ATTRIBUTES: INTENT(IN OUT)
687 !
688 ! OPTIONAL OUTPUTS:
689 ! Version: Integer indicating the data version of the object.
690 ! UNITS: N/A
691 ! TYPE: INTEGER
692 ! DIMENSION: Scalar
693 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
694 !
695 ! n_Frequencies: Number of spectral frequencies for which there are
696 ! data.
697 ! UNITS: N/A
698 ! TYPE: INTEGER
699 ! DIMENSION: Scalar
700 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
701 !
702 ! n_Latitudes: Number of latitude values for which there are
703 ! data.
704 ! UNITS: N/A
705 ! TYPE: INTEGER
706 ! DIMENSION: Scalar
707 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
708 !
709 ! n_Longitudes: Number of longitude values for which there are
710 ! data.
711 ! UNITS: N/A
712 ! TYPE: INTEGER
713 ! DIMENSION: Scalar
714 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
715 !
716 ! Frequency: Real array to which the Frequency component of the
717 ! LSEatlas object will be assigned. The actual
718 ! argument must be declared as allocatable.
719 ! UNITS: N/A
720 ! TYPE: REAL(fp)
721 ! DIMENSION: Rank-1 (L)
722 ! ATTRIBUTES: INTENT(OUT), OPTIONAL, ALLOCATABLE
723 !
724 ! Latitude: Real array to which the Latitude component of the
725 ! LSEatlas object will be assigned. The actual
726 ! argument must be declared as allocatable.
727 ! UNITS: N/A
728 ! TYPE: REAL(fp)
729 ! DIMENSION: Rank-1 (I)
730 ! ATTRIBUTES: INTENT(OUT), OPTIONAL, ALLOCATABLE
731 !
732 ! Longitude: Real array to which the Longitude component of the
733 ! LSEatlas object will be assigned. The actual
734 ! argument must be declared as allocatable.
735 ! UNITS: N/A
736 ! TYPE: REAL(fp)
737 ! DIMENSION: Rank-1 (J)
738 ! ATTRIBUTES: INTENT(OUT), OPTIONAL, ALLOCATABLE
739 !
740 ! Emissivity: Real array to which the Emissivity component of the
741 ! LSEatlas object will be assigned. The actual
742 ! argument must be declared as allocatable.
743 ! UNITS: N/A
744 ! TYPE: REAL(fp)
745 ! DIMENSION: Rank-3 (L x I x J)
746 ! ATTRIBUTES: INTENT(OUT), OPTIONAL, ALLOCATABLE
747 !
748 !:sdoc-:
749 !--------------------------------------------------------------------------------
750 
751  SUBROUTINE lseatlas_getvalue( &
752  self , & ! Input
753  Version , & ! Optional input
754  n_Frequencies, & ! Optional output
755  n_Latitudes , & ! Optional output
756  n_Longitudes , & ! Optional output
757  Frequency , & ! Optional output
758  Latitude , & ! Optional output
759  Longitude , & ! Optional output
760  Emissivity ) ! Optional output
761  ! Arguments
762  TYPE(lseatlas_type), INTENT(IN) :: self
763  INTEGER , OPTIONAL, INTENT(OUT) :: version
764  INTEGER , OPTIONAL, INTENT(OUT) :: n_frequencies
765  INTEGER , OPTIONAL, INTENT(OUT) :: n_latitudes
766  INTEGER , OPTIONAL, INTENT(OUT) :: n_longitudes
767  REAL(fp), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: frequency(:)
768  REAL(fp), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: latitude(:)
769  REAL(fp), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: longitude(:)
770  REAL(fp), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: emissivity(:,:,:)
771 
772  IF ( .NOT. lseatlas_associated(self) ) RETURN
773 
774  IF ( PRESENT(version ) ) version = self%Version
775  IF ( PRESENT(n_frequencies) ) n_frequencies = self%n_Frequencies
776  IF ( PRESENT(n_latitudes ) ) n_latitudes = self%n_Latitudes
777  IF ( PRESENT(n_longitudes ) ) n_longitudes = self%n_Longitudes
778 
779  IF ( PRESENT(frequency) ) THEN
780  ALLOCATE(frequency(self%n_Frequencies))
781  frequency = self%Frequency
782  END IF
783 
784  IF ( PRESENT(latitude) ) THEN
785  ALLOCATE(latitude(self%n_Latitudes))
786  latitude = self%Latitude
787  END IF
788 
789  IF ( PRESENT(longitude) ) THEN
790  ALLOCATE(longitude(self%n_Longitudes))
791  longitude = self%Longitude
792  END IF
793 
794  IF ( PRESENT(emissivity) ) THEN
795  ALLOCATE(emissivity(self%n_Frequencies,self%n_Latitudes,self%n_Longitudes))
796  emissivity = self%Emissivity
797  END IF
798 
799  END SUBROUTINE lseatlas_getvalue
800 
801 
802 
803 !------------------------------------------------------------------------------
804 !:sdoc+:
805 !
806 ! NAME:
807 ! LSEatlas_InquireFile
808 !
809 ! PURPOSE:
810 ! Function to inquire LSEatlas object files.
811 !
812 ! CALLING SEQUENCE:
813 ! Error_Status = LSEatlas_InquireFile( &
814 ! Filename , &
815 ! n_Frequencies = n_Frequencies, &
816 ! n_Latitudes = n_Latitudes , &
817 ! n_Longitudes = n_Longitudes , &
818 ! Release = Release , &
819 ! Version = Version )
820 !
821 ! INPUTS:
822 ! Filename: Character string specifying the name of the
823 ! data file to inquire.
824 ! UNITS: N/A
825 ! TYPE: CHARACTER(*)
826 ! DIMENSION: Scalar
827 ! ATTRIBUTES: INTENT(IN)
828 !
829 ! OPTIONAL OUTPUTS:
830 ! n_Frequencies: Number of spectral frequencies for which there are
831 ! data.
832 ! UNITS: N/A
833 ! TYPE: INTEGER
834 ! DIMENSION: Scalar
835 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
836 !
837 ! n_Latitudes: Number of latitude values for which there are
838 ! data.
839 ! UNITS: N/A
840 ! TYPE: INTEGER
841 ! DIMENSION: Scalar
842 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
843 !
844 ! n_Longitudes: Number of longitude values for which there are
845 ! data.
846 ! UNITS: N/A
847 ! TYPE: INTEGER
848 ! DIMENSION: Scalar
849 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
850 !
851 ! Release: The data/file release number. Used to check
852 ! for data/software mismatch.
853 ! UNITS: N/A
854 ! TYPE: INTEGER
855 ! DIMENSION: Scalar
856 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
857 !
858 ! Version: The data/file version number. Used for
859 ! purposes only in identifying the dataset for
860 ! a particular release.
861 ! UNITS: N/A
862 ! TYPE: INTEGER
863 ! DIMENSION: Scalar
864 ! ATTRIBUTES: INTENT(OUT), OPTIONAL
865 !
866 ! FUNCTION RESULT:
867 ! Error_Status: The return value is an integer defining the error
868 ! status. The error codes are defined in the
869 ! Message_Handler module.
870 ! If == SUCCESS the file inquire was successful
871 ! == FAILURE an unrecoverable error occurred.
872 ! UNITS: N/A
873 ! TYPE: INTEGER
874 ! DIMENSION: Scalar
875 !
876 !:sdoc-:
877 !------------------------------------------------------------------------------
878 
879  FUNCTION lseatlas_inquirefile( &
880  Filename , & ! Input
881  n_Frequencies, & ! Optional output
882  n_Latitudes , & ! Optional output
883  n_Longitudes , & ! Optional output
884  Release , & ! Optional output
885  Version , & ! Optional output
886  Title , & ! Optional output
887  History , & ! Optional output
888  Comment ) & ! Optional output
889  result( err_stat )
890  ! Arguments
891  CHARACTER(*), INTENT(IN) :: filename
892  INTEGER , OPTIONAL, INTENT(OUT) :: n_frequencies
893  INTEGER , OPTIONAL, INTENT(OUT) :: n_latitudes
894  INTEGER , OPTIONAL, INTENT(OUT) :: n_longitudes
895  INTEGER , OPTIONAL, INTENT(OUT) :: release
896  INTEGER , OPTIONAL, INTENT(OUT) :: version
897  CHARACTER(*), OPTIONAL, INTENT(OUT) :: title
898  CHARACTER(*), OPTIONAL, INTENT(OUT) :: history
899  CHARACTER(*), OPTIONAL, INTENT(OUT) :: comment
900  ! Function result
901  INTEGER :: err_stat
902  ! Function parameters
903  CHARACTER(*), PARAMETER :: routine_name = 'LSEatlas_InquireFile'
904  ! Function variables
905  CHARACTER(ML) :: msg
906  CHARACTER(ML) :: io_msg
907  INTEGER :: io_stat
908  INTEGER :: fid
909  TYPE(lseatlas_type) :: lseatlas
910 
911 
912  ! Setup
913  err_stat = success
914  ! ...Check that the file exists
915  IF ( .NOT. file_exists( filename ) ) THEN
916  msg = 'File '//trim(filename)//' not found.'
917  CALL inquire_cleanup(); RETURN
918  END IF
919 
920 
921  ! Open the file
922  err_stat = open_binary_file( filename, fid )
923  IF ( err_stat /= success ) THEN
924  msg = 'Error opening '//trim(filename)
925  CALL inquire_cleanup(); RETURN
926  END IF
927 
928 
929  ! Read and check the datatype name
930  err_stat = read_datatype( fid, lseatlas%Datatype_name )
931  IF ( err_stat /= success ) THEN
932  msg = 'Error reading Datatype_Name'
933  CALL inquire_cleanup(); RETURN
934  END IF
935  IF ( trim(lseatlas%Datatype_Name) /= lseatlas_datatype ) THEN
936  msg = lseatlas_datatype//' datatype name check failed.'
937  CALL inquire_cleanup(); RETURN
938  END IF
939 
940 
941  ! Read the release and version
942  READ( fid, iostat=io_stat, iomsg=io_msg ) &
943  lseatlas%Release, &
944  lseatlas%Version
945  IF ( io_stat /= 0 ) THEN
946  msg = 'Error reading Release/Version - '//trim(io_msg)
947  CALL inquire_cleanup(); RETURN
948  END IF
949  IF ( .NOT. lseatlas_validrelease( lseatlas ) ) THEN
950  msg = 'LSEatlas Release check failed.'
951  CALL inquire_cleanup(); RETURN
952  END IF
953 
954 
955  ! Read the dimensions
956  READ( fid, iostat=io_stat, iomsg=io_msg ) &
957  lseatlas%n_Frequencies, &
958  lseatlas%n_Latitudes , &
959  lseatlas%n_Longitudes
960  IF ( io_stat /= 0 ) THEN
961  msg = 'Error reading dimension values from '//trim(filename)//' - '//trim(io_msg)
962  CALL inquire_cleanup(); RETURN
963  END IF
964 
965 
966  ! Read the global attributes
967  err_stat = readgatts_binary_file( &
968  fid, &
969  title = title , &
970  history = history, &
971  comment = comment )
972  IF ( err_stat /= success ) THEN
973  msg = 'Error reading global attributes'
974  CALL inquire_cleanup(); RETURN
975  END IF
976 
977 
978  ! Close the file
979  CLOSE( fid, iostat=io_stat, iomsg=io_msg )
980  IF ( io_stat /= 0 ) THEN
981  msg = 'Error closing '//trim(filename)//' - '//trim(io_msg)
982  CALL inquire_cleanup(); RETURN
983  END IF
984 
985 
986  ! Assign the return arguments
987  IF ( PRESENT(n_frequencies) ) n_frequencies = lseatlas%n_Frequencies
988  IF ( PRESENT(n_latitudes ) ) n_latitudes = lseatlas%n_Latitudes
989  IF ( PRESENT(n_longitudes ) ) n_longitudes = lseatlas%n_Longitudes
990  IF ( PRESENT(release ) ) release = lseatlas%Release
991  IF ( PRESENT(version ) ) version = lseatlas%Version
992 
993  CONTAINS
994 
995  SUBROUTINE inquire_cleanup()
996  ! Close file if necessary
997  IF ( file_open(fid) ) THEN
998  CLOSE( fid, iostat=io_stat, iomsg=io_msg )
999  IF ( io_stat /= 0 ) &
1000  msg = trim(msg)//'; Error closing input file during error cleanup - '//trim(io_msg)
1001  END IF
1002  ! Set error status and print error message
1003  err_stat = failure
1004  CALL display_message( routine_name, msg, err_stat )
1005  END SUBROUTINE inquire_cleanup
1006 
1007  END FUNCTION lseatlas_inquirefile
1008 
1009 
1010 !--------------------------------------------------------------------------------
1011 !:sdoc+:
1012 !
1013 ! NAME:
1014 ! LSEatlas_ReadFile
1015 !
1016 ! PURPOSE:
1017 ! Function to read LSEatlas object files.
1018 !
1019 ! CALLING SEQUENCE:
1020 ! Error_Status = LSEatlas_ReadFile( &
1021 ! LSEatlas , &
1022 ! Filename , &
1023 ! No_Close = No_Close, &
1024 ! Quiet = Quiet )
1025 !
1026 ! OBJECTS:
1027 ! LSEatlas: LSEatlas object containing the data read from file.
1028 ! UNITS: N/A
1029 ! TYPE: LSEatlas_type
1030 ! DIMENSION: Scalar
1031 ! ATTRIBUTES: INTENT(OUT)
1032 !
1033 ! INPUTS:
1034 ! Filename: Character string specifying the name of a
1035 ! LSEatlas data file to read.
1036 ! UNITS: N/A
1037 ! TYPE: CHARACTER(*)
1038 ! DIMENSION: Scalar
1039 ! ATTRIBUTES: INTENT(IN)
1040 !
1041 ! OPTIONAL INPUTS:
1042 ! No_Close: Set this logical argument to *NOT* close the datafile
1043 ! upon exiting this routine. This option is required if
1044 ! the LSEatlas data is embedded within another file.
1045 ! If == .FALSE., File is closed upon function exit [DEFAULT].
1046 ! == .TRUE., File is NOT closed upon function exit
1047 ! If not specified, default is .FALSE.
1048 ! UNITS: N/A
1049 ! TYPE: LOGICAL
1050 ! DIMENSION: Scalar
1051 ! ATTRIBUTES: INTENT(IN), OPTIONAL
1052 !
1053 ! Quiet: Set this logical argument to suppress INFORMATION
1054 ! messages being printed to stdout
1055 ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
1056 ! == .TRUE., INFORMATION messages are SUPPRESSED.
1057 ! If not specified, default is .FALSE.
1058 ! UNITS: N/A
1059 ! TYPE: LOGICAL
1060 ! DIMENSION: Scalar
1061 ! ATTRIBUTES: INTENT(IN), OPTIONAL
1062 !
1063 ! FUNCTION RESULT:
1064 ! Error_Status: The return value is an integer defining the error status.
1065 ! The error codes are defined in the Message_Handler module.
1066 ! If == SUCCESS, the file read was successful
1067 ! == FAILURE, an unrecoverable error occurred.
1068 ! UNITS: N/A
1069 ! TYPE: INTEGER
1070 ! DIMENSION: Scalar
1071 !
1072 !:sdoc-:
1073 !------------------------------------------------------------------------------
1074 
1075  FUNCTION lseatlas_readfile( &
1076  LSEatlas, & ! Output
1077  Filename , & ! Input
1078  No_Close , & ! Optional input
1079  Quiet , & ! Optional input
1080  Title , & ! Optional output
1081  History , & ! Optional output
1082  Comment , & ! Optional output
1083  Debug ) & ! Optional input (Debug output control)
1084  result( err_stat )
1085  ! Arguments
1086  TYPE(lseatlas_type) , INTENT(OUT) :: lseatlas
1087  CHARACTER(*), INTENT(IN) :: filename
1088  LOGICAL, OPTIONAL, INTENT(IN) :: no_close
1089  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
1090  CHARACTER(*), OPTIONAL, INTENT(OUT) :: title
1091  CHARACTER(*), OPTIONAL, INTENT(OUT) :: history
1092  CHARACTER(*), OPTIONAL, INTENT(OUT) :: comment
1093  LOGICAL, OPTIONAL, INTENT(IN) :: debug
1094  ! Function result
1095  INTEGER :: err_stat
1096  ! Function parameters
1097  CHARACTER(*), PARAMETER :: routine_name = 'LSEatlas_ReadFile'
1098  ! Function variables
1099  CHARACTER(ML) :: msg
1100  CHARACTER(ML) :: io_msg
1101  LOGICAL :: close_file
1102  LOGICAL :: noisy
1103  INTEGER :: io_stat
1104  INTEGER :: fid
1105  TYPE(lseatlas_type) :: dummy
1106 
1107  ! Setup
1108  err_stat = success
1109  ! ...Check No_Close argument
1110  close_file = .true.
1111  IF ( PRESENT(no_close) ) close_file = .NOT. no_close
1112  ! ...Check Quiet argument
1113  noisy = .true.
1114  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
1115  ! ...Override Quiet settings if debug set.
1116  IF ( PRESENT(debug) ) THEN
1117  IF ( debug ) noisy = .true.
1118  END IF
1119 
1120 
1121  ! Check if the file is open.
1122  IF ( file_open( filename ) ) THEN
1123  ! ...Inquire for the logical unit number
1124  INQUIRE( file=filename, number=fid )
1125  ! ...Ensure it's valid
1126  IF ( fid < 0 ) THEN
1127  msg = 'Error inquiring '//trim(filename)//' for its FileID'
1128  CALL read_cleanup(); RETURN
1129  END IF
1130  ELSE
1131  ! ...Open the file if it exists
1132  IF ( file_exists( filename ) ) THEN
1133  err_stat = open_binary_file( filename, fid )
1134  IF ( err_stat /= success ) THEN
1135  msg = 'Error opening '//trim(filename)
1136  CALL read_cleanup(); RETURN
1137  END IF
1138  ELSE
1139  msg = 'File '//trim(filename)//' not found.'
1140  CALL read_cleanup(); RETURN
1141  END IF
1142  END IF
1143 
1144 
1145  ! Read and check the datatype name
1146  err_stat = read_datatype( fid, dummy%Datatype_name )
1147  IF ( err_stat /= success ) THEN
1148  msg = 'Error reading Datatype_Name'
1149  CALL read_cleanup(); RETURN
1150  END IF
1151  IF ( trim(dummy%Datatype_Name) /= lseatlas_datatype ) THEN
1152  msg = lseatlas_datatype//' datatype name check failed.'
1153  CALL read_cleanup(); RETURN
1154  END IF
1155 
1156 
1157  ! Read and check the release and version
1158  READ( fid, iostat=io_stat, iomsg=io_msg ) &
1159  dummy%Release, &
1160  dummy%Version
1161  IF ( io_stat /= 0 ) THEN
1162  msg = 'Error reading Release/Version - '//trim(io_msg)
1163  CALL read_cleanup(); RETURN
1164  END IF
1165  IF ( .NOT. lseatlas_validrelease( dummy ) ) THEN
1166  msg = 'LSEatlas Release check failed.'
1167  CALL read_cleanup(); RETURN
1168  END IF
1169 
1170 
1171  ! Read the dimensions
1172  READ( fid, iostat=io_stat, iomsg=io_msg ) &
1173  dummy%n_Frequencies, &
1174  dummy%n_Latitudes , &
1175  dummy%n_Longitudes
1176  IF ( io_stat /= 0 ) THEN
1177  msg = 'Error reading data dimensions - '//trim(io_msg)
1178  CALL read_cleanup(); RETURN
1179  END IF
1180  ! ...Allocate the object
1181  CALL lseatlas_create( &
1182  lseatlas , &
1183  dummy%n_Frequencies, &
1184  dummy%n_Latitudes , &
1185  dummy%n_Longitudes )
1186  IF ( .NOT. lseatlas_associated( lseatlas ) ) THEN
1187  msg = 'LSEatlas object allocation failed.'
1188  CALL read_cleanup(); RETURN
1189  END IF
1190  ! ...Explicitly assign the version number
1191  lseatlas%Version = dummy%Version
1192 
1193 
1194  ! Read the global attributes
1195  err_stat = readgatts_binary_file( &
1196  fid, &
1197  title = title , &
1198  history = history, &
1199  comment = comment )
1200  IF ( err_stat /= success ) THEN
1201  msg = 'Error reading global attributes'
1202  CALL read_cleanup(); RETURN
1203  END IF
1204 
1205 
1206  ! Read the coefficient data
1207  ! ...Read the dimensional vectors
1208  READ( fid, iostat=io_stat, iomsg=io_msg ) &
1209  lseatlas%Frequency, &
1210  lseatlas%Latitude , &
1211  lseatlas%Longitude
1212  IF ( io_stat /= 0 ) THEN
1213  msg = 'Error reading dimensional vectors - '//trim(io_msg)
1214  CALL read_cleanup(); RETURN
1215  END IF
1216  ! ...Read the emissivity data
1217  READ( fid, iostat=io_stat, iomsg=io_msg ) &
1218  lseatlas%Emissivity
1219  IF ( io_stat /= 0 ) THEN
1220  msg = 'Error reading emissivity data - '//trim(io_msg)
1221  CALL read_cleanup(); RETURN
1222  END IF
1223 
1224 
1225  ! Close the file
1226  IF ( close_file ) THEN
1227  CLOSE( fid, iostat=io_stat, iomsg=io_msg )
1228  IF ( io_stat /= 0 ) THEN
1229  msg = 'Error closing '//trim(filename)//' - '//trim(io_msg)
1230  CALL read_cleanup(); RETURN
1231  END IF
1232  END IF
1233 
1234 
1235  ! Output an info message
1236  IF ( noisy ) THEN
1237  CALL lseatlas_info( lseatlas, msg )
1238  CALL display_message( routine_name, 'FILE: '//trim(filename)//'; '//trim(msg), information )
1239  END IF
1240 
1241  CONTAINS
1242 
1243  SUBROUTINE read_cleanup()
1244  IF ( file_open(filename) ) THEN
1245  CLOSE( fid, iostat=io_stat, iomsg=io_msg )
1246  IF ( io_stat /= 0 ) &
1247  msg = trim(msg)//'; Error closing input file during error cleanup - '//trim(io_msg)
1248  END IF
1249  CALL lseatlas_destroy( lseatlas )
1250  err_stat = failure
1251  CALL display_message( routine_name, msg, err_stat )
1252  END SUBROUTINE read_cleanup
1253 
1254  END FUNCTION lseatlas_readfile
1255 
1256 
1257 !--------------------------------------------------------------------------------
1258 !:sdoc+:
1259 !
1260 ! NAME:
1261 ! LSEatlas_WriteFile
1262 !
1263 ! PURPOSE:
1264 ! Function to write LSEatlas object files.
1265 !
1266 ! CALLING SEQUENCE:
1267 ! Error_Status = LSEatlas_WriteFile( &
1268 ! LSEatlas , &
1269 ! Filename , &
1270 ! No_Close = No_Close, &
1271 ! Quiet = Quiet )
1272 !
1273 ! OBJECTS:
1274 ! LSEatlas: LSEatlas object containing the data to write to file.
1275 ! UNITS: N/A
1276 ! TYPE: LSEatlas_type
1277 ! DIMENSION: Scalar
1278 ! ATTRIBUTES: INTENT(IN)
1279 !
1280 ! INPUTS:
1281 ! Filename: Character string specifying the name of a
1282 ! LSEatlas format data file to write.
1283 ! UNITS: N/A
1284 ! TYPE: CHARACTER(*)
1285 ! DIMENSION: Scalar
1286 ! ATTRIBUTES: INTENT(IN)
1287 !
1288 ! OPTIONAL INPUTS:
1289 ! No_Close: Set this logical argument to *NOT* close the datafile
1290 ! upon exiting this routine. This option is required if
1291 ! the LSEatlas data is to be embedded within another file.
1292 ! If == .FALSE., File is closed upon function exit [DEFAULT].
1293 ! == .TRUE., File is NOT closed upon function exit
1294 ! If not specified, default is .FALSE.
1295 ! UNITS: N/A
1296 ! TYPE: LOGICAL
1297 ! DIMENSION: Scalar
1298 ! ATTRIBUTES: INTENT(IN), OPTIONAL
1299 !
1300 ! Quiet: Set this logical argument to suppress INFORMATION
1301 ! messages being printed to stdout
1302 ! If == .FALSE., INFORMATION messages are OUTPUT [DEFAULT].
1303 ! == .TRUE., INFORMATION messages are SUPPRESSED.
1304 ! If not specified, default is .FALSE.
1305 ! UNITS: N/A
1306 ! TYPE: LOGICAL
1307 ! DIMENSION: Scalar
1308 ! ATTRIBUTES: INTENT(IN), OPTIONAL
1309 !
1310 ! FUNCTION RESULT:
1311 ! Error_Status: The return value is an integer defining the error status.
1312 ! The error codes are defined in the Message_Handler module.
1313 ! If == SUCCESS, the file write was successful
1314 ! == FAILURE, an unrecoverable error occurred.
1315 ! UNITS: N/A
1316 ! TYPE: INTEGER
1317 ! DIMENSION: Scalar
1318 !
1319 !:sdoc-:
1320 !------------------------------------------------------------------------------
1321 
1322  FUNCTION lseatlas_writefile( &
1323  LSEatlas, & ! Input
1324  Filename , & ! Input
1325  No_Close , & ! Optional input
1326  Quiet , & ! Optional input
1327  Title , & ! Optional input
1328  History , & ! Optional input
1329  Comment , & ! Optional input
1330  Debug ) & ! Optional input (Debug output control)
1331  result( err_stat )
1332  ! Arguments
1333  TYPE(lseatlas_type), INTENT(IN) :: lseatlas
1334  CHARACTER(*), INTENT(IN) :: filename
1335  LOGICAL, OPTIONAL, INTENT(IN) :: no_close
1336  LOGICAL, OPTIONAL, INTENT(IN) :: quiet
1337  CHARACTER(*), OPTIONAL, INTENT(IN) :: title
1338  CHARACTER(*), OPTIONAL, INTENT(IN) :: history
1339  CHARACTER(*), OPTIONAL, INTENT(IN) :: comment
1340  LOGICAL, OPTIONAL, INTENT(IN) :: debug
1341  ! Function result
1342  INTEGER :: err_stat
1343  ! Function parameters
1344  CHARACTER(*), PARAMETER :: routine_name = 'LSEatlas_WriteFile'
1345  ! Function variables
1346  CHARACTER(ML) :: msg
1347  CHARACTER(ML) :: io_msg
1348  LOGICAL :: close_file
1349  LOGICAL :: noisy
1350  INTEGER :: io_stat
1351  INTEGER :: fid
1352 
1353 
1354  ! Setup
1355  err_stat = success
1356  ! ...Check No_Close argument
1357  close_file = .true.
1358  IF ( PRESENT(no_close) ) close_file = .NOT. no_close
1359  ! ...Check Quiet argument
1360  noisy = .true.
1361  IF ( PRESENT(quiet) ) noisy = .NOT. quiet
1362  ! ...Override Quiet settings if debug set.
1363  IF ( PRESENT(debug) ) THEN
1364  IF ( debug ) noisy = .true.
1365  END IF
1366  ! ...Check there is data to write
1367  IF ( .NOT. lseatlas_associated( lseatlas ) ) THEN
1368  msg = 'LSEatlas object is empty.'
1369  CALL write_cleanup(); RETURN
1370  END IF
1371 
1372 
1373  ! Check if the file is open.
1374  IF ( file_open( filename ) ) THEN
1375  ! ...Inquire for the logical unit number
1376  INQUIRE( file=filename, number=fid )
1377  ! ...Ensure it's valid
1378  IF ( fid < 0 ) THEN
1379  msg = 'Error inquiring '//trim(filename)//' for its FileID'
1380  CALL write_cleanup(); RETURN
1381  END IF
1382  ELSE
1383  ! ...Open the file for output
1384  err_stat = open_binary_file( filename, fid, for_output=.true. )
1385  IF ( err_stat /= success ) THEN
1386  msg = 'Error opening '//trim(filename)
1387  CALL write_cleanup(); RETURN
1388  END IF
1389  END IF
1390 
1391 
1392  ! Write the datatype name
1393  WRITE( fid, iostat=io_stat, iomsg=io_msg ) &
1394  len(lseatlas%Datatype_Name)
1395  IF ( io_stat /= 0 ) THEN
1396  msg = 'Error writing Datatype_Name length - '//trim(io_msg)
1397  CALL write_cleanup(); RETURN
1398  END IF
1399  WRITE( fid, iostat=io_stat, iomsg=io_msg ) &
1400  lseatlas%Datatype_Name
1401  IF ( io_stat /= 0 ) THEN
1402  msg = 'Error writing Datatype_Name - '//trim(io_msg)
1403  CALL write_cleanup(); RETURN
1404  END IF
1405 
1406 
1407  ! Write the release and version
1408  WRITE( fid, iostat=io_stat, iomsg=io_msg ) &
1409  lseatlas%Release, &
1410  lseatlas%Version
1411  IF ( io_stat /= 0 ) THEN
1412  msg = 'Error writing Release/Version - '//trim(io_msg)
1413  CALL write_cleanup(); RETURN
1414  END IF
1415 
1416 
1417  ! Write the dimensions
1418  WRITE( fid, iostat=io_stat, iomsg=io_msg ) &
1419  lseatlas%n_Frequencies, &
1420  lseatlas%n_Latitudes , &
1421  lseatlas%n_Longitudes
1422  IF ( io_stat /= 0 ) THEN
1423  msg = 'Error writing data dimensions - '//trim(io_msg)
1424  CALL write_cleanup(); RETURN
1425  END IF
1426 
1427 
1428  ! Write the global attributes
1429  err_stat = writegatts_binary_file( &
1430  fid, &
1431  write_module = module_version_id, &
1432  title = title , &
1433  history = history, &
1434  comment = comment )
1435  IF ( err_stat /= success ) THEN
1436  msg = 'Error writing global attributes'
1437  CALL write_cleanup(); RETURN
1438  END IF
1439 
1440 
1441  ! Write the coefficient data
1442  ! ...Write the dimensional vectors
1443  WRITE( fid, iostat=io_stat, iomsg=io_msg ) &
1444  lseatlas%Frequency, &
1445  lseatlas%Latitude , &
1446  lseatlas%Longitude
1447  IF ( io_stat /= 0 ) THEN
1448  msg = 'Error writing dimensional vectors - '//trim(io_msg)
1449  CALL write_cleanup(); RETURN
1450  END IF
1451  ! ...Write the emissivity data
1452  WRITE( fid, iostat=io_stat, iomsg=io_msg ) &
1453  lseatlas%Emissivity
1454  IF ( io_stat /= 0 ) THEN
1455  msg = 'Error writing emissivity data - '//trim(io_msg)
1456  CALL write_cleanup(); RETURN
1457  END IF
1458 
1459 
1460  ! Close the file
1461  IF ( close_file ) THEN
1462  CLOSE( fid, iostat=io_stat, iomsg=io_msg )
1463  IF ( io_stat /= 0 ) THEN
1464  msg = 'Error closing '//trim(filename)//' - '//trim(io_msg)
1465  CALL write_cleanup(); RETURN
1466  END IF
1467  END IF
1468 
1469 
1470  ! Output an info message
1471  IF ( noisy ) THEN
1472  CALL lseatlas_info( lseatlas, msg )
1473  CALL display_message( routine_name, 'FILE: '//trim(filename)//'; '//trim(msg), information )
1474  END IF
1475 
1476  CONTAINS
1477 
1478  SUBROUTINE write_cleanup()
1479  IF ( file_open(filename) ) THEN
1480  CLOSE( fid, iostat=io_stat, iomsg=io_msg )
1481  IF ( io_stat /= 0 ) &
1482  msg = trim(msg)//'; Error closing output file during error cleanup - '//trim(io_msg)
1483  END IF
1484  err_stat = failure
1485  CALL display_message( routine_name, msg, err_stat )
1486  END SUBROUTINE write_cleanup
1487 
1488  END FUNCTION lseatlas_writefile
1489 
1490 
1491 !################################################################################
1492 !################################################################################
1493 !## ##
1494 !## ## PRIVATE PROCEDURES ## ##
1495 !## ##
1496 !################################################################################
1497 !################################################################################
1498 
1499 !--------------------------------------------------------------------------------
1500 !
1501 ! NAME:
1502 ! LSEatlas_Equal
1503 !
1504 ! PURPOSE:
1505 ! Elemental function to test the equality of two LSEatlas objects.
1506 ! Used in OPERATOR(==) interface block.
1507 !
1508 ! CALLING SEQUENCE:
1509 ! is_equal = LSEatlas_Equal( x, y )
1510 !
1511 ! or
1512 !
1513 ! IF ( x == y ) THEN
1514 ! ...
1515 ! END IF
1516 !
1517 ! OBJECTS:
1518 ! x, y: Two LSEatlas objects to be compared.
1519 ! UNITS: N/A
1520 ! TYPE: LSEatlas_type
1521 ! DIMENSION: Scalar or any rank
1522 ! ATTRIBUTES: INTENT(IN)
1523 !
1524 ! FUNCTION RESULT:
1525 ! is_equal: Logical value indicating whether the inputs are equal.
1526 ! UNITS: N/A
1527 ! TYPE: LOGICAL
1528 ! DIMENSION: Same as inputs.
1529 !
1530 !--------------------------------------------------------------------------------
1531 
1532  ELEMENTAL FUNCTION lseatlas_equal( x, y ) RESULT( is_equal )
1533  TYPE(lseatlas_type), INTENT(IN) :: x, y
1534  LOGICAL :: is_equal
1535 
1536  ! Set up
1537  is_equal = .false.
1538 
1539  ! Check the object association status
1540  IF ( (.NOT. lseatlas_associated(x)) .OR. &
1541  (.NOT. lseatlas_associated(y)) ) RETURN
1542 
1543  ! Check contents
1544  ! ...Release/version info
1545  IF ( (x%Release /= y%Release) .OR. &
1546  (x%Version /= y%Version) ) RETURN
1547  ! ...Dimensions
1548  IF ( (x%n_Frequencies /= y%n_Frequencies ) .OR. &
1549  (x%n_Latitudes /= y%n_Latitudes ) .OR. &
1550  (x%n_Longitudes /= y%n_Longitudes ) ) RETURN
1551  ! ...Arrays
1552  IF ( all(x%Frequency .equalto. y%Frequency ) .AND. &
1553  all(x%Latitude .equalto. y%Latitude ) .AND. &
1554  all(x%Longitude .equalto. y%Longitude ) .AND. &
1555  all(x%Emissivity .equalto. y%Emissivity ) ) &
1556  is_equal = .true.
1557 
1558  END FUNCTION lseatlas_equal
1559 
1560 
1561  FUNCTION read_datatype( fid, datatype_name ) RESULT( err_stat )
1562  ! Arguments
1563  INTEGER , INTENT(IN) :: fid
1564  CHARACTER(*), INTENT(OUT) :: datatype_name
1565  ! Function result
1566  INTEGER :: err_stat
1567  ! Local variables
1568  CHARACTER(1), ALLOCATABLE :: dummy(:)
1569  INTEGER :: i, strlen
1570  INTEGER :: io_stat
1571  INTEGER :: alloc_stat
1572 
1573  ! Set up
1574  err_stat = failure
1575  datatype_name = ''
1576 
1577  ! Get the string length
1578  READ( fid, iostat=io_stat ) strlen
1579  IF ( io_stat /= 0 ) RETURN
1580 
1581  ! Allocate dummy string array
1582  ALLOCATE( dummy(strlen), stat=alloc_stat )
1583  IF ( alloc_stat /= 0 ) RETURN
1584 
1585  ! Read the string into the dummy array
1586  READ( fid, iostat=io_stat ) dummy
1587  IF ( io_stat /= 0 ) RETURN
1588 
1589  ! Transfer array into string
1590  DO i = 1, min(strlen,len(datatype_name))
1591  datatype_name(i:i) = dummy(i)
1592  END DO
1593 
1594  ! Done
1595  err_stat = success
1596  END FUNCTION read_datatype
1597 
1598 END MODULE lseatlas_define
integer function read_datatype(fid, datatype_name)
elemental logical function lseatlas_equal(x, y)
integer, parameter, public failure
integer, parameter, public strlen
real(fp), parameter, public zero
integer, parameter, public long
Definition: Type_Kinds.f90:76
integer, parameter, public fp
Definition: Type_Kinds.f90:124
character(len(self%datatype_name)) function, public lseatlas_name(self)
integer function, public readgatts_binary_file(fid, Write_Module, Created_On, Title, History, Comment)
character(*), parameter, public lseatlas_datatype
integer function, public lseatlas_inquirefile(Filename, n_Frequencies, n_Latitudes, n_Longitudes, Release, Version, Title, History, Comment)
integer, parameter, public double
Definition: Type_Kinds.f90:106
subroutine inquire_cleanup()
elemental logical function, public lseatlas_associated(self)
subroutine read_cleanup()
subroutine, public lseatlas_inspect(self)
character(*), parameter write_error_status
subroutine write_cleanup()
integer, parameter lseatlas_version
integer function, public open_binary_file(Filename, FileID, For_Output, No_Check)
real(fp), parameter, public one
recursive subroutine, public display_message(Routine_Name, Message, Error_State, Message_Log)
logical function, public lseatlas_validrelease(self)
elemental subroutine, public lseatlas_create(self, n_Frequencies, n_Latitudes, n_Longitudes)
subroutine, public lseatlas_info(self, Info)
integer function, public writegatts_binary_file(fid, Write_Module, Created_On, Title, History, Comment)
integer function, public lseatlas_readfile(LSEatlas, Filename, No_Close, Quiet, Title, History, Comment, Debug)
elemental subroutine, public lseatlas_destroy(self)
character(*), parameter module_version_id
integer, parameter lseatlas_release
integer, parameter ml
subroutine, public lseatlas_setvalue(self, Version, Frequency, Latitude, Longitude, Emissivity)
#define min(a, b)
Definition: mosaic_util.h:32
integer, parameter, public success
integer, parameter sl
subroutine, public lseatlas_getvalue(self, Version, n_Frequencies, n_Latitudes, n_Longitudes, Frequency, Latitude, Longitude, Emissivity)
integer, parameter, public information
subroutine, public lseatlas_defineversion(Id)
integer function, public lseatlas_writefile(LSEatlas, Filename, No_Close, Quiet, Title, History, Comment, Debug)