module set_crtm_cloudmod
!$$$ module documentation block
!           .      .    .                                       .
! module:   set_crtm_cloudmod
!  prgmmr: todling          org: gmao                date: 2011-06-01
!
! abstract: module providing interface to set-crtm-cloud procedures
!
! program history log:
!   2011-06-01  todling
!   2011-11-17  zhu     --- merge set_crtm_cloudmod with crtm_cloud
!
! subroutines included:
!   sub Set_CRTM_Cloud
!
! attributes:
!   language: f90
!   machine:
!
!$$$ end documentation block

  use kinds, only: i_kind,r_kind
  use constants, only: zero,one,two,five,r0_05,t0c,fv,rd,grav
  use CRTM_Cloud_Define, only: CRTM_Cloud_type
  use CRTM_Cloud_Define, only: WATER_CLOUD,ICE_CLOUD,RAIN_CLOUD, &
      SNOW_CLOUD,GRAUPEL_CLOUD,HAIL_CLOUD 
  use mpeu_util, only: die

  implicit none

private
public Set_CRTM_Cloud

CONTAINS

  subroutine Set_CRTM_Cloud ( km, nac, cloud_name, icmask, nc, cloud_cont, cloud_efr,jcloud, dp, tp, pr, qh, cloud)

  implicit none

  integer(i_kind) , intent(in)    :: km                ! number of levels
  integer(i_kind) , intent(in)    :: nac               ! number of actual clouds
  character(len=*), intent(in)    :: cloud_name(nac)   ! [nac]   Model cloud names: qi, ql, etc.
  logical,          intent(in)    :: icmask            ! mask determining where to consider clouds
  integer(i_kind),  intent(in)    :: nc                ! number of clouds
  integer(i_kind),  intent(in)    :: jcloud(nc)        ! cloud index
  real(r_kind),     intent(in)    :: cloud_cont(km,nc) ! cloud content 
  real(r_kind),     intent(in)    :: cloud_efr (km,nc) ! cloud effective radius
  real(r_kind),     intent(in)    :: dp(km)            ! [km]    
  real(r_kind),     intent(in)    :: tp(km)            ! [km]   atmospheric temperature (K)
  real(r_kind),     intent(in)    :: pr(km)            ! [km]   atmospheric pressure  
  real(r_kind),     intent(in)    :: qh(km)            ! [km]   specific humidity

  type(CRTM_Cloud_type), intent(inout) :: cloud(nc)    ! [nc]   CRTM Cloud object

  call setCloud (cloud_name, icmask, cloud_cont, cloud_efr, jcloud, dp, tp, pr, qh, cloud)

  end subroutine Set_CRTM_Cloud

 
  subroutine setCloud (cloud_name, icmask, cloud_cont, cloud_efr,jcloud, dp, tp, pr, qh, cloud)

  use gridmod, only: regional,wrf_mass_regional

  implicit none

! !ARGUMENTS:

  character(len=*), intent(in)    :: cloud_name(:)     ! [nc]    Model cloud names: Water, Ice, etc.
  logical,          intent(in)    :: icmask            !         mask for where to consider clouds  
  integer(i_kind),  intent(in)    :: jcloud(:)         !         cloud order
  real(r_kind),     intent(in)    :: cloud_cont(:,:)   ! [km,nc] cloud contents  (kg/m2)
  real(r_kind),     intent(in)    :: cloud_efr (:,:)   ! [km,nc] cloud effective radius (microns)
  real(r_kind),     intent(in)    :: dp(:)             ! [km]    layer thickness   
  real(r_kind),     intent(in)    :: tp(:)             ! [km]    atmospheric temperature (K)
  real(r_kind),     intent(in)    :: pr(:)             ! [km]    atmospheric pressure (??)
  real(r_kind),     intent(in)    :: qh(:)             ! [km]    atmospheric specific humidity (??)

  type(CRTM_Cloud_type), intent(inout) :: cloud(:)     ! [nc]   CRTM Cloud object

! !DESCRIPTION: Set the CRTM Cloud object given Model cloud properties.
!
! !REVISION HISTORY:
!
! 03May2011  Min-Jeong  Initial version.
! 14May2011  Todling    Encapsulate Min-Jeong's code in present module.
! 01July2011 Zhu        Add jcloud and cloud_efr; add codes for regional 
!
!EOP
!-----------------------------------------------------------------------------

  character(len=*), parameter :: myname = 'setCloud'
  integer(i_kind) :: na, nc, km, n, k, rc, iTable
  real(r_kind)    :: tem1,tem2,tem3,tem4

  km = size(cloud_cont,1)
  nc = size(cloud_cont,2)
  na = size(cloud_name)

! Handle hand-split case as particular case
! -----------------------------------------
  if (na /= nc .and. (.not. regional)) then

     cloud(1)%Type = 1
     cloud(2)%Type = 2
     if(icmask) then
        Cloud(1)%water_content(:) = cloud_cont(:,1)
        Cloud(2)%water_content(:) = cloud_cont(:,2)
     else
        Cloud(1)%water_content(:) = zero
        Cloud(2)%water_content(:) = zero
     endif

!    Calculate effective radius for each cloud component (wired to 2)
!    ----------------------------------------------------------------
     if(icmask) then
        do k=1,km
           ! liquid water cloud drop size
           tem4=max(zero,(t0c-tp(k))*r0_05)
           cloud(1)%effective_radius(k) = five + five * min(one, tem4)

           ! ice water cloud particle size
           tem2 = tp(k) - t0c
           tem1 = grav/rd
           tem3 = tem1 * cloud(2)%water_content(k) * (pr(k)/dp(k)) &
                 /tp(k) * (one + fv * qh(k))

           if (tem2 < -50.0_r_kind ) then
              cloud(2)%effective_radius(k) =  (1250._r_kind/9.917_r_kind)*tem3**0.109_r_kind
           elseif (tem2 < -40.0_r_kind ) then
              cloud(2)%effective_radius(k) =  (1250._r_kind/9.337_r_kind)*tem3**0.08_r_kind
           elseif (tem2 < -30.0_r_kind ) then
              cloud(2)%effective_radius(k) =  (1250._r_kind/9.208_r_kind)*tem3**0.055_r_kind
           else
              cloud(2)%effective_radius(k) =  (1250._r_kind/9.387_r_kind)*tem3**0.031_r_kind
           endif

           cloud(1)%effective_radius(k)=max(zero, cloud(1)%effective_radius(k))
           cloud(2)%effective_radius(k)=max(zero, cloud(2)%effective_radius(k))

        end do
        cloud(1)%effective_variance(:) = two
        cloud(2)%effective_variance(:) = two

     else
        cloud(1)%effective_radius  (:) = zero
        cloud(2)%effective_radius  (:) = zero
        cloud(1)%effective_variance(:) = two
        cloud(2)%effective_variance(:) = two
     endif
  else ! Handle general case with arbitray number of clouds
       ! --------------------------------------------------

!    Loop over clouds ...
!    --------------------
     do n = 1, nc

!       Map Model cloud names into CRTM Cloud indices
!       ---------------------------------------------
        Cloud(n)%Type = CloudType_(cloud_name(jcloud(n)))

        if(icmask) then
           Cloud(n)%water_content(:) = cloud_cont(:,n)
        else
           Cloud(n)%water_content(:) = zero
        endif

!       Calculate effective radius of given cloud type
!       ----------------------------------------------
        if(icmask) then
           if (regional .and. (.not. wrf_mass_regional)) then
              cloud(n)%Effective_Radius(:) = cloud_efr(:,n)
           else
              cloud(n)%Effective_Radius(:) = EftSize_(cloud_name(jcloud(n)))
           end if
        else
           cloud(n)%Effective_Radius(:) = zero
        endif
        cloud(n)%effective_variance(:) = two

     enddo

  endif
  end subroutine setCloud

  function CloudType_(name) Result(ctype)
    character(len=*), parameter :: myname = 'CloudType_'
    character(len=*) :: name  ! Model cloud name
    integer(i_kind)  :: ctype ! CRTM cloud type

    if ( trim(name) == 'ql' ) then
       ctype = WATER_CLOUD
    else if ( trim(name) == 'qi' ) then
       ctype = ICE_CLOUD
    else if ( trim(name) == 'qh' ) then
       ctype = HAIL_CLOUD
    else if ( trim(name) == 'qg' ) then
       ctype = GRAUPEL_CLOUD
    else if ( trim(name) == 'qr' ) then
       ctype = RAIN_CLOUD
    else if ( trim(name) == 'qs' ) then
       ctype = SNOW_CLOUD

    else
       call die(myname,"cannot recognize cloud name <"//trim(name)//">")
    end if

  end function CloudType_

  function EftSize_(name) Result(csize)
    character(len=*), parameter :: myname = 'EftSize_'
    character(len=*) :: name  ! Model cloud name
    real(r_kind)     :: csize ! CRTM cloud type

! Note: Values below from Tom Auligne
    if ( trim(name) == 'ql' ) then
       csize = 10.0_r_kind  ! in micron
    else if ( trim(name) == 'qi' ) then
       csize = 30.0_r_kind
    else if ( trim(name) == 'qh' ) then
       csize = zero ! RT: can somebody fill this in?
    else if ( trim(name) == 'qg' ) then
       csize = 600.0_r_kind
    else if ( trim(name) == 'qr' ) then
       csize = 300.0_r_kind
    else if ( trim(name) == 'qs' ) then
       csize = 600.0_r_kind

    else
       call die(myname,"cannot recognize cloud name <"//trim(name)//">")
    end if

  end function EftSize_

end module set_crtm_cloudmod
