! (c) british crown copyright, the met office.
! all rights reserved.
!
! redistribution and use in source and binary forms, with or without modification, are permitted
! provided that the following conditions are met:
!
!     * redistributions of source code must retain the above copyright notice, this list
!       of conditions and the following disclaimer.
!     * redistributions in binary form must reproduce the above copyright notice, this list
!       of conditions and the following disclaimer in the documentation and/or other materials
!       provided with the distribution.
!     * neither the name of the met office nor the names of its contributors may be used
!       to endorse or promote products derived from this software without specific prior written
!       permission.
!
! this software is provided by the copyright holders and contributors "as is" and any express or
! implied warranties, including, but not limited to, the implied warranties of merchantability and
! fitness for a particular purpose are disclaimed. in no event shall the copyright owner or
! contributors be liable for any direct, indirect, incidental, special, exemplary, or consequential
! damages (including, but not limited to, procurement of substitute goods or services; loss of use,
! data, or profits; or business interruption) however caused and on any theory of liability, whether
! in contract, strict liability, or tort (including negligence or otherwise) arising in any way out
! of the use of this software, even if advised of the possibility of such damage.

module mod_cosp_rttov
  use rttov_const, only : errorstatus_success, errorstatus_fatal

  ! rttov_types contains definitions of all rttov data types
  use rttov_types, only : rttov_options,       &
       rttov_coefs,         &
       profile_type,        &
       transmission_type,   &
       radiance_type,       &
       rttov_chanprof,      &
       rttov_emissivity,    &
       profile_cloud_type

  use rttov_const, only : surftype_sea, surftype_land, surftype_seaice

  use rttov_unix_env, only : rttov_exit

  implicit none

#include "rttov_direct.interface"
#include "rttov_alloc_prof.interface"
#include "rttov_alloc_rad.interface"
#include "rttov_alloc_transmission.interface"
#include "rttov_dealloc_coefs.interface"
#include "rttov_user_options_checkinput.interface"
#include "rttov_read_coefs.interface"
#include "rttov_get_emis.interface"

  integer, parameter :: maxlim  =  10000

contains

  subroutine rttov_multprof( &
       nch_in,     & ! number of channels
       ichan_in,   & ! channel indices
       surfem_in,  & ! surface emissivity values
       prf_num_in, & ! number of profiles to simulate
       nlevels_in, & ! number of pressure levels
       plat_in,    & ! platform number
       sat_in,     & ! satellite number
       sens_in,    & ! instrument number
       opts,       &
       coef_rttov, &
       zenang_in,  & ! zenith angle
       p_in,       & ! pressure [hpa]
       t_in,       & ! temperature [ k ]
       q_in,       & ! specific humidity [ ppmv ]
       o3_in,      & ! ozone vmr [ ppmv ]
       co2_in,     & ! co2 vmr [ ppmv ] *this is a single value*
       ch4_in,     & ! ch4 vmr [ ppmv ] *this is a single value*
       n2o_in,     & ! n2o vmr [ ppmv ] *this is a single value*
       co_in,      & ! co vmr [ ppmv ]  *this is a single value*
       h_surf,     & ! surface height [ m ]
       u_surf,     & ! u wind at 10 m  [ m/s ]
       v_surf,     & ! v wind at 10 m [ m/s ]
       t_skin,     & ! skin temperatre [ k ]
       p_surf,     & ! surface pressure
       t_surf,     & ! 1.5 m temperature [ k ]
       q_surf,     & ! 1.5 m specific humidity [ ppmv ]
       lsmask,     & ! land sea mask
       seaice,     & ! seaice fraction
       latitude,   & ! latitude [ deg north ]
       longitude,  & ! longitude [ deg east ]
       tbs         & ! brightness temperature [ k ] (output)
       )

    !------ input arguments. no rttov kinds should be used here -----------------
    integer, intent(in)  :: nch_in             ! number of channels to be computed
    integer, intent(in)  :: ichan_in(nch_in)   ! indices of selected channels
    real(wp), intent(in)     :: surfem_in(nch_in)  ! surface emissivities for the channels
    integer, intent(in)  :: prf_num_in
    integer, intent(in)  :: nlevels_in
    integer, intent(in)  :: plat_in  ! satellite platform
    integer, intent(in)  :: sat_in   ! satellite number
    integer, intent(in)  :: sens_in  ! satellite sensor
    real(wp), intent(in)     :: zenang_in          ! satellite zenith angle

    type(rttov_options)  :: opts
    type(rttov_coefs)    :: coef_rttov

    real(wp), intent(in)     :: p_in(prf_num_in, nlevels_in)  ! pressure profiles
    real(wp), intent(in)     :: t_in(prf_num_in, nlevels_in)  ! temperature profiles
    real(wp), intent(in)     :: q_in(prf_num_in, nlevels_in)  ! humidity profiles
    real(wp), intent(in)     :: o3_in(prf_num_in, nlevels_in) ! ozone profiles

    ! the following trace gases contain constant values
    real(wp), intent(in) ::  co2_in ! carbon dioxide
    real(wp), intent(in) ::  ch4_in ! methane
    real(wp), intent(in) ::  n2o_in ! n2o
    real(wp), intent(in) ::  co_in  ! carbon monoxide
    real(wp), intent(in) ::  h_surf(prf_num_in)         ! surface height
    real(wp), intent(in) ::  u_surf(prf_num_in)         ! u component of surface wind
    real(wp), intent(in) ::  v_surf(prf_num_in)         ! v component of surface wind
    real(wp), intent(in) ::  t_skin(prf_num_in)         ! surface skin temperature
    real(wp), intent(in) ::  p_surf(prf_num_in)                  ! surface pressure
    real(wp), intent(in) ::  t_surf(prf_num_in)         ! 1.5 m temperature
    real(wp), intent(in) ::  q_surf(prf_num_in)         ! 1.5 m specific humidity
    real(wp), intent(in) ::  lsmask(prf_num_in)         ! land-sea mask
    real(wp), intent(in) ::  seaice(prf_num_in)         ! sea-ice fraction
    real(wp), intent(in) ::  latitude(prf_num_in)       ! latitude
    real(wp), intent(in) ::  longitude(prf_num_in)      ! longitude

    real(wp), intent(inout) :: tbs(prf_num_in, nch_in)  ! tbs (in the right format)

    !------ local variables. use only rttov kinds or derived types.
    !       logical variables are declared with the same kind
    !       as integers, as they are affected inthe same way by flags like -qintsize=8

    !     type(rttov_options)                  :: opts           ! options structure
    !     type(rttov_coefs),       allocatable :: coefs(:)       ! coefficients structure
    type(rttov_chanprof),    allocatable :: chanprof(:)    ! input channel/profile list
    type(profile_type),      allocatable :: profiles(:)    ! input profiles
    logical,      allocatable :: calcemis(:)    ! flag to indicate calculation of emissivity within rttov
    type(rttov_emissivity),  allocatable :: emissivity(:)  ! input/output surface emissivity
    type(transmission_type)              :: transmission   ! output transmittances
    type(radiance_type)                  :: radiance       ! output radiances

    integer, allocatable :: instrument(:,:) ! instrument id (3 x n_instruments)
    integer, allocatable :: nchan(:) ! number of channels per instrument
    integer, allocatable :: ichan(:,:)   ! channel list per instrument

    integer :: asw
    integer :: mxchn
    integer :: nrttovid     ! maximum number of instruments
    integer :: no_id        ! instrument loop index
    integer :: i, j, jch
    integer :: nprof  ! number of calls to rttov
    integer :: nch ! intermediate variable
    integer :: errorstatus
    integer :: ich, ich_temp, nchanprof, nchannels, chan
    integer :: alloc_status(60)

    real(wp),    allocatable :: input_emissivity (:)

    character (len=14)  :: nameofroutine = 'rttov_multprof'

    logical :: refrac, solrad, laerosl, lclouds, lsun, all_channels

    ! local variables for input arguments that need type casting to avoid type-mismatch with
    ! rttov kinds. this happens with some compiler flags (-qintsize=8).
    integer  :: prof_num
    integer  :: nlevels

    ! --------------------------------------------------------------------------
    ! 0. initialise cosp-specific things
    ! --------------------------------------------------------------------------

    ! type-casting of input arguments that need to be passed to rttov
    prof_num = prf_num_in
    nlevels  = nlevels_in
    nprof = prof_num

    ! currently we plan to calculate only 1 instrument per call
    nrttovid  =  1
    mxchn  =  nch_in

    errorstatus     = 0
    alloc_status(:) = 0

    !     allocate(coefs(nrttovid), stat = alloc_status(1))

    !     allocate(instrument(3, nrttovid), stat = alloc_status(4))

    !maximum number of channels allowed for one instrument is mxchn
    !    allocate(surfem(nch_in, nrttovid), stat = alloc_status(11))
    allocate(ichan(nch_in, nrttovid), stat = alloc_status(12))
    call rttov_error('ichan mem allocation error for profile array' , lalloc = .true.)


    do no_id = 1, nrttovid
       ichan(:, no_id)   = ichan_in
    enddo

    asw = 1 ! switch for allocation passed into rttov subroutines

    ! allocate input profile arrays
    allocate(profiles(nprof), stat = alloc_status(1))
    call rttov_error('Profile mem allocation error' , lalloc = .true.)

    call rttov_alloc_prof(     &
         errorstatus,             &
         nprof,                   &
         profiles,                &
         nlevels,                 &
         opts,                    &
         asw,                     &
         coefs = coef_rttov,      &
         init = .true.)
    call rttov_error('Profile 2 mem allocation error' , lalloc = .true.)
    ! --------------------------------------------------------------------------
    ! 5. store profile data in profile type
    ! --------------------------------------------------------------------------
    do i = 1, nprof
       profiles(i)%p(:) =  p_in(i, :)
       profiles(i)%t(:) =  t_in(i, :)
       profiles(i)%q(:) =  q_in(i, :)

       where(profiles(i)%q(:) < 1e-4)
          profiles(i)%q(:) = 1e-4
       end where

       profiles(i)%cfraction  =  0.
       profiles(i)%ctp        =  500.

       ! 2m parameters
       profiles(i)%s2m%p  =  p_surf(i)
       profiles(i)%s2m%t  =  t_surf(i)
       profiles(i)%s2m%q  =  q_surf(i)
       profiles(i)%s2m%u  =  u_surf(i) ! dar: hard-coded at 2ms-1?
       profiles(i)%s2m%v  =  v_surf(i) ! dar: hard-coded at 2ms-1?
       profiles(i)%s2m%wfetc  =  10000. ! dar: default?

       ! skin variables for emissivity calculations
       profiles(i)%skin%t          =  t_skin(i)

       ! fastem coefficients - for mw calculations
       profiles(i)%skin%fastem(1)  =  3.0
       profiles(i)%skin%fastem(2)  =  5.0
       profiles(i)%skin%fastem(3)  =  15.0
       profiles(i)%skin%fastem(4)  =  0.1
       profiles(i)%skin%fastem(5)  =  0.3

       profiles(i)%zenangle      = zenang_in ! pass in from cosp

       profiles(i)%azangle       = 0. ! hard-coded in rttov9 int

       profiles(i)%latitude      = latitude(i)
       profiles(i)%longitude     = longitude(i)
       profiles(i)%elevation     = h_surf(i)

       profiles(i)%sunzenangle   = 0. ! hard-coded in rttov9 int
       profiles(i)%sunazangle    = 0. ! hard-coded in rttov9 int

       ! surface type
       ! land-sea mask indicates proportion of land in grid
       if (lsmask(i) < 0.5) then
          profiles(i)%skin%surftype  = surftype_sea
       else
          profiles(i)%skin%surftype  = surftype_land
       endif
       ! sea-ice fraction
       if (seaice(i) >= 0.5) then
          profiles(i)%skin%surftype  = surftype_seaice
       endif

       ! dar: hard-coded to 1 (=ocean water) in rttov 9 int
       profiles(i)%skin%watertype = 1
       profiles(i) %idg         = 0.
       profiles(i) %ish         = 0.
    enddo
    ! end of 5.

    ich_temp = 1
    nchannels = nch_in
    do no_id = 1, nrttovid

       ! --------------------------------------------------------------------------
       ! 3. build the list of profile/channel indices in chanprof
       ! --------------------------------------------------------------------------

       allocate(nchan(nprof))     ! number of channels per profile
       nchan(:) = size(ichan(:,no_id))  ! = nch_in

       ! size of chanprof array is total number of channels over all profiles
       ! square in this case - here same channels done for all profiles
       nchanprof = sum(nchan(:))

       ! pack channels and input emissivity arrays
       allocate(chanprof(nchanprof))
       !      allocate(emis(nchanprof))

       nch = 0
       do j = 1, nprof
          do jch = 1, nchan(j)
             nch = nch + 1
             chanprof(nch)%prof = j
             if(ichan(jch, no_id) < 1) then
                errorstatus = errorstatus_fatal
                call rttov_error('Sensor channel number must be 1 or greater' , lalloc = .true.)
             else
                chanprof(nch)%chan = ichan(jch, no_id)
             endif
          enddo
       enddo

       ! end of 3.

       ! allocate output radiance arrays
       call rttov_alloc_rad( &
            errorstatus,        &
            nchanprof,          &
            radiance,           &
            nlevels - 1,   & ! nlayers
            asw)
       call rttov_error('allocation error for radiance arrays' , lalloc = .true.)

       ! allocate transmittance structure
       call rttov_alloc_transmission( &
            errorstatus,             &
            transmission,            &
            nlevels - 1,        &
            nchanprof,               &
            asw,                     &
            init=.true.)
       call rttov_error('allocation error for transmission arrays' , lalloc = .true.)

       ! allocate arrays for surface emissivity
       allocate(calcemis(nchanprof), stat=alloc_status(1))
       allocate(emissivity(nchanprof), stat=alloc_status(2))
       call rttov_error('mem allocation error for emissivity arrays' , lalloc = .true.)

       call rttov_get_emis(       &
            & errorstatus, &
            & opts,        &
            & chanprof,    &
            & profiles,    &
            & coef_rttov,  &
            & emissivity=emissivity(:)%emis_in)
       !            & emissivity(:)%emis_in)
       call rttov_error('Get emissivity error' , lalloc = .true.)
       calcemis(:) = .false.
       ! calculate emissivity for missing and ocean location (fastem)
       where (emissivity(:)%emis_in <= 0.0)
          calcemis(:) = .true.
       endwhere

       call rttov_direct(              &
            errorstatus,               &! out
            chanprof,                  &
            opts,                      &
            profiles,                  &! in
            coef_rttov,                &! in
            transmission,              &! out
            radiance,                  &
            calcemis = calcemis,       &! in
            emissivity = emissivity)    ! inout

       call rttov_error('rttov_direct error', lalloc = .true.)

       tbs(1:prof_num , ich_temp:ich_temp + size(ichan(:,no_id)) - 1) = &
            transpose(reshape(radiance%bt(1:nchanprof), (/ size(ichan(:,no_id)), prof_num/) ))

       ich_temp = ich_temp + size(ichan(:,no_id))

       ! --------------------------------------------------------------------------
       ! 8. deallocate all rttov arrays and structures
       ! --------------------------------------------------------------------------
       deallocate (nchan,       stat=alloc_status(3))
       deallocate (chanprof,    stat=alloc_status(4))
       deallocate (emissivity,  stat=alloc_status(5))
       deallocate (calcemis,    stat=alloc_status(6))
       call rttov_error('rttov array deallocation error', lalloc = .true.)

       asw = 0 ! switch for deallocation passed into rttov subroutines

       ! deallocate radiance arrays
       call rttov_alloc_rad(errorstatus, nchannels, radiance, nlevels - 1, asw)
       call rttov_error('radiance deallocation error', lalloc = .true.)

       ! deallocate transmission arrays
       call rttov_alloc_transmission(errorstatus, transmission, nlevels - 1, nchannels, asw)
       call rttov_error('transmission deallocation error', lalloc = .true.)

    enddo

    ! deallocate profile arrays
    call rttov_alloc_prof(errorstatus, nprof, profiles, nlevels, opts, asw)
    call rttov_error('profile deallocation error', lalloc = .true.)

    deallocate(profiles, stat=alloc_status(1))
    call rttov_error('mem deallocation error for profile array', lalloc= .true.)

  contains

    subroutine rttov_error(msg, lalloc)
      character(*) :: msg
      logical  :: lalloc

      if(lalloc) then
         if (any(alloc_status /= 0)) then
            write(*,*) msg
            errorstatus = 1
            call rttov_exit(errorstatus)
         endif
      else
         if (errorstatus /= errorstatus_success) then
            write(*,*) msg
            call rttov_exit(errorstatus)
         endif
      endif
    end subroutine rttov_error

  end subroutine rttov_multprof
  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  !----------------- subroutine cosp_rttov_mwscatt ---------------
  !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

  subroutine cosp_rttov_mwscatt(&
       nch_in,     & ! number of channels
       ichan_in,   & ! channel indices
       surfem_in,  & ! surface emissivity values
       prf_num_in, & ! number of profiles to simulate
       nlevels_in, & ! number of pressure levels
       plat_in,    & ! platform number
       sat_in,     & ! satellite number
       sens_in,    & ! instrument number
       opts,       &
       opts_scatt, &
       coef_rttov, &
       coef_scatt, &
       zenang_in,  & ! zenith angle
       p_in,       & ! pressure [hpa]
       ph_in,      & ! pressure on half levels [hpa]
       t_in,       & ! temperature [ k ]
       q_in,       & ! specific humidity [ ppmv ]
       o3_in,      & ! ozone vmr [ ppmv ]
       clw_in,     & ! cloud water [0-1]
       ciw_in,     & ! cloud ice [0-1]
       cc_in,      & ! effective cloud fraction [0-1]
       totalice_in,& ! total ice, except snow [kg/kg] or [kg/m2/s]
       sp_in,      & ! solid precip with snow [kg/kg] or [kg/m2/s]
       rain_in,    & ! total liquid water [kg/kg] or [kg/m2/s]
       co2_in,     & ! co2 vmr [ ppmv ] *this is a single value*
       ch4_in,     & ! ch4 vmr [ ppmv ] *this is a single value*
       n2o_in,     & ! n2o vmr [ ppmv ] *this is a single value*
       co_in,      & ! co vmr [ ppmv ]  *this is a single value*
       h_surf,     & ! surface height [ m ]
       u_surf,     & ! u wind at 10 m  [ m/s ]
       v_surf,     & ! v wind at 10 m [ m/s ]
       t_skin,     & ! skin temperatre [ k ]
       p_surf,     & ! surface pressure
       t_surf,     & ! 1.5 m temperature [ k ]
       q_surf,     & ! 1.5 m specific humidity [ ppmv ]
       lsmask,     & ! land sea mask
       seaice,     & ! seaice fraction
       latitude,   & ! latitude [ deg north ]
       longitude,  & ! longitude [ deg east ]
       use_totalice,& ! separate ice and snow, or total ice hydrometeor types
       mmr_snowrain,& ! units for snow and rain: if true units are kg/kg (the default)
       cfrac,       & ! opts_scatt%lusercfrac=true., supply the effective cloud fraction
       tbs          & ! brightness temperature [ k ] (output)
       )


    use rttov_types, only :   &
         & rttov_coefs          ,&
         & rttov_scatt_coef     ,&
         & rttov_chanprof       ,&
         & rttov_options        ,&
         & rttov_options_scatt  ,&
         & profile_type         ,&
         & profile_cloud_type   ,&
         & radiance_type        ,&
         & rttov_emissivity

    use rttov_unix_env, only : rttov_exit

    implicit none

    !------ input arguments. no rttov kinds should be used here -----------------
    integer, intent(in)  :: nch_in             ! number of channels to be computed
    integer, intent(in)  :: ichan_in(nch_in)   ! indices of selected channels
    real(wp), intent(in)     :: surfem_in(nch_in)  ! surface emissivities for the channels
    integer, intent(in)  :: prf_num_in
    integer, intent(in)  :: nlevels_in
    integer, intent(in)  :: plat_in  ! satellite platform
    integer, intent(in)  :: sat_in   ! satellite number
    integer, intent(in)  :: sens_in  ! satellite sensor
    real(wp), intent(in)     :: zenang_in          ! satellite zenith angle

    type(rttov_options)       :: opts
    type(rttov_options_scatt) :: opts_scatt
    type(rttov_coefs)         :: coef_rttov
    type(rttov_scatt_coef)    :: coef_scatt

    real(wp), intent(in)     :: p_in(prf_num_in, nlevels_in)  ! pressure profiles
    real(wp), intent(in)     :: t_in(prf_num_in, nlevels_in)  ! temperature profiles
    real(wp), intent(in)     :: q_in(prf_num_in, nlevels_in)  ! humidity profiles
    real(wp), intent(in)     :: o3_in(prf_num_in, nlevels_in) ! ozone profiles
    real(wp), intent(in)     :: clw_in(prf_num_in, nlevels_in)
    real(wp), intent(in)     :: ciw_in(prf_num_in, nlevels_in)
    real(wp), intent(in)     :: cc_in(prf_num_in, nlevels_in)
    real(wp), intent(in)     :: totalice_in(prf_num_in, nlevels_in)
    real(wp), intent(in)     :: sp_in(prf_num_in, nlevels_in)
    real(wp), intent(in)     :: rain_in(prf_num_in, nlevels_in)
    real(wp), intent(in)     :: ph_in(prf_num_in, nlevels_in+1)

    ! the following trace gases contain constant values
    real(wp), intent(in) ::  co2_in ! carbon dioxide
    real(wp), intent(in) ::  ch4_in ! methane
    real(wp), intent(in) ::  n2o_in ! n2o
    real(wp), intent(in) ::  co_in  ! carbon monoxide
    real(wp), intent(in) ::  h_surf(prf_num_in)         ! surface height
    real(wp), intent(in) ::  u_surf(prf_num_in)         ! u component of surface wind
    real(wp), intent(in) ::  v_surf(prf_num_in)         ! v component of surface wind
    real(wp), intent(in) ::  t_skin(prf_num_in)         ! surface skin temperature
    real(wp), intent(in) ::  p_surf(prf_num_in)                  ! surface pressure
    real(wp), intent(in) ::  t_surf(prf_num_in)         ! 1.5 m temperature
    real(wp), intent(in) ::  q_surf(prf_num_in)         ! 1.5 m specific humidity
    real(wp), intent(in) ::  lsmask(prf_num_in)         ! land-sea mask
    real(wp), intent(in) ::  seaice(prf_num_in)         ! seaice fraction
    real(wp), intent(in) ::  latitude(prf_num_in)       ! latitude
    real(wp), intent(in) ::  longitude(prf_num_in)      ! longitude
    logical, intent(in) :: cfrac, use_totalice, mmr_snowrain

    real(wp), intent(inout) :: tbs(prf_num_in, nch_in)  ! tbs (in the right format)
    !****************** local variables **********************************************
    logical       , allocatable :: calcemis(:)
    type(rttov_emissivity)   , allocatable :: emissivity(:)
    integer       , allocatable :: frequencies(:)
    type(rttov_chanprof)     , allocatable :: chanprof(:) ! channel and profile indices
    type(profile_type)       , allocatable :: profiles(:)
    type(profile_cloud_type) , allocatable :: cld_profiles(:)

    integer, allocatable :: ichan(:,:)   ! channel list per instrument

    integer              :: errorstatus
    type (radiance_type) :: radiance
    integer :: j,k,asw
    integer :: nchanxnprof, ninstruments
    real(wp),    :: zenangle
    character (len=256) :: outstring
    integer :: alloc_status(60)

#include "rttov_init_rad.interface"
#include "rttov_scatt_setupindex.interface"
#include "rttov_scatt.interface"
#include "rttov_alloc_rad.interface"
#include "rttov_alloc_prof.interface"
#include "rttov_alloc_scatt_prof.interface"
#include "rttov_get_emis.interface"

    errorstatus     = 0
    alloc_status(:) = 0
    ninstruments = 1 ! number of sensors or platforms

    allocate(ichan(nch_in, ninstruments), stat = alloc_status(3))

    do j = 1, ninstruments
       ichan(:, j) = ichan_in
    enddo

    nchanxnprof =  prf_num_in * nch_in  ! total channels to simulate * profiles

    allocate (chanprof(nchanxnprof))
    allocate (frequencies(nchanxnprof))
    allocate (emissivity(nchanxnprof))
    allocate (calcemis(nchanxnprof))
    allocate (profiles(prf_num_in))
    allocate (cld_profiles(prf_num_in))

    ! request rttov / fastem to calculate surface emissivity
    calcemis  = .true.
    emissivity % emis_in = 0.0

    ! setup indices
    call rttov_scatt_setupindex ( 	&
	 & prf_num_in,      			& ! in
	 & nch_in,          			& ! in
	 & coef_rttov%coef, 			& ! in
	 & nchanxnprof,       			& ! in
	 & chanprof,        			& ! out
	 & frequencies)       		      ! out

    ! allocate profiles (input) and radiance (output) structures
    asw = 1
    call rttov_alloc_prof( errorstatus,prf_num_in,profiles,nlevels_in,opts,asw, init = .true.)
    call rttov_alloc_scatt_prof(prf_num_in,cld_profiles, nlevels_in, .false., 1, init = .true.)
    call rttov_alloc_rad(errorstatus,nchanxnprof,radiance,nlevels_in-1,asw)

    ! fill the profile structures with data
    do j = 1, prf_num_in
       profiles(j)%latitude    = latitude(j)
       profiles(j)%longitude   = longitude(j)
       profiles(j)%elevation   = h_surf(j)
       profiles(j)%sunzenangle = 0.0 ! hard-coded in rttov9 int
       profiles(j)%sunazangle  = 0.0 ! hard-coded in rttov9 int
       profiles(j)%azangle     = 0.0
       profiles(j)%zenangle    = zenang_in
       profiles(j)%s2m%t       = t_surf(j)
       profiles(j)%s2m%q       = q_surf(j)
       profiles(j)%s2m%u       = u_surf(j)
       profiles(j)%s2m%v       = v_surf(j)
       profiles(j)%s2m%wfetc   = 10000.
       profiles(j)%skin%t      = t_skin(j)
       profiles(j)%skin%watertype  = 1 ! ocean water
       if (lsmask(j) < 0.5) then
          profiles(j)%skin%surftype  = surftype_sea
       else
          profiles(j)%skin%surftype  = surftype_land
       endif
       if (seaice(j) >= 0.5) then
          profiles(j)%skin%surftype  = surftype_seaice
       endif
       profiles(j)%skin%fastem(1)  =  3.0
       profiles(j)%skin%fastem(2)  =  5.0
       profiles(j)%skin%fastem(3)  =  15.0
       profiles(j)%skin%fastem(4)  =  0.1
       profiles(j)%skin%fastem(5)  =  0.3
       profiles(j)%cfraction       = 0.0
       profiles(j)%ctp 	           = 500.0 ! not used but still required by rttov
       profiles(j)%p(:)            = p_in(j,:)
       profiles(j)%t(:)            = t_in(j,:)
       profiles(j)%q(:)	           = q_in(j,:)
       profiles(j)%idg             = 0.
       profiles(j)%ish             = 0.
       where(profiles(j)%q(:) < 1e-4)
          profiles(j)%q(:) = 1e-4
       end where
       cld_profiles(j)%ph(:)   = ph_in(j,:)
       cld_profiles(j)%cc(:)   = cc_in(j,:)
       cld_profiles(j)%clw(:)  = clw_in(j,:)
       cld_profiles(j)%ciw(:)  = ciw_in(j,:)
       cld_profiles(j)%rain(:) = rain_in(j,:)
       cld_profiles(j)%sp(:)   = sp_in(j,:)
       profiles(j)%s2m%p       = cld_profiles(j)%ph(nlevels_in+1)
    enddo

    call rttov_get_emis(  &
         & errorstatus, &
         & opts,       &
         & chanprof,   &
         & profiles,   &
         & coef_rttov,      &
         & emissivity=emissivity(:)%emis_in)
    if (errorstatus /= errorstatus_success) then
       write(*,*) 'In COSP_RTTOV11: Error RTTOV_GET_EMIS!'
       call rttov_exit(errorstatus)
    endif

    calcemis(:) = .false.
    where (emissivity(:)%emis_in <= 0.)
       calcemis(:) = .true.
    endwhere

    call rttov_scatt (   &
         & errorstatus,  &! out
         & opts_scatt,   &! in
         & nlevels_in,   &! in
         & chanprof,     &! in
         & frequencies,  &! in
         & profiles,     &! in
         & cld_profiles, &! in
         & coef_rttov,   &! in
         & coef_scatt,   &! in
         & calcemis,     &! in
         & emissivity,   &! in
         & radiance)      ! out

    if (errorstatus /= errorstatus_success) then
       write(*,*) 'In COSP_RTTOV11: Error RTTOV_SCATT!'
       call rttov_exit(errorstatus)
    endif
    
    tbs(1:prf_num_in,1:1+size(ichan(:,1))-1) = &
         transpose(reshape(radiance%bt(1:nchanxnprof), &
         (/ size(ichan(:,1)),prf_num_in/) ))

    ! deallocate all storage
    asw = 0
    call rttov_alloc_prof(errorstatus,prf_num_in,profiles,nlevels_in,opts,asw)
    call rttov_alloc_scatt_prof(prf_num_in,cld_profiles,nlevels_in,.false.,asw)
    call rttov_alloc_rad(errorstatus,nchanxnprof,radiance,nlevels_in-1,asw)
    deallocate(ichan,chanprof,frequencies,emissivity,calcemis)  !instrument,
    !***************************************************************************
    !-------- end section --------
    !***************************************************************************
  end subroutine cosp_rttov_mwscatt

end module mod_cosp_rttov
