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

History

• 2016-05-17 (S.Nishizawa) [new]

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 62 of file scale_atmos_dyn_tstep_tracer_fvm_heve.F90.

References scale_process::prc_mpistop().

Referenced by scale_atmos_dyn_tstep_tracer::atmos_dyn_tstep_tracer_setup().

    use scale_process, only: &
       prc_mpistop
    implicit none
    character(len=*), intent(in) :: type

    if ( type /= 'FVM-HEVE' ) then
       write(*,*) 'xxx Tstep_tracer_type is not "FVM-HEVE"!'
       call prc_mpistop
    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 85 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_gridtrans::i_uy, scale_gridtrans::i_uyz, scale_gridtrans::i_xv, scale_gridtrans::i_xvz, scale_gridtrans::i_xy, scale_gridtrans::i_xyw, scale_gridtrans::i_xyz, scale_grid_index::iblock, scale_grid_index::ie, scale_grid_index::is, scale_grid_index::jblock, scale_grid_index::je, scale_grid_index::js, scale_grid_index::ke, scale_grid_index::ks, scale_grid_index::xdir, scale_grid_index::ydir, and scale_grid_index::zdir.

Referenced by scale_atmos_dyn_tstep_tracer::atmos_dyn_tstep_tracer_setup().

    use scale_gridtrans, only: &
       i_xyz, &
       i_xyw, &
       i_uyz, &
       i_xvz, &
       i_xy,  &
       i_uy,  &
       i_xv
    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: