!
! CRTM_IRSSEM
!
! Module containing function to invoke the CRTM Infrared
! Sea Surface Emissivity Model (IRSSEM).
!
!
! CREATION HISTORY:
!       Written by:     Paul van Delst, 22-Jun-2005
!                       paul.vandelst@noaa.gov
!

MODULE CRTM_IRSSEM

  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE Type_Kinds,          ONLY: fp
  USE Message_Handler,     ONLY: SUCCESS, FAILURE, Display_Message
  USE CRTM_Parameters,     ONLY: ZERO, ONE, DEGREES_TO_RADIANS
  USE CRTM_Interpolation,  ONLY: NPTS, &
                                 LPoly, &
                                 LPoly_type, &
                                 Clear_LPoly, &
                                 Find_Index, &
                                 Interp_3D, &
                                 LPoly_TL, &
                                 Interp_3D_TL, &
                                 LPoly_AD, &
                                 Interp_3D_AD
  USE IRwaterCoeff_Define, ONLY: IRwaterCoeff_type
  ! Disable implicit typing
  IMPLICIT NONE

  ! ------------
  ! Visibilities
  ! ------------
  ! Everything private by default
  PRIVATE
  ! Derived type
  PUBLIC :: iVar_type
  ! Procedures
  PUBLIC :: CRTM_Compute_IRSSEM
  PUBLIC :: CRTM_Compute_IRSSEM_TL
  PUBLIC :: CRTM_Compute_IRSSEM_AD


  ! -----------------
  ! Module parameters
  ! -----------------
  ! Version Id for the module
  CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = &
  '$Id: CRTM_IRSSEM.f90 99117 2017-11-27 18:37:14Z tong.zhu@noaa.gov $'
  ! Message string length
  INTEGER, PARAMETER :: ML = 256


  ! -------------------------------
  ! Structure definition to hold
  ! forward interpolating variables
  ! across fwd, tl and adjoint
  ! -------------------------------
  ! The interpolation routine structure
  TYPE :: Einterp_type
    ! The dimensions
    INTEGER :: n_Angles = 0
    INTEGER :: n_Pts    = 0
    ! Allocation indicator
    LOGICAL :: Is_Allocated = .FALSE.
    ! The interpolating polynomials
    TYPE(LPoly_type), ALLOCATABLE :: wlp(:)  ! Angle
    TYPE(LPoly_type)              :: xlp     ! Frequency
    TYPE(LPoly_type)              :: ylp     ! Wind Speed
    ! The LUT interpolation indices
    INTEGER, ALLOCATABLE :: i1(:), i2(:)     ! Angle
    INTEGER              :: j1    , j2       ! Frequency
    INTEGER              :: k1    , k2       ! Wind Speed
    ! The LUT interpolation boundary check
    LOGICAL, ALLOCATABLE :: a_outbound(:)    ! Angle
    LOGICAL              :: f_outbound       ! Frequency
    LOGICAL              :: v_outbound       ! Wind Speed
    ! The interpolation input
    REAL(fp), ALLOCATABLE :: a_int(:)        ! Angle
    REAL(fp)              :: f_int           ! Frequency
    REAL(fp)              :: v_int           ! Wind Speed
    ! The data to be interpolated
    REAL(fp), ALLOCATABLE :: a(:,:)          ! Angle
    REAL(fp), ALLOCATABLE :: f(:)            ! Frequency
    REAL(fp), ALLOCATABLE :: v(:)            ! Wind Speed
  END TYPE Einterp_type

  ! The main internal variable structure
  TYPE :: iVar_type
    PRIVATE
    ! The interpolation data
    TYPE(Einterp_type) :: ei
  END TYPE iVar_type


CONTAINS


!################################################################################
!################################################################################
!##                                                                            ##
!##                         ## PUBLIC MODULE ROUTINES ##                       ##
!##                                                                            ##
!################################################################################
!################################################################################


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Compute_IRSSEM
!
! PURPOSE:
!       Function to compute the CRTM infrared sea surface emissivity (IRSSE)
!       for input wind speed, frequency, and angles.
!
! CALLING SEQUENCE:
!       Error_Status = CRTM_Compute_IRSSEM( IRwaterCoeff, &
!                                           Wind_Speed  , &
!                                           Frequency   , &
!                                           Angle       , &
!                                           iVar        , &
!                                           Emissivity    )
!
! INPUTS:
!       IRwaterCoeff:   Infrared water emissivity model coefficient object.
!                       Load the object with the coefficients for the emissivity
!                       model to use.
!                       UNITS:      N/A
!                       TYPE:       IRwaterCoeff_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       Wind_Speed:     Wind speed.
!                       UNITS:      metres per second (m.s^-1)
!                       TYPE:       REAL(fp)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       Frequency:      Infrared frequency.
!                       UNITS:      inverse centimetres (cm^-1)
!                       TYPE:       REAL(fp)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       Angle:          Surface zenith angle.
!                       UNITS:      Degrees
!                       TYPE:       REAL(fp)
!                       DIMENSION:  Rank-1 (n_Angles)
!                       ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!       iVar:           Structure containing internal variables required for
!                       subsequent tangent-linear or adjoint model calls.
!                       The contents of this structure are NOT accessible
!                       outside of this module.
!                       UNITS:      N/A
!                       TYPE:       iVar_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(OUT)
!
!       Emissivity:     Sea surface emissivities for the
!                       requested wind speed, frequency, and angles.
!                       UNITS:      N/A
!                       TYPE:       REAL(fp)
!                       DIMENSION:  Same as input ANGLE argument.
!                       ATTRIBUTES: INTENT(OUT)
!
! FUNCTION RESULT:
!       Error_Status:   The return value is an integer defining the error status.
!                       The error codes are defined in the Message_Handler module.
!                       If == SUCCESS the computation was successful.
!                          == FAILURE an unrecoverable error occurred.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
!:sdoc-:
!--------------------------------------------------------------------------------

  FUNCTION CRTM_Compute_IRSSEM( &
    IRwaterCoeff, &  ! Input model coefficients
    Wind_Speed  , &  ! Input
    Frequency   , &  ! Input
    Angle       , &  ! Input
    iVar        , &  ! Internal variable output
    Emissivity  ) &  ! Output
  RESULT( err_stat )
    ! Arguments
    TYPE(IRwaterCoeff_type), INTENT(IN)  :: IRwaterCoeff
    REAL(fp)               , INTENT(IN)  :: Wind_Speed     ! v
    REAL(fp)               , INTENT(IN)  :: Frequency      ! f
    REAL(fp)               , INTENT(IN)  :: Angle(:)       ! a
    TYPE(iVar_type)        , INTENT(OUT) :: iVar
    REAL(fp)               , INTENT(OUT) :: Emissivity(:)
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Compute_IRSSEM'
    ! Local variables
    CHARACTER(ML) :: msg
    INTEGER :: n_Angles, i
    REAL(fp) :: sec_angle(SIZE(Angle))

    ! Set up
    err_stat = SUCCESS
    ! ...Check dimensions
    n_Angles = SIZE(Angle)
    IF ( SIZE(Emissivity) /= n_Angles ) THEN
      err_stat = FAILURE
      msg = 'Input Angle and output Emissivity array dimensions inconsistent.'
      CALL Display_Message( ROUTINE_NAME, msg, err_stat )
      RETURN
    END IF
    ! ...Allocate interpolation variable structure
    CALL Einterp_Create( iVar%ei, NPTS, n_Angles )
    IF ( .NOT. Einterp_Associated( iVar%ei ) ) THEN
      err_stat = FAILURE
      msg = 'Error allocating interpolation variable structure.'
      CALL Display_Message( ROUTINE_NAME, msg, err_stat )
      RETURN
    END IF
    ! ...Convert angles to secants
    sec_angle = ONE/COS(DEGREES_TO_RADIANS*Angle)


    ! Compute the wind speed interpolating polynomial
    ! ...Find the LUT indices and check if input is out of bounds
    iVar%ei%v_int = Wind_Speed
    CALL find_index(IRwaterCoeff%Wind_Speed, &
                    iVar%ei%v_int, iVar%ei%k1, iVar%ei%k2, iVar%ei%v_outbound)
    iVar%ei%v = IRwaterCoeff%Wind_Speed(iVar%ei%k1:iVar%ei%k2)
    ! ...Compute the polynomial
    CALL LPoly( iVar%ei%v    , & ! Input
                iVar%ei%v_int, & ! Input
                iVar%ei%ylp    ) ! Output


    ! Compute the frequency interpolating polynomial
    ! ...Find the LUT indices and check if input is out of bounds
    iVar%ei%f_int = Frequency
    CALL find_index(IRwaterCoeff%Frequency, &
                    iVar%ei%f_int, iVar%ei%j1, iVar%ei%j2, iVar%ei%f_outbound)
    iVar%ei%f = IRwaterCoeff%Frequency(iVar%ei%j1:iVar%ei%j2)
    ! ...Compute the polynomial
    CALL LPoly( iVar%ei%f    , & ! Input
                iVar%ei%f_int, & ! Input
                iVar%ei%xlp    ) ! Output


    ! Compute the angle interpolating polynomials
    DO i = 1, n_Angles

      ! ...Find the LUT indices and check if input is out of bounds
      iVar%ei%a_int(i) = ABS(Angle(i))
      CALL find_index(IRwaterCoeff%Angle, &
                      iVar%ei%a_int(i), iVar%ei%i1(i), iVar%ei%i2(i), iVar%ei%a_outbound(i))
      iVar%ei%a(:,i) = IRwaterCoeff%Angle(iVar%ei%i1(i):iVar%ei%i2(i))

!! Secant interpolation test
!iVar%ei%a_int(i) = sec_angle(i)
!CALL find_index(IRwaterCoeff%Secant_Angle, &
!                iVar%ei%a_int(i), iVar%ei%i1(i), iVar%ei%i2(i), iVar%ei%a_outbound(i))
!iVar%ei%a(:,i) = IRwaterCoeff%Secant_Angle(iVar%ei%i1(i):iVar%ei%i2(i))

      ! ...Compute the polynomial
      CALL LPoly( iVar%ei%a(:,i)  , & ! Input
                  iVar%ei%a_int(i), & ! Input
                  iVar%ei%wlp(i)    ) ! Output


      ! Compute the interpolated emissivity
      CALL Interp_3D( IRwaterCoeff%Emissivity( iVar%ei%i1(i):iVar%ei%i2(i), &
                                               iVar%ei%j1   :iVar%ei%j2   , &
                                               iVar%ei%k1   :iVar%ei%k2     ), & ! Input
                      iVar%ei%wlp(i), & ! Input
                      iVar%ei%xlp   , & ! Input
                      iVar%ei%ylp   , & ! Input
                      Emissivity(i)   ) ! Output

    END DO

  END FUNCTION CRTM_Compute_IRSSEM


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Compute_IRSSEM_TL
!
! PURPOSE:
!       Function to compute the tangent-linear CRTM infrared sea surface
!       emissivity (IRSSE) for input wind speed, frequency, and angles.
!
!       This function must be called *after* the forward model function,
!       CRTM_Compute_IRSSEM, has been called. The forward model function
!       populates the internal variable structure argument, iVar.
!
! CALLING SEQUENCE:
!       Error_Status = CRTM_Compute_IRSSEM_TL( IRwaterCoeff , &
!                                              Wind_Speed_TL, &
!                                              iVar         , &
!                                              Emissivity_TL  )
! INPUTS:
!       IRwaterCoeff:   Infrared water emissivity model coefficient object.
!                       Load the object with the coefficients for the emissivity
!                       model to use.
!                       UNITS:      N/A
!                       TYPE:       IRwaterCoeff_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       Wind_Speed_TL:  The tangent-linear wind speed.
!                       UNITS:      metres per second (m.s^-1)
!                       TYPE:       REAL(fp)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       iVar:           Structure containing internal variables required for
!                       subsequent tangent-linear or adjoint model calls.
!                       The contents of this structure are NOT accessible
!                       outside of this module.
!                       UNITS:      N/A
!                       TYPE:       iVar_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!       Emissivity_TL:  Tangent-linear sea surface emissivity.
!                       UNITS:      N/A
!                       TYPE:       REAL(fp)
!                       DIMENSION:  Rank-1 (n_Angles)
!                       ATTRIBUTES: INTENT(OUT)
!
! FUNCTION RESULT:
!       Error_Status:   The return value is an integer defining the error status.
!                       The error codes are defined in the Message_Handler module.
!                       If == SUCCESS the computation was successful.
!                          == FAILURE an unrecoverable error occurred.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
!:sdoc-:
!--------------------------------------------------------------------------------

  FUNCTION CRTM_Compute_IRSSEM_TL( &
    IRwaterCoeff , &  ! Input model coefficients
    Wind_Speed_TL, &  ! Input
    iVar         , &  ! Internal variable input
    Emissivity_TL) &  ! Output
  RESULT( err_stat )
    ! Arguments
    TYPE(IRwaterCoeff_type), INTENT(IN)  :: IRwaterCoeff
    REAL(fp)               , INTENT(IN)  :: Wind_Speed_TL
    TYPE(iVar_type)        , INTENT(IN)  :: iVar
    REAL(fp)               , INTENT(OUT) :: Emissivity_TL(:)
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Compute_IRSSEM_TL'
    ! Local variables
    CHARACTER(ML) :: msg
    INTEGER  :: i
    REAL(fp) :: v_TL(NPTS)
    REAL(fp) :: e_TL(NPTS,NPTS,NPTS)
    TYPE(LPoly_Type) :: ylp_TL, xlp_TL, wlp_TL

    ! Set up
    err_stat = SUCCESS
    ! ...Check internal variable allocation
    IF ( .NOT. Einterp_Associated( iVar%ei ) ) THEN
      err_stat = FAILURE
      msg = 'Internal structure ei is not allocated'
      CALL Display_Message( ROUTINE_NAME, msg, err_stat )
      RETURN
    END IF
    ! ...Check dimensions
    IF ( SIZE( Emissivity_TL ) /= iVar%ei%n_Angles ) THEN
      err_stat = FAILURE
      msg = 'Input Emissivity_TL array dimensions inconsistent with number of angles.'
      CALL Display_Message( ROUTINE_NAME, msg, err_stat )
      RETURN
    END IF
    ! ...No TL if wind speed is out of bounds
    IF ( iVar%ei%v_outbound ) THEN
      Emissivity_TL = ZERO
      RETURN
    END IF
    ! ...Initialise local TL variables
    v_TL = ZERO
    e_TL = ZERO
    CALL Clear_LPoly(wlp_TL)
    CALL Clear_LPoly(xlp_TL)


    ! Calculate the TL interpolating
    ! polynomials for wind speed
    CALL LPoly_TL( iVar%ei%v, iVar%ei%v_int, & ! FWD Input
                   iVar%ei%ylp,              & ! FWD Input
                   v_TL, Wind_Speed_TL,      & ! TL  Input
                   ylp_TL                    ) ! TL  Output


    ! Begin loop over angles
    DO i = 1, iVar%ei%n_Angles

      ! Perform interpolation
      CALL interp_3D_TL(IRwaterCoeff%Emissivity(iVar%ei%i1(i):iVar%ei%i2(i), &
                                            iVar%ei%j1   :iVar%ei%j2   , &
                                            iVar%ei%k1   :iVar%ei%k2     ), & ! FWD Emissivity input
                        iVar%ei%wlp(i), & ! FWD polynomial input
                        iVar%ei%xlp   , & ! FWD polynomial input
                        iVar%ei%ylp   , & ! FWD polynomial input
                        e_TL, wlp_TL, xlp_TL, ylp_TL, & ! TL input
                        Emissivity_TL(i)              ) ! Output

    END DO

  END FUNCTION CRTM_Compute_IRSSEM_TL


!--------------------------------------------------------------------------------
!:sdoc+:
!
! NAME:
!       CRTM_Compute_IRSSEM_AD
!
! PURPOSE:
!       Function to compute the adjoint of the CRTM infrared sea surface
!       emissivity (IRSSE) for input wind speed, frequency, and angles.
!
!       This function must be called *after* the forward model function,
!       CRTM_Compute_IRSSEM, has been called. The forward model function
!       populates the internal variable structure argument, iVar.
!
! CALLING SEQUENCE:
!       Error_Status = CRTM_Compute_IRSSEM_AD( IRwaterCoeff , &
!                                              Emissivity_AD, &
!                                              iVar         , &
!                                              Wind_Speed_AD  )
!
! INPUTS:
!       IRwaterCoeff:   Infrared water emissivity model coefficient object.
!                       Load the object with the coefficients for the emissivity
!                       model to use.
!                       UNITS:      N/A
!                       TYPE:       IRwaterCoeff_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
!       Emissivity_AD:  Adjoint sea surface emissivity.
!                       *** SET TO ZERO ON EXIT ***
!                       UNITS:      N/A
!                       TYPE:       REAL(fp)
!                       DIMENSION:  Rank-1 (n_Angles)
!                       ATTRIBUTES: INTENT(IN OUT)
!
!       iVar:           Structure containing internal variables required for
!                       subsequent tangent-linear or adjoint model calls.
!                       The contents of this structure are NOT accessible
!                       outside of this module.
!                       UNITS:      N/A
!                       TYPE:       iVar_type
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN)
!
! OUTPUTS:
!       Wind_Speed_AD:  Adjoint wind speed.
!                       *** MUST HAVE VALUE ON ENTRY ***
!                       UNITS:      per metres per second, (m.s^-1)^-1
!                       TYPE:       REAL(fp)
!                       DIMENSION:  Scalar
!                       ATTRIBUTES: INTENT(IN OUT)
!
! FUNCTION RESULT:
!       Error_Status:   The return value is an integer defining the error status.
!                       The error codes are defined in the Message_Handler module.
!                       If == SUCCESS the computation was successful.
!                          == FAILURE an unrecoverable error occurred.
!                       UNITS:      N/A
!                       TYPE:       INTEGER
!                       DIMENSION:  Scalar
!
!:sdoc-:
!--------------------------------------------------------------------------------

  FUNCTION CRTM_Compute_IRSSEM_AD( &
    IRwaterCoeff , &  ! Input model coefficients
    Emissivity_AD, &  ! Input
    iVar         , &  ! Internal Variable Input
    Wind_Speed_AD) &  ! Output
  RESULT( err_stat )
    ! Arguments
    TYPE(IRwaterCoeff_type), INTENT(IN)     :: IRwaterCoeff
    REAL(fp)               , INTENT(IN OUT) :: Emissivity_AD(:)
    TYPE(iVar_type)        , INTENT(IN)     :: iVar
    REAL(fp)               , INTENT(IN OUT) :: Wind_Speed_AD
    ! Function result
    INTEGER :: err_stat
    ! Local parameters
    CHARACTER(*), PARAMETER :: ROUTINE_NAME = 'CRTM_Compute_IRSSEM_AD'
    ! Local variables
    CHARACTER(ML) :: msg
    INTEGER  :: i
    REAL(fp) :: e_AD(NPTS,NPTS,NPTS)
    REAL(fp) :: v_AD(NPTS)
    TYPE(LPoly_Type) :: wlp_AD, xlp_AD, ylp_AD

    ! Set Up
    err_stat = SUCCESS
    e_AD = ZERO
    v_AD = ZERO
    ! ...Check internal variable allocation
    IF ( .NOT. Einterp_Associated( iVar%ei ) ) THEN
      err_stat = FAILURE
      msg = 'Internal structure ei is not allocated'
      CALL Display_Message( ROUTINE_NAME, msg, err_stat )
      RETURN
    END IF
    ! ...Check dimensions
    IF ( SIZE(Emissivity_AD) /= iVar%ei%n_Angles ) THEN
      err_stat = FAILURE
      msg = 'Input Emissivity_AD array dimensions inconsistent with number of angles.'
      CALL Display_Message( ROUTINE_NAME, msg, err_stat )
      RETURN
    END IF
    ! ...No AD if wind speed is out of bounds
    IF ( iVar%ei%v_outbound ) RETURN
    ! ...Initialize local variables
    CALL Clear_LPoly(wlp_AD)
    CALL Clear_LPoly(xlp_AD)
    CALL Clear_LPoly(ylp_AD)

    ! Loop over emissivity calculation angles
    DO i = 1, iVar%ei%n_Angles

      ! Get the adjoint interpoalting polynomial for wind speed
      CALL Interp_3D_AD(IRwaterCoeff%Emissivity( iVar%ei%i1(i):iVar%ei%i2(i), &
                                                 iVar%ei%j1   :iVar%ei%j2   , &
                                                 iVar%ei%k1   :iVar%ei%k2     ), & ! FWD Input
                        iVar%ei%wlp(i)  , & ! FWD Input
                        iVar%ei%xlp     , & ! FWD Input
                        iVar%ei%ylp     , & ! FWD Input
                        Emissivity_AD(i), & ! AD Input
                        e_AD, wlp_AD, xlp_AD, ylp_AD ) ! AD Output

      ! Set adjoint emissivity to zero
      Emissivity_AD(i) = ZERO

    END DO

    ! Compute the wind speed adjoint
    CALL Lpoly_AD(iVar%ei%v    , & ! FWD Input
                  iVar%ei%v_int, & ! FWD Input
                  iVar%ei%ylp  , & ! FWD Input
                  ylp_AD       , & ! AD  Input
                  v_AD         , & ! AD  Output
                  Wind_Speed_AD  ) ! AD  Output

  END FUNCTION CRTM_Compute_IRSSEM_AD


!################################################################################
!################################################################################
!##                                                                            ##
!##                        ## PRIVATE MODULE ROUTINES ##                       ##
!##                                                                            ##
!################################################################################
!################################################################################

  ! ----------------------------------------------
  ! Procedures to manipulate the Einterp structure
  ! ----------------------------------------------
  ELEMENTAL FUNCTION Einterp_Associated( ei ) RESULT( Status )
    TYPE(Einterp_type), INTENT(IN) :: ei
    LOGICAL :: Status
    Status = ei%Is_Allocated
  END FUNCTION Einterp_Associated

  ELEMENTAL SUBROUTINE Einterp_Create( ei, n_Pts, n_Angles )
    TYPE(Einterp_type), INTENT(OUT) :: ei
    INTEGER,            INTENT(IN)  :: n_Pts
    INTEGER,            INTENT(IN)  :: n_Angles
    INTEGER :: alloc_stat
    IF ( n_Pts < 1 .OR. n_Angles < 1 ) RETURN
    ALLOCATE( ei%wlp(n_Angles)       , &
              ei%i1(n_Angles)        , &
              ei%i2(n_Angles)        , &
              ei%a_outbound(n_Angles), &
              ei%a_int(n_Angles)     , &
              ei%a(n_Pts,n_Angles)   , &
              ei%f(n_Pts)            , &
              ei%v(n_Pts)            , &
              STAT = alloc_stat )
    IF ( alloc_stat /= 0 ) RETURN
    ei%n_Angles = n_Angles
    ei%n_Pts    = n_Pts
    ei%Is_Allocated = .TRUE.
  END SUBROUTINE Einterp_Create

END MODULE CRTM_IRSSEM