!
! NESDIS_SSMI_SnowEM_Module
!
! Module containing the SSM/I microwave snow emissivity model
!
! References:
!       Yan,B., F.Weng, and K.Okamoto, 2004, A microwave snow emissivity model,
!         8th Specialist Meeting on Microwave Radiometry and Remote Sensing Applications,
!         24-27 February, 2004, Rome, Italy.
!
!
! CREATION HISTORY:
!       Written by:     Banghua Yan, 16-May-2005, banghua.yan@noaa.gov
!                       Fuzhong Weng, fuzhong.weng@noaa.gov
!
!       Modified by:    Banghua Yan, 10-Sep-2005
!                       Quanhua Liu, quanhua.liu@noaa.gov
!                       Yong Han, yong.han@noaa.gov
!

MODULE NESDIS_SSMI_SnowEM_Module


  ! -----------------
  ! Environment setup
  ! -----------------
  ! Module use
  USE Type_Kinds, ONLY: fp
  USE NESDIS_LandEM_Module
  ! Disable implicit typing
  IMPLICIT NONE


  ! ------------
  ! Visibilities
  ! ------------
  PRIVATE
  PUBLIC  :: NESDIS_SSMI_SnowEM


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


CONTAINS


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

!-------------------------------------------------------------------------------------------------------------
!
! NAME:
!       NESDIS_SSMI_SnowEM
!
! PURPOSE:
!       Subroutine to simulate microwave emissivity over snow conditions from AMSU measurements at
!       window channels.
!
! REFERENCES:
!       Yan, B., F. Weng and K.Okamoto,2004: "A microwave snow emissivity model, 8th Specialist Meeting on
!       Microwave Radiometry and Remote Sension Applications,24-27 February, 2004, Rome, Italy.
!
! CATEGORY:
!       CRTM : Surface : MW SNOW EM
!
! LANGUAGE:
!       Fortran-95
!
! CALLING SEQUENCE:
!       CALL NESDIS_SSMI_SnowEM
!
! INPUT ARGUMENTS:
!
!         Frequency                Frequency User defines
!                                  This is the "I" dimension
!                                  UNITS:      GHz
!                                  TYPE:       REAL( fp )
!                                  DIMENSION:  Scalar
!
!
!         Angle                    The angle values in degree.
!                                  ** NOTE: THIS IS A MANDATORY MEMBER **
!                                  **       OF THIS STRUCTURE          **
!                                  UNITS:      Degrees
!                                  TYPE:       REAL( fp )
!                                  DIMENSION:  Rank-1, (I)
!
!
!         Tb                      BRIGHTNESS TEMPERATURES AT SEVEN SSMI WINDOW CHANNELS
!                                  UNITS:      Kelvin, K
!                                  TYPE:       REAL( fp )
!                                  DIMENSION   7*1 SCALAR
!
!                 tb[1] :  at 19.35 GHz  v-polarization
!                 tb[2] :  at 19.35 GHz  h-polarization
!                 tb[3] :  at 22.235 GHz v-polarization
!                 tb[4] :  at 37 GHz     v-polarization
!                 tb[5] :  at 37 GHz     h-polarization
!                 tb[6] :  at 85 GHz     v-polarization
!                 tb[7] :  at 85 GHz     h-polarization
!
!                         WHICH ARE
!
!                                  tbb[1] = TB at 89 GHz
!                                  tbb[2] = TB at 150 GHz
!
!
!         Ts                       Snow surface temperature.
!                                  UNITS:      Kelvin, K
!                                  TYPE:       REAL( fp )
!                                  DIMENSION:  Scalar
!
!
!         Depth:                   The snow  depth
!                                  UNITS:      mm
!                                  TYPE:       REAL( fp )
!                                  DIMENSION:  Scalar

! OUTPUT ARGUMENTS:
!
!         Emissivity_H:            The surface emissivity at a horizontal polarization.
!                                  ** NOTE: THIS IS A MANDATORY MEMBER **
!                                  **       OF THIS STRUCTURE          **
!                                  UNITS:      N/A
!                                  TYPE:       REAL( fp )
!                                  DIMENSION:  Scalar
!
!         Emissivity_V:            The surface emissivity at a vertical polarization.
!                                  ** NOTE: THIS IS A MANDATORY MEMBER **
!                                  **       OF THIS STRUCTURE          **
!                                  UNITS:      N/A
!                                  TYPE:       REAL( fp )
!                                  DIMENSION:  Scalar
!
!
! INTERNAL ARGUMENTS:
!
!     SSMI_Angle         : local zenith angle in degree
!
!
! CALLS:
!
!       SSMI_SnowEM_CORE : Subroutine to calculate the microwave emissivity over snow conditions
!
!
!
! PROGRAM HISTORY LOG:
!   2004-01-01  yan,b -  implement the algorithm for snow/ice emissivity
!   2004-02-01  yan,b -  modify the code for SSI
!   2005-05-28  okamoto - modify the code for CRTM
!
! SIDE EFFECTS:
!       None.
!
! RESTRICTIONS:
!       None.
!
! COMMENTS:
!       Note the INTENT on the output SensorData argument is IN OUT rather than
!       just OUT. This is necessary because the argument may be defined upon
!       input. To prevent memory leaks, the IN OUT INTENT is a must.
!
! CREATION HISTORY:
!       Written by:     Banghua Yan, QSS Group Inc., Banghua.Yan@noaa.gov (28-May-2005)
!
!
!       and             Fuzhong Weng, NOAA/NESDIS/ORA, Fuzhong.Weng@noaa.gov
!
!  Copyright (C) 2005 Fuzhong Weng and Banghua Yan
!
!  This program is free software; you can redistribute it and/or modify it under the terms of the GNU
!  General Public License as published by the Free Software Foundation; either version 2 of the License,
!  or (at your option) any later version.
!
!  This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even
!  the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
!  License for more details.
!
!  You should have received a copy of the GNU General Public License along with this program; if not, write
!  to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
!
!------------------------------------------------------------------------------------------------------------

subroutine NESDIS_SSMI_SnowEM(frequency,                                          & ! INPUT
                               Angle,                                             & ! INPUT
                               Ts,                                                & ! INPUT
                               tb,                                                & ! INPUT
                               Depth,                                             & ! INPUT
                               Emissivity_H,                                      & ! OUTPUT
                               Emissivity_V)                                        ! OUTPUT

  integer, parameter:: nw=7,nwv=4,nwh=3

  real(fp), parameter :: SSMI_Angle= 53.0_fp

  REAL(fp), PARAMETER ::  ev_default = 0.9_fp

  REAL(fp), PARAMETER ::  eh_default = 0.88_fp

  real(fp)     :: Depth,Angle,frequency,Ts,tb(nw),tv(nwv),th(nwh)

  real(fp)     :: em_vector(2),esh1,esv1,esh2,esv2,desh,desv,dem

  real(fp), intent(out) :: Emissivity_H, Emissivity_V


  Emissivity_H  =  eh_default  ;  Emissivity_V  =  ev_default

  tv(1) = tb(1);  tv(2) = tb(3);  tv(3) = tb(4);  tv(4) = tb(6)

  th(1) = tb(2); th(2) = tb(5);  th(3) = tb(7)

! Emissivity at SSMI_Angle

  call SSMI_SnowEM_CORE(frequency,Ts,tv,th,em_vector)

! Get the emissivity angle dependence

  if (Depth .lt. one_tenth) Depth = one_tenth

  if (Depth .gt. 10.0_fp) Depth = 10.0_fp

  call NESDIS_LandEM(SSMI_Angle,frequency,0.0_fp,0.0_fp,Ts,Ts,0.0_fp,9,13,Depth,esh1,esv1)

  call NESDIS_LandEM(Angle,frequency,0.0_fp,0.0_fp,Ts,Ts,0.0_fp,9,13,Depth,esh2,esv2)

  desh = esh1 - esh2

  desv = esv1 - esv2

  dem = ( desh + desv ) * 0.5_fp

! Emissivity at User's Angle

  Emissivity_H = em_vector(1) - dem;  Emissivity_V = em_vector(2)- dem

! Quality Control

  if(Emissivity_H.gt.one) Emissivity_H = one

  if(Emissivity_H.lt.0.3_fp) Emissivity_H = 0.3_fp

  if(Emissivity_V.gt.one) Emissivity_V = one

  if(Emissivity_V.lt.0.3_fp) Emissivity_V = 0.3_fp

  if(Emissivity_V.lt.Emissivity_H) Emissivity_V = Emissivity_H


  return

end subroutine NESDIS_SSMI_SnowEM


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

subroutine SSMI_SnowEM_CORE(frequency,Ts,tv,th,em_vector)

!------------------------------------------------------------------------------------------------------------
!
!$$$  subprogram documentation block
!                .      .    .                                       .
! subprogram: SSMI_SnowEM_CORE  noaa/nesdis SSM/I emissivity model over snow
!
!   prgmmr: Banghua Yan                 org: nesdis              date: 2004-02-12
!
! abstract: Simulate microwave emissivity over  snow conditions
!           using SSM/I  measurements and surface temperature
!
! program history log:
!
!      01/2004   : Implement the algorithm for snow/ice emissivity to F90 code by Banghua Yan
!      02/2004   : Modify the code for SSI subsystem                           by Banghua Yan
!      07/2004   : Modify the code for GSI subsystem                           by Kozo Okamoto
!      05/2005   : Modify the code for CRTM                                    by Banghua Yan
!
! input argument list:
!
!      frequency: frequency in GHz
!      Ts       :  scattering layer temperature (K)
!      tv[1] ~ tv[4]: brightness temperature at four SSM/I vertical polarization
!          tv[1] : 19.35  GHz
!          tv[2] : 22.235 GHz
!          tv[3] : 37     GHz
!          tv[4] : 85     GHz
!
!      th[1] ~ th[3]: brightness temperature at three SSM/I horizontal polarization
!          th[1] : 19.35  GHz
!          th[2] : 37     GHz
!          th[3] : 85     GHz
! output argument list:
!
!      em_vector     :  emissivity at two polarizations
!           em_vector[1] = eh
!           em_vector[2] = ev
!
! remarks:
!
! attributes:
!   language: f90
!   machine:  ibm rs/6000 sp
!
!------------------------------------------------------------------------------------------------------------

  integer,parameter :: ntype = 3, nv=4, nh=3,ncoev=5,ncoeh=4

  integer :: ich,k,lp,nch

  real(fp), parameter, dimension(nv) ::   &

                freq_v=(/19.35_fp, 22.235_fp, 37.0_fp, 85.0_fp/)

  real(fp), parameter, dimension(nh) ::   &

                freq_h=(/19.35_fp, 37.0_fp, 85.0_fp/)

  real(fp) frequency,Ts,tv(*),th(*),em_vector(*)

  real(fp) ev(nv),eh(nh),ev_22

  real(fp) coe_v(nv,ncoev),coe_h(nh,ncoeh),pe , ev_cor,eh_cor

  logical data_invalid

  save  coe_v,coe_h

!snow
  coe_v(1,1:5) = (/  1.109066e-001_fp,  5.449409e-003_fp,  &
       1.835799e-004_fp, -1.765248e-003_fp, -2.996101e-004_fp/)
  coe_v(2,1:5) = (/ 9.356505e-002_fp,  1.320617e-003_fp,  &
       4.449195e-003_fp, -1.786960e-003_fp, -3.479687e-004_fp/)
  coe_v(3,1:5) = (/ 6.387097e-002_fp,  1.252447e-003_fp,  &
       1.998846e-004_fp, 2.680219e-003_fp, -3.740141e-004_fp/)
  coe_v(4,1:5) = (/ 4.150689e-002_fp,  1.420274e-003_fp,  &
       1.223339e-004_fp, -1.948946e-003_fp,  4.248289e-003_fp/)

  coe_h(1,1:4) = (/ &
       8.503807e-002_fp,  5.357374e-003_fp, -1.361660e-003_fp, &
       -3.319696e-004_fp/)
  coe_h(2,1:4) = (/ &
       4.200333e-002_fp,  1.278894e-003_fp,  2.963129e-003_fp, &
       -4.087036e-004_fp/)
  coe_h(3,1:4) = (/ &
       2.082461e-002_fp,  1.438480e-003_fp, -1.723992e-003_fp,  &
       4.194914e-003_fp/)

! save  coe_v,coe_h


! Initialization

  em_vector(1) = 0.7_fp

  em_vector(2) = 0.8_fp

! Data status check

  data_invalid = .False.

  if ( (Ts <= 140.0_fp) .or. (Ts >= 330.0_fp) ) data_invalid = .True.

  do ich = 1, nv
     if ( (tv(ich) .le. 50.0_fp) .or. (tv(ich) .ge. 330.0_fp) )  then
        data_invalid = .True.
        exit
     end if
  end do

  do ich = 1, nh
     if ( (th(ich) <= 50.0_fp) .or. (th(ich) >= 330.0_fp) )  then
        data_invalid = .True.
        exit
     end if
  end do

  if (data_invalid) RETURN


!*** Get intial emissivity for each frequency

! v components
  do ich=1,nv
     ev(ich) =  coe_v(ich,1) + coe_v(ich,2)*tv(1)  &
          + coe_v(ich,3)*tv(2) + coe_v(ich,4)*tv(3)  &
          + coe_v(ich,5)*tv(4)
  end do

! h components
  do ich=1,nh
     eh(ich) =  coe_h(ich,1)
     do lp =2,4
        eh(ich) =  eh(ich) + coe_h(ich,lp)*th(lp-1)
     end do
  end do


  pe=     -0.002_fp + 4.470142e-003_fp*(tv(1) - th(1)) -  &
          1.991876e-004_fp*(tv(3) - th(2)) -  &
          1.704354e-005_fp*(tv(4) - th(3))

  ev_cor = one - pe*(Ts-tv(1))/(tv(1)-th(1))

  if (ev_cor >  one)         ev_cor = one
  if (ev_cor <= 0.2_fp) ev_cor = 0.2_fp
  eh_cor = ev_cor - pe
  ev_cor = ev(1) - ev_cor
  eh_cor = eh(1) - eh_cor

!*** Calculate emissivity
  do ich=1, nv
     ev(ich) = ev(ich) - ev_cor
     if(ich <= 3) eh(ich) = eh(ich) - eh_cor
  end do


!*** Quality control at 22.235 GHz
  ev_22 = ev(1) + (ev(3)-ev(1))*(22.235_fp-19.35_fp)/(37.0_fp-19.35_fp)
!/\ type
  if( (ev(2) .gt. ev(1)) .and. (ev(2) .gt. ev(3)) ) ev(2) = ev_22
!\/ type
  if( (ev(2) .lt. ev(1)) .and. (ev(2) .lt. ev(3)) ) ev(2) = ev_22



!*** Interpolate emissivity at a certain frequency



! v-component
  nch = 4
  do ich=1,nv
     if(frequency <= freq_v(ich)) then
        nch = ich
        exit
     end if
  end do


  if (nch == 1) then
     em_vector(2) = ev(1)
  else
     if (frequency .ge. freq_v(nv)) then
        em_vector(2) = ev(4)
     else
        em_vector(2) = ev(nch-1) + (ev(nch) - ev(nch-1))* &
             (frequency - freq_v(nch-1))/(freq_v(nch) - freq_v(nch-1))
     end if
  end if


! h-component
  nch = 3
  do ich=1,nh
     if(frequency <= freq_h(ich)) then
        nch = ich
        exit
     end if
  end do
  if (nch == 1) then
     em_vector(1) = eh(1)
  else
     if (frequency .ge. freq_h(nh)) then
        em_vector(1) = eh(3)
     else
        em_vector(1) = eh(nch-1) + (eh(nch) - eh(nch-1))* &
             (frequency - freq_h(nch-1))/(freq_h(nch) - freq_h(nch-1))
     end if

  end if

end subroutine SSMI_SnowEM_CORE


END MODULE NESDIS_SSMI_SnowEM_Module
