38 PUBLIC ::
OPERATOR(==)
58 INTERFACE OPERATOR(==)
60 END INTERFACE OPERATOR(==)
67 '$Id: LSEatlas_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $' 76 REAL(fp),
PARAMETER ::
zero = 0.0_fp
77 REAL(fp),
PARAMETER ::
one = 1.0_fp
79 INTEGER,
PARAMETER ::
ml = 256
80 INTEGER,
PARAMETER ::
sl = 80
90 LOGICAL :: is_allocated = .false.
97 INTEGER(Long) :: n_frequencies = 0
98 INTEGER(Long) :: n_latitudes = 0
99 INTEGER(Long) :: n_longitudes = 0
101 REAL(Double),
ALLOCATABLE :: frequency(:)
102 REAL(Double),
ALLOCATABLE :: latitude(:)
103 REAL(Double),
ALLOCATABLE :: longitude(:)
105 REAL(Double),
ALLOCATABLE :: emissivity(:,:,:)
159 status = self%Is_Allocated
187 self%Is_Allocated = .false.
188 self%n_Frequencies = 0
190 self%n_Longitudes = 0
246 n_Frequencies, & ! Input
247 n_Latitudes , & ! Input
251 INTEGER ,
INTENT(IN) :: n_frequencies
252 INTEGER ,
INTENT(IN) :: n_latitudes
253 INTEGER ,
INTENT(IN) :: n_longitudes
255 INTEGER :: alloc_stat
258 IF ( n_frequencies < 1 .OR. &
259 n_latitudes < 1 .OR. &
260 n_longitudes < 1 )
RETURN 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 ), &
269 IF ( alloc_stat /= 0 )
RETURN 274 self%n_Frequencies = n_frequencies
275 self%n_Latitudes = n_latitudes
276 self%n_Longitudes = n_longitudes
278 self%Frequency =
zero 280 self%Longitude =
zero 281 self%Emissivity =
zero 284 self%Is_Allocated = .true.
313 WRITE(*,
'(1x,"LSEatlas OBJECT")')
315 WRITE(*,
'(3x,"Release.Version :",1x,i0,".",i0)') self%Release, self%Version
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
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
329 WRITE(*,
'(3x,"Emissivity :")')
330 WRITE(*,
'(5(1x,es13.6,:))') self%Emissivity
370 CHARACTER(*),
PARAMETER :: routine_name =
'LSEatlas_ValidRelease' 381 WRITE( msg,
'("An LSEatlas data update is needed. ", & 382 &"LSEatlas release is ",i0,". Valid release is ",i0,"." )' ) &
391 WRITE( msg,
'("An LSEatlas software update is needed. ", & 392 &"LSEatlas release is ",i0,". Valid release is ",i0,"." )' ) &
434 CHARACTER(*),
INTENT(OUT) :: info
436 INTEGER,
PARAMETER :: carriage_return = 13
437 INTEGER,
PARAMETER :: linefeed = 10
439 CHARACTER(2000) :: long_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, &
456 info = long_string(1:
min(len(info), len_trim(long_string)))
494 CHARACTER(LEN(self%Datatype_Name)) :: datatype_name
496 datatype_name = self%Datatype_Name
525 CHARACTER(*),
INTENT(OUT) :: id
606 Version , & ! Optional input
607 Frequency , & ! Optional input
608 Latitude , & ! Optional input
609 Longitude , & ! Optional input
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(:,:,:)
621 IF (
PRESENT(version) ) self%Version = version
623 IF (
PRESENT(frequency) )
THEN 624 IF (
SIZE(frequency) == self%n_Frequencies )
THEN 625 self%Frequency = frequency
627 self%Frequency =
zero 631 IF (
PRESENT(latitude) )
THEN 632 IF (
SIZE(latitude) == self%n_Latitudes )
THEN 633 self%Latitude = latitude
639 IF (
PRESENT(longitude) )
THEN 640 IF (
SIZE(longitude) == self%n_Longitudes )
THEN 641 self%Longitude = longitude
643 self%Longitude =
zero 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
653 self%Emissivity =
zero 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
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(:,:,:)
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
779 IF (
PRESENT(frequency) )
THEN 780 ALLOCATE(frequency(self%n_Frequencies))
781 frequency = self%Frequency
784 IF (
PRESENT(latitude) )
THEN 785 ALLOCATE(latitude(self%n_Latitudes))
786 latitude = self%Latitude
789 IF (
PRESENT(longitude) )
THEN 790 ALLOCATE(longitude(self%n_Longitudes))
791 longitude = self%Longitude
794 IF (
PRESENT(emissivity) )
THEN 795 ALLOCATE(emissivity(self%n_Frequencies,self%n_Latitudes,self%n_Longitudes))
796 emissivity = self%Emissivity
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
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
903 CHARACTER(*),
PARAMETER :: routine_name =
'LSEatlas_InquireFile' 906 CHARACTER(ML) :: io_msg
916 msg =
'File '//trim(filename)//
' not found.' 923 IF ( err_stat /=
success )
THEN 924 msg =
'Error opening '//trim(filename)
931 IF ( err_stat /=
success )
THEN 932 msg =
'Error reading Datatype_Name' 942 READ( fid, iostat=io_stat, iomsg=io_msg ) &
945 IF ( io_stat /= 0 )
THEN 946 msg =
'Error reading Release/Version - '//trim(io_msg)
950 msg =
'LSEatlas Release check failed.' 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)
972 IF ( err_stat /=
success )
THEN 973 msg =
'Error reading global attributes' 979 CLOSE( fid, iostat=io_stat, iomsg=io_msg )
980 IF ( io_stat /= 0 )
THEN 981 msg =
'Error closing '//trim(filename)//
' - '//trim(io_msg)
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
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)
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
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
1097 CHARACTER(*),
PARAMETER :: routine_name =
'LSEatlas_ReadFile' 1099 CHARACTER(ML) :: msg
1100 CHARACTER(ML) :: io_msg
1101 LOGICAL :: close_file
1111 IF (
PRESENT(no_close) ) close_file = .NOT. no_close
1114 IF (
PRESENT(quiet) ) noisy = .NOT. quiet
1116 IF (
PRESENT(debug) )
THEN 1117 IF ( debug ) noisy = .true.
1124 INQUIRE( file=filename, number=fid )
1127 msg =
'Error inquiring '//trim(filename)//
' for its FileID' 1134 IF ( err_stat /=
success )
THEN 1135 msg =
'Error opening '//trim(filename)
1139 msg =
'File '//trim(filename)//
' not found.' 1147 IF ( err_stat /=
success )
THEN 1148 msg =
'Error reading Datatype_Name' 1158 READ( fid, iostat=io_stat, iomsg=io_msg ) &
1161 IF ( io_stat /= 0 )
THEN 1162 msg =
'Error reading Release/Version - '//trim(io_msg)
1166 msg =
'LSEatlas Release check failed.' 1172 READ( fid, iostat=io_stat, iomsg=io_msg ) &
1173 dummy%n_Frequencies, &
1174 dummy%n_Latitudes , &
1176 IF ( io_stat /= 0 )
THEN 1177 msg =
'Error reading data dimensions - '//trim(io_msg)
1183 dummy%n_Frequencies, &
1184 dummy%n_Latitudes , &
1185 dummy%n_Longitudes )
1187 msg =
'LSEatlas object allocation failed.' 1191 lseatlas%Version = dummy%Version
1198 history = history, &
1200 IF ( err_stat /=
success )
THEN 1201 msg =
'Error reading global attributes' 1208 READ( fid, iostat=io_stat, iomsg=io_msg ) &
1209 lseatlas%Frequency, &
1210 lseatlas%Latitude , &
1212 IF ( io_stat /= 0 )
THEN 1213 msg =
'Error reading dimensional vectors - '//trim(io_msg)
1217 READ( fid, iostat=io_stat, iomsg=io_msg ) &
1219 IF ( io_stat /= 0 )
THEN 1220 msg =
'Error reading emissivity data - '//trim(io_msg)
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)
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)
1324 Filename , & ! Input
1325 No_Close , & ! Optional input
1326 Quiet , & ! Optional input
1327 Title , & ! Optional input
1328 History , & ! Optional input
1329 Comment , & ! Optional input
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
1344 CHARACTER(*),
PARAMETER :: routine_name =
'LSEatlas_WriteFile' 1346 CHARACTER(ML) :: msg
1347 CHARACTER(ML) :: io_msg
1348 LOGICAL :: close_file
1358 IF (
PRESENT(no_close) ) close_file = .NOT. no_close
1361 IF (
PRESENT(quiet) ) noisy = .NOT. quiet
1363 IF (
PRESENT(debug) )
THEN 1364 IF ( debug ) noisy = .true.
1368 msg =
'LSEatlas object is empty.' 1376 INQUIRE( file=filename, number=fid )
1379 msg =
'Error inquiring '//trim(filename)//
' for its FileID' 1385 IF ( err_stat /=
success )
THEN 1386 msg =
'Error opening '//trim(filename)
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)
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)
1408 WRITE( fid, iostat=io_stat, iomsg=io_msg ) &
1411 IF ( io_stat /= 0 )
THEN 1412 msg =
'Error writing Release/Version - '//trim(io_msg)
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)
1433 history = history, &
1435 IF ( err_stat /=
success )
THEN 1436 msg =
'Error writing global attributes' 1443 WRITE( fid, iostat=io_stat, iomsg=io_msg ) &
1444 lseatlas%Frequency, &
1445 lseatlas%Latitude , &
1447 IF ( io_stat /= 0 )
THEN 1448 msg =
'Error writing dimensional vectors - '//trim(io_msg)
1452 WRITE( fid, iostat=io_stat, iomsg=io_msg ) &
1454 IF ( io_stat /= 0 )
THEN 1455 msg =
'Error writing emissivity data - '//trim(io_msg)
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)
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)
1545 IF ( (x%Release /= y%Release) .OR. &
1546 (x%Version /= y%Version) )
RETURN 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 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 ) ) &
1561 FUNCTION read_datatype( fid, datatype_name )
RESULT( err_stat )
1563 INTEGER ,
INTENT(IN) :: fid
1564 CHARACTER(*),
INTENT(OUT) :: datatype_name
1568 CHARACTER(1),
ALLOCATABLE :: dummy(:)
1571 INTEGER :: alloc_stat
1578 READ( fid, iostat=io_stat )
strlen 1579 IF ( io_stat /= 0 )
RETURN 1582 ALLOCATE( dummy(
strlen), stat=alloc_stat )
1583 IF ( alloc_stat /= 0 )
RETURN 1586 READ( fid, iostat=io_stat ) dummy
1587 IF ( io_stat /= 0 )
RETURN 1590 DO i = 1,
min(
strlen,len(datatype_name))
1591 datatype_name(i:i) = dummy(i)
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
integer, parameter, public fp
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
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
subroutine, public lseatlas_setvalue(self, Version, Frequency, Latitude, Longitude, Emissivity)
integer, parameter, public success
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)