scale_atmos_dyn_tinteg_tracer_rk3.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_atmos_dyn_tinteg_tracer_rk3
  !-----------------------------------------------------------------------------
  !
  !++ 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_rk3_setup
  public :: atmos_dyn_tinteg_tracer_rk3_finalize
  public :: atmos_dyn_tinteg_tracer_rk3
 
  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  real(RP), allocatable :: QTRC_RK1(:,:,:)
  real(RP), allocatable :: QTRC_RK2(:,:,:)
  integer :: I_COMM_RK1
  integer :: I_COMM_RK2
  !-----------------------------------------------------------------------------
contains
 
  !-----------------------------------------------------------------------------
  subroutine atmos_dyn_tinteg_tracer_rk3_setup( &
       tinteg_type )
    use scale_const, only: &
       undef => const_undef
    use scale_prc, only: &
       prc_abort
    use scale_comm_cartesc, only: &
       comm_vars8_init
    implicit none
 
    character(len=*) :: tinteg_type
 
    integer :: iv
    !---------------------------------------------------------------------------
 
    if ( tinteg_type /= 'RK3WS2002' ) then
       log_error("ATMOS_DYN_Tinteg_tracer_rk3_setup",*) 'TINTEG_TRACER_TYPE is not RK3WS2002. Check!'
       call prc_abort
    end if
 
    allocate( qtrc_rk1(ka,ia,ja) )
    allocate( qtrc_rk2(ka,ia,ja) )
    qtrc_rk1(:,:,:) = undef
    qtrc_rk2(:,:,:) = undef
    !$acc enter data create(QTRC_RK1, QTRC_RK2)
 
    i_comm_rk1 = 1
    call comm_vars8_init( 'QTRC_RK1', qtrc_rk1, i_comm_rk1 )
 
    i_comm_rk2 = 1
    call comm_vars8_init( 'QTRC_RK2', qtrc_rk2, i_comm_rk2 )
 
    return
  end subroutine atmos_dyn_tinteg_tracer_rk3_setup
 
  !-----------------------------------------------------------------------------
  subroutine atmos_dyn_tinteg_tracer_rk3_finalize
 
    !$acc exit data delete(QTRC_RK1, QTRC_RK2)
    deallocate( qtrc_rk1 )
    deallocate( qtrc_rk2 )
 
    return
  end subroutine atmos_dyn_tinteg_tracer_rk3_finalize
 
  !-----------------------------------------------------------------------------
  subroutine atmos_dyn_tinteg_tracer_rk3( &
       QTRC, & ! (out)
       qflx, & ! (out)
       qtrc0, rhoq_t, &! (in)
       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, & ! (in)
       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)
    real(rp) :: dtrk
    integer :: k, i, j
 
    !$acc data copy(QTRC), copyout(qflx) &
    !$acc      copyin(QTRC0, RHOQ_t, DENS0, DENS, mflx_hi, num_diff, &
    !$acc             GSQRT, MAPF, CDZ, RCDZ, RCDX, RCDY) &
    !$acc      create(DENS_RK)
    !------------------------------------------------------------------------
    ! Start RK
    !------------------------------------------------------------------------
 
    !$acc kernels
    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) ) / 3.0_rp
    end do
    end do
    end do
    !$acc end kernels
 
    dtrk = dtl / 3.0_rp
    call atmos_dyn_tstep_tracer( &
         qtrc_rk1, & ! (out)
         qflx, & ! (out)
         qtrc, qtrc0, rhoq_t, &! (in)
         dens0, dens_rk, & ! (in)
         mflx_hi, num_diff, & ! (in)
         gsqrt, mapf, & ! (in)
         cdz, rcdz, rcdx, rcdy, & ! (in)
         twod, dtrk, & ! (in)
         .false., flag_fct_along_stream ) ! (in)
 
    call atmos_dyn_copy_boundary_tracer( qtrc_rk1,                   & ! [INOUT]
                                         qtrc0,                      & ! [IN]
                                         bnd_w, bnd_e, bnd_s, bnd_n, & ! [IN]
                                         twod                        ) ! [IN]
 
    call comm_vars8( qtrc_rk1(:,:,:), i_comm_rk1 )
    call comm_wait ( qtrc_rk1(:,:,:), i_comm_rk1, .false. )
 
 
    !$acc kernels
    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) ) * 0.5_rp
    end do
    end do
    end do
    !$acc end kernels
 
    dtrk = dtl / 2.0_rp
    call atmos_dyn_tstep_tracer( &
         qtrc_rk2, & ! (out)
         qflx, & ! (out)
         qtrc_rk1, qtrc0, rhoq_t, &! (in)
         dens0, dens_rk, & ! (in)
         mflx_hi, num_diff, & ! (in)
         gsqrt, mapf, & ! (in)
         cdz, rcdz, rcdx, rcdy, & ! (in)
         twod, dtrk, & ! (in)
         .false., flag_fct_along_stream ) ! (in)
 
    call atmos_dyn_copy_boundary_tracer( qtrc_rk2,                   & ! [INOUT]
                                         qtrc0,                      & ! [IN]
                                         bnd_w, bnd_e, bnd_s, bnd_n, & ! [IN]
                                         twod                        ) ! [IN]
 
    call comm_vars8( qtrc_rk2(:,:,:), i_comm_rk2 )
    call comm_wait ( qtrc_rk2(:,:,:), i_comm_rk2, .false. )
 
 
    dtrk = dtl
    call atmos_dyn_tstep_tracer( &
         qtrc, & ! (out)
         qflx, & ! (out)
         qtrc_rk2, qtrc0, rhoq_t, &! (in)
         dens0, dens, & ! (in)
         mflx_hi, num_diff, & ! (in)
         gsqrt, mapf, & ! (in)
         cdz, rcdz, rcdx, rcdy, & ! (in)
         twod, & ! (in)
         dtrk, & ! (in)
         flag_fct_tracer, flag_fct_along_stream ) ! (in)
 
    !$acc end data
 
    return
  end subroutine atmos_dyn_tinteg_tracer_rk3
 
end module scale_atmos_dyn_tinteg_tracer_rk3