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, QTRC, QTRC0, RHOQ_t, DENS0, DENS, mflx_hi, num_diff, GSQRT, MAPF, CDZ, RCDZ, RCDX, RCDY, 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.

References scale_prc::prc_abort().

Referenced by scale_atmos_dyn_tstep_tracer::atmos_dyn_tstep_tracer_setup().

    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

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), 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,
		real(rp), intent(in)	dtl,
		logical, intent(in)	FLAG_FCT_TRACER,
		logical, intent(in)	FLAG_FCT_ALONG_STREAM
	)

Definition at line 82 of file scale_atmos_dyn_tstep_tracer_fvm_heve.F90.

References scale_atmos_dyn_common::atmos_dyn_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_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().

    use scale_atmos_dyn_common, only: &
       atmos_dyn_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(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)
    real(RP), intent(in)  :: dtl
    logical,  intent(in)  :: flag_fct_tracer
    logical,  intent(in)  :: flag_fct_along_stream


    ! For tracer advection
    real(RP) :: qflx_hi  (ka,ia,ja,3)  ! rho * vel(x,y,z) * phi @ (u,v,w)-face high order
    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  :: i, j, k
    !---------------------------------------------------------------------------

#ifdef DEBUG
    qflx_hi(:,:,:,:) = undef
    qflx_lo(:,:,:,:) = undef
#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)
       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)

          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_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, 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, ke
             qtrco(k,i,j) = ( qtrc0(k,i,j) * dens0(k,i,j) &
                            + dtl * ( - ( ( qflx_hi(k  ,i  ,j  ,zdir) - qflx_anti(k  ,i  ,j  ,zdir) &
                                          - qflx_hi(k-1,i  ,j  ,zdir) + qflx_anti(k-1,i  ,j  ,zdir) ) * rcdz(k) &
                                        + ( qflx_hi(k  ,i  ,j  ,xdir) - qflx_anti(k  ,i  ,j  ,xdir) &
                                          - qflx_hi(k  ,i-1,j  ,xdir) + qflx_anti(k  ,i-1,j  ,xdir) ) * rcdx(i) &
                                        + ( qflx_hi(k  ,i  ,j  ,ydir) - qflx_anti(k  ,i  ,j  ,ydir) &
                                          - qflx_hi(k  ,i  ,j-1,ydir) + qflx_anti(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

       enddo
       enddo

    else ! skip FCT

       do jjs = js, je, jblock
       jje = jjs+jblock-1
       do iis = is, ie, iblock
       iie = iis+iblock-1

          !$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) 
          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

       enddo
       enddo

    end if

    return

Here is the call graph for this function:

Here is the caller graph for this function: