18 USE iso_fortran_env ,
ONLY: output_unit
23 OPERATOR(.equalto.), &
49 PUBLIC ::
OPERATOR(==)
74 INTERFACE OPERATOR(==)
76 END INTERFACE OPERATOR(==)
80 END INTERFACE OPERATOR(-)
87 '$Id: CRTM_Geometry_Define.f90 60152 2015-08-13 19:19:13Z paul.vandelst@noaa.gov $' 89 REAL(fp),
PARAMETER ::
zero = 0.0_fp
91 INTEGER,
PARAMETER ::
ml = 256
104 LOGICAL :: is_allocated = .false.
110 REAL(fp) :: surface_altitude =
zero 112 REAL(fp) :: sensor_scan_angle =
zero 113 REAL(fp) :: sensor_zenith_angle =
zero 114 REAL(fp) :: sensor_azimuth_angle = 999.9_fp
116 REAL(fp) :: source_zenith_angle = 100.0_fp
117 REAL(fp) :: source_azimuth_angle =
zero 121 INTEGER :: year = 2001
176 status = geometry%Is_Allocated
204 geo%Is_Allocated = .false.
237 geo%Is_Allocated = .true.
370 iFOV , & ! Optional input
371 Longitude , & ! Optional input
372 Latitude , & ! Optional input
373 Surface_Altitude , & ! Optional input
374 Sensor_Scan_Angle , & ! Optional input
375 Sensor_Zenith_Angle , & ! Optional input
376 Sensor_Azimuth_Angle, & ! Optional input
377 Source_Zenith_Angle , & ! Optional input
378 Source_Azimuth_Angle, & ! Optional input
379 Flux_Zenith_Angle , & ! Optional input
380 Year , & ! Optional input
381 Month , & ! Optional input
385 INTEGER ,
OPTIONAL,
INTENT(IN) :: ifov
386 REAL(fp),
OPTIONAL,
INTENT(IN) :: longitude
387 REAL(fp),
OPTIONAL,
INTENT(IN) :: latitude
388 REAL(fp),
OPTIONAL,
INTENT(IN) :: surface_altitude
389 REAL(fp),
OPTIONAL,
INTENT(IN) :: sensor_scan_angle
390 REAL(fp),
OPTIONAL,
INTENT(IN) :: sensor_zenith_angle
391 REAL(fp),
OPTIONAL,
INTENT(IN) :: sensor_azimuth_angle
392 REAL(fp),
OPTIONAL,
INTENT(IN) :: source_zenith_angle
393 REAL(fp),
OPTIONAL,
INTENT(IN) :: source_azimuth_angle
394 REAL(fp),
OPTIONAL,
INTENT(IN) :: flux_zenith_angle
395 INTEGER,
OPTIONAL,
INTENT(IN) :: year
396 INTEGER,
OPTIONAL,
INTENT(IN) :: month
397 INTEGER,
OPTIONAL,
INTENT(IN) :: day
400 IF (
PRESENT(ifov ) ) geo%iFOV = ifov
401 IF (
PRESENT(longitude ) ) geo%Longitude = longitude
402 IF (
PRESENT(latitude ) ) geo%Latitude = latitude
403 IF (
PRESENT(surface_altitude ) ) geo%Surface_Altitude = surface_altitude
404 IF (
PRESENT(sensor_scan_angle ) ) geo%Sensor_Scan_Angle = sensor_scan_angle
405 IF (
PRESENT(sensor_zenith_angle ) ) geo%Sensor_Zenith_Angle = sensor_zenith_angle
406 IF (
PRESENT(sensor_azimuth_angle) ) geo%Sensor_Azimuth_Angle = sensor_azimuth_angle
407 IF (
PRESENT(source_zenith_angle ) ) geo%Source_Zenith_Angle = source_zenith_angle
408 IF (
PRESENT(source_azimuth_angle) ) geo%Source_Azimuth_Angle = source_azimuth_angle
409 IF (
PRESENT(flux_zenith_angle ) ) geo%Flux_Zenith_Angle = flux_zenith_angle
410 IF (
PRESENT(year ) ) geo%Year = year
411 IF (
PRESENT(month ) ) geo%Month = month
412 IF (
PRESENT(day ) ) geo%Day = day
545 iFOV , & ! Optional output
546 Longitude , & ! Optional output
547 Latitude , & ! Optional output
548 Surface_Altitude , & ! Optional output
549 Sensor_Scan_Angle , & ! Optional output
550 Sensor_Zenith_Angle , & ! Optional output
551 Sensor_Azimuth_Angle, & ! Optional output
552 Source_Zenith_Angle , & ! Optional output
553 Source_Azimuth_Angle, & ! Optional output
554 Flux_Zenith_Angle , & ! Optional output
555 Year , & ! Optional output
556 Month , & ! Optional output
560 INTEGER ,
OPTIONAL,
INTENT(OUT) :: ifov
561 REAL(fp),
OPTIONAL,
INTENT(OUT) :: longitude
562 REAL(fp),
OPTIONAL,
INTENT(OUT) :: latitude
563 REAL(fp),
OPTIONAL,
INTENT(OUT) :: surface_altitude
564 REAL(fp),
OPTIONAL,
INTENT(OUT) :: sensor_scan_angle
565 REAL(fp),
OPTIONAL,
INTENT(OUT) :: sensor_zenith_angle
566 REAL(fp),
OPTIONAL,
INTENT(OUT) :: sensor_azimuth_angle
567 REAL(fp),
OPTIONAL,
INTENT(OUT) :: source_zenith_angle
568 REAL(fp),
OPTIONAL,
INTENT(OUT) :: source_azimuth_angle
569 REAL(fp),
OPTIONAL,
INTENT(OUT) :: flux_zenith_angle
570 INTEGER,
OPTIONAL,
INTENT(OUT) :: year
571 INTEGER,
OPTIONAL,
INTENT(OUT) :: month
572 INTEGER,
OPTIONAL,
INTENT(OUT) :: day
575 IF (
PRESENT(ifov ) ) ifov = geo%iFOV
576 IF (
PRESENT(longitude ) ) longitude = geo%Longitude
577 IF (
PRESENT(latitude ) ) latitude = geo%Latitude
578 IF (
PRESENT(surface_altitude ) ) surface_altitude = geo%Surface_Altitude
579 IF (
PRESENT(sensor_scan_angle ) ) sensor_scan_angle = geo%Sensor_Scan_Angle
580 IF (
PRESENT(sensor_zenith_angle ) ) sensor_zenith_angle = geo%Sensor_Zenith_Angle
581 IF (
PRESENT(sensor_azimuth_angle) ) sensor_azimuth_angle = geo%Sensor_Azimuth_Angle
582 IF (
PRESENT(source_zenith_angle ) ) source_zenith_angle = geo%Source_Zenith_Angle
583 IF (
PRESENT(source_azimuth_angle) ) source_azimuth_angle = geo%Source_Azimuth_Angle
584 IF (
PRESENT(flux_zenith_angle ) ) flux_zenith_angle = geo%Flux_Zenith_Angle
585 IF (
PRESENT(year ) ) year = geo%Year
586 IF (
PRESENT(month ) ) month = geo%Month
587 IF (
PRESENT(day ) ) day = geo%Day
635 CHARACTER(*),
PARAMETER :: routine_name =
'CRTM_Geometry_IsValid' 642 IF ( geo%iFOV < 0 )
THEN 643 msg =
'Invalid FOV index. Must be > 0.' 649 IF ( geo%Longitude <
zero .OR. geo%Longitude > 360.0_fp )
THEN 650 msg =
'Invalid longitude. Must be degrees East (0->360)' 654 IF ( geo%Latitude < -90.0_fp .OR. geo%Latitude > 90.0_fp )
THEN 655 msg =
'Invalid latitude. Must be degrees North (-90->+90)' 661 WRITE(msg,
'("Invalid surface altitude. Must be metres (",f6.1,"->+",f6.1,")")') &
669 WRITE(msg,
'("Invalid sensor scan angle. Must be |thetas(i)|<=",f4.1)') &
675 WRITE(msg,
'("Invalid sensor zenith angle. Must be |thetaz(i)|<=",f4.1)') &
689 IF ( abs(geo%Source_Zenith_Angle) > 180.0_fp )
THEN 690 msg =
'Invalid source zenith angle. Must be |thetaz(s)|<=180.0' 694 IF ( geo%Source_Azimuth_Angle <
zero .OR. &
696 WRITE(msg,
'("Invalid source azimuth angle. Must be 0<=phi(s)<=",f5.1)') &
704 WRITE(msg,
'("Invalid flux zenith angle. Must be |thetaz(f)|<=",f4.1)') &
712 WRITE(msg,
'("Invalid year. Must be > ",i0)')
min_year 716 IF ( geo%Month < 1 .OR. geo%Month > 12 )
THEN 722 IF ( geo%Day < 1 .OR. geo%Day >
daysinmonth(geo%Month,geo%Year) )
THEN 766 INTEGER,
OPTIONAL,
INTENT(IN) :: unit
768 CHARACTER(*),
PARAMETER :: rfmt =
'es13.6' 774 IF (
PRESENT(unit) )
THEN 779 WRITE(fid,
'(1x,"Geometry OBJECT")')
781 WRITE(fid,
'(3x,"FOV index :",1x,i0)') geo%iFOV
783 WRITE(fid,
'(3x,"Longitude :",1x,'//rfmt//
')') geo%Longitude
784 WRITE(fid,
'(3x,"Latitude :",1x,'//rfmt//
')') geo%Latitude
785 WRITE(fid,
'(3x,"Surface altitude :",1x,'//rfmt//
')') geo%Surface_Altitude
787 WRITE(fid,
'(3x,"Sensor scan angle :",1x,'//rfmt//
')') geo%Sensor_Scan_Angle
788 WRITE(fid,
'(3x,"Sensor zenith angle :",1x,'//rfmt//
')') geo%Sensor_Zenith_Angle
789 WRITE(fid,
'(3x,"Sensor azimuth angle:",1x,'//rfmt//
')') geo%Sensor_Azimuth_Angle
791 WRITE(fid,
'(3x,"Source zenith angle :",1x,'//rfmt//
')') geo%Source_Zenith_Angle
792 WRITE(fid,
'(3x,"Source azimuth angle:",1x,'//rfmt//
')') geo%Source_Azimuth_Angle
794 WRITE(fid,
'(3x,"Flux zenith angle :",1x,'//rfmt//
')') geo%Flux_Zenith_Angle
796 WRITE(fid,
'(3x,"Year :",1x,i4)') geo%Year
797 WRITE(fid,
'(3x,"Month :",1x,i4)') geo%Month
798 WRITE(fid,
'(3x,"Day :",1x,i4)') geo%Day
827 CHARACTER(*),
INTENT(OUT) :: id
871 result( is_comparable )
874 INTEGER,
OPTIONAL,
INTENT(IN) :: n_sigfig
876 LOGICAL :: is_comparable
881 is_comparable = .false.
882 IF (
PRESENT(n_sigfig) )
THEN 893 IF ( (x%iFOV /= y%iFOV) .OR. &
903 (x%Year /= y%Year ) .OR. &
904 (x%Month /= y%Month) .OR. &
905 (x%Day /= y%Day ) )
RETURN 908 is_comparable = .true.
959 CHARACTER(*),
INTENT(IN) :: filename
960 INTEGER ,
OPTIONAL,
INTENT(OUT) :: n_profiles
964 CHARACTER(*),
PARAMETER :: routine_name =
'CRTM_Geometry_InquireFile' 967 CHARACTER(ML) :: io_msg
976 msg =
'File '//trim(filename)//
' not found.' 983 IF ( err_stat /=
success )
THEN 984 msg =
'Error opening '//trim(filename)
990 READ( fid,iostat=io_stat,iomsg=io_msg ) m
991 IF ( io_stat /= 0 )
THEN 992 msg =
'Error reading data dimension from '//trim(filename)//
' - '//trim(io_msg)
998 CLOSE( fid,iostat=io_stat,iomsg=io_msg )
999 IF ( io_stat /= 0 )
THEN 1000 msg =
'Error closing '//trim(filename)//
' - '//trim(io_msg)
1006 IF (
PRESENT(n_profiles) ) n_profiles = m
1012 CLOSE( fid,iostat=io_stat,iomsg=io_msg )
1014 msg = trim(msg)//
'; Error closing input file during error cleanup - '//trim(io_msg)
1095 Filename , & ! Input
1096 Geometry , & ! Output
1097 Quiet , & ! Optional input
1098 No_Close , & ! Optional input
1099 n_Profiles, & ! Optional output
1103 CHARACTER(*),
INTENT(IN) :: filename
1105 LOGICAL,
OPTIONAL,
INTENT(IN) :: quiet
1106 LOGICAL,
OPTIONAL,
INTENT(IN) :: no_close
1107 INTEGER,
OPTIONAL,
INTENT(OUT) :: n_profiles
1108 LOGICAL,
OPTIONAL,
INTENT(IN) :: debug
1112 CHARACTER(*),
PARAMETER :: routine_name =
'CRTM_Geometry_ReadFile' 1114 CHARACTER(ML) :: msg
1115 CHARACTER(ML) :: io_msg
1116 CHARACTER(ML) :: alloc_msg
1118 INTEGER :: alloc_stat
1120 LOGICAL :: yes_close
1122 INTEGER :: m, n_input_profiles
1129 IF (
PRESENT(quiet) ) noisy = .NOT. quiet
1132 IF (
PRESENT(no_close) ) yes_close = .NOT. no_close
1134 IF (
PRESENT(debug) ) noisy = debug
1141 INQUIRE( file=filename,number=fid )
1142 IF ( fid == -1 )
THEN 1143 msg =
'Error inquiring '//trim(filename)//
' for its unit number' 1150 msg =
'File '//trim(filename)//
' not found.' 1155 IF ( err_stat /=
success )
THEN 1156 msg =
'Error opening '//trim(filename)
1163 READ( fid,iostat=io_stat,iomsg=io_msg ) n_input_profiles
1164 IF ( io_stat /= 0 )
THEN 1165 msg =
'Error reading dimension from '//trim(filename)//
' - '//trim(io_msg)
1169 ALLOCATE(geometry(n_input_profiles), stat=alloc_stat, errmsg=alloc_msg)
1170 IF ( alloc_stat /= 0 )
THEN 1171 msg =
'Error allocating Geometry array - '//trim(alloc_msg)
1177 geometry_loop:
DO m = 1, n_input_profiles
1179 IF ( err_stat /=
success )
THEN 1180 WRITE( msg,
'("Error reading Geometry element #",i0," from ",a)' ) m, trim(filename)
1183 END DO geometry_loop
1187 IF ( yes_close )
THEN 1188 CLOSE( fid,iostat=io_stat,iomsg=io_msg )
1189 IF ( io_stat /= 0 )
THEN 1190 msg =
'Error closing '//trim(filename)//
' - '//trim(io_msg)
1197 IF (
PRESENT(n_profiles) ) n_profiles = n_input_profiles
1202 WRITE( msg,
'("Number of Geometry entries read from ",a,": ",i0)' ) &
1203 trim(filename), n_input_profiles
1211 CLOSE( fid,iostat=io_stat,iomsg=io_msg )
1212 IF ( io_stat /= 0 ) &
1213 msg = trim(msg)//
'; Error closing input file during error cleanup - '//trim(io_msg)
1215 IF (
ALLOCATED(geometry) )
THEN 1216 DEALLOCATE(geometry, stat=alloc_stat, errmsg=alloc_msg)
1217 IF ( alloc_stat /= 0 ) &
1218 msg = trim(msg)//
'; Error deallocating Geometry array during error cleanup - '//&
1298 Quiet , & ! Optional input
1299 No_Close, & ! Optional input
1303 CHARACTER(*),
INTENT(IN) :: filename
1305 LOGICAL,
OPTIONAL,
INTENT(IN) :: quiet
1306 LOGICAL,
OPTIONAL,
INTENT(IN) :: no_close
1307 LOGICAL,
OPTIONAL,
INTENT(IN) :: debug
1311 CHARACTER(*),
PARAMETER :: routine_name =
'CRTM_Geometry_WriteFile' 1313 CHARACTER(ML) :: msg
1314 CHARACTER(ML) :: io_msg
1317 LOGICAL :: yes_close
1325 IF (
PRESENT(quiet) ) noisy = .NOT. quiet
1328 IF (
PRESENT(no_close) ) yes_close = .NOT. no_close
1330 IF (
PRESENT(debug) ) noisy = debug
1336 INQUIRE( file=filename,number=fid )
1337 IF ( fid == -1 )
THEN 1338 msg =
'Error inquiring '//trim(filename)//
' for its unit number' 1344 IF ( err_stat /=
success )
THEN 1345 msg =
'Error opening '//trim(filename)
1353 WRITE( fid,iostat=io_stat,iomsg=io_msg ) ng
1354 IF ( io_stat /= 0 )
THEN 1355 msg =
'Error writing data dimension to '//trim(filename)//
'- '//trim(io_msg)
1361 geometry_loop:
DO m = 1, ng
1363 IF ( err_stat /=
success )
THEN 1364 WRITE( msg,
'("Error writing Geometry element #",i0," to ",a)' ) m, trim(filename)
1367 END DO geometry_loop
1371 IF ( yes_close )
THEN 1372 CLOSE( fid,status=
'KEEP',iostat=io_stat,iomsg=io_msg )
1373 IF ( io_stat /= 0 )
THEN 1374 msg =
'Error closing '//trim(filename)//
'- '//trim(io_msg)
1382 WRITE( msg,
'("Number of geometry entries written to ",a,": ",i0)' ) trim(filename), ng
1391 IF ( io_stat /= 0 ) &
1392 msg = trim(msg)//
'; Error deleting output file during error cleanup - '//trim(io_msg)
1440 INTEGER,
INTENT(IN) :: fid
1445 CHARACTER(*),
PARAMETER :: routine_name =
'CRTM_Geometry_ReadRecord' 1447 CHARACTER(ML) :: msg
1448 CHARACTER(ML) :: io_msg
1455 READ( fid,iostat=io_stat,iomsg=io_msg ) &
1459 geo%Surface_Altitude , &
1460 geo%Sensor_Scan_Angle , &
1461 geo%Sensor_Zenith_Angle , &
1462 geo%Sensor_Azimuth_Angle, &
1463 geo%Source_Zenith_Angle , &
1464 geo%Source_Azimuth_Angle, &
1465 geo%Flux_Zenith_Angle , &
1470 IF ( io_stat /= 0 )
THEN 1471 msg =
'Error reading Geometry data - '//trim(io_msg)
1479 CLOSE( fid,iostat=io_stat,iomsg=io_msg )
1481 msg = trim(msg)//
'; Error closing file during error cleanup - '//trim(io_msg)
1527 INTEGER,
INTENT(IN) :: fid
1532 CHARACTER(*),
PARAMETER :: routine_name =
'CRTM_Geometry_WriteRecord' 1534 CHARACTER(ML) :: msg
1535 CHARACTER(ML) :: io_msg
1543 WRITE( fid,iostat=io_stat,iomsg=io_msg ) &
1547 geo%Surface_Altitude , &
1548 geo%Sensor_Scan_Angle , &
1549 geo%Sensor_Zenith_Angle , &
1550 geo%Sensor_Azimuth_Angle, &
1551 geo%Source_Zenith_Angle , &
1552 geo%Source_Azimuth_Angle, &
1553 geo%Flux_Zenith_Angle , &
1557 IF ( io_stat /= 0 )
THEN 1558 msg =
'Error writing Geometry data - '//trim(io_msg)
1567 msg = trim(msg)//
'; Error closing file during error cleanup - '//trim(io_msg)
1620 is_equal = ( (x%iFOV == y%iFOV ) .AND. &
1621 (x%Longitude .equalto. y%Longitude ) .AND. &
1622 (x%Latitude .equalto. y%Latitude ) .AND. &
1623 (x%Surface_Altitude .equalto. y%Surface_Altitude ) .AND. &
1624 (x%Sensor_Scan_Angle .equalto. y%Sensor_Scan_Angle ) .AND. &
1625 (x%Sensor_Zenith_Angle .equalto. y%Sensor_Zenith_Angle ) .AND. &
1626 (x%Sensor_Azimuth_Angle .equalto. y%Sensor_Azimuth_Angle) .AND. &
1627 (x%Source_Zenith_Angle .equalto. y%Source_Zenith_Angle ) .AND. &
1628 (x%Source_Azimuth_Angle .equalto. y%Source_Azimuth_Angle) .AND. &
1629 (x%Flux_Zenith_Angle .equalto. y%Flux_Zenith_Angle ) .AND. &
1630 (x%Year == y%Year ) .AND. &
1631 (x%Month == y%Month) .AND. &
1677 gdiff%iFOV = gdiff%iFOV - g2%iFOV
1678 gdiff%Longitude = gdiff%Longitude - g2%Longitude
1679 gdiff%Latitude = gdiff%Latitude - g2%Latitude
1680 gdiff%Surface_Altitude = gdiff%Surface_Altitude - g2%Surface_Altitude
1681 gdiff%Sensor_Scan_Angle = gdiff%Sensor_Scan_Angle - g2%Sensor_Scan_Angle
1682 gdiff%Sensor_Zenith_Angle = gdiff%Sensor_Zenith_Angle - g2%Sensor_Zenith_Angle
1683 gdiff%Sensor_Azimuth_Angle = gdiff%Sensor_Azimuth_Angle - g2%Sensor_Azimuth_Angle
1684 gdiff%Source_Zenith_Angle = gdiff%Source_Zenith_Angle - g2%Source_Zenith_Angle
1685 gdiff%Source_Azimuth_Angle = gdiff%Source_Azimuth_Angle - g2%Source_Azimuth_Angle
1686 gdiff%Flux_Zenith_Angle = gdiff%Flux_Zenith_Angle - g2%Flux_Zenith_Angle
1687 gdiff%Year = gdiff%Year - g2%Year
1688 gdiff%Month = gdiff%Month - g2%Month
1689 gdiff%Day = gdiff%Day - g2%Day
real(fp), parameter, public max_sensor_zenith_angle
real(fp), parameter, public diffusivity_angle
subroutine, public crtm_geometry_defineversion(Id)
integer, parameter, public failure
integer, parameter, public warning
integer function, public crtm_geometry_writefile(Filename, Geometry, Quiet, No_Close, Debug)
integer, parameter, public fp
elemental subroutine, public crtm_geometry_getvalue(geo, iFOV, Longitude, Latitude, Surface_Altitude, Sensor_Scan_Angle, Sensor_Zenith_Angle, Sensor_Azimuth_Angle, Source_Zenith_Angle, Source_Azimuth_Angle, Flux_Zenith_Angle, Year, Month, Day)
integer function, public readgatts_binary_file(fid, Write_Module, Created_On, Title, History, Comment)
elemental subroutine, public crtm_geometry_destroy(geo)
elemental logical function, public crtm_geometry_compare(x, y, n_SigFig)
integer, parameter min_year
subroutine inquire_cleanup()
real(fp), parameter, public max_sensor_azimuth_angle
real(fp), parameter, public max_source_zenith_angle
subroutine read_cleanup()
character(*), parameter write_error_status
character(*), parameter module_version_id
subroutine write_cleanup()
subroutine read_record_cleanup()
integer function, public crtm_geometry_readrecord(fid, geo)
real(fp), parameter, public max_source_azimuth_angle
integer function, public open_binary_file(Filename, FileID, For_Output, No_Check)
recursive subroutine, public display_message(Routine_Name, Message, Error_State, Message_Log)
real(fp), parameter, public max_flux_zenith_angle
subroutine, public crtm_geometry_inspect(geo, Unit)
logical function, public crtm_geometry_isvalid(geo)
elemental subroutine, public crtm_geometry_setvalue(geo, iFOV, Longitude, Latitude, Surface_Altitude, Sensor_Scan_Angle, Sensor_Zenith_Angle, Sensor_Azimuth_Angle, Source_Zenith_Angle, Source_Azimuth_Angle, Flux_Zenith_Angle, Year, Month, Day)
real(fp), parameter, public max_sensor_scan_angle
integer, parameter, public default_n_sigfig
elemental integer function, public daysinmonth(Month, Year)
real(fp), parameter, public min_surface_altitude
integer function, public writegatts_binary_file(fid, Write_Module, Created_On, Title, History, Comment)
real(fp), parameter, public max_surface_altitude
elemental logical function, public crtm_geometry_associated(Geometry)
subroutine write_record_cleanup()
elemental type(crtm_geometry_type) function crtm_geometry_subtract(g1, g2)
elemental logical function crtm_geometry_equal(x, y)
integer function, public crtm_geometry_readfile(Filename, Geometry, Quiet, No_Close, n_Profiles, Debug)
integer function, public crtm_geometry_writerecord(fid, geo)
integer, parameter, public success
integer function, public crtm_geometry_inquirefile(Filename, n_Profiles)
integer, parameter, public information
elemental subroutine, public crtm_geometry_create(geo)