! (c) british crown copyright 2008, the met office.
! all rights reserved.
! $revision: 131 $, $date: 2014-12-01 18:30:45 +0100 (mon, 01 dec 2014) $
! $url: http://cfmip-obs-sim.googlecode.com/svn/devel/branches/supportrttov11/cosp_rttov_simulator.f90 $
!
! 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.

!
! history:
! aug 2008 - v. john - initial version
! feb 2009 - v. john - trace gases and max number of profiles

module mod_cosp_rttov_simulator
  use mod_cosp_constants, only : i_lscliq, i_lscice, i_lsrain, i_lssnow
  use mod_cosp_types
  use mod_cosp_rttov
  use rttov_const, only : errorstatus_success, errorstatus_fatal
  
  implicit none

#include "cosp_defs.h"

  contains

!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
!----------------- subroutine cosp_rttov_simulator ---------------
!%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
subroutine cosp_rttov_simulator(gbx,sgh,y)

  use rttov_types, only :   &
    & rttov_coefs          ,&
    & rttov_scatt_coef     ,&
    & rttov_options        ,&
    & rttov_options_scatt
  
  use rttov_unix_env, only : rttov_exit
  
  ! arguments
  type(cosp_gridbox),intent(in)  :: gbx ! gridbox info
  type(cosp_sghydro),intent(in)  :: sgh ! shydro info
  type(cosp_rttov),intent(inout) :: y   ! rttov output

  ! some local variables for profile conversions etc.
  real(wp), parameter :: eps    =  0.622
  real(wp), parameter :: mdry   =  28.966
  real(wp), parameter :: mo3    =  47.9983
  real(wp), parameter :: mco2   =  44.0096
  real(wp), parameter :: mch4   =  16.0426
  real(wp), parameter :: mn2o   =  44.0129
  real(wp), parameter :: mco    =  28.0102

  ! local variables
  integer :: npoints
  real(wp),:: sh(gbx%npoints, gbx%nlevels)
  real(wp),:: pp(gbx%npoints, gbx%nlevels)
  real(wp),:: ph(gbx%npoints, gbx%nlevels+1)
  real(wp),:: tt(gbx%npoints, gbx%nlevels)
  real(wp),:: o3(gbx%npoints, gbx%nlevels)
  real(wp),:: ciw(gbx%npoints, gbx%nlevels)
  real(wp),:: clw(gbx%npoints, gbx%nlevels)
  real(wp),:: cc(gbx%npoints, gbx%nlevels)
  real(wp),:: totalice(gbx%npoints, gbx%nlevels)
  real(wp),:: sp(gbx%npoints, gbx%nlevels)
  real(wp),:: rain(gbx%npoints, gbx%nlevels)
  real(wp),:: tbs(gbx%npoints, gbx%Nchan)
  real(wp),:: co2,ch4,n2o,co
  real(wp),:: tt_surf(gbx%npoints) ! 1.5 m t
  real(wp),:: sh_surf(gbx%npoints) ! 1.5 m q
  integer :: nloop,rmod,il
  integer :: istart,istop
  integer :: nprof,nlevels, ncolumns
  logical :: use_totalice, mmr_snowrain, cfrac

  type (rttov_options)       :: opts     ! default everything optional switched off
  type (rttov_options_scatt) :: opts_scatt
  type (rttov_coefs)         :: coef_rttov
  type (rttov_scatt_coef)    :: coef_scatt

  integer, allocatable :: instrument(:,:) ! instrument id (3 x n_instruments)
  integer :: ninstruments

  integer :: errorstatus
  integer :: i,j,subcol
  integer :: alloc_status(60)

#include "rttov_read_coefs.interface"
#include "rttov_read_scattcoeffs.interface"
#include "rttov_user_options_checkinput.interface"
#include "rttov_dealloc_coefs.interface"
#include "rttov_dealloc_scattcoeffs.interface"
#include "rttov_setup_emis_atlas.interface"
#include "rttov_deallocate_emis_atlas.interface"
#include "rttov_print_opts.interface"
#include "rttov_print_profile.interface"

  ! Options common to clear-sky and scattering
  opts%interpolation%addinterp  = .true.  ! allow interpolation of input profile
  opts%rt_all%use_q2m           = .true.
  opts%config%do_checkinput     = .false.
  opts%config%verbose           = .false.
  opts%rt_all%addrefrac         = .true.  ! include refraction in path calc
  opts%interpolation%reg_limit_extrap = .true.
  if(gbx%use_mw_scatt) then
     ncolumns = gbx%ncolumns
     opts_scatt%lusercfrac              = cfrac
     opts_scatt%config%do_checkinput    = .false.
     opts_scatt%config%verbose          = .false.
     opts_scatt%config%apply_reg_limits = .true.
     opts_scatt%interp_mode             = 1
     opts_scatt%reg_limit_extrap        = .true.
     opts_scatt%use_q2m                 = .true.
  else
     opts%rt_mw%clw_data = .true. ! *** This is not being used in rttov_multprof
     ! opts%rt_mw%clw_data = .true. ! *** You don't need this if you use
     ! RTTOV-SCATT: this is for "clear-sky" only, treats profiles(:)%clw
     ! as purely absorbing medium
     ncolumns = 1
     write(*,*) 'Clear sky radiances requested!'
     write(*,*) 'Setting number of sub colums to 1!'
  endif
  nlevels = gbx%nlevels
  npoints = gbx%npoints
  tbs = 0.0
  do subcol = 1, ncolumns
     y%tbs = 0.0
     ! reverting levels from toa to surface
     sh  = gbx%sh(:,nlevels:1:-1) ! specific humidity
     pp  = gbx%p(:,nlevels:1:-1) / 100.
     ph(:,2:nlevels+1) = gbx%ph(:,nlevels:1:-1) / 100.
     ph(:,1) = 0.0
     cc = gbx%tca(:,nlevels:1:-1) !gbx%effcldfrac(:,nlevels:1:-1)
     o3 = gbx%mr_ozone(:,nlevels:1:-1)
     tt  = gbx%t(:,nlevels:1:-1)
     if (ncolumns .eq. 1) then
        clw = gbx%mr_hydro(:,nlevels:1:-1,i_lscliq)
        ciw = gbx%mr_hydro(:,nlevels:1:-1,i_lscice)
        rain = gbx%mr_hydro(:,nlevels:1:-1,i_lsrain) + &
               gbx%mr_hydro(:,nlevels:1:-1,i_cvrain)
        sp = gbx%mr_hydro(:,nlevels:1:-1,i_lssnow) + &
             gbx%mr_hydro(:,nlevels:1:-1,i_cvsnow)
     else
        clw = sgh%mr_hydro(:,subcol,nlevels:1:-1,i_lscliq)
        ciw = sgh%mr_hydro(:,subcol,nlevels:1:-1,i_lscice)
        ! The USE_FLUXES in COSP must be turned on for this part to work for RTTOV
        rain = sgh%mr_hydro(:,subcol,nlevels:1:-1,i_lsrain) + &
               sgh%mr_hydro(:,subcol,nlevels:1:-1,i_cvrain)
        sp = sgh%mr_hydro(:,subcol,nlevels:1:-1,i_lssnow) + &
             sgh%mr_hydro(:,subcol,nlevels:1:-1,i_cvsnow)
        where(clw > 0. .or. &
             ciw  > 0. .or. &
             rain > 0. .or. &
             sp   > 0. )
           cc = 1.0
        elsewhere
           cc = 0.0
        endwhere
     endif
     write(*,*) maxval(sp), ' <= sp: ', subcol, ' => ', minval(sp)
     write(*,*) maxval(rain), ' <= rain: ', subcol, ' => ', minval(rain)
     totalice = 0.0
     tt_surf = gbx%t2m
     !converting specific humidity to ppmv
     sh  =  ( sh / ( sh + eps * ( 1.0 - sh ) ) ) * 1e6
     sh_surf  = ( gbx%q2m / ( gbx%q2m + eps * ( 1.0 - gbx%q2m ) ) ) * 1e6 ! ppmv
     !converting mass mixing ratio of other trace gases to ppmv
     o3   =  ( mdry / mo3  ) *     o3  * 1e6
     co2  =  ( mdry / mco2 ) * gbx%co2 * 1e6
     ch4  =  ( mdry / mch4 ) * gbx%ch4 * 1e6
     n2o  =  ( mdry / mn2o ) * gbx%n2o * 1e6
     co   =  ( mdry / mco  ) * gbx%co  * 1e6
     !! rttov can handle only about 100 profiles at a time (fixme: check this with roger)
     !! so we are putting a loop of 100
     nloop  =  npoints / maxlim
     rmod   =  mod( npoints, maxlim )
     use_totalice = .false.
     mmr_snowrain = .true.
     cfrac        = .true.
     if( rmod .ne. 0 ) then
        nloop = nloop + 1
     endif

     ninstruments = 1 ! *** The code needs modifying to work for more than one instrument
     allocate(instrument(3, ninstruments), stat = alloc_status(2))
     
     instrument(1, 1) = gbx%plat
     instrument(2, 1) = gbx%sat
     instrument(3, 1) = gbx%inst
     
     call rttov_read_coefs(errorstatus,coef_rttov, opts, instrument=instrument(:,1))
     if (errorstatus /= errorstatus_success) then
        write(*,*) 'In COSP_RTTOV_SIMULATOR: Error reading RTTOV coefficients!'
        call rttov_exit(errorstatus)
     endif
     if (gbx%use_mw_scatt) then
        call rttov_read_scattcoeffs (errorstatus, coef_rttov%coef, coef_scatt)
        if (errorstatus /= errorstatus_success) then
           write(*,*) 'In COSP_RTTOV_SIMULATOR: Error reading scattering coefficients!'
           call rttov_exit(errorstatus)
        endif
     endif
     ! ensure the options and coefficients are consistent
     call rttov_user_options_checkinput(errorstatus, opts, coef_rttov)
     if (errorstatus /= errorstatus_success) then
        write(*,*) 'In COSP_RTTOV_SIMULATOR: Error when checking input data!'
        call rttov_exit(errorstatus)
     endif
     if(any(coef_rttov%coef%ff_val_chn(:) /= 1 )) then
        write(*,*) 'some requested channels have bad validity parameter'
        do j = 1, size(coef_rttov%coef%ff_val_chn(:))
           write(*,*) j, coef_rttov%coef%ff_val_chn(j)
        end do
     endif
     
     call rttov_setup_emis_atlas(errorstatus, &
          &  opts,                      &
          &  gbx%ifsmonth,              &  ! *** set month
          &  coef_rttov)!,              &
     !&  path)                         ! *** Uncomment this optional argument and specify path to atlas files they are NOT in current directory
     if (errorstatus /= errorstatus_success) then
        write(*,*) 'In COSP_RTTOV_SIMULATOR: Error reading emis atlas data!'
        call rttov_exit(errorstatus)
     endif
     
     !! looping over maxlim number of profiles
     do il = 1, nloop
        istart  =  (il - 1) * maxlim + 1
        istop   =  min(il * maxlim, npoints)
        if( ( il .eq. nloop ) .and. ( rmod .ne. 0 ) ) then
           nprof = rmod
        else
           nprof = maxlim
        endif
        write(*,*) istart, ' <= istart:istop => ', istop
        if(.not.gbx%use_mw_scatt) then
           call rttov_multprof(                &
                gbx%nchan,                    &
                gbx%ichan,                    &
                gbx%surfem(istart:istop),     &
                nprof,                        &
                nlevels,                      &
                gbx%plat,                     &
                gbx%sat,                      &
                gbx%inst,                     &
                opts,                         &
                coef_rttov,                   &
                gbx%zenang,                   &
                pp(istart:istop, :),          &
                tt(istart:istop, :),          &
                sh(istart:istop, :),          &
                o3(istart:istop, :),          &
                co2,                          &
                ch4,                          &
                n2o,                          &
                co,                           &
                gbx%zlev_half(istart:istop,1),&
                gbx%u_wind(istart:istop),     &
                gbx%v_wind(istart:istop),     &
                gbx%skt(istart:istop),        &
                gbx%psfc(istart:istop)/100.,  &
                tt_surf(istart:istop),        &
                sh_surf(istart:istop),        &
                gbx%land(istart:istop),       &
                gbx%seaice(istart:istop),     &
                gbx%latitude(istart:istop),   &
                gbx%longitude(istart:istop),  &
                y%tbs(istart:istop, :))
        else
           call cosp_rttov_mwscatt(        &
                gbx%nchan,                    &
                gbx%ichan,                    &
                gbx%surfem(istart:istop),     &
                nprof,                        &
                nlevels,                      &
                gbx%plat,                     &
                gbx%sat,                      &
                gbx%inst,                     &
                opts,                         &
                opts_scatt,                   &
                coef_rttov,                   &
                coef_scatt,                   &
                gbx%zenang,                   &
                pp(istart:istop, :),          &
                ph(istart:istop, :),          &
                tt(istart:istop, :),          &
                sh(istart:istop, :),          &
                o3(istart:istop, :),          &
                clw(istart:istop, :),         &
                ciw(istart:istop, :),         &
                cc(istart:istop, :),          &
                totalice(istart:istop, :),    &
                sp(istart:istop, :),          &
                rain(istart:istop, :),        &
                co2,                          &
                ch4,                          &
                n2o,                          &
                co,                           &
                gbx%zlev_half(istart:istop,1),&
                gbx%u_wind(istart:istop),     &
                gbx%v_wind(istart:istop),     &
                gbx%skt(istart:istop),        &
                gbx%psfc(istart:istop)/100.,  &
                tt_surf(istart:istop),        &
                sh_surf(istart:istop),        &
                gbx%land(istart:istop),       &
                gbx%seaice(istart:istop),     &
                gbx%latitude(istart:istop),   &
                gbx%longitude(istart:istop),  &
                use_totalice,                 &
                mmr_snowrain,                 &
                cfrac,                        &
                y%tbs(istart:istop, :))
        endif
        tbs(istart:istop, :) = tbs(istart:istop, :) + y%tbs(istart:istop, :)
     enddo
  enddo
  y%tbs = tbs/ncolumns
  call rttov_deallocate_emis_atlas(coef_rttov)
  call rttov_dealloc_coefs(errorstatus,coef_rttov)
  if (gbx%use_mw_scatt) call rttov_dealloc_scattcoeffs(coef_scatt)
  deallocate(instrument)
end subroutine cosp_rttov_simulator
end module mod_cosp_rttov_simulator
