scale_atmos_dyn_tinteg_tracer_linrk.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_atmos_dyn_tinteg_tracer_linrk
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  use scale_atmos_grid_cartesc_index
  use scale_index
  use scale_tracer
 
#ifdef DEBUG
  use scale_debug, only: &
     check
  use scale_const, only: &
     undef  => const_undef, &
     iundef => const_undef2
#endif
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_dyn_tinteg_tracer_linrk_setup
  public :: atmos_dyn_tinteg_tracer_linrk
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  real(RP), allocatable :: QTRC_RK_list(:,:,:,:)
  integer, private  :: I_COMM_RK_list(2) 
  integer, private  :: nstage = 3
 
  !-----------------------------------------------------------------------------
contains
 
  !-----------------------------------------------------------------------------
  subroutine atmos_dyn_tinteg_tracer_linrk_setup( &
       tinteg_type )
    use scale_prc, only: &
       prc_abort
    use scale_comm_cartesc, only: &
       comm_vars8_init
    implicit none
 
    character(len=*) :: tinteg_type
 
    !---------------------------------------------------------------------------
 
    if ( tinteg_type(1:5) /= 'LINRK' .or. tinteg_type(7:7) /= 's' ) then
       log_error("ATMOS_DYN_Tinteg_tracer_linrkNs_setup",*) 'TINTEG_TRACER_TYPE is invalid. Check!'
       call prc_abort
    end if
    read(tinteg_type(6:6),*) nstage
 
    allocate( qtrc_rk_list(ka,ia,ja,2) )
    i_comm_rk_list(:) = (/ 1, 2 /)
    call comm_vars8_init( 'QTRC_RK1', qtrc_rk_list(:,:,:,1), i_comm_rk_list(1) )
    call comm_vars8_init( 'QTRC_RK2', qtrc_rk_list(:,:,:,2), i_comm_rk_list(2) )
 
    return
  end subroutine atmos_dyn_tinteg_tracer_linrk_setup
 
  !-----------------------------------------------------------------------------
  subroutine atmos_dyn_tinteg_tracer_linrk(   &
       QTRC, qflx,                            & ! (out)
       qtrc0, rhoq_t, dens0, dens,            & ! (in)
       mflx_hi, num_diff,                     & ! (in)
       gsqrt, mapf,                           & ! (in)
       cdz, rcdz, rcdx, rcdy,                 & ! (in)
       bnd_w, bnd_e, bnd_s, bnd_n,            & ! (in)
       twod,                                  & ! (in)
       dtl,                                   & ! (in)
       flag_fct_tracer, flag_fct_along_stream ) ! (in)
 
    use scale_comm_cartesc, only: &
       comm_vars8, &
       comm_wait
    use scale_atmos_dyn_tstep_tracer, only: &
       atmos_dyn_tstep_tracer
    use scale_atmos_dyn_common, only: &
       atmos_dyn_copy_boundary_tracer
    implicit none
    real(rp), intent(inout) :: qtrc    (ka,ia,ja)
    real(rp), intent(out)   :: qflx    (ka,ia,ja,3)
    real(rp), intent(in)    :: qtrc0   (ka,ia,ja)
    real(rp), intent(in)    :: rhoq_t  (ka,ia,ja)
    real(rp), intent(in)    :: dens0   (ka,ia,ja)
    real(rp), intent(in)    :: dens    (ka,ia,ja)
    real(rp), intent(in)    :: mflx_hi (ka,ia,ja,3)
    real(rp), intent(in)    :: num_diff(ka,ia,ja,3)
    real(rp), intent(in)    :: gsqrt   (ka,ia,ja,7)
    real(rp), intent(in)    :: mapf    (ia,ja)
    real(rp), intent(in)    :: cdz(ka)
    real(rp), intent(in)    :: rcdz(ka)
    real(rp), intent(in)    :: rcdx(ia)
    real(rp), intent(in)    :: rcdy(ja)
    logical,  intent(in)    :: bnd_w
    logical,  intent(in)    :: bnd_e
    logical,  intent(in)    :: bnd_s
    logical,  intent(in)    :: bnd_n
    logical,  intent(in)    :: twod
    real(rp), intent(in)    :: dtl
    logical,  intent(in)    :: flag_fct_tracer
    logical,  intent(in)    :: flag_fct_along_stream
 
    real(rp) :: dens_rk(ka,ia,ja)
    integer :: k, i, j
    integer :: nowstage
    real(rp) :: linrk_coef
    integer :: i_in, i_out, i_tmp
 
    !------------------------------------------------------------------------
    ! Start RK
    !------------------------------------------------------------------------
 
    i_in = 1; i_out = 2
 
    !$omp parallel do collapse(2) private(k)
    do j = js, je
    do i = is, ie
    do k = ks, ke
      qtrc_rk_list(k,i,j,i_in) = qtrc0(k,i,j)
    end do
    end do
    end do    
 
    do nowstage=1, nstage
      linrk_coef = 1.0_rp/real(nstage - nowstage + 1, kind=rp)
    
      call atmos_dyn_copy_boundary_tracer( qtrc_rk_list(:,:,:,i_in),  & ! [INOUT]
         qtrc0,                                                       & ! [IN]
         bnd_w, bnd_e, bnd_s, bnd_n,                                  & ! [IN]
         twod                                                         ) ! [IN]
 
      call comm_vars8( qtrc_rk_list(:,:,:,i_in), i_comm_rk_list(i_in) )
      call comm_wait ( qtrc_rk_list(:,:,:,i_in), i_comm_rk_list(i_in), .false. )
            
      if (nowstage < nstage) then
         !$omp parallel do collapse(2) private(k)
         do j = js-1, je+1
         do i = max(is-1,1), min(ie+1,ia)
         do k = ks, ke
            dens_rk(k,i,j) = dens0(k,i,j) &
                           + ( dens(k,i,j) - dens0(k,i,j) ) * linrk_coef
         end do
         end do
         end do
 
         call atmos_dyn_tstep_tracer( &
               qtrc_rk_list(:,:,:,i_out), qflx,          & ! (out)
               qtrc_rk_list(:,:,:,i_in), qtrc0, rhoq_t,  & ! (in)
               dens0, dens_rk,                           & ! (in)
               mflx_hi, num_diff,                        & ! (in)
               gsqrt, mapf,                              & ! (in)
               cdz, rcdz, rcdx, rcdy,                    & ! (in)
               twod, dtl*linrk_coef,                     & ! (in)
               .false., flag_fct_along_stream            ) ! (in)
                           
      else ! final stage
         call atmos_dyn_tstep_tracer( &
               qtrc, qflx,                              & ! (out)
               qtrc_rk_list(:,:,:,i_in), qtrc0, rhoq_t, & ! (in)
               dens0, dens,                             & ! (in)
               mflx_hi, num_diff,                       & ! (in)
               gsqrt, mapf,                             & ! (in)
               cdz, rcdz, rcdx, rcdy,                   & ! (in)
               twod, dtl,                               & ! (in)
               flag_fct_tracer, flag_fct_along_stream   ) ! (in)    
           
      end if
 
      i_tmp = i_out
      i_out = i_in; i_in = i_tmp
    end do
    
    return
  end subroutine atmos_dyn_tinteg_tracer_linrk
 
end module scale_atmos_dyn_tinteg_tracer_linrk