scale_atmos_phy_rd_common.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
module scale_atmos_phy_rd_common
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_stdio
  use scale_prof
  use scale_grid_index
  use scale_tracer
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_phy_rd_heating

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  ! for direction
  integer,  public, parameter :: i_up = 1
  integer,  public, parameter :: i_dn = 2
  ! for band region
  integer,  public, parameter :: i_lw = 1
  integer,  public, parameter :: i_sw = 2
  ! for band region
  integer,  public, parameter :: i_direct  = 1
  integer,  public, parameter :: i_diffuse = 2

  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_rd_heating( &
       flux_rad, &
       DENS,     &
       RHOT,     &
       QTRC,     &
       FZ,       &
       dt,       &
       TEMP_t,   &
       RHOT_t    )
    use scale_atmos_thermodyn, only: &
       thermodyn_qd   => atmos_thermodyn_qd,   &
       thermodyn_cv   => atmos_thermodyn_cv,   &
       thermodyn_rhoe => atmos_thermodyn_rhoe, &
       thermodyn_rhot => atmos_thermodyn_rhot
    implicit none

    real(RP), intent(in)  :: flux_rad(ka,ia,ja,2,2)
    real(RP), intent(in)  :: DENS    (ka,ia,ja)
    real(RP), intent(in)  :: RHOT    (ka,ia,ja)
    real(RP), intent(in)  :: QTRC    (ka,ia,ja,qa)
    real(RP), intent(in)  :: FZ      (0:ka,ia,ja)
    real(DP), intent(in)  :: dt
    real(RP), intent(out) :: TEMP_t  (ka,ia,ja,3)
    real(RP), intent(out) :: RHOT_t  (ka,ia,ja)

    real(RP) :: RHOE  (ka,ia,ja)
    real(RP) :: RHOE_t(ka,ia,ja,2)
    real(RP) :: RHOT1 (ka,ia,ja)
    real(RP) :: QDRY  (ka,ia,ja)
    real(RP) :: CVtot (ka,ia,ja)

    integer :: k, i, j
    !---------------------------------------------------------------------------

    call thermodyn_rhoe( rhoe(:,:,:),  & ! [OUT]
                         rhot(:,:,:),  & ! [IN]
                         qtrc(:,:,:,:) ) ! [IN]

    do j = js, je
    do i = is, ie
    do k = ks, ke

       rhoe_t(k,i,j,i_lw) = ( ( flux_rad(k,i,j,i_lw,i_dn) - flux_rad(k-1,i,j,i_lw,i_dn) ) &
                            - ( flux_rad(k,i,j,i_lw,i_up) - flux_rad(k-1,i,j,i_lw,i_up) ) &
                            ) / ( fz(k,i,j) - fz(k-1,i,j) )

       rhoe_t(k,i,j,i_sw) = ( ( flux_rad(k,i,j,i_sw,i_dn) - flux_rad(k-1,i,j,i_sw,i_dn) ) &
                            - ( flux_rad(k,i,j,i_sw,i_up) - flux_rad(k-1,i,j,i_sw,i_up) ) &
                            ) / ( fz(k,i,j) - fz(k-1,i,j) )

       rhoe(k,i,j) = rhoe(k,i,j) + dt * ( rhoe_t(k,i,j,i_lw) + rhoe_t(k,i,j,i_sw) )

    enddo
    enddo
    enddo

    call thermodyn_rhot( rhot1(:,:,:), & ! [OUT]
                         rhoe(:,:,:),  & ! [IN]
                         qtrc(:,:,:,:) ) ! [IN]

    ! update rhot
    do j = js, je
    do i = is, ie
    do k = ks, ke
       rhot_t(k,i,j) = ( rhot1(k,i,j) - rhot(k,i,j) ) / dt
    enddo
    enddo
    enddo

    call thermodyn_qd( qdry(:,:,:),  & ! [OUT]
                       qtrc(:,:,:,:) ) ! [IN]

    call thermodyn_cv( cvtot(:,:,:),   & ! [OUT]
                       qtrc(:,:,:,:), & ! [IN]
                       qdry(:,:,:)    ) ! [IN]

    do j = js, je
    do i = is, ie
    do k = ks, ke
       temp_t(k,i,j,i_lw) = rhoe_t(k,i,j,i_lw) / dens(k,i,j) / cvtot(k,i,j) * 86400.0_rp ! [K/day]
       temp_t(k,i,j,i_sw) = rhoe_t(k,i,j,i_sw) / dens(k,i,j) / cvtot(k,i,j) * 86400.0_rp ! [K/day]

       temp_t(k,i,j,3)    = temp_t(k,i,j,i_lw) + temp_t(k,i,j,i_sw)
    enddo
    enddo
    enddo

    return
  end subroutine atmos_phy_rd_heating

end module scale_atmos_phy_rd_common