! DART software - Copyright UCAR. This open source software is provided
! by UCAR, "as is", without charge, subject to all terms of use at
! http://www.image.ucar.edu/DAReS/DART/DART_download

module amsua_netCDF_support_mod

use         types_mod, only : r4, r8, digits12, deg2rad, rad2deg, PI, MISSING_R8

use     utilities_mod, only : error_handler, E_MSG, E_ERR, &
                              is_longitude_between, register_module

use  time_manager_mod, only : time_type, get_date, set_date,            &
                              get_time, set_time, set_calendar_type,    &
                              GREGORIAN, print_date, print_time,        &
                              operator(+)

use  obs_sequence_mod, only : init_obs_sequence, init_obs, insert_obs_in_seq, &
                              set_obs_values, obs_sequence_type,              &
                              obs_type, set_copy_meta_data, set_qc_meta_data, &
                              print_obs_seq_summary

use      location_mod, only : location_type, VERTISUNDEF, &
                              set_location, get_location

use      obs_kind_mod, only : get_index_for_type_of_obs

use obs_utilities_mod, only : add_obs_to_seq, create_3d_obs

use netcdf_utilities_mod, only : nc_open_file_readonly, &
                                 nc_get_dimension_size, &
                                 nc_get_global_attribute, &
                                 nc_get_variable, &
                                 nc_define_dimension, &
                                 nc_define_unlimited_dimension, &
                                 nc_define_double_variable, &
                                 nc_define_real_variable, &
                                 nc_define_integer_variable, &
                                 nc_add_attribute_to_variable, &
                                 nc_put_variable, &
                                 nc_end_define_mode, &
                                 NF90_MAX_NAME, NF90_MAX_VAR_DIMS, &
                                 nc_close_file

use obs_def_rttov_mod, only : set_mw_metadata, &
                              get_rttov_option_logical

use amsua_bt_mod, only : amsua_bt_granule, &
                         AMSUA_BT_GEOXTRACK,  AMSUA_BT_GEOTRACK,    AMSUA_BT_CHANNEL, &
                         AMSUA_BT_CALXTRACK,  AMSUA_BT_SPACEXTRACK, AMSUA_BT_BBXTRACK, &
                         AMSUA_BT_WARMPRTA11, AMSUA_BT_WARMPRTA12,  AMSUA_BT_WARMPRTA2

implicit none
private

public :: initialize_amsua_netcdf, &
          channel_list_to_indices, &
          amsua_bt_granule, &
          read_amsua_bt_netCDF_granule, &
          make_obs_sequence, &
          define_amsua_dimensions, &
          define_amsua_variables, &
          fill_amsua_variables

! version controlled file description for error handling, do not edit
character(len=*), parameter :: source   = 'amsua_netCDF_support_mod.f90'
character(len=*), parameter :: revision = ''
character(len=*), parameter :: revdate  = ''

logical, save :: module_initialized = .false.

character(len=512) :: string1, string2, string3

contains

!------------------------------------------------------------------------------
!>

subroutine initialize_module

call register_module(source, revision, revdate)

call set_calendar_type(GREGORIAN)

module_initialized = .true.

end subroutine initialize_module

!------------------------------------------------------------------------------
!>

subroutine initialize_amsua_netcdf(filename)

character(len=*), intent(in) :: filename

integer :: ncid
integer :: GEOXTRACK,  GEOTRACK,    CHANNEL, &
           CALXTRACK,  SPACEXTRACK, BBXTRACK, &
           WARMPRTA11, WARMPRTA12,  WARMPRTA2
logical :: mismatch

character(len=*), parameter :: context = 'initialize_amsua_netcdf'

if ( .not. module_initialized ) call initialize_module

ncid = nc_open_file_readonly(filename,context)

GEOXTRACK   = nc_get_dimension_size(ncid, 'GeoXTrack',   context)
GEOTRACK    = nc_get_dimension_size(ncid, 'GeoTrack',    context)
CHANNEL     = nc_get_dimension_size(ncid, 'Channel',     context)
CALXTRACK   = nc_get_dimension_size(ncid, 'CalXTrack',   context)
SPACEXTRACK = nc_get_dimension_size(ncid, 'SpaceXTrack', context)
BBXTRACK    = nc_get_dimension_size(ncid, 'BBXTrack',    context)
WARMPRTA11  = nc_get_dimension_size(ncid, 'WarmPRTA11',  context)
WARMPRTA12  = nc_get_dimension_size(ncid, 'WarmPRTA12',  context)
WARMPRTA2   = nc_get_dimension_size(ncid, 'WarmPRTA2',   context)

call nc_close_file(ncid,context)

! compare to values from amsua_bt_mod.f90 just to make sure
mismatch = .false.
if ( AMSUA_BT_GEOXTRACK   /= GEOXTRACK   ) mismatch = .true.
if ( AMSUA_BT_GEOTRACK    /= GEOTRACK    ) mismatch = .true.
if ( AMSUA_BT_CHANNEL     /= CHANNEL     ) mismatch = .true.
if ( AMSUA_BT_CALXTRACK   /= CALXTRACK   ) mismatch = .true.
if ( AMSUA_BT_SPACEXTRACK /= SPACEXTRACK ) mismatch = .true.
if ( AMSUA_BT_BBXTRACK    /= BBXTRACK    ) mismatch = .true.
if ( AMSUA_BT_WARMPRTA11  /= WARMPRTA11  ) mismatch = .true.
if ( AMSUA_BT_WARMPRTA12  /= WARMPRTA12  ) mismatch = .true.
if ( AMSUA_BT_WARMPRTA2   /= WARMPRTA2   ) mismatch = .true.

if (mismatch) then
   call error_handler(E_ERR,'initialize_amsua_netcdf','assumptions wrong',source)
endif

end subroutine initialize_amsua_netcdf

!------------------------------------------------------------------------------
!> Convert character representation of desired channels to the channel index
!> The desired input can be either an alphanumeric or numeric representation.
!>
!> from the documentation
!> A2-1, A2-2 | A1-1, A1-2, A1-3,   A1-4, A1-5    A1-6, A1-7 ...  A1-13
!> 23.8, 31.4 | 50.3, 52.8, 53.596, 54.4, 54.940, 55.5, 57.29034, 89

subroutine channel_list_to_indices(channel_list,use_channels)

character(len=*), intent(in)  :: channel_list(:)
logical,          intent(out) :: use_channels(:)

! from the dump of the converted netCDF file (chs 9-14 ?)
! center_freq = 23.8,     31.4,     50.3,     52.8,     53.596, ...
!               54.4,     54.94,    55.5,     57.29034, 57.29034, ...
!               57.29034, 57.29034, 57.29034, 57.29034, 89 ;

integer :: ichannel

if ( .not. module_initialized ) call initialize_module

use_channels = .false.

CHANNELS: do ichannel = 1,size(channel_list)
   select case (channel_list(ichannel))
      case('1','A2-1','23.8')
         use_channels(1) = .true.
      case('2','A2-2','31.4')
         use_channels(2) = .true.
      case('3','A1-1','50.3')
         use_channels(3) = .true.
      case('4','A1-2','52.8')
         use_channels(4) = .true.
      case('5','A1-3','53.596')
         use_channels(5) = .true.
      case('6','A1-4','54.4')
         use_channels(6) = .true.
      case('7','A1-5','54.94')
         use_channels(7) = .true.
      case('8','A1-6','55.5')
         use_channels(8) = .true.
      case('9','A1-7')
         use_channels(9) = .true.
      case('10','A1-8')
         use_channels(10) = .true.
      case('11','A1-9')
         use_channels(11) = .true.
      case('12','A1-10')
         use_channels(12) = .true.
      case('13','A1-11')
         use_channels(13) = .true.
      case('14','A1-12')
         use_channels(14) = .true.
      case('15','A1-13','89')
         use_channels(15) = .true.
      case ('null')
         exit CHANNELS
      case default
         write(string1,*)'<'//trim(channel_list(ichannel))//'> is not a valid channel declaration'
         call error_handler(E_ERR,'channel_list_to_indices','unknown channel input')
    end select
enddo CHANNELS

! FIXME ... print a summary of the channels and frequences being used

end subroutine channel_list_to_indices

!------------------------------------------------------------------------------
!> Routine to ingest an entire netCDF-format granule as converted by h4tonccf_nc4.
!>
!> Based on the 'amsua_bt_rdr' routine which was part of the NASA-provided software.
!> Modified by TJH Sep 2020:
!> note: 'swath' seems historical, 'granule' is in the current documentation.

subroutine read_amsua_bt_netCDF_granule(file_name, granule)

character(len=*),       intent(in)  :: file_name
TYPE(amsua_bt_granule), intent(out) :: granule

character(len=*), parameter :: context = 'read_amsua_bt_netCDF_granule'
character(len=*), parameter :: SWATHNAME = 'L1B_AMSU'

integer :: swid                   ! netCDF file identifier
integer :: nchar
character(len=256) :: swath_title ! Name of swath

if ( .not. module_initialized ) call initialize_module

swid = nc_open_file_readonly(file_name, context)

! Get name of swath, make sure it is the right one
! turns out there are non-printable characters in what you get from the netCDF file

call nc_get_global_attribute(swid, 'SWATH_TITLE__', swath_title, context)

nchar = len_trim(SWATHNAME)

if (swath_title(1:nchar) .ne. SWATHNAME) then
   write(string1,*) 'ERROR: bad SWATH_TITLE__ global attribute in file "'//trim(file_name)//'"'
   write(string2,*) 'Expected "'//SWATHNAME//'"'
   write(string3,*) 'got      "'//swath_title(1:nchar)//'"'
   call error_handler(E_ERR, context, string1, &
              source, revision, revdate, text2=string2, text3=string3)
end if

! FIXME ... unsupported types are commented out for now.
! Support for them must be provided in netcdf_utilities_mod.f90

! Attributes
call nc_get_global_attribute(swid, "processing_level", granule%processing_level, context)
call nc_get_global_attribute(swid, "instrument", granule%instrument, context)
call nc_get_global_attribute(swid, "DayNightFlag", granule%DayNightFlag, context)
call nc_get_global_attribute(swid, "AutomaticQAFlag", granule%AutomaticQAFlag, context)
call nc_get_global_attribute(swid, "NumTotalData", granule%NumTotalData, context)
call nc_get_global_attribute(swid, "NumProcessData", granule%NumProcessData, context)
call nc_get_global_attribute(swid, "NumSpecialData", granule%NumSpecialData, context)
call nc_get_global_attribute(swid, "NumBadData", granule%NumBadData, context)
call nc_get_global_attribute(swid, "NumMissingData",granule%NumMissingData, context)
call nc_get_global_attribute(swid, "NumLandSurface", granule%NumLandSurface, context)
call nc_get_global_attribute(swid, "NumOceanSurface", granule%NumOceanSurface, context)
call nc_get_global_attribute(swid, "node_type", granule%node_type, context)
call nc_get_global_attribute(swid, "start_year", granule%start_year, context)
call nc_get_global_attribute(swid, "start_month", granule%start_month, context)
call nc_get_global_attribute(swid, "start_day", granule%start_day, context)
call nc_get_global_attribute(swid, "start_hour", granule%start_hour, context)
call nc_get_global_attribute(swid, "start_minute", granule%start_minute, context)
call nc_get_global_attribute(swid, "start_sec", granule%start_sec, context)
call nc_get_global_attribute(swid, "start_orbit", granule%start_orbit, context)
call nc_get_global_attribute(swid, "end_orbit", granule%end_orbit, context)
call nc_get_global_attribute(swid, "orbit_path", granule%orbit_path, context)
call nc_get_global_attribute(swid, "start_orbit_row", granule%start_orbit_row, context)
call nc_get_global_attribute(swid, "end_orbit_row", granule%end_orbit_row, context)
call nc_get_global_attribute(swid, "granule_number", granule%granule_number, context)
call nc_get_global_attribute(swid, "num_scansets", granule%num_scansets, context)
call nc_get_global_attribute(swid, "num_scanlines", granule%num_scanlines, context)
call nc_get_global_attribute(swid, "start_Latitude", granule%start_Latitude, context)
call nc_get_global_attribute(swid, "start_Longitude", granule%start_Longitude, context)
call nc_get_global_attribute(swid, "start_Time", granule%start_Time, context)
call nc_get_global_attribute(swid, "end_Latitude", granule%end_Latitude, context)
call nc_get_global_attribute(swid, "end_Longitude", granule%end_Longitude, context)
call nc_get_global_attribute(swid, "end_Time", granule%end_Time, context)
call nc_get_global_attribute(swid, "eq_x_longitude", granule%eq_x_longitude, context)
call nc_get_global_attribute(swid, "eq_x_tai", granule%eq_x_tai, context)
call nc_get_global_attribute(swid, "orbitgeoqa", granule%orbitgeoqa, context)
! call nc_get_global_attribute(swid, "num_satgeoqa", granule%num_satgeoqa, context)
! call nc_get_global_attribute(swid, "num_glintgeoqa", granule%num_glintgeoqa, context)
! call nc_get_global_attribute(swid, "num_moongeoqa", granule%num_moongeoqa, context)
! call nc_get_global_attribute(swid, "num_ftptgeoqa", granule%num_ftptgeoqa, context)
! call nc_get_global_attribute(swid, "num_zengeoqa", granule%num_zengeoqa, context)
! call nc_get_global_attribute(swid, "num_demgeoqa", granule%num_demgeoqa, context)
! call nc_get_global_attribute(swid, "num_fpe", granule%num_fpe, context)
! call nc_get_global_attribute(swid, "LonGranuleCen", granule%LonGranuleCen, context)
! call nc_get_global_attribute(swid, "LatGranuleCen", granule%LatGranuleCen, context)
! call nc_get_global_attribute(swid, "LocTimeGranuleCen", granule%LocTimeGranuleCen, context)
call nc_get_global_attribute(swid, "num_scanlines_not_norm_mode_a1", granule%num_scanlines_not_norm_mode_a1, context)
call nc_get_global_attribute(swid, "num_scanlines_not_norm_mode_a2", granule%num_scanlines_not_norm_mode_a2, context)
call nc_get_global_attribute(swid, "num_missing_scanlines_a1", granule%num_missing_scanlines_a1, context)
call nc_get_global_attribute(swid, "num_missing_scanlines_a2", granule%num_missing_scanlines_a2, context)
call nc_get_global_attribute(swid, "num_data_gaps_a1", granule%num_data_gaps_a1, context)
call nc_get_global_attribute(swid, "num_data_gaps_a2", granule%num_data_gaps_a2, context)
call nc_get_global_attribute(swid, "num_instr_mode_changes_a1", granule%num_instr_mode_changes_a1, context)
call nc_get_global_attribute(swid, "num_instr_mode_changes_a2", granule%num_instr_mode_changes_a2, context)
call nc_get_global_attribute(swid, "num_scanlines_rec_cal_prob_a11", granule%num_scanlines_rec_cal_prob_a11, context)
call nc_get_global_attribute(swid, "num_scanlines_rec_cal_prob_a12", granule%num_scanlines_rec_cal_prob_a12, context)
call nc_get_global_attribute(swid, "num_scanlines_rec_cal_prob_a2", granule%num_scanlines_rec_cal_prob_a2, context)
call nc_get_global_attribute(swid, "num_scanlines_sig_coast_xing", granule%num_scanlines_sig_coast_xing, context)
call nc_get_global_attribute(swid, "num_scanlines_sig_sun_glint", granule%num_scanlines_sig_sun_glint, context)
call nc_get_global_attribute(swid, "MoonInViewMWCount", granule%MoonInViewMWCount, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a11_min", granule%QA_bb_PRT_a11%min, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a11_max", granule%QA_bb_PRT_a11%max, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a11_mean", granule%QA_bb_PRT_a11%mean, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a11_dev", granule%QA_bb_PRT_a11%dev, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a11_num_in", granule%QA_bb_PRT_a11%num_in, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a11_num_lo", granule%QA_bb_PRT_a11%num_lo, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a11_num_hi", granule%QA_bb_PRT_a11%num_hi, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a11_num_bad", granule%QA_bb_PRT_a11%num_bad, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a11_range_min", granule%QA_bb_PRT_a11%range_min, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a11_range_max", granule%QA_bb_PRT_a11%range_max, context)
! call nc_get_global_attribute(swid, "QA_bb_PRT_a11_missing", granule%QA_bb_PRT_a11%missing, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a11_max_track", granule%QA_bb_PRT_a11%max_track, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a11_max_xtrack", granule%QA_bb_PRT_a11%max_xtrack, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a11_min_track", granule%QA_bb_PRT_a11%min_track, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a11_min_xtrack", granule%QA_bb_PRT_a11%min_xtrack, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a12_min", granule%QA_bb_PRT_a12%min, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a12_max", granule%QA_bb_PRT_a12%max, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a12_mean", granule%QA_bb_PRT_a12%mean, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a12_dev", granule%QA_bb_PRT_a12%dev, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a12_num_in", granule%QA_bb_PRT_a12%num_in, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a12_num_lo", granule%QA_bb_PRT_a12%num_lo, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a12_num_hi", granule%QA_bb_PRT_a12%num_hi, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a12_num_bad", granule%QA_bb_PRT_a12%num_bad, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a12_range_min", granule%QA_bb_PRT_a12%range_min, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a12_range_max", granule%QA_bb_PRT_a12%range_max, context)
! call nc_get_global_attribute(swid, "QA_bb_PRT_a12_missing", granule%QA_bb_PRT_a12%missing, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a12_max_track", granule%QA_bb_PRT_a12%max_track, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a12_max_xtrack", granule%QA_bb_PRT_a12%max_xtrack, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a12_min_track", granule%QA_bb_PRT_a12%min_track, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a12_min_xtrack", granule%QA_bb_PRT_a12%min_xtrack, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a2_min", granule%QA_bb_PRT_a2%min, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a2_max", granule%QA_bb_PRT_a2%max, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a2_mean", granule%QA_bb_PRT_a2%mean, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a2_dev", granule%QA_bb_PRT_a2%dev, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a2_num_in", granule%QA_bb_PRT_a2%num_in, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a2_num_lo", granule%QA_bb_PRT_a2%num_lo, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a2_num_hi", granule%QA_bb_PRT_a2%num_hi, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a2_num_bad", granule%QA_bb_PRT_a2%num_bad, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a2_range_min", granule%QA_bb_PRT_a2%range_min, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a2_range_max", granule%QA_bb_PRT_a2%range_max, context)
! call nc_get_global_attribute(swid, "QA_bb_PRT_a2_missing", granule%QA_bb_PRT_a2%missing, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a2_max_track", granule%QA_bb_PRT_a2%max_track, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a2_max_xtrack", granule%QA_bb_PRT_a2%max_xtrack, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a2_min_track", granule%QA_bb_PRT_a2%min_track, context)
call nc_get_global_attribute(swid, "QA_bb_PRT_a2_min_xtrack", granule%QA_bb_PRT_a2%min_xtrack, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a11_min", granule%QA_rec_PRT_a11%min, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a11_max", granule%QA_rec_PRT_a11%max, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a11_mean", granule%QA_rec_PRT_a11%mean, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a11_dev", granule%QA_rec_PRT_a11%dev, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a11_num_in", granule%QA_rec_PRT_a11%num_in, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a11_num_lo", granule%QA_rec_PRT_a11%num_lo, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a11_num_hi", granule%QA_rec_PRT_a11%num_hi, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a11_num_bad", granule%QA_rec_PRT_a11%num_bad, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a11_range_min", granule%QA_rec_PRT_a11%range_min, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a11_range_max", granule%QA_rec_PRT_a11%range_max, context)
! call nc_get_global_attribute(swid, "QA_rec_PRT_a11.missing", granule%QA_rec_PRT_a11%missing, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a11_max_track", granule%QA_rec_PRT_a11%max_track, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a11_max_xtrack", granule%QA_rec_PRT_a11%max_xtrack, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a11_min_track", granule%QA_rec_PRT_a11%min_track, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a11_min_xtrack", granule%QA_rec_PRT_a11%min_xtrack, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a12_min", granule%QA_rec_PRT_a12%min, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a12_max", granule%QA_rec_PRT_a12%max, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a12_mean", granule%QA_rec_PRT_a12%mean, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a12_dev", granule%QA_rec_PRT_a12%dev, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a12_num_in", granule%QA_rec_PRT_a12%num_in, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a12_num_lo", granule%QA_rec_PRT_a12%num_lo, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a12_num_hi", granule%QA_rec_PRT_a12%num_hi, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a12_num_bad", granule%QA_rec_PRT_a12%num_bad, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a12_range_min", granule%QA_rec_PRT_a12%range_min, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a12_range_max", granule%QA_rec_PRT_a12%range_max, context)
! call nc_get_global_attribute(swid, "QA_rec_PRT_a12_missing", granule%QA_rec_PRT_a12%missing, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a12_max_track", granule%QA_rec_PRT_a12%max_track, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a12_max_xtrack", granule%QA_rec_PRT_a12%max_xtrack, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a12_min_track", granule%QA_rec_PRT_a12%min_track, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a12_min_xtrack", granule%QA_rec_PRT_a12%min_xtrack, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a2_min", granule%QA_rec_PRT_a2%min, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a2_max", granule%QA_rec_PRT_a2%max, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a2_mean", granule%QA_rec_PRT_a2%mean, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a2_dev", granule%QA_rec_PRT_a2%dev, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a2_num_in", granule%QA_rec_PRT_a2%num_in, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a2_num_lo", granule%QA_rec_PRT_a2%num_lo, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a2_num_hi", granule%QA_rec_PRT_a2%num_hi, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a2_num_bad", granule%QA_rec_PRT_a2%num_bad, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a2_range_min", granule%QA_rec_PRT_a2%range_min, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a2_range_max", granule%QA_rec_PRT_a2%range_max, context)
! call nc_get_global_attribute(swid, "QA_rec_PRT_a2_missing", granule%QA_rec_PRT_a2%missing, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a2_max_track", granule%QA_rec_PRT_a2%max_track, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a2_max_xtrack", granule%QA_rec_PRT_a2%max_xtrack, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a2_min_track", granule%QA_rec_PRT_a2%min_track, context)
call nc_get_global_attribute(swid, "QA_rec_PRT_a2_min_xtrack", granule%QA_rec_PRT_a2%min_xtrack, context)
call nc_get_global_attribute(swid, "granules_present", granule%granules_present, context)

call dump_attributes(granule)

! Geolocation fields
call nc_get_variable(swid, "latitude",  granule%latitude, context)
call nc_get_variable(swid, "longitude", granule%longitude, context)
call nc_get_variable(swid, "Time",      granule%Time, context)

! Data Fields
call nc_get_variable(swid, "scanang",   granule%scanang, context)
call nc_get_variable(swid, "satheight", granule%satheight, context)
call nc_get_variable(swid, "satroll",   granule%satroll, context)
call nc_get_variable(swid, "satpitch",  granule%satpitch, context)
call nc_get_variable(swid, "satyaw",    granule%satyaw, context)

call nc_get_variable(swid, "satgeoqa",   granule%satgeoqa, context)
call nc_get_variable(swid, "glintgeoqa", granule%glintgeoqa, context)
call nc_get_variable(swid, "moongeoqa",  granule%moongeoqa, context)
call nc_get_variable(swid, "ftptgeoqa",  granule%ftptgeoqa, context)
call nc_get_variable(swid, "zengeoqa",   granule%zengeoqa, context)
call nc_get_variable(swid, "demgeoqa",   granule%demgeoqa, context)

call nc_get_variable(swid, "nadirTAI", granule%nadirTAI, context)
call nc_get_variable(swid, "sat_lat", granule%sat_lat, context)
call nc_get_variable(swid, "sat_lon", granule%sat_lon, context)
! call nc_get_variable(swid, "scan_node_type", granule%scan_node_type, context)

call nc_get_variable(swid, "satzen", granule%satzen, context)
call nc_get_variable(swid, "satazi", granule%satazi, context)
call nc_get_variable(swid, "solzen", granule%solzen, context)
call nc_get_variable(swid, "solazi", granule%solazi, context)
call nc_get_variable(swid, "glintlat", granule%glintlat, context)
call nc_get_variable(swid, "glintlon", granule%glintlon, context)
call nc_get_variable(swid, "sun_glint_distance", granule%sun_glint_distance, context)
call nc_get_variable(swid, "topog", granule%topog, context)
call nc_get_variable(swid, "topog_err", granule%topog_err, context)
call nc_get_variable(swid, "landFrac", granule%landFrac, context)
call nc_get_variable(swid, "landFrac_err", granule%landFrac_err, context)
call nc_get_variable(swid, "antenna_temp", granule%antenna_temp, context)
call nc_get_variable(swid, "brightness_temp", granule%brightness_temp, context)
call nc_get_variable(swid, "brightness_temp_err", granule%brightness_temp_err, context)
call nc_get_variable(swid, "center_freq", granule%center_freq, context)
call nc_get_variable(swid, "IF_offset_1", granule%IF_offset_1, context)
call nc_get_variable(swid, "IF_offset_2", granule%IF_offset_2, context)
call nc_get_variable(swid, "bandwidth", granule%bandwidth, context)
call nc_get_variable(swid, "num_calibrated_scanlines", granule%num_calibrated_scanlines, context)
call nc_get_variable(swid, "num_scanlines_ch_cal_problems", granule%num_scanlines_ch_cal_problems, context)
call nc_get_variable(swid, "bb_signals_min", granule%bb_signals%min, context)
call nc_get_variable(swid, "bb_signals_max", granule%bb_signals%max, context)
call nc_get_variable(swid, "bb_signals_mean", granule%bb_signals%mean, context)
call nc_get_variable(swid, "bb_signals_dev", granule%bb_signals%dev, context)
call nc_get_variable(swid, "bb_signals_num", granule%bb_signals%num, context)
call nc_get_variable(swid, "bb_signals_num_bad", granule%bb_signals%num_bad, context)
call nc_get_variable(swid, "bb_signals_max_track", granule%bb_signals%max_track, context)
call nc_get_variable(swid, "bb_signals_max_xtrack", granule%bb_signals%max_xtrack, context)
call nc_get_variable(swid, "bb_signals_min_track", granule%bb_signals%min_track, context)
call nc_get_variable(swid, "bb_signals_min_xtrack", granule%bb_signals%min_xtrack, context)
call nc_get_variable(swid, "space_signals_min", granule%space_signals%min, context)
call nc_get_variable(swid, "space_signals_max", granule%space_signals%max, context)
call nc_get_variable(swid, "space_signals_mean", granule%space_signals%mean, context)
call nc_get_variable(swid, "space_signals_dev", granule%space_signals%dev, context)
call nc_get_variable(swid, "space_signals_num", granule%space_signals%num, context)
call nc_get_variable(swid, "space_signals_num_bad", granule%space_signals%num_bad, context)
call nc_get_variable(swid, "space_signals_max_track", granule%space_signals%max_track, context)
call nc_get_variable(swid, "space_signals_max_xtrack", granule%space_signals%max_xtrack, context)
call nc_get_variable(swid, "space_signals_min_track", granule%space_signals%min_track, context)
call nc_get_variable(swid, "space_signals_min_xtrack", granule%space_signals%min_xtrack, context)
call nc_get_variable(swid, "gain_stats_min", granule%gain_stats%min, context)
call nc_get_variable(swid, "gain_stats_max", granule%gain_stats%max, context)
call nc_get_variable(swid, "gain_stats_mean", granule%gain_stats%mean, context)
call nc_get_variable(swid, "gain_stats_dev", granule%gain_stats%dev, context)
call nc_get_variable(swid, "gain_stats_num", granule%gain_stats%num, context)
call nc_get_variable(swid, "gain_stats_num_bad", granule%gain_stats%num_bad, context)
call nc_get_variable(swid, "gain_stats_max_track", granule%gain_stats%max_track, context)
call nc_get_variable(swid, "gain_stats_max_xtrack", granule%gain_stats%max_xtrack, context)
call nc_get_variable(swid, "gain_stats_min_track", granule%gain_stats%min_track, context)
call nc_get_variable(swid, "gain_stats_min_xtrack", granule%gain_stats%min_xtrack, context)
call nc_get_variable(swid, "NeDT", granule%NeDT, context)
call nc_get_variable(swid, "QA_unfiltered_scene_count_min", granule%QA_unfiltered_scene_count%min, context)
call nc_get_variable(swid, "QA_unfiltered_scene_count_max", granule%QA_unfiltered_scene_count%max, context)
call nc_get_variable(swid, "QA_unfiltered_scene_count_mean", granule%QA_unfiltered_scene_count%mean, context)
call nc_get_variable(swid, "QA_unfiltered_scene_count_dev", granule%QA_unfiltered_scene_count%dev, context)
call nc_get_variable(swid, "QA_unfiltered_scene_count_num", granule%QA_unfiltered_scene_count%num, context)
call nc_get_variable(swid, "QA_unfiltered_scene_count_num_bad", granule%QA_unfiltered_scene_count%num_bad, context)
call nc_get_variable(swid, "QA_unfiltered_scene_count_max_track", granule%QA_unfiltered_scene_count%max_track, context)
call nc_get_variable(swid, "QA_unfiltered_scene_count_max_xtrack", granule%QA_unfiltered_scene_count%max_xtrack, context)
call nc_get_variable(swid, "QA_unfiltered_scene_count_min_track", granule%QA_unfiltered_scene_count%min_track, context)
call nc_get_variable(swid, "QA_unfiltered_scene_count_min_xtrack", granule%QA_unfiltered_scene_count%min_xtrack, context)
call nc_get_variable(swid, "QA_unfiltered_BB_count_min", granule%QA_unfiltered_BB_count%min, context)
call nc_get_variable(swid, "QA_unfiltered_BB_count_max", granule%QA_unfiltered_BB_count%max, context)
call nc_get_variable(swid, "QA_unfiltered_BB_count_mean", granule%QA_unfiltered_BB_count%mean, context)
call nc_get_variable(swid, "QA_unfiltered_BB_count_dev", granule%QA_unfiltered_BB_count%dev, context)
call nc_get_variable(swid, "QA_unfiltered_BB_count_num", granule%QA_unfiltered_BB_count%num, context)
call nc_get_variable(swid, "QA_unfiltered_BB_count_num_bad", granule%QA_unfiltered_BB_count%num_bad, context)
call nc_get_variable(swid, "QA_unfiltered_BB_count_max_track", granule%QA_unfiltered_BB_count%max_track, context)
call nc_get_variable(swid, "QA_unfiltered_BB_count_max_xtrack", granule%QA_unfiltered_BB_count%max_xtrack, context)
call nc_get_variable(swid, "QA_unfiltered_BB_count_min_track", granule%QA_unfiltered_BB_count%min_track, context)
call nc_get_variable(swid, "QA_unfiltered_BB_count_min_xtrack", granule%QA_unfiltered_BB_count%min_xtrack, context)
call nc_get_variable(swid, "QA_unfiltered_space_count_min", granule%QA_unfiltered_space_count%min, context)
call nc_get_variable(swid, "QA_unfiltered_space_count_max", granule%QA_unfiltered_space_count%max, context)
call nc_get_variable(swid, "QA_unfiltered_space_count_mean", granule%QA_unfiltered_space_count%mean, context)
call nc_get_variable(swid, "QA_unfiltered_space_count_dev", granule%QA_unfiltered_space_count%dev, context)
call nc_get_variable(swid, "QA_unfiltered_space_count_num", granule%QA_unfiltered_space_count%num, context)
call nc_get_variable(swid, "QA_unfiltered_space_count_num_bad", granule%QA_unfiltered_space_count%num_bad, context)
call nc_get_variable(swid, "QA_unfiltered_space_count_max_track", granule%QA_unfiltered_space_count%max_track, context)
call nc_get_variable(swid, "QA_unfiltered_space_count_max_xtrack", granule%QA_unfiltered_space_count%max_xtrack, context)
call nc_get_variable(swid, "QA_unfiltered_space_count_min_track", granule%QA_unfiltered_space_count%min_track, context)
call nc_get_variable(swid, "QA_unfiltered_space_count_min_xtrack", granule%QA_unfiltered_space_count%min_xtrack, context)
call nc_get_variable(swid, "QA_cal_coef_a0_min", granule%QA_cal_coef_a0%min, context)
call nc_get_variable(swid, "QA_cal_coef_a0_max", granule%QA_cal_coef_a0%max, context)
call nc_get_variable(swid, "QA_cal_coef_a0_mean", granule%QA_cal_coef_a0%mean, context)
call nc_get_variable(swid, "QA_cal_coef_a0_dev", granule%QA_cal_coef_a0%dev, context)
call nc_get_variable(swid, "QA_cal_coef_a0_num", granule%QA_cal_coef_a0%num, context)
call nc_get_variable(swid, "QA_cal_coef_a0_num_bad", granule%QA_cal_coef_a0%num_bad, context)
call nc_get_variable(swid, "QA_cal_coef_a0_max_track", granule%QA_cal_coef_a0%max_track, context)
call nc_get_variable(swid, "QA_cal_coef_a0_max_xtrack", granule%QA_cal_coef_a0%max_xtrack, context)
call nc_get_variable(swid, "QA_cal_coef_a0_min_track", granule%QA_cal_coef_a0%min_track, context)
call nc_get_variable(swid, "QA_cal_coef_a0_min_xtrack", granule%QA_cal_coef_a0%min_xtrack, context)
call nc_get_variable(swid, "QA_cal_coef_a1_min", granule%QA_cal_coef_a1%min, context)
call nc_get_variable(swid, "QA_cal_coef_a1_max", granule%QA_cal_coef_a1%max, context)
call nc_get_variable(swid, "QA_cal_coef_a1_mean", granule%QA_cal_coef_a1%mean, context)
call nc_get_variable(swid, "QA_cal_coef_a1_dev", granule%QA_cal_coef_a1%dev, context)
call nc_get_variable(swid, "QA_cal_coef_a1_num", granule%QA_cal_coef_a1%num, context)
call nc_get_variable(swid, "QA_cal_coef_a1_num_bad", granule%QA_cal_coef_a1%num_bad, context)
call nc_get_variable(swid, "QA_cal_coef_a1_max_track", granule%QA_cal_coef_a1%max_track, context)
call nc_get_variable(swid, "QA_cal_coef_a1_max_xtrack", granule%QA_cal_coef_a1%max_xtrack, context)
call nc_get_variable(swid, "QA_cal_coef_a1_min_track", granule%QA_cal_coef_a1%min_track, context)
call nc_get_variable(swid, "QA_cal_coef_a1_min_xtrack", granule%QA_cal_coef_a1%min_xtrack, context)
call nc_get_variable(swid, "QA_cal_coef_a2_min", granule%QA_cal_coef_a2%min, context)
call nc_get_variable(swid, "QA_cal_coef_a2_max", granule%QA_cal_coef_a2%max, context)
call nc_get_variable(swid, "QA_cal_coef_a2_mean", granule%QA_cal_coef_a2%mean, context)
call nc_get_variable(swid, "QA_cal_coef_a2_dev", granule%QA_cal_coef_a2%dev, context)
call nc_get_variable(swid, "QA_cal_coef_a2_num", granule%QA_cal_coef_a2%num, context)
call nc_get_variable(swid, "QA_cal_coef_a2_num_bad", granule%QA_cal_coef_a2%num_bad, context)
call nc_get_variable(swid, "QA_cal_coef_a2_max_track", granule%QA_cal_coef_a2%max_track, context)
call nc_get_variable(swid, "QA_cal_coef_a2_max_xtrack", granule%QA_cal_coef_a2%max_xtrack, context)
call nc_get_variable(swid, "QA_cal_coef_a2_min_track", granule%QA_cal_coef_a2%min_track, context)
call nc_get_variable(swid, "QA_cal_coef_a2_min_xtrack", granule%QA_cal_coef_a2%min_xtrack, context)
call nc_get_variable(swid, "QA_bb_raw_noise_counts_min", granule%QA_bb_raw_noise_counts%min, context)
call nc_get_variable(swid, "QA_bb_raw_noise_counts_max", granule%QA_bb_raw_noise_counts%max, context)
call nc_get_variable(swid, "QA_bb_raw_noise_counts_mean", granule%QA_bb_raw_noise_counts%mean, context)
call nc_get_variable(swid, "QA_bb_raw_noise_counts_dev", granule%QA_bb_raw_noise_counts%dev, context)
call nc_get_variable(swid, "QA_bb_raw_noise_counts_num", granule%QA_bb_raw_noise_counts%num, context)
call nc_get_variable(swid, "QA_bb_raw_noise_counts_num_bad", granule%QA_bb_raw_noise_counts%num_bad, context)
call nc_get_variable(swid, "QA_bb_raw_noise_counts_max_track", granule%QA_bb_raw_noise_counts%max_track, context)
call nc_get_variable(swid, "QA_bb_raw_noise_counts_max_xtrack", granule%QA_bb_raw_noise_counts%max_xtrack, context)
call nc_get_variable(swid, "QA_bb_raw_noise_counts_min_track", granule%QA_bb_raw_noise_counts%min_track, context)
call nc_get_variable(swid, "QA_bb_raw_noise_counts_min_xtrack", granule%QA_bb_raw_noise_counts%min_xtrack, context)
call nc_get_variable(swid, "QA_sv_raw_noise_counts_min", granule%QA_sv_raw_noise_counts%min, context)
call nc_get_variable(swid, "QA_sv_raw_noise_counts_max", granule%QA_sv_raw_noise_counts%max, context)
call nc_get_variable(swid, "QA_sv_raw_noise_counts_mean", granule%QA_sv_raw_noise_counts%mean, context)
call nc_get_variable(swid, "QA_sv_raw_noise_counts_dev", granule%QA_sv_raw_noise_counts%dev, context)
call nc_get_variable(swid, "QA_sv_raw_noise_counts_num", granule%QA_sv_raw_noise_counts%num, context)
call nc_get_variable(swid, "QA_sv_raw_noise_counts_num_bad", granule%QA_sv_raw_noise_counts%num_bad, context)
call nc_get_variable(swid, "QA_sv_raw_noise_counts_max_track", granule%QA_sv_raw_noise_counts%max_track, context)
call nc_get_variable(swid, "QA_sv_raw_noise_counts_max_xtrack", granule%QA_sv_raw_noise_counts%max_xtrack, context)
call nc_get_variable(swid, "QA_sv_raw_noise_counts_min_track", granule%QA_sv_raw_noise_counts%min_track, context)
call nc_get_variable(swid, "QA_sv_raw_noise_counts_min_xtrack", granule%QA_sv_raw_noise_counts%min_xtrack, context)
call nc_get_variable(swid, "state1", granule%state1, context)
call nc_get_variable(swid, "state2", granule%state2, context)
call nc_get_variable(swid, "cal_coef_a0", granule%cal_coef_a0, context)
call nc_get_variable(swid, "cal_coef_a0_err", granule%cal_coef_a0_err, context)
call nc_get_variable(swid, "cal_coef_a1", granule%cal_coef_a1, context)
call nc_get_variable(swid, "cal_coef_a1_err", granule%cal_coef_a1_err, context)
call nc_get_variable(swid, "cal_coef_a2", granule%cal_coef_a2, context)
call nc_get_variable(swid, "cal_coef_a2_err", granule%cal_coef_a2_err, context)
! call nc_get_variable(swid, "a1_ColdCalPstion", granule%a1_ColdCalPstion, context)
! call nc_get_variable(swid, "a2_ColdCalPstion", granule%a2_ColdCalPstion, context)
! call nc_get_variable(swid, "a1_PLO_Redundncy", granule%a1_PLO_Redundncy, context)
! call nc_get_variable(swid, "a11_mux_temp_used", granule%a11_mux_temp_used, context)
call nc_get_variable(swid, "a11_receiver_temp", granule%a11_receiver_temp, context)
call nc_get_variable(swid, "a11_target_temp", granule%a11_target_temp, context)
! call nc_get_variable(swid, "a12_mux_temp_used", granule%a12_mux_temp_used, context)
call nc_get_variable(swid, "a12_receiver_temp", granule%a12_receiver_temp, context)
call nc_get_variable(swid, "a12_target_temp", granule%a12_target_temp, context)
! call nc_get_variable(swid, "a2_diplexer_temp_used", granule%a2_diplexer_temp_used, context)
call nc_get_variable(swid, "a2_receiver_temp", granule%a2_receiver_temp, context)
call nc_get_variable(swid, "a2_target_temp", granule%a2_target_temp, context)
! call nc_get_variable(swid, "qa_scanline", granule%qa_scanline, context)
! call nc_get_variable(swid, "qa_receiver_a11", granule%qa_receiver_a11, context)
! call nc_get_variable(swid, "qa_receiver_a12", granule%qa_receiver_a12, context)
! call nc_get_variable(swid, "qa_receiver_a2", granule%qa_receiver_a2, context)
! call nc_get_variable(swid, "qa_channel", granule%qa_channel, context)

! Final clean-up
call nc_close_file(swid,context)

return

end subroutine read_amsua_bt_netCDF_granule

!-----------------------------------------------------------------------------
!>  extract the requested AMSUA channel observations from a granule
!>  and convert to DART observation format.  allow caller to specify
!>  a bounding box and only extract data within that region.

subroutine make_obs_sequence (seq, granule, lon1, lon2, lat1, lat2, &
                             use_channels, scan_thin, xtrack_thin)

type(obs_sequence_type), intent(inout) :: seq
type(amsua_bt_granule),  intent(in)    :: granule
real(r8),                intent(in)    :: lon1, lon2, lat1, lat2
logical,                 intent(in)    :: use_channels(:)
integer,                 intent(in)    :: scan_thin, xtrack_thin

type(obs_type) :: obs, prev_obs

integer :: num_copies, num_qc

! max possible obs from this one granule. in practice if the
! real number of processed channels is very much smaller, make
! another parameter so we don't allocate all these unused obs
! (takes time & space) and then delete them at the end.
integer :: max_num

logical :: is_first_obs
type(time_type) :: pre_time

character(len=*), parameter :: routine = 'make_obs_sequence'

if ( .not. module_initialized ) then
    write(string1,*) 'The data has not been read yet.'
    call error_handler(E_ERR,routine,string1,source,revision,revdate)
endif

! one observation data value and one quality control value
! per obs.  if you change these you have to set additional
! metadata for them below.
num_copies  = 1
num_qc      = 1

! Initialize an obs_sequence
max_num = AMSUA_BT_GEOXTRACK * AMSUA_BT_GEOTRACK * AMSUA_BT_CHANNEL

call init_obs_sequence(seq, num_copies, num_qc, max_num)

! set meta data of obs_seq
call set_copy_meta_data(seq, 1, 'observation')
call set_qc_meta_data(seq, 1, 'QC')

! Initialize the obs variables
call init_obs(     obs, 1, 1)
call init_obs(prev_obs, 1, 1)

is_first_obs = .true.

call add_granule_observations(seq,lon1,lon2,lat1,lat2,use_channels,&
                            scan_thin, xtrack_thin, obs, prev_obs,  &
                            is_first_obs, pre_time, granule)

end subroutine make_obs_sequence

!-----------------------------------------------------------------------------
!> routine to extract required parts of an AMSUA granule needed for a
!> brightness temperature radiance observation.

subroutine add_granule_observations(seq, lon1, lon2, lat1, lat2, use_channels,  &
                            scan_thin, xtrack_thin, obs, prev_obs, is_first_obs, &
                            pre_time, swath)

type(obs_sequence_type),    intent(inout) :: seq
real(r8),                   intent(in)    :: lon1, lon2, lat1, lat2
logical,                    intent(in)    :: use_channels(:)
integer,                    intent(in)    :: scan_thin, xtrack_thin
type(obs_type),             intent(inout) :: obs, prev_obs
logical,                    intent(inout) :: is_first_obs
type(time_type),            intent(inout) :: pre_time
type(amsua_bt_granule),     intent(in)    :: swath

integer :: ipix, iscan, ichan
integer :: days, seconds
integer :: obs_num, key
integer :: which_vert

real(r8) :: olon, olat, vloc
real(r8) :: obs_value, obs_err
real(r8) :: rqc

real(r8) :: lam1, lam2, phi1, phi2, x, y

real(r8) :: sat_az, sat_ze
integer :: platform_id, sat_id, sensor_id
real(r8) :: mag_field, cosbk
real(r8) :: fastem_p1
real(r8) :: fastem_p2
real(r8) :: fastem_p3
real(r8) :: fastem_p4
real(r8) :: fastem_p5

type(time_type) :: obs_time, time_base
character(len=*), parameter :: routine = 'add_granule_observations:'

integer :: robstype

real(digits12) :: time_offset(size(swath%Time,1),size(swath%Time,2))

! things known (and constant) about the input data and rttov
! consistent with values in rttov_sensor_db.csv

platform_id = 9  ! EOS
sat_id      = 2  ! satellite
sensor_id   = 3  ! AMSUA

!>@todo FIXME not happy with the time - seems like the swath%start_Time
!       and the time from the data are off by 10 seconds. leaving this
!       code commented out for more exploration later.

!TJH print*,'swath%start_Time ',swath%start_Time
!TJH print*,'min from data    ',minval(swath%Time)
!TJH print*,'max from data    ',maxval(swath%Time)
!TJH print*,'swath%end_Time   ',swath%end_Time
!TJH
!TJH obs_time = set_date(1993, 1, 1) + set_time(int(swath%start_Time))
!TJH call print_date(obs_time,'start date from 1993')
!TJH call print_time(obs_time,'start time from 1993')
!TJH obs_time = set_date(1993, 1, 1) + set_time(int(swath%end_Time))
!TJH call print_date(obs_time,'end   date from 1993')
!TJH call print_time(obs_time,'end   time from 1993')

! The global metadata has start year.month.day... and start_Time
! The data (Time) have the same base as start_Time.
! So I can convert the data time to an offset to get the number of
! seconds since the start_Time

time_base = set_date(swath%start_year, swath%start_month,      swath%start_day, &
                     swath%start_hour, swath%start_minute, int(swath%start_sec))

time_offset = swath%Time - swath%start_Time

!TJH call print_date(time_base,'start date from global metadata')
!TJH call print_time(time_base,'start time from global metadata')
!TJH obs_time = time_base + set_time(int(minval(time_offset)), 0)
!TJH call print_date(obs_time,'minimum date ')
!TJH call print_time(obs_time,'minimum time ')
!TJH obs_time = time_base + set_time(int(maxval(time_offset)), 0)
!TJH call print_date(obs_time,'maximum date ')
!TJH call print_time(obs_time,'maxiumu time ')

!------------------------------------------------------------------------------
!  loop over all observations within the file

obs_num = 0
which_vert = VERTISUNDEF

! assign each observation the correct observation type
robstype = get_index_for_type_of_obs('EOS_2_AMSUA_TB')
if (robstype < 1) then
   string1 = 'unknown observation type EOS_2_AMSUA_TB'
   call error_handler(E_ERR,routine,string1,source,revision,revdate)
endif

!        Latitude(                  AMSUA_BT_GEOXTRACK, AMSUA_BT_GEOTRACK)
!       Longitude(                  AMSUA_BT_GEOXTRACK, AMSUA_BT_GEOTRACK)
! brightness_temp(AMSUA_BT_CHANNEL, AMSUA_BT_GEOXTRACK, AMSUA_BT_GEOTRACK)
! rows are along-track, stepping in the direction the satellite is moving

scanloop:  do iscan=1,size(swath%Latitude,2) ! AKA GEOTRACK

   ! if we're going to subset rows, we will cycle here
   if (scan_thin > 0) then
      if (modulo(iscan, scan_thin) /= 0) cycle scanloop
   endif

   ! Reject bad scans here, if desired.
   ! "Bit field for each scanline (bit 0 set if sun glint in scanline;
   ! bit 1 set if costal crossing in scanline, bit 2 set if some
   ! channels had excessive NeDT estimated), dimension (45)"

   rqc = swath%qa_scanline(iscan)
   ! if (rqc /= 0) cycle scanloop ! REJECT IF DESIRED

   ! columns are across-track, varying faster than rows.
   pixloop:  do ipix=1,size(swath%Latitude,1) ! AKA GEOXTRACK

      ! if we're going to subset columns, ditto
      if (xtrack_thin > 0) then
         if (modulo(ipix, xtrack_thin) /= 0) cycle pixloop
      endif

      ! observation lat, lon:
      olat  = swath%Latitude (ipix,iscan) ! valid range [ -90.00,  90.00]
      olon  = swath%Longitude(ipix,iscan) ! valid range [-180.00, 180.00]

      ! verify the location is not outside valid limits.  AIRS  uses -180/180
      if((olon > 180.0_r8) .or. (olon < -180.0_r8) .or.  &
         (olat >  90.0_r8) .or. (olat <  -90.0_r8)) then
         write(*,*)'WARNING : invalid location.  col,row,lon,lat = ', ipix,iscan,olon,olat
         cycle pixloop
      endif

      ! make sure lon is between 0 and 360
      if (olon < 0.0_r8) olon = olon + 360.0_r8

      ! reject observations outside the bounding box (allowing wrapping)
      if(( olat < lat1) .or. ( olat > lat2 ) .or. &
         (.not. is_longitude_between(olon, lon1, lon2))) cycle pixloop

      ! set the zenith angle (aka earth incidence angle)
      sat_ze = swath%satzen(ipix,iscan)

      lam1 = deg2rad*swath%longitude(ipix,iscan)
      lam2 = deg2rad*swath%sat_lon(iscan)
      phi1 = deg2rad*swath%latitude(ipix,iscan)
      phi2 = deg2rad*swath%sat_lat(iscan)

      ! calculate the bearing between the obs lat/lon and the SClat/lon
      y = sin(lam2-lam1)*cos(phi2)
      x = cos(phi1)*sin(phi2)-sin(phi1)*cos(phi2)*cos(lam2-lam1)
      sat_az = rad2deg*atan2(y,x)

      ! convert observation time to DART format
      obs_time = time_base + set_time(int(time_offset(ipix,iscan)), 0)
      call get_time(obs_time, seconds, days)

      channel_loop: do ichan=1, size(use_channels)

         if (.not. use_channels(ichan)) cycle channel_loop

         ! create the radiance obs for this observation, add to sequence

         ! apparently -9999 is missing data, outside of qc mechanism
         ! FIXME ... there is a '_FillValue'
         obs_value = swath%brightness_temp(ichan,ipix,iscan)
         if (obs_value < 0.0_r8) cycle channel_loop

         obs_err = swath%brightness_temp_err(ichan,ipix,iscan)

         ! column integrated value, so no vertical location
         vloc = 0.0_r8

         if (get_rttov_option_logical('use_zeeman')) then

            ! From RTTOV v12 Users Guide Section 8.12: "For microwave sensors
            ! that have high peaking weighting functions in the mesosphere ...,
            ! channels close to lines of molecular oxygen may be significantly
            ! affected by the redistribution of line intensity through Zeeman
            ! splitting as described in the RTTOV v10 Science and Validation Report.
            ! The absorption for the affected channels will depend on the strength
            ! and orientation of the magnetic field. You must specify two input
            ! variables for the geomagnetic field in the rttov_profiles structure,
            ! these being the magnitude, Be, of the field and the cosine, cosbk,
            ! of the angle between the field vector and the viewing path considered.
            ! ...
            ! For AMSU-A, only channel 14 is affected. This channel ... impact is
            ! therefore much smaller (~0.5K). If a Zeeman coefficient file is used,
            ! then a small set of additional predictors will be included. These will
            ! contribute for channel 14 but will be nullified for the other channels
            ! by zero coefficients."
            !
            ! From RTTOV v12 Users Guide Table 12 (p 46):
            ! profiles(i)%Be    is the Earth magnetic field strength in Gauss
            ! profiles(i)%cosbk is the cosine of the angle between the Earth magnetic
            !                   field and wave propagation direction

            write(string1,*) 'Compensating for the Zeeman effect is not supported for AMSU-A observations.'
            write(string2,*) 'See https://github.com/NCAR/DART/issues/99#'
            write(string3,*) 'Also Section 8.12 of the RTTOV v12 user guide.'
            call error_handler(E_ERR, routine, string1, &
                       source, revision, revdate, text2=string2, text3=string3)
         else
            mag_field = MISSING_R8
            cosbk = MISSING_R8
         end if

         ! FIXME: consider adding an atlas for looking up FASTEM parameters
         ! From the RTTOV User guide:
         ! Surface type
         ! Typical RTTOV default for land: 3.0, 5.0, 15.0, 0.1, 0.3
         ! Summer land surface:
         !        Forest: 1.7, 1.0, 163.0, 0.0, 0.5
         !        Open grass: 2.2, 1.3, 138.0, 0.0, 0.42
         !        Bare soil: 2.3, 1.9, 21.8, 0.0, 0.5
         ! Winter surface type:
         !        Forest and snow: 2.9, 3.4, 27.0, 0.0, 0.0
         !        Deep dry snow: 3.0, 24.0, 60.0, 0.1, 0.15
         !        Frozen soil: 117.8, 2.0, 0.19, 0.2 ,0.35
         ! Sea ice
         !        Grease ice: 23.7, 7.7, 17.3, 0.0, 0.15
         !        Baltic nilas: 1.6, 3.3, 2.2, 0.0, 0.0
         !        New ice (no snow): 2.9, 3.4, 27.0, 0.0, 0.0
         !        New ice (snow): 2.2, 3.7, 122.0, 0.0, 0.15
         !        Brash ice: 3.0, 5.5, 183.0, 0.0, 0.0
         !        Compact pack ice: 2.0, 1700000.0, 49000000.0, 0.0, 0.0
         !        Fast ice: 1.5, 77.8, 703.0, 0.1, 0.35
         !        Lake ice + snow: 1.8, 67.1, 534.0, 0.1, 0.15
         !        Multi-year ice: 1.5, 85000.0, 4700000.0, 0.0, 0.0
         fastem_p1 = 3.0d0
         fastem_p2 = 5.0d0
         fastem_p3 = 15.0d0
         fastem_p4 = 0.1d0
         fastem_p5 = 0.3d0

         call set_mw_metadata(key, sat_az, sat_ze, platform_id, sat_id, sensor_id, &
                              ichan, mag_field, cosbk, &
                              fastem_p1, fastem_p2, fastem_p3, fastem_p4, fastem_p5)

         call create_3d_obs(olat, olon, vloc, which_vert, obs_value, robstype, &
                            obs_err, days, seconds, rqc, obs, key)

         call add_obs_to_seq(seq, obs, obs_time, prev_obs, pre_time, is_first_obs)

         obs_num = obs_num + 1

      enddo channel_loop
   enddo pixloop
enddo scanloop

! Print a little summary
call print_obs_seq_summary(seq)

write(string1,*) 'Converted ',obs_num,' obs for ',trim(swath%instrument), &
                 '; total obs = ',key
call error_handler(E_MSG, routine, string1, source, revision, revdate)

end subroutine add_granule_observations

!-----------------------------------------------------------------------------
!> routine to confirm granule metadata

subroutine dump_attributes(granule)
type (amsua_bt_granule), intent(in) :: granule

print *,' AutomaticQAFlag               "'//trim(granule%AutomaticQAFlag)//'"'
print *,' DayNightFlag                  "'//trim(granule%DayNightFlag)//'"'
print *,' LatGranuleCen                  ', granule%LatGranuleCen
print *,' LocTimeGranuleCen              ', granule%LocTimeGranuleCen
print *,' LonGranuleCen                  ', granule%LonGranuleCen
print *,' MoonInViewMWCount              ', granule%MoonInViewMWCount
print *,' NumBadData                     ', granule%NumBadData
print *,' NumLandSurface                 ', granule%NumLandSurface
print *,' NumMissingData                 ', granule%NumMissingData
print *,' NumOceanSurface                ', granule%NumOceanSurface
print *,' NumProcessData                 ', granule%NumProcessData
print *,' NumSpecialData                 ', granule%NumSpecialData
print *,' NumTotalData                   ', granule%NumTotalData
print *,' eq_x_longitude                 ', granule%eq_x_longitude
print *,' eq_x_tai                       ', granule%eq_x_tai
print *,' granule_number                 ', granule%granule_number
print *,' instrument                    "'//trim(granule%instrument)//'"'
print *,' node_type                     "'//trim(granule%node_type)//'"'
print *,' num_data_gaps_a1               ', granule%num_data_gaps_a1
print *,' num_data_gaps_a2               ', granule%num_data_gaps_a2
print *,' num_demgeoqa                   ', granule%num_demgeoqa
print *,' num_fpe                        ', granule%num_fpe
print *,' num_ftptgeoqa                  ', granule%num_ftptgeoqa
print *,' num_glintgeoqa                 ', granule%num_glintgeoqa
print *,' num_instr_mode_changes_a1      ', granule%num_instr_mode_changes_a1
print *,' num_instr_mode_changes_a2      ', granule%num_instr_mode_changes_a2
print *,' num_missing_scanlines_a1       ', granule%num_missing_scanlines_a1
print *,' num_missing_scanlines_a2       ', granule%num_missing_scanlines_a2
print *,' num_moongeoqa                  ', granule%num_moongeoqa
print *,' num_satgeoqa                   ', granule%num_satgeoqa
print *,' num_scanlines                  ', granule%num_scanlines
print *,' num_scanlines_not_norm_mode_a1 ', granule%num_scanlines_not_norm_mode_a1
print *,' num_scanlines_not_norm_mode_a2 ', granule%num_scanlines_not_norm_mode_a2
print *,' num_scanlines_rec_cal_prob_a11 ', granule%num_scanlines_rec_cal_prob_a11
print *,' num_scanlines_rec_cal_prob_a12 ', granule%num_scanlines_rec_cal_prob_a12
print *,' num_scanlines_rec_cal_prob_a2  ', granule%num_scanlines_rec_cal_prob_a2
print *,' num_scanlines_sig_coast_xing   ', granule%num_scanlines_sig_coast_xing
print *,' num_scanlines_sig_sun_glint    ', granule%num_scanlines_sig_sun_glint
print *,' num_scansets                   ', granule%num_scansets
print *,' num_zengeoqa                   ', granule%num_zengeoqa
print *,' orbit_path                     ', granule%orbit_path
print *,' orbitgeoqa                     ', granule%orbitgeoqa
print *,' processing_level              "'//trim(granule%processing_level)//'"'
print *,' start_Latitude                 ', granule%start_Latitude
print *,' end_Latitude                   ', granule%end_Latitude
print *,' start_Longitude                ', granule%start_Longitude
print *,' end_Longitude                  ', granule%end_Longitude
print *,' start_Time                     ', granule%start_Time
print *,' end_Time                       ', granule%end_Time
print *,' start_year                     ', granule%start_year
print *,' start_month                    ', granule%start_month
print *,' start_day                      ', granule%start_day
print *,' start_hour                     ', granule%start_hour
print *,' start_minute                   ', granule%start_minute
print *,' start_sec                      ', granule%start_sec
print *,' start_orbit                    ', granule%start_orbit
print *,' end_orbit                      ', granule%end_orbit
print *,' start_orbit_row                ', granule%start_orbit_row
print *,' end_orbit_row                  ', granule%end_orbit_row

end subroutine dump_attributes

!-------------------------------------------------------------------------------
!>

subroutine define_amsua_dimensions(ncid, context)

integer,                    intent(in) :: ncid
character(len=*), optional, intent(in) :: context

call error_handler(E_ERR,'define_amsua_dimensions','routine not verified',source)

! These names are chosen to match the output of h4tonccf_nc4
call nc_define_dimension(ncid, "GeoXTrack", AMSUA_BT_GEOXTRACK, context)
call nc_define_dimension(ncid, "GeoTrack",  AMSUA_BT_GEOTRACK, context)
call nc_define_dimension(ncid, "Channel",   AMSUA_BT_CHANNEL, context)
call nc_define_unlimited_dimension(ncid, "granule_number", context)

end subroutine define_amsua_dimensions

!------------------------------------------------------------------------------
!> The attributes I am using come from :
!> https://docserver.gesdisc.eosdis.nasa.gov/repository/Mission/AIRS/\
!> 3.3_ScienceDataProductDocumentation/3.3.4_ProductGenerationAlgorithms/\
!> README.AIRABRAD.pdf

subroutine define_amsua_variables(granule, ncid, context)

type(amsua_bt_granule),     intent(in) :: granule
integer,                    intent(in) :: ncid
character(len=*), optional, intent(in) :: context

character(len=NF90_MAX_NAME) :: dimnames(NF90_MAX_VAR_DIMS)
character(len=512) :: string1, string2

call error_handler(E_ERR,'define_amsua_variables','routine not finished',source)

! There are 240 granules per day

call nc_define_integer_variable(ncid,'granule_number','granule_number',context)

! The declarations happen in reverse order from the Fortran.
! The old 'column major' vs. 'row major' argument.
! Fortran slowest is on left, C (and the netCDF libs), slowest on right.

dimnames(1) = 'GeoXTrack'
dimnames(2) = 'GeoTrack'
dimnames(3) = 'granule_number'

call nc_define_double_variable(ncid,'Latitude' ,dimnames(1:3),context)
call nc_define_double_variable(ncid,'Longitude',dimnames(1:3),context)
call nc_define_double_variable(ncid,'Time'     ,dimnames(1:3),context)

write(string1,*)'AIRS spot boresight geodetic latitude'
write(string2,*)'degrees North'
call nc_add_attribute_to_variable(ncid,'Latitude','long_name',string1,context)
call nc_add_attribute_to_variable(ncid,'Latitude','units'    ,string2,context)
call nc_add_attribute_to_variable(ncid,'Latitude','_FillValue',-9999.0_digits12,context)
call nc_add_attribute_to_variable(ncid,'Latitude','valid_range', &
          (/ -90.0_digits12, 90.0_digits12 /),context)

write(string1,*)'AIRS spot boresight geodetic longitude'
write(string2,*)'degrees East'
call nc_add_attribute_to_variable(ncid,'Longitude','long_name',string1,context)
call nc_add_attribute_to_variable(ncid,'Longitude','units'    ,string2,context)
call nc_add_attribute_to_variable(ncid,'Longitude','_FillValue',-9999.0_digits12,context)
call nc_add_attribute_to_variable(ncid,'Longitude' ,'valid_range', &
          (/ -180.0_digits12, 180.0_digits12 /),context)

write(string1,*)'Footprint (shutter) TAI Time'
write(string2,*)'seconds since 1993-01-01 00:00:00'
call nc_add_attribute_to_variable(ncid,'Time','long_name',string1,context)
call nc_add_attribute_to_variable(ncid,'Time','units'    ,string2,context)
call nc_add_attribute_to_variable(ncid,'Time','_FillValue',-9999.0_digits12,context)

dimnames(1) = 'AMSUA_BT_CHANNEL'
dimnames(2) = 'AMSUA_BT_GEOXTRACK'
dimnames(3) = 'AMSUA_BT_GEOTRACK'
dimnames(4) = 'granule_number'

call nc_define_real_variable(     ncid,'brightness_temp', dimnames(1:4), context)
call nc_add_attribute_to_variable(ncid,'brightness_temp','units','degrees Kelvin',context)
call nc_add_attribute_to_variable(ncid,'brightness_temp','_FillValue',-9999.0_r4,context)

end subroutine define_amsua_variables

!-------------------------------------------------------------------------------
!>

subroutine fill_amsua_variables(granule, ncid, context)
type(amsua_bt_granule),     intent(in) :: granule
integer,                    intent(in) :: ncid
character(len=*), optional, intent(in) :: context

call error_handler(E_ERR,'fill_amsua_variables','routine not finished',source)

call nc_put_variable(ncid, 'Latitude',        granule%Latitude,        context)
call nc_put_variable(ncid, 'Longitude',       granule%Longitude,       context)
call nc_put_variable(ncid, 'Time',            granule%Time,            context)
call nc_put_variable(ncid, 'brightness_temp', granule%brightness_temp, context)

end subroutine fill_amsua_variables

!-------------------------------------------------------------------------------

end module amsua_netCDF_support_mod


! H0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
! H0 X
! H0 X   libAtoms+QUIP: atomistic simulation library
! H0 X
! H0 X   Portions of this code were written by
! H0 X     Albert Bartok-Partay, Silvia Cereda, Gabor Csanyi, James Kermode,
! H0 X     Ivan Solt, Wojciech Szlachta, Csilla Varnai, Steven Winfield.
! H0 X
! H0 X   Copyright 2006-2010.
! H0 X
! H0 X   These portions of the source code are released under the GNU General
! H0 X   Public License, version 2, http://www.gnu.org/copyleft/gpl.html
! H0 X
! H0 X   If you would like to license the source code under different terms,
! H0 X   please contact Gabor Csanyi, gabor@csanyi.net
! H0 X
! H0 X   Portions of this code were written by Noam Bernstein as part of
! H0 X   his employment for the U.S. Government, and are not subject
! H0 X   to copyright in the USA.
! H0 X
! H0 X
! H0 X   When using this software, please cite the following reference:
! H0 X
! H0 X   http://www.libatoms.org
! H0 X
! H0 X  Additional contributions by
! H0 X    Alessio Comisso, Chiara Gattinoni, and Gianpietro Moras
! H0 X
! H0 XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

!X
!X TBModel module
!X
!% General object which handles the possible TB scheme, addressing
!% the calls to the right modules.
!% The available models are the following
!%   \begin{itemize}
!%    \item    "NRL_TB", whose related object is \texttt{TBModel_NRL_TB}
!%    \item    "Bowler",  whose related object is \texttt{TBModel_Bowler}
!%    \item    "DFTB" , whose related object is \texttt{TBModel_DFTB}
!%    \item    "GSP" , whose related object is \texttt{TBModel_GSP}
!%   \end{itemize}
!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

module TBModel_module

use system_module, only : dp, print, inoutput, PRINT_VERBOSE, system_abort, operator(//)
use dictionary_module
use paramreader_module
use atoms_module

use QUIP_Common_module
use TBModel_NRL_TB_module
use TBModel_Bowler_module
use TBModel_DFTB_module
use TBModel_GSP_module

implicit none
private

integer, parameter :: FF_NONE = 0, FF_NRL_TB = 1, FF_Bowler = 2, FF_DFTB = 3, FF_GSP = 4
character(len=6) :: ff_names(0:4) = (/ &
      'NONE  ', &
      'NRL_TB', &
      'Bowler', &
      'DFTB  ', &
      'GSP   '/)

include 'TBModel_interface.h'

public :: TBModel
type TBModel
  real(dp) cutoff

  logical is_orthogonal
  integer :: functional_form = FF_NONE

  type(TBModel_NRL_TB) tbmodel_nrl_tb
  type(TBModel_Bowler) tbmodel_bowler
  type(TBModel_DFTB)   tbmodel_dftb
  type(TBModel_GSP)    tbmodel_gsp

  logical :: has_default_fermi_E, has_default_fermi_T, has_default_band_width, has_default_k_density
  real(dp) :: default_fermi_E, default_fermi_T, default_band_width, default_k_density

end type TBModel

interface Initialise
  module procedure TBModel_Initialise_str
end interface Initialise

interface Finalise
  module procedure TBModel_Finalise
end interface Finalise

interface Print
  module procedure TBModel_Print
end interface Print

interface n_orbs_of_Z
  module procedure TBModel_n_orbs_of_Z
end interface n_orbs_of_Z

interface n_orb_sets_of_Z
  module procedure TBModel_n_orb_sets_of_Z
end interface n_orb_sets_of_Z

interface n_orbs_of_orb_set_of_Z
  module procedure TBModel_n_orbs_of_orb_set_of_Z
end interface n_orbs_of_orb_set_of_Z

interface orb_type_of_orb_set_of_Z
  module procedure TBModel_orb_type_of_orb_set_of_Z
end interface orb_type_of_orb_set_of_Z

interface n_elecs_of_Z
  module procedure TBModel_n_elecs_of_Z
end interface n_elecs_of_Z

interface get_HS_blocks
  module procedure TBModel_get_HS_blocks
end interface get_HS_blocks

interface get_dHS_masks
  module procedure TBModel_get_dHS_masks
end interface get_dHS_masks

interface get_dHS_blocks
  module procedure TBModel_get_dHS_blocks
end interface get_dHS_blocks

interface get_local_rep_E
  module procedure TBModel_get_local_rep_E
end interface get_local_rep_E

interface get_local_rep_E_force
  module procedure TBModel_get_local_rep_E_force
end interface get_local_rep_E_force

interface get_local_rep_E_virial
  module procedure TBModel_get_local_rep_E_virial
end interface get_local_rep_E_virial

public :: has_fermi_E
interface has_fermi_E
  module procedure TBModel_has_fermi_E
end interface has_fermi_E

public :: has_fermi_T
interface has_fermi_T
  module procedure TBModel_has_fermi_T
end interface has_fermi_T

public :: has_band_width
interface has_band_width
  module procedure TBModel_has_band_width
end interface has_band_width

public :: has_k_density
interface has_k_density
  module procedure TBModel_has_k_density
end interface has_k_density

contains

subroutine TBModel_Initialise_str(this, args_str, param_str)
  type(TBModel), intent(inout) :: this
  character(len=*), intent(in) :: args_str, param_str

  type(Dictionary) :: params
  logical :: is_nrl_tb, is_bowler, is_dftb, is_gsp
  real(dp) :: str_fermi_e, str_fermi_T, str_band_width, str_k_density
  logical, target :: has_str_fermi_e, has_str_fermi_T, has_str_band_width, has_str_k_density

  call Initialise(params)
  call param_register(params, 'NRL-TB', 'false', is_nrl_tb, help_string="No help yet.  This source file was $LastChangedBy$")
  call param_register(params, 'Bowler', 'false', is_bowler, help_string="No help yet.  This source file was $LastChangedBy$")
  call param_register(params, 'DFTB', 'false', is_dftb, help_string="No help yet.  This source file was $LastChangedBy$")
  call param_register(params, 'GSP', 'false', is_gsp, help_string="No help yet.  This source file was $LastChangedBy$")
  call param_register(params, 'fermi_e', '0.0', str_fermi_e, has_value_target=has_str_fermi_e, help_string="No help yet.  This source file was $LastChangedBy$")
  call param_register(params, 'fermi_T', '0.0', str_fermi_T, has_value_target=has_str_fermi_T, help_string="No help yet.  This source file was $LastChangedBy$")
  call param_register(params, 'band_width', '0.0', str_band_width, has_value_target=has_str_band_width, help_string="No help yet.  This source file was $LastChangedBy$")
  call param_register(params, 'k_density', '0.0', str_k_density, has_value_target=has_str_k_density, help_string="No help yet.  This source file was $LastChangedBy$")
  if (.not. param_read_line(params, args_str, ignore_unknown=.true.,task='TBModel_Initialise_str args_str')) then
    call system_abort("TBModel_Initialise_str failed to parse args_str='"//trim(args_str)//"'")
  endif
  call finalise(params)

  if (count((/is_nrl_tb, is_bowler, is_dftb, is_gsp/)) /= 1) then
    call system_abort("TBModel_Initialise_str found too few or too many TB Model types args_str='"//trim(args_str)//"'")
  endif

  if (is_nrl_tb) then
    this%functional_form = FF_NRL_TB
    call Initialise(this%tbmodel_nrl_tb, args_str, param_str)
    this%cutoff=this%tbmodel_nrl_tb%cutoff
    this%is_orthogonal = this%tbmodel_nrl_tb%is_orthogonal
    this%has_default_fermi_e = this%tbmodel_nrl_tb%has_default_fermi_e
    this%has_default_fermi_T = this%tbmodel_nrl_tb%has_default_fermi_T
    this%has_default_band_width = this%tbmodel_nrl_tb%has_default_band_width
    this%has_default_k_density = this%tbmodel_nrl_tb%has_default_k_density
    this%default_fermi_e = this%tbmodel_nrl_tb%default_fermi_e
    this%default_fermi_T = this%tbmodel_nrl_tb%default_fermi_T
    this%default_band_width = this%tbmodel_nrl_tb%default_band_width
    this%default_k_density = this%tbmodel_nrl_tb%default_k_density
  else if (is_bowler) then
    this%functional_form = FF_Bowler
    call Initialise(this%tbmodel_bowler, args_str, param_str)
    this%cutoff=this%tbmodel_bowler%cutoff
    this%is_orthogonal = this%tbmodel_bowler%is_orthogonal
    this%has_default_fermi_e = this%tbmodel_bowler%has_default_fermi_e
    this%has_default_fermi_T = this%tbmodel_bowler%has_default_fermi_T
    this%has_default_band_width = this%tbmodel_bowler%has_default_band_width
    this%has_default_k_density = this%tbmodel_bowler%has_default_k_density
    this%default_fermi_e = this%tbmodel_bowler%default_fermi_e
    this%default_fermi_T = this%tbmodel_bowler%default_fermi_T
    this%default_band_width = this%tbmodel_bowler%default_band_width
    this%default_k_density = this%tbmodel_bowler%default_k_density
  else  if(is_dftb) then
    this%functional_form = FF_DFTB
    call Initialise(this%tbmodel_dftb, args_str, param_str)
    this%cutoff=this%tbmodel_dftb%cutoff
    this%is_orthogonal = this%tbmodel_dftb%is_orthogonal
    this%has_default_fermi_e = this%tbmodel_dftb%has_default_fermi_e
    this%has_default_fermi_T = this%tbmodel_dftb%has_default_fermi_T
    this%has_default_band_width = this%tbmodel_dftb%has_default_band_width
    this%has_default_k_density = this%tbmodel_dftb%has_default_k_density
    this%default_fermi_e = this%tbmodel_dftb%default_fermi_e
    this%default_fermi_T = this%tbmodel_dftb%default_fermi_T
    this%default_band_width = this%tbmodel_dftb%default_band_width
    this%default_k_density = this%tbmodel_dftb%default_k_density
  else if (is_gsp) then
    this%functional_form = FF_GSP
    call Initialise(this%tbmodel_gsp, args_str, param_str)
    this%cutoff=this%tbmodel_gsp%cutoff
    this%is_orthogonal = this%tbmodel_gsp%is_orthogonal
    this%has_default_fermi_e = this%tbmodel_gsp%has_default_fermi_e
    this%has_default_fermi_T = this%tbmodel_gsp%has_default_fermi_T
    this%has_default_band_width = this%tbmodel_gsp%has_default_band_width
    this%has_default_k_density = this%tbmodel_gsp%has_default_k_density
    this%default_fermi_e = this%tbmodel_gsp%default_fermi_e
    this%default_fermi_T = this%tbmodel_gsp%default_fermi_T
    this%default_band_width = this%tbmodel_gsp%default_band_width
    this%default_k_density = this%tbmodel_gsp%default_k_density
  end if

  if (has_str_fermi_e) then
    this%has_default_fermi_e = .true.
    this%default_fermi_e = str_fermi_e
  endif
  if (has_str_fermi_T) then
    this%has_default_fermi_T = .true.
    this%default_fermi_T = str_fermi_T
  endif
  if (has_str_band_width) then
    this%has_default_band_width = .true.
    this%default_band_width = str_band_width
  endif
  if (has_str_k_density) then
    this%has_default_k_density = .true.
    this%default_k_density = str_k_density
  endif

end subroutine TBModel_Initialise_str

subroutine TBModel_Finalise(this)
  type(TBModel), intent(inout) :: this

  select case(this%functional_form)
    case (FF_NRL_TB)
      call Finalise(this%tbmodel_nrl_tb)
    case (FF_Bowler)
      call Finalise(this%tbmodel_bowler)
    case (FF_DFTB)
      call Finalise(this%tbmodel_dftb)
    case (FF_GSP)
      call Finalise(this%tbmodel_gsp)
    case (FF_NONE)
      return
    case default
      call system_abort ('TBModel_Finalise confused by functional_form' // this%functional_form)
  end select

end subroutine TBModel_Finalise

function TBModel_n_orbs_of_Z(this, Z)
  type(TBModel), intent(in) :: this
  integer, intent(in) :: Z
  integer TBModel_n_orbs_of_Z

  select case(this%functional_form)
    case (FF_NRL_TB)
      TBModel_n_orbs_of_Z = n_orbs_of_Z(this%tbmodel_nrl_tb,Z)
    case (FF_Bowler)
      TBModel_n_orbs_of_Z = n_orbs_of_Z(this%tbmodel_bowler,Z)
    case (FF_DFTB)
      TBModel_n_orbs_of_Z = n_orbs_of_Z(this%tbmodel_dftb,Z)
    case (FF_GSP)
      TBModel_n_orbs_of_Z = n_orbs_of_Z(this%tbmodel_gsp,Z)
    case default
      call system_abort ('TBModel_n_orbs_of_Z confused by functional_form' // this%functional_form)
  end select

end function TBModel_n_orbs_of_Z

function TBModel_n_orb_sets_of_Z(this, Z)
  type(TBModel), intent(in) :: this
  integer, intent(in) :: Z
  integer TBModel_n_orb_sets_of_Z

  select case(this%functional_form)
    case (FF_NRL_TB)
      TBModel_n_orb_sets_of_Z = n_orb_sets_of_Z(this%tbmodel_nrl_tb,Z)
    case (FF_Bowler)
      TBModel_n_orb_sets_of_Z = n_orb_sets_of_Z(this%tbmodel_bowler,Z)
    case (FF_DFTB)
      TBModel_n_orb_sets_of_Z = n_orb_sets_of_Z(this%tbmodel_dftb,Z)
    case (FF_GSP)
      TBModel_n_orb_sets_of_Z = n_orb_sets_of_Z(this%tbmodel_gsp,Z)
    case default
      call system_abort ('TBModel_n_orb_sets_of_Z confused by functional_form' // this%functional_form)
  end select

end function TBModel_n_orb_sets_of_Z

function TBModel_n_orbs_of_orb_set_of_Z(this, Z, i_set)
  type(TBModel), intent(in) :: this
  integer, intent(in) :: Z, i_set
  integer TBModel_n_orbs_of_orb_set_of_Z

  select case(this%functional_form)
    case (FF_NRL_TB)
      TBModel_n_orbs_of_orb_set_of_Z = n_orbs_of_orb_set_of_Z(this%tbmodel_nrl_tb,Z,i_set)
    case (FF_Bowler)
      TBModel_n_orbs_of_orb_set_of_Z = n_orbs_of_orb_set_of_Z(this%tbmodel_bowler,Z,i_set)
    case (FF_DFTB)
      TBModel_n_orbs_of_orb_set_of_Z = n_orbs_of_orb_set_of_Z(this%tbmodel_dftb,Z,i_set)
    case (FF_GSP)
      TBModel_n_orbs_of_orb_set_of_Z = n_orbs_of_orb_set_of_Z(this%tbmodel_gsp,Z,i_set)
    case default
      call system_abort ('TBModel_n_orbs_of_orb_set_of_Z confused by functional_form' // this%functional_form)
  end select

end function TBModel_n_orbs_of_orb_set_of_Z

function TBModel_orb_type_of_orb_set_of_Z(this, Z, i_set)
  type(TBModel), intent(in) :: this
  integer, intent(in) :: Z, i_set
  integer TBModel_orb_type_of_orb_set_of_Z

  select case(this%functional_form)
    case (FF_NRL_TB)
      TBModel_orb_type_of_orb_set_of_Z = orb_type_of_orb_set_of_Z(this%tbmodel_nrl_tb,Z,i_set)
    case (FF_Bowler)
      TBModel_orb_type_of_orb_set_of_Z = orb_type_of_orb_set_of_Z(this%tbmodel_bowler,Z,i_set)
    case (FF_DFTB)
      TBModel_orb_type_of_orb_set_of_Z = orb_type_of_orb_set_of_Z(this%tbmodel_dftb,Z,i_set)
    case (FF_GSP)
      TBModel_orb_type_of_orb_set_of_Z = orb_type_of_orb_set_of_Z(this%tbmodel_gsp,Z,i_set)
    case default
      call system_abort ('TBModel_orb_type_of_orb_set_of_Z confused by functional_form' // this%functional_form)
  end select

end function TBModel_orb_type_of_orb_set_of_Z

function TBModel_n_elecs_of_Z(this, Z)
  type(TBModel), intent(in) :: this
  integer, intent(in) :: Z
  real(dp) TBModel_n_elecs_of_Z

  select case(this%functional_form)
    case (FF_NRL_TB)
      TBModel_n_elecs_of_Z = n_elecs_of_Z(this%tbmodel_nrl_tb,Z)
    case (FF_Bowler)
      TBModel_n_elecs_of_Z = n_elecs_of_Z(this%tbmodel_bowler,Z)
    case (FF_DFTB)
      TBModel_n_elecs_of_Z = n_elecs_of_Z(this%tbmodel_dftb,Z)
    case (FF_GSP)
      TBModel_n_elecs_of_Z = n_elecs_of_Z(this%tbmodel_gsp,Z)
    case default
      call system_abort ('TBModel_n_elecs_of_Z confused by functional_form' // this%functional_form)
  end select

end function TBModel_n_elecs_of_Z

subroutine TBModel_Print(this,file)
  type(TBModel),    intent(in)           :: this
  type(Inoutput), intent(inout),optional :: file

  call print("TBModel: is_orthogonal " // this%is_orthogonal, PRINT_VERBOSE)
  call print("TBModel: functional_form " // ff_names(this%functional_form), PRINT_VERBOSE)
  call print("TBModel: has_default_fermi_e " // this%has_default_fermi_e // " default_fermi_e " // &
    this%default_fermi_e, PRINT_VERBOSE)
  call print("TBModel: has_default_fermi_T " // this%has_default_fermi_T // " default_fermi_T " // &
    this%default_fermi_T, PRINT_VERBOSE)
  call print("TBModel: has_default_band_width " // this%has_default_band_width // " default_band_width " // &
    this%default_band_width, PRINT_VERBOSE)
  call print("TBModel: has_default_k_density " // this%has_default_k_density // " default_k_density " // &
    this%default_k_density, PRINT_VERBOSE)

  select case(this%functional_form)
    case (FF_NRL_TB)
      call Print(this%tbmodel_nrl_tb, file=file)
    case (FF_Bowler)
      call Print(this%tbmodel_bowler, file=file)
    case (FF_DFTB)
      call Print(this%tbmodel_dftb, file=file)
    case (FF_GSP)
      call Print(this%tbmodel_gsp, file=file)
    case default
      call system_abort ('TBModel_Print confused by functional_form' // this%functional_form)
  end select

end subroutine

subroutine TBModel_get_HS_blocks(this, at, i, j, dv_hat, dv_mag, b_H, b_S, i_mag)
  type(TBModel), intent(in) :: this
  type(Atoms), intent(in) :: at
  integer, intent(in) :: i, j
  real(dp), intent(in) :: dv_hat(3), dv_mag
  real(dp), intent(out) :: b_H(:,:), b_S(:,:)
  integer, intent(in), optional :: i_mag

  select case(this%functional_form)
    case (FF_NRL_TB)
      call get_HS_blocks(this%tbmodel_nrl_tb, at, i, j, dv_hat, dv_mag, b_H, b_S, i_mag)
    case (FF_Bowler)
      call get_HS_blocks(this%tbmodel_bowler, at, i, j, dv_hat, dv_mag, b_H, b_S, i_mag)
    case (FF_DFTB)
      call get_HS_blocks(this%tbmodel_dftb, at, i, j, dv_hat, dv_mag, b_H, b_S, i_mag)
    case (FF_GSP)
      call get_HS_blocks(this%tbmodel_gsp, at, i, j, dv_hat, dv_mag, b_H, b_S)
    case default
      call system_abort ('TBModel_get_HS_blocks confused by functional_form' // this%functional_form)
  end select

end subroutine

subroutine TBModel_get_dHS_masks(this, at, at_ind, d_mask, od_mask)
  type(TBModel), intent(in) :: this
  type(Atoms), intent(in) :: at
  integer, intent(in) :: at_ind
  logical, intent(out), optional :: d_mask(:), od_mask(:)

  select case(this%functional_form)
    case (FF_NRL_TB)
      call get_dHS_masks(this%tbmodel_nrl_tb, at, at_ind, d_mask, od_mask)
    case (FF_Bowler)
      call get_dHS_masks(this%tbmodel_bowler, at, at_ind, d_mask, od_mask)
    case (FF_DFTB)
      call get_dHS_masks(this%tbmodel_dftb, at, at_ind, d_mask, od_mask)
    case (FF_GSP)
      call get_dHS_masks(this%tbmodel_gsp, at_ind, d_mask, od_mask)
    case default
      call system_abort ('TBModel_get_HS_masks confused by functional_form' // this%functional_form)
  end select

end subroutine

function TBModel_get_dHS_blocks(this, at, i, j, dv_hat, dv_mag, at_ind, b_dH, b_dS, i_mag)
  type(TBModel), intent(inout) :: this
  type(Atoms), intent(in) :: at
  integer, intent(in) :: i, j
  real(dp), intent(in) :: dv_hat(3), dv_mag
  integer, intent(in) :: at_ind
  real(dp), intent(out) :: b_dH(:,:,:), b_dS(:,:,:)
  integer, intent(in), optional :: i_mag
  logical TBModel_get_dHS_blocks

  select case(this%functional_form)
    case (FF_NRL_TB)
      TBModel_get_dHS_blocks = get_dHS_blocks(this%tbmodel_nrl_tb, at, i, j, dv_hat, dv_mag, at_ind, b_dH, b_dS, i_mag)
    case (FF_Bowler)
      TBModel_get_dHS_blocks = get_dHS_blocks(this%tbmodel_bowler, at, i, j, dv_hat, dv_mag, at_ind, b_dH, b_dS, i_mag)
    case (FF_DFTB)
      TBModel_get_dHS_blocks = get_dHS_blocks(this%tbmodel_dftb, at, i, j, dv_hat, dv_mag, at_ind, b_dH, b_dS, i_mag)
    case (FF_GSP)
      TBModel_get_dHS_blocks = get_dHS_blocks(this%tbmodel_gsp, at, i, j, dv_hat, dv_mag, at_ind, b_dH, b_dS)
    case default
      call system_abort ('TBModel_get_HS_blocks confused by functional_form' // this%functional_form)
  end select

end function TBModel_get_dHS_blocks

function TBModel_get_local_rep_E(this, at, i)
  type(TBModel), intent(in) :: this
  type(Atoms), intent(in) :: at
  integer, intent(in) :: i
  real(dp) :: TBModel_get_local_rep_E

  select case(this%functional_form)
    case (FF_NRL_TB)
      TBModel_get_local_rep_E = get_local_rep_E(this%tbmodel_nrl_tb, at, i)
    case (FF_Bowler)
      TBModel_get_local_rep_E = get_local_rep_E(this%tbmodel_bowler, at, i)
    case (FF_DFTB)
      TBModel_get_local_rep_E = get_local_rep_E(this%tbmodel_dftb, at, i)
    case (FF_GSP)
      TBModel_get_local_rep_E = get_local_rep_E(this%tbmodel_gsp, at, i)
    case default
      call system_abort ('TBModel_get_local_rep_E confused by functional_form' // this%functional_form)
  end select
end function TBModel_get_local_rep_E

function TBModel_get_local_rep_E_force(this, at, i) result(force)
  type(TBModel), intent(in) :: this
  type(Atoms), intent(in) :: at
  integer, intent(in) :: i
  real(dp) :: force(3,at%N)

  select case(this%functional_form)
    case (FF_NRL_TB)
      force = get_local_rep_E_force(this%tbmodel_nrl_tb, at, i)
    case (FF_Bowler)
      force = get_local_rep_E_force(this%tbmodel_bowler, at, i)
    case (FF_DFTB)
      force = get_local_rep_E_force(this%tbmodel_dftb, at, i)
    case (FF_GSP)
      force = get_local_rep_E_force(this%tbmodel_gsp, at, i)
    case default
      call system_abort ('TBModel_get_local_rep_E_force confused by functional_form' // this%functional_form)
  end select
end function TBModel_get_local_rep_E_force

function TBModel_get_local_rep_E_virial(this, at, i) result(virial)
  type(TBModel), intent(in) :: this
  type(Atoms), intent(in) :: at
  integer, intent(in) :: i
  real(dp) :: virial(3,3)

  select case(this%functional_form)
    case (FF_NRL_TB)
      virial = get_local_rep_E_virial(this%tbmodel_nrl_tb, at, i)
    case (FF_Bowler)
      virial = get_local_rep_E_virial(this%tbmodel_bowler, at, i)
    case (FF_DFTB)
      virial = get_local_rep_E_virial(this%tbmodel_dftb, at, i)
    case (FF_GSP)
      virial = get_local_rep_E_virial(this%tbmodel_gsp, at, i)
    case default
      call system_abort ('TBModel_get_local_rep_E_virial confused by functional_form' // this%functional_form)
  end select
end function TBModel_get_local_rep_E_virial

function TBModel_has_Fermi_E(out_Fermi_E, this, Fermi_E, args_str)
  real(dp), intent(out) :: out_Fermi_E
  type(TBModel), intent(in) :: this
  real(dp), optional, intent(in) :: Fermi_E
  character(len=*), optional, intent(in) :: args_str
  logical :: TBModel_has_Fermi_E

  type(Dictionary) :: params
  logical :: has_str_fermi_e

  TBModel_has_Fermi_E = .false.
  if (present(Fermi_E)) then
    out_Fermi_E = Fermi_E
    TBModel_has_Fermi_E = .true.
  else
    if (this%has_default_fermi_E) then
      out_Fermi_E = this%default_Fermi_E
      TBModel_has_Fermi_E = .true.
    endif
    if (present(args_str)) then
      call initialise(params)
      call param_register(params, 'fermi_e', ''//out_fermi_E, out_fermi_E, has_value_target=has_str_fermi_e, help_string="No help yet.  This source file was $LastChangedBy$")
      if (.not. param_read_line(params, args_str, ignore_unknown=.true.,task='TBModel_has_Fermi_E args_str')) then
        call system_abort("TBModel_has_fermi_e failed to parse args_str='"//trim(args_str)//"'")
      endif
      call finalise(params)
      if (has_str_fermi_e) TBModel_has_fermi_E = .true.
    endif
  endif

end function TBModel_has_Fermi_E

function TBModel_has_Fermi_T(out_Fermi_T, this, Fermi_T, args_str)
  real(dp), intent(out) :: out_Fermi_T
  type(TBModel), intent(in) :: this
  real(dp), optional, intent(in) :: Fermi_T
  character(len=*), optional, intent(in) :: args_str
  logical :: TBModel_has_Fermi_T

  type(Dictionary) :: params
  logical :: has_str_fermi_T

  TBModel_has_Fermi_T = .false.
  if (present(Fermi_T)) then
    out_Fermi_T = Fermi_T
    TBModel_has_Fermi_T = .true.
  else
    if (this%has_default_fermi_T) then
      out_Fermi_T = this%default_Fermi_T
      TBModel_has_Fermi_T = .true.
    endif
    if (present(args_str)) then
      call initialise(params)
      call param_register(params, 'fermi_T', ''//out_fermi_T, out_fermi_T, has_value_target=has_str_fermi_T, help_string="No help yet.  This source file was $LastChangedBy$")
      if (.not. param_read_line(params, args_str, ignore_unknown=.true.,task='TBModel_has_Fermi_T args_str')) then
        call system_abort("TBModel_has_fermi_T failed to parse args_str='"//trim(args_str)//"'")
      endif
      call finalise(params)
      if (has_str_fermi_T) TBModel_has_fermi_T = .true.
    endif
  endif

end function TBModel_has_Fermi_T

function TBModel_has_band_width(out_band_width, this, band_width, args_str)
  real(dp), intent(out) :: out_band_width
  type(TBModel), intent(in) :: this
  real(dp), optional, intent(in) :: band_width
  character(len=*), optional, intent(in) :: args_str
  logical :: TBModel_has_band_width

  type(Dictionary) :: params
  logical :: has_str_band_width

  TBModel_has_band_width = .false.
  if (present(band_width)) then
    out_band_width = band_width
    TBModel_has_band_width = .true.
  else
    if (this%has_default_band_width) then
      out_band_width = this%default_band_width
      TBModel_has_band_width = .true.
    endif
    if (present(args_str)) then
      call initialise(params)
      call param_register(params, 'band_width', ''//out_band_width, out_band_width, has_value_target=has_str_band_width, help_string="No help yet.  This source file was $LastChangedBy$")
      if (.not. param_read_line(params, args_str, ignore_unknown=.true.,task='TBModel_has_band_width args_str')) then
        call system_abort("TBModel_has_band_width failed to parse args_str='"//trim(args_str)//"'")
      endif
      call finalise(params)
      if (has_str_band_width) TBModel_has_band_width = .true.
    endif
  endif

end function TBModel_has_band_width

function TBModel_has_k_density(out_k_density, this, k_density, args_str)
  real(dp), intent(out) :: out_k_density
  type(TBModel), intent(in) :: this
  real(dp), optional, intent(in) :: k_density
  character(len=*), optional, intent(in) :: args_str
  logical :: TBModel_has_k_density

  type(Dictionary) :: params
  logical :: has_str_k_density

  TBModel_has_k_density = .false.
  if (present(k_density)) then
    out_k_density = k_density
    TBModel_has_k_density = .true.
  else
    if (this%has_default_k_density) then
      out_k_density = this%default_k_density
      TBModel_has_k_density = .true.
    endif
    if (present(args_str)) then
      call initialise(params)
      call param_register(params, 'k_density', ''//out_k_density, out_k_density, has_value_target=has_str_k_density, help_string="No help yet.  This source file was $LastChangedBy$")
      if (.not. param_read_line(params, args_str, ignore_unknown=.true.,task='TBModel_has_k_density args_str')) then
        call system_abort("TBModel_has_k_density failed to parse args_str='"//trim(args_str)//"'")
      endif
      call finalise(params)
      if (has_str_k_density) TBModel_has_k_density = .true.
    endif
  endif

end function TBModel_has_k_density

end module TBModel_module


! ###############################################################
! #                                                             #
! #                    THE VECTOR LIDORT MODEL                  #
! #                                                             #
! #  (Vector LInearized Discrete Ordinate Radiative Transfer)   #
! #   -      --         -        -        -         -           #
! #                                                             #
! ###############################################################

! ###############################################################
! #                                                             #
! #  Author :      Robert. J. D. Spurr                          #
! #                                                             #
! #  Address :     RT Solutions, inc.                           #
! #                9 Channing Street                            #
! #                Cambridge, MA 02138, USA                     #
! #                Tel: (617) 492 1183                          #
! #                                                             #
! #  Email :       rtsolutions@verizon.net                      #
! #                                                             #
! #  Versions     :   2.0, 2.2, 2.3, 2.4, 2.4R, 2.4RT, 2.4RTC,  #
! #                   2.5, 2.6, 2.7                             #
! #  Release Date :   December 2005  (2.0)                      #
! #  Release Date :   March 2007     (2.2)                      #
! #  Release Date :   October 2007   (2.3)                      #
! #  Release Date :   December 2008  (2.4)                      #
! #  Release Date :   April 2009     (2.4R)                     #
! #  Release Date :   July 2009      (2.4RT)                    #
! #  Release Date :   October 2010   (2.4RTC)                   #
! #  Release Date :   March 2011     (2.5)                      #
! #  Release Date :   May 2012       (2.6)                      #
! #  Release Date :   August 2014    (2.7)                      #
! #                                                             #
! #       NEW: TOTAL COLUMN JACOBIANS         (2.4)             #
! #       NEW: BPDF Land-surface KERNELS      (2.4R)            #
! #       NEW: Thermal Emission Treatment     (2.4RT)           #
! #       Consolidated BRDF treatment         (2.4RTC)          #
! #       f77/f90 Release                     (2.5)             #
! #       External SS / New I/O Structures    (2.6)             #
! #                                                             #
! #       SURFACE-LEAVING / BRDF-SCALING      (2.7)             #
! #       TAYLOR Series / OMP THREADSAFE      (2.7)             #
! #                                                             #
! ###############################################################

!    #####################################################
!    #                                                   #
!    #   This Version of VLIDORT comes with a GNU-style  #
!    #   license. Please read the license carefully.     #
!    #                                                   #
!    #####################################################

      MODULE VLIDORT_LinWork_def

!  This module contains the following VLIDORT linearized work structures:
!  (n/a = not available at present)

!         VLIDORT_LinWork_RadTran    n/a
!            VLIDORT_LinWork_User    n/a
!           VLIDORT_LinWork_Solar    n/a
!         VLIDORT_LinWork_Thermal
!        VLIDORT_LinWork_Geometry    n/a
!    VLIDORT_LinWork_Miscellanous
!      VLIDORT_LinWork_Multiplier
!     VLIDORT_LinWork_Corrections    n/a
!      VLIDORT_LinWork_FirstOrder    n/a
!         VLIDORT_LinWork_Control    n/a
!         VLIDORT_LinWork_Optical    n/a
!            VLIDORT_LinWork_BRDF    n/a
!          VLIDORT_LinWork_SLEAVE    n/a
!          VLIDORT_LinWork_Output    n/a

      USE VLIDORT_PARS

      IMPLICIT NONE

! #####################################################################
! #####################################################################

      TYPE VLIDORT_LinWork_Thermal

      DOUBLE PRECISION :: L_THERMCOEFFS &
          ( MAXLAYERS, MAX_THERMAL_COEFFS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: L_DELTAU_POWER &
          ( MAXLAYERS, MAX_THERMAL_COEFFS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: L_XTAU_POWER &
          ( MAX_PARTLAYERS, MAX_THERMAL_COEFFS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: L_TCOM1 &
          ( MAXLAYERS, MAX_THERMAL_COEFFS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: L_T_DIRECT_UP &
          ( MAX_USER_STREAMS, MAXLAYERS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: L_T_DIRECT_DN &
          ( MAX_USER_STREAMS, MAXLAYERS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: L_T_UT_DIRECT_UP &
          ( MAX_USER_STREAMS, MAX_PARTLAYERS, MAX_ATMOSWFS)
      DOUBLE PRECISION :: L_T_UT_DIRECT_DN &
          ( MAX_USER_STREAMS, MAX_PARTLAYERS, MAX_ATMOSWFS )

      END TYPE VLIDORT_LinWork_Thermal

! #####################################################################
! #####################################################################

      TYPE VLIDORT_LinWork_Miscellanous

      DOUBLE PRECISION :: L_OMEGA_TOTAL ( MAX_ATMOSWFS, MAXLAYERS )
      DOUBLE PRECISION :: L_DELTAU_VERT ( MAX_ATMOSWFS, MAXLAYERS )
      DOUBLE PRECISION :: L_GREEKMAT_TOTAL &
          ( MAX_ATMOSWFS, 0:MAXMOMENTS, MAXLAYERS, MAXSTOKES_SQ )
      DOUBLE PRECISION :: L_DELTAU_SLANT &
          ( MAX_ATMOSWFS, MAXLAYERS, MAXLAYERS, MAXBEAMS )
      LOGICAL ::          DO_SCATMAT_VARIATION ( MAXLAYERS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: L_TRUNC_FACTOR ( MAX_ATMOSWFS, MAXLAYERS )
      DOUBLE PRECISION :: L_OMEGA_GREEK &
          ( 0:MAXMOMENTS, MAXLAYERS, MAXSTOKES, MAXSTOKES, MAX_ATMOSWFS )

      DOUBLE PRECISION :: L_T_DELT_DISORDS &
          ( MAXSTREAMS, MAXLAYERS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: L_T_DISORDS_UTDN &
          ( MAXSTREAMS, MAX_USER_LEVELS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: L_T_DISORDS_UTUP &
          ( MAXSTREAMS, MAX_USER_LEVELS, MAX_ATMOSWFS )

      DOUBLE PRECISION :: L_T_DELT_USERM &
          ( MAXLAYERS, MAX_USER_STREAMS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: L_T_UTDN_USERM &
          ( MAX_USER_LEVELS, MAX_USER_STREAMS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: L_T_UTUP_USERM &
          ( MAX_USER_LEVELS, MAX_USER_STREAMS, MAX_ATMOSWFS )

      DOUBLE PRECISION :: LP_AVERAGE_SECANT &
          ( MAXLAYERS, MAXLAYERS, MAXBEAMS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: LP_INITIAL_TRANS &
          ( MAXLAYERS, MAXLAYERS, MAXBEAMS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: LP_T_DELT_MUBAR &
          ( MAXLAYERS, MAXLAYERS, MAXBEAMS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: LP_T_UTDN_MUBAR &
          ( MAX_USER_LEVELS, MAXLAYERS, MAXBEAMS, MAX_ATMOSWFS)

      DOUBLE PRECISION :: LC_AVERAGE_SECANT &
          ( MAXLAYERS, MAXBEAMS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: LC_INITIAL_TRANS &
          ( MAXLAYERS, MAXBEAMS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: LC_T_DELT_MUBAR &
          ( MAXLAYERS, MAXBEAMS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: LC_T_UTDN_MUBAR &
          ( MAX_USER_LEVELS, MAXBEAMS, MAX_ATMOSWFS)

      END TYPE VLIDORT_LinWork_Miscellanous

! #####################################################################
! #####################################################################

      TYPE VLIDORT_LinWork_Multiplier

      DOUBLE PRECISION :: LP_EMULT_UP &
          ( MAX_USER_STREAMS, MAXLAYERS, MAXLAYERS, &
            MAXBEAMS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: LP_EMULT_DN &
          ( MAX_USER_STREAMS, MAXLAYERS, MAXLAYERS, &
            MAXBEAMS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: LP_UT_EMULT_UP &
          ( MAX_USER_STREAMS, MAX_PARTLAYERS, MAXLAYERS, &
            MAXBEAMS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: LP_UT_EMULT_DN &
          ( MAX_USER_STREAMS, MAX_PARTLAYERS, MAXLAYERS, &
            MAXBEAMS, MAX_ATMOSWFS )

      DOUBLE PRECISION :: LC_EMULT_UP &
          ( MAX_USER_STREAMS, MAXLAYERS, &
            MAXBEAMS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: LC_EMULT_DN &
          ( MAX_USER_STREAMS, MAXLAYERS, &
            MAXBEAMS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: LC_UT_EMULT_UP &
          ( MAX_USER_STREAMS, MAX_PARTLAYERS, &
            MAXBEAMS, MAX_ATMOSWFS )
      DOUBLE PRECISION :: LC_UT_EMULT_DN &
          ( MAX_USER_STREAMS, MAX_PARTLAYERS, &
            MAXBEAMS, MAX_ATMOSWFS )

      END TYPE VLIDORT_LinWork_Multiplier

! #####################################################################
! #####################################################################

!  EVERYTHING PUBLIC HERE

      PRIVATE
      PUBLIC :: & !VLIDORT_LinWork_RadTran, &
                !VLIDORT_LinWork_User, &
                !VLIDORT_LinWork_Solar, &
                VLIDORT_LinWork_Thermal, &
                !VLIDORT_LinWork_Geometry, &
                VLIDORT_LinWork_Miscellanous, &
                VLIDORT_LinWork_Multiplier!, &
                !VLIDORT_LinWork_Corr_Nadir, &
                !VLIDORT_LinWork_Corr_OutGo, &
                !VLIDORT_LinWork_Corr_DB, &
                !VLIDORT_LinWork_FirstOrder, &
                !VLIDORT_LinWork_Control, &
                !VLIDORT_LinWork_Optical, &
                !VLIDORT_LinWork_BRDF, &
                !VLIDORT_LinWork_SLEAVE, &
                !VLIDORT_LinWork_Output, &
                !VLIDORT_LinWork_Corrections

   END MODULE VLIDORT_LinWork_def