scale_atmos_phy_rd_common.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "inc_openmp.h"
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_tracer, only: &
       tracer_r, &
       tracer_cv, &
       tracer_mass
    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]
                         tracer_cv(:),  & ! [IN]
                         tracer_r(:),   & ! [IN]
                         tracer_mass(:) ) ! [IN]

    !$omp parallel do default(none)                       &
    !$omp shared(JS,JE,IS,IE,KS,KE,RHOE_t,flux_rad,FZ,dt,RHOE) &
    !$omp private(i,j,k) OMP_SCHEDULE_ collapse(2)
    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]
                         tracer_cv(:),  & ! [IN]
                         tracer_r(:),   & ! [IN]
                         tracer_mass(:) ) ! [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]
                       tracer_mass(:) ) ! [IN]

    call thermodyn_cv( cvtot(:,:,:),   & ! [OUT]
                       qtrc(:,:,:,:), & ! [IN]
                       tracer_cv(:),   & ! [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