scale_atmos_dyn_tstep_tracer_fvm_heve Module Reference

module Atmosphere / Dynamics More...

Functions/Subroutines
subroutine, public	atmos_dyn_tstep_tracer_fvm_heve_setup (type)
	Setup. More...
subroutine, public	atmos_dyn_tstep_tracer_fvm_heve (QTRCo, qflx_hi, QTRC, QTRC0, RHOQ_t, DENS0, DENS, mflx_hi, num_diff, GSQRT, MAPF, CDZ, RCDZ, RCDX, RCDY, TwoD, dtl, FLAG_FCT_TRACER, FLAG_FCT_ALONG_STREAM)

Detailed Description

module Atmosphere / Dynamics

Description

HEVE FVM scheme for tracer advection in Atmospheric dynamical process

Author

Team SCALE

Function/Subroutine Documentation

atmos_dyn_tstep_tracer_fvm_heve_setup()

subroutine, public scale_atmos_dyn_tstep_tracer_fvm_heve::atmos_dyn_tstep_tracer_fvm_heve_setup

(

character(len=*), intent(in)

type

)

Setup.

Definition at line 59 of file scale_atmos_dyn_tstep_tracer_fvm_heve.F90.

    use scale_prc, only: &
       prc_abort
    implicit none
    character(len=*), intent(in) :: type
 
    if ( type /= 'FVM-HEVE' ) then
       log_error("ATMOS_DYN_Tstep_tracer_fvm_heve_setup",*) 'Tstep_tracer_type is not "FVM-HEVE"!'
       call prc_abort
    end if
 
    return

References scale_prc::prc_abort().

Referenced by scale_atmos_dyn_tstep_tracer::atmos_dyn_tstep_tracer_setup().

Here is the call graph for this function:

Here is the caller graph for this function:

atmos_dyn_tstep_tracer_fvm_heve()

subroutine, public scale_atmos_dyn_tstep_tracer_fvm_heve::atmos_dyn_tstep_tracer_fvm_heve	(	real(rp), dimension (ka,ia,ja), intent(inout)	QTRCo,
		real(rp), dimension (ka,ia,ja,3), intent(out)	qflx_hi,
		real(rp), dimension (ka,ia,ja), intent(in)	QTRC,
		real(rp), dimension (ka,ia,ja), intent(in)	QTRC0,
		real(rp), dimension (ka,ia,ja), intent(in)	RHOQ_t,
		real(rp), dimension (ka,ia,ja), intent(in)	DENS0,
		real(rp), dimension (ka,ia,ja), intent(in)	DENS,
		real(rp), dimension (ka,ia,ja,3), intent(in)	mflx_hi,
		real(rp), dimension(ka,ia,ja,3), intent(in)	num_diff,
		real(rp), dimension (ka,ia,ja,7), intent(in)	GSQRT,
		real(rp), dimension (ia,ja,2), intent(in)	MAPF,
		real(rp), dimension(ka), intent(in)	CDZ,
		real(rp), dimension(ka), intent(in)	RCDZ,
		real(rp), dimension(ia), intent(in)	RCDX,
		real(rp), dimension(ja), intent(in)	RCDY,
		logical, intent(in)	TwoD,
		real(rp), intent(in)	dtl,
		logical, intent(in)	FLAG_FCT_TRACER,
		logical, intent(in)	FLAG_FCT_ALONG_STREAM
	)

Definition at line 84 of file scale_atmos_dyn_tstep_tracer_fvm_heve.F90.

    use scale_atmos_dyn_fvm_fct, only: &
       atmos_dyn_fvm_fct
    use scale_atmos_dyn_fvm_flux, only: &
       atmos_dyn_fvm_fluxz_xyz_tracer, &
       atmos_dyn_fvm_fluxx_xyz_tracer, &
       atmos_dyn_fvm_fluxy_xyz_tracer
    use scale_atmos_dyn_fvm_flux_ud1, only: &
       atmos_dyn_fvm_fluxz_xyz_ud1, &
       atmos_dyn_fvm_fluxx_xyz_ud1, &
       atmos_dyn_fvm_fluxy_xyz_ud1
    implicit none
    real(RP), intent(inout) :: QTRCo   (KA,IA,JA) ! could be identical to QTRC0
    real(RP), intent(out) :: qflx_hi (KA,IA,JA,3) ! rho * vel(x,y,z) * phi @ (u,v,w)-face high order
    real(RP), intent(in)  :: QTRC    (KA,IA,JA)
    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,2)
    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)  :: TwoD
    real(RP), intent(in)  :: dtl
    logical,  intent(in)  :: FLAG_FCT_TRACER
    logical,  intent(in)  :: FLAG_FCT_ALONG_STREAM
 
 
    ! For tracer advection
    real(RP) :: qflx_lo  (KA,IA,JA,3)  ! rho * vel(x,y,z) * phi,  monotone flux
    real(RP) :: qflx_anti(KA,IA,JA,3)  ! anti-diffusive flux
 
    integer  :: IIS, IIE
    integer  :: JJS, JJE
    integer  :: IIS0, JJS0
    integer  :: i, j, k
    !---------------------------------------------------------------------------
 
    !$acc data copy(QTRCo) &
    !$acc      copyout(qflx_hi) &
    !$acc      copyin(QTRC, QTRC0, RHOQ_t, DENS0, DENS, mflx_hi, num_diff, &
    !$acc             GSQRT, MAPF, CDZ, RCDZ, RCDX, RCDY) &
    !$acc      create(qflx_lo, qflx_anti)
 
#ifdef DEBUG
    !$acc kernels
    qflx_hi(:,:,:,:) = undef
    qflx_lo(:,:,:,:) = undef
    !$acc end kernels
#endif
 
    do jjs = js, je, jblock
    jje = jjs+jblock-1
    do iis = is, ie, iblock
    iie = iis+iblock-1
 
       ! at (x, y, w)
       call atmos_dyn_fvm_fluxz_xyz_tracer( qflx_hi(:,:,:,zdir), & ! (out)
            mflx_hi(:,:,:,zdir), qtrc, gsqrt(:,:,:,i_xyw), & ! (in)
            num_diff(:,:,:,zdir), & ! (in)
            cdz, & ! (in)
            iis, iie, jjs, jje ) ! (in)
 
       ! at (u, y, z)
       if ( .not. twod ) &
       call atmos_dyn_fvm_fluxx_xyz_tracer( qflx_hi(:,:,:,xdir), & ! (out)
            mflx_hi(:,:,:,xdir), qtrc, gsqrt(:,:,:,i_uyz), & ! (in)
            num_diff(:,:,:,xdir), & ! (in)
            cdz, & ! (in)
            iis, iie, jjs, jje ) ! (in)
 
       ! at (x, v, z)
       call atmos_dyn_fvm_fluxy_xyz_tracer( qflx_hi(:,:,:,ydir), & ! (out)
            mflx_hi(:,:,:,ydir), qtrc, gsqrt(:,:,:,i_xvz), & ! (in)
            num_diff(:,:,:,ydir), & ! (in)
            cdz, & ! (in)
            iis, iie, jjs, jje ) ! (in)
       
       if ( flag_fct_tracer ) then
 
          call atmos_dyn_fvm_fluxz_xyz_ud1( qflx_lo(:,:,:,zdir), & ! (out)
               mflx_hi(:,:,:,zdir), qtrc0, gsqrt(:,:,:,i_xyw), & ! (in)
               num_diff(:,:,:,zdir), & ! (in)
               cdz, & ! (in)
               iis-1, iie+1, jjs-1, jje+1 ) ! (in)
 
          if ( .not. twod ) &
          call atmos_dyn_fvm_fluxx_xyz_ud1( qflx_lo(:,:,:,xdir), & ! (out)
               mflx_hi(:,:,:,xdir), qtrc0, gsqrt(:,:,:,i_uyz), & ! (in)
               num_diff(:,:,:,xdir), & ! (in)
               cdz, & ! (in)
               iis-1, iie+1, jjs-1, jje+1 ) ! (in)
 
          call atmos_dyn_fvm_fluxy_xyz_ud1( qflx_lo(:,:,:,ydir), & ! (out)
               mflx_hi(:,:,:,ydir), qtrc0, gsqrt(:,:,:,i_xvz), & ! (in)
               num_diff(:,:,:,ydir), & ! (in)
               cdz, & ! (in)
               iis-1, iie+1, jjs-1, jje+1 ) ! (in)
       end if
 
    enddo
    enddo
 
    if ( flag_fct_tracer ) then
 
       call atmos_dyn_fvm_fct( qflx_anti,        & ! (out)
                           qtrc0, dens0, dens,   & ! (in)
                           qflx_hi, qflx_lo,     & ! (in)
                           mflx_hi,              & ! (in)
                           rcdz, rcdx, rcdy,     & ! (in)
                           gsqrt(:,:,:,i_xyz),   & ! (in)
                           mapf, twod, dtl,      & ! (in)
                           flag_fct_along_stream ) ! (in)
 
       do jjs = js, je, jblock
       jje = jjs+jblock-1
       do iis = is, ie, iblock
       iie = iis+iblock-1
 
          !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
          do j = jjs, jje
          do i = iis, iie
          do k = ks-1, ke
             qflx_hi(k,i,j,zdir) = qflx_hi(k,i,j,zdir) - qflx_anti(k,i,j,zdir)
          end do
          end do
          end do
 
          if ( .not. twod ) then
             if ( iis == is ) then
                iis0 = iis-1
             else
                iis0 = iis
             end if
             !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
             do j = jjs, jje
             do i = iis0, iie
             do k = ks, ke
                qflx_hi(k,i,j,xdir) = qflx_hi(k,i,j,xdir) - qflx_anti(k,i,j,xdir)
             end do
             end do
             end do
          end if
 
          if ( jjs == js ) then
             jjs0 = jjs-1
          else
             jjs0 = jjs
          end if
          !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
          do j = jjs0, jje
          do i = iis, iie
          do k = ks, ke
             qflx_hi(k,i,j,ydir) = qflx_hi(k,i,j,ydir) - qflx_anti(k,i,j,ydir)
          end do
          end do
          end do
 
 
          if ( twod ) then
             !$omp parallel do private(i,j,k) OMP_SCHEDULE_
             do j = jjs, jje
             do k = ks, ke
                qtrco(k,is,j) = ( qtrc0(k,is,j) * dens0(k,is,j) &
                                + dtl * ( - ( ( qflx_hi(k,is,j,zdir) - qflx_hi(k-1,is,j  ,zdir)  ) * rcdz(k) &
                                            + ( qflx_hi(k,is,j,ydir) - qflx_hi(k  ,is,j-1,ydir)  ) * rcdy(j) &
                                          ) * mapf(is,j,2) / gsqrt(k,is,j,i_xyz) &
                                + rhoq_t(k,is,j) ) ) / dens(k,is,j)
             enddo
             enddo
          else
             !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
             do j = jjs, jje
             do i = iis, iie
             do k = ks, ke
                qtrco(k,i,j) = ( qtrc0(k,i,j) * dens0(k,i,j) &
                               + dtl * ( - ( ( qflx_hi(k,i,j,zdir) - qflx_hi(k-1,i  ,j  ,zdir)  ) * rcdz(k) &
                                           + ( qflx_hi(k,i,j,xdir) - qflx_hi(k  ,i-1,j  ,xdir)  ) * rcdx(i) &
                                           + ( qflx_hi(k,i,j,ydir) - qflx_hi(k  ,i  ,j-1,ydir)  ) * rcdy(j) &
                                         ) * mapf(i,j,1) * mapf(i,j,2) / gsqrt(k,i,j,i_xyz) &
                               + rhoq_t(k,i,j) ) ) / dens(k,i,j)
             enddo
             enddo
             enddo
          end if
 
       enddo
       enddo
 
    else ! skip FCT
 
       do jjs = js, je, jblock
       jje = jjs+jblock-1
       do iis = is, ie, iblock
       iie = iis+iblock-1
 
          if ( twod ) then
             !$omp parallel do default(none) private(j,k) OMP_SCHEDULE_ &
             !$omp shared(JJS,JJE,IS,KS,KE,QTRCo,QTRC0,DENS0,dtl,qflx_hi,RCDZ,RCDY,MAPF) &
             !$omp shared(GSQRT,RHOQ_t,DENS,I_XYZ) 
             !$acc kernels
             do j = jjs, jje
             do k = ks, ke
                qtrco(k,is,j) = ( qtrc0(k,is,j) * dens0(k,is,j) &
                                + dtl * ( - ( ( qflx_hi(k,is,j,zdir) - qflx_hi(k-1,is,j  ,zdir)  ) * rcdz(k) &
                                            + ( qflx_hi(k,is,j,ydir) - qflx_hi(k  ,is,j-1,ydir)  ) * rcdy(j) &
                                           ) * mapf(is,j,2) / gsqrt(k,is,j,i_xyz) &
                               + rhoq_t(k,is,j) ) ) / dens(k,is,j)
             enddo
             enddo
             !$acc end kernels
          else
             !$omp parallel do default(none) private(i,j,k) OMP_SCHEDULE_ collapse(2) &
             !$omp shared(JJS,JJE,IIS,IIE,KS,KE,QTRCo,QTRC0,DENS0,dtl,qflx_hi,RCDZ,RCDX,RCDY,MAPF) &
             !$omp shared(GSQRT,RHOQ_t,DENS,I_XYZ) 
             !$acc kernels
             do j = jjs, jje
             do i = iis, iie
             do k = ks, ke
                qtrco(k,i,j) = ( qtrc0(k,i,j) * dens0(k,i,j) &
                               + dtl * ( - ( ( qflx_hi(k,i,j,zdir) - qflx_hi(k-1,i  ,j  ,zdir)  ) * rcdz(k) &
                                           + ( qflx_hi(k,i,j,xdir) - qflx_hi(k  ,i-1,j  ,xdir)  ) * rcdx(i) &
                                           + ( qflx_hi(k,i,j,ydir) - qflx_hi(k  ,i  ,j-1,ydir)  ) * rcdy(j) &
                                           ) * mapf(i,j,1) * mapf(i,j,2) / gsqrt(k,i,j,i_xyz) &
                               + rhoq_t(k,i,j) ) ) / dens(k,i,j)
             enddo
             enddo
             enddo
             !$acc end kernels
          end if
 
       enddo
       enddo
 
    end if
    !$acc end data
 
    return

References scale_atmos_dyn_fvm_fct::atmos_dyn_fvm_fct(), scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_fluxx_xyz_tracer, scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxx_xyz_ud1(), scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_fluxy_xyz_tracer, scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxy_xyz_ud1(), scale_atmos_dyn_fvm_flux::atmos_dyn_fvm_fluxz_xyz_tracer, scale_atmos_dyn_fvm_flux_ud1::atmos_dyn_fvm_fluxz_xyz_ud1(), scale_atmos_grid_cartesc_index::i_uyz, scale_atmos_grid_cartesc_index::i_xvz, scale_atmos_grid_cartesc_index::i_xyw, scale_atmos_grid_cartesc_index::i_xyz, scale_atmos_grid_cartesc_index::iblock, scale_atmos_grid_cartesc_index::ie, scale_atmos_grid_cartesc_index::is, scale_atmos_grid_cartesc_index::jblock, scale_atmos_grid_cartesc_index::je, scale_atmos_grid_cartesc_index::js, scale_tracer::k, scale_atmos_grid_cartesc_index::ke, scale_atmos_grid_cartesc_index::ks, scale_atmos_grid_cartesc_index::xdir, scale_atmos_grid_cartesc_index::ydir, and scale_atmos_grid_cartesc_index::zdir.

Referenced by scale_atmos_dyn_tstep_tracer::atmos_dyn_tstep_tracer_setup().

Here is the call graph for this function:

Here is the caller graph for this function: