scale_atmos_phy_rd_common.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_atmos_phy_rd_common
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_phy_rd_calc_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

  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine atmos_phy_rd_calc_heating( &
       KA, KS, KE, IA, IS, IE, JA, JS, JE, &
       flux_rad,     &
       DENS, TEMP,   &
       CVtot,        &
       FZ,           &
       RHOH,         &
       TEMP_t        )
    implicit none
    integer, intent(in) :: KA, KS, KE
    integer, intent(in) :: IA, IS, IE
    integer, intent(in) :: JA, JS, JE

    real(RP), intent(in)  :: flux_rad(ka,ia,ja,2,2)
    real(RP), intent(in)  :: DENS    (ka,ia,ja)
    real(RP), intent(in)  :: TEMP    (ka,ia,ja)
    real(RP), intent(in)  :: CVtot   (ka,ia,ja)
    real(RP), intent(in)  :: FZ      (0:ka,ia,ja)

    real(RP), intent(out) :: RHOH(ka,ia,ja)

    real(RP), intent(out), optional :: TEMP_t(ka,ia,ja,3)

    real(RP) :: RHOH_LW, RHOH_SW

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

    !$omp parallel do default(none) OMP_SCHEDULE_ collapse(2) &
    !$omp private(i,j,k, &
    !$omp         RHOH_LW,RHOH_SW) &
    !$omp shared(RHOH,TEMP_t,flux_rad,DENS,CVtot,FZ, &
    !$omp        KS,KE,IS,IE,JS,JE)
    do j = js, je
    do i = is, ie
    do k = ks, ke

       rhoh_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) )

       rhoh_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) )

       rhoh(k,i,j) = rhoh_lw + rhoh_sw

       temp_t(k,i,j,i_lw) = rhoh_lw / dens(k,i,j) / cvtot(k,i,j) * 86400.0_rp ! [K/day]
       temp_t(k,i,j,i_sw) = rhoh_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_calc_heating

end module scale_atmos_phy_rd_common