scale_atmos_dyn_tinteg_short_rk3 Module Reference

module Atmosphere / Dyn Tinteg More...

Functions/Subroutines
subroutine, public	atmos_dyn_tinteg_short_rk3_setup (tinteg_type)
	Setup. More...
subroutine, public	atmos_dyn_tinteg_short_rk3 (DENS, MOMZ, MOMX, MOMY, RHOT, PROG, mflx_hi, tflx_hi, DENS_t, MOMZ_t, MOMX_t, MOMY_t, RHOT_t, Rtot, CVtot, CORIOLI, num_diff, divdmp_coef, DDIV, FLAG_FCT_MOMENTUM, FLAG_FCT_T, FLAG_FCT_ALONG_STREAM, CDZ, FDZ, FDX, FDY, RCDZ, RCDX, RCDY, RFDZ, RFDX, RFDY, PHI, GSQRT, J13G, J23G, J33G, MAPF, REF_pres, REF_dens, BND_W, BND_E, BND_S, BND_N, dt)
	RK3. More...

Detailed Description

module Atmosphere / Dyn Tinteg

Description

Temporal integration in Dynamical core for Atmospheric process three step Runge-Kutta scheme

Author

Team SCALE

History

• 2016-04-18 (S.Nishizawa) [mod] split from scale_atmos_dyn.F90

Function/Subroutine Documentation

atmos_dyn_tinteg_short_rk3_setup()

subroutine, public scale_atmos_dyn_tinteg_short_rk3::atmos_dyn_tinteg_short_rk3_setup

(

character(len=*)

tinteg_type

)

Setup.

Definition at line 94 of file scale_atmos_dyn_tinteg_short_rk3.F90.

References scale_comm::comm_vars8_init(), scale_const::const_undef, scale_grid_index::ia, scale_stdio::io_fid_log, scale_stdio::io_l, scale_grid_index::ja, scale_grid_index::ka, scale_process::prc_mpistop(), and scale_index::va.

Referenced by scale_atmos_dyn_tinteg_short::atmos_dyn_tinteg_short_setup().

    use scale_process, only: &
       prc_mpistop
    use scale_const, only: &
       undef => const_undef
    use scale_comm, only: &
       comm_vars8_init
    implicit none

    character(len=*) :: tinteg_type

    integer :: iv
    !---------------------------------------------------------------------------

    select case ( tinteg_type )
    case ( 'RK3' )
       if( io_l ) write(io_fid_log,*) "*** RK3: Heun's method is used"
       ! Heun's method
       ! k1 = f(\phi_n); r1 = \phi_n + k1 * dt / 3
       ! k2 = f(r1);     r2 = \phi_n + k2 * dt * 2 / 3
       ! k3 = f(r2);     r3 = \phi_n + k3 * dt
       ! \phi_{n+1} = \phi_n + ( k1 + 3 * k3 ) dt / 4
       !            = \phi_n + ( (r1-\phi_n) * 3 + (r3-\phi_n) * 3 ) / 4
       !            = ( r1 * 3 + r3 * 3 - \phi_n * 2 ) / 4
       flag_ws2002 = .false.
       fact_dt1 = 1.0_rp / 3.0_rp
       fact_dt2 = 2.0_rp / 3.0_rp
    case ( 'RK3WS2002' )
       if( io_l ) write(io_fid_log,*) "*** RK3: Wichere and Skamarock (2002) is used"
       ! Wicher and Skamarock (2002) RK3 scheme
       ! k1 = f(\phi_n); r1 = \phi_n + k1 * dt / 3
       ! k2 = f(r1);     r2 = \phi_n + k2 * dt / 2
       ! k3 = f(r2);     r3 = \phi_n + k3 * dt
       ! \phi_{n+1} = r3
       flag_ws2002 = .true.
       fact_dt1 = 1.0_rp / 3.0_rp
       fact_dt2 = 1.0_rp / 2.0_rp
    case default
       write(*,*) 'xxx TINTEG_TYPE is not RK3. Check!'
       call prc_mpistop
    end select

    allocate( dens_rk1(ka,ia,ja) )
    allocate( momz_rk1(ka,ia,ja) )
    allocate( momx_rk1(ka,ia,ja) )
    allocate( momy_rk1(ka,ia,ja) )
    allocate( rhot_rk1(ka,ia,ja) )

    allocate( dens_rk2(ka,ia,ja) )
    allocate( momz_rk2(ka,ia,ja) )
    allocate( momx_rk2(ka,ia,ja) )
    allocate( momy_rk2(ka,ia,ja) )
    allocate( rhot_rk2(ka,ia,ja) )

    allocate( prog_rk1(ka,ia,ja,max(va,1)) )
    allocate( prog_rk2(ka,ia,ja,max(va,1)) )
    allocate( i_comm_prog_rk1(max(va,1)) )
    allocate( i_comm_prog_rk2(max(va,1)) )

    call comm_vars8_init( dens_rk1, i_comm_dens_rk1 )
    call comm_vars8_init( momz_rk1, i_comm_momz_rk1 )
    call comm_vars8_init( momx_rk1, i_comm_momx_rk1 )
    call comm_vars8_init( momy_rk1, i_comm_momy_rk1 )
    call comm_vars8_init( rhot_rk1, i_comm_rhot_rk1 )
    do iv = 1, va
       i_comm_prog_rk1(iv) = 5 + iv
       call comm_vars8_init( prog_rk1(:,:,:,iv), i_comm_prog_rk1(iv) )
    enddo

    call comm_vars8_init( dens_rk2, i_comm_dens_rk2 )
    call comm_vars8_init( momz_rk2, i_comm_momz_rk2 )
    call comm_vars8_init( momx_rk2, i_comm_momx_rk2 )
    call comm_vars8_init( momy_rk2, i_comm_momy_rk2 )
    call comm_vars8_init( rhot_rk2, i_comm_rhot_rk2 )
    do iv = 1, va
       i_comm_prog_rk2(iv) = 5 + iv
       call comm_vars8_init( prog_rk2(:,:,:,iv), i_comm_prog_rk2(iv) )
    enddo

    dens_rk1(:,:,:) = undef
    momz_rk1(:,:,:) = undef
    momx_rk1(:,:,:) = undef
    momy_rk1(:,:,:) = undef
    rhot_rk1(:,:,:) = undef
    if ( va > 0 ) prog_rk1(:,:,:,:) = undef

    dens_rk2(:,:,:) = undef
    momz_rk2(:,:,:) = undef
    momx_rk2(:,:,:) = undef
    momy_rk2(:,:,:) = undef
    rhot_rk2(:,:,:) = undef
    if ( va > 0 ) prog_rk2(:,:,:,:) = undef

    return

Here is the call graph for this function:

Here is the caller graph for this function:

atmos_dyn_tinteg_short_rk3()

subroutine, public scale_atmos_dyn_tinteg_short_rk3::atmos_dyn_tinteg_short_rk3	(	real(rp), dimension(ka,ia,ja), intent(inout)	DENS,
		real(rp), dimension(ka,ia,ja), intent(inout)	MOMZ,
		real(rp), dimension(ka,ia,ja), intent(inout)	MOMX,
		real(rp), dimension(ka,ia,ja), intent(inout)	MOMY,
		real(rp), dimension(ka,ia,ja), intent(inout)	RHOT,
		real(rp), dimension(ka,ia,ja,va), intent(inout)	PROG,
		real(rp), dimension(ka,ia,ja,3), intent(inout)	mflx_hi,
		real(rp), dimension(ka,ia,ja,3), intent(inout)	tflx_hi,
		real(rp), dimension(ka,ia,ja), intent(in)	DENS_t,
		real(rp), dimension(ka,ia,ja), intent(in)	MOMZ_t,
		real(rp), dimension(ka,ia,ja), intent(in)	MOMX_t,
		real(rp), dimension(ka,ia,ja), intent(in)	MOMY_t,
		real(rp), dimension(ka,ia,ja), intent(in)	RHOT_t,
		real(rp), dimension(ka,ia,ja), intent(in)	Rtot,
		real(rp), dimension(ka,ia,ja), intent(in)	CVtot,
		real(rp), dimension(ia,ja), intent(in)	CORIOLI,
		real(rp), dimension(ka,ia,ja,5,3), intent(in)	num_diff,
		real(rp), intent(in)	divdmp_coef,
		real(rp), dimension(ka,ia,ja), intent(in)	DDIV,
		logical, intent(in)	FLAG_FCT_MOMENTUM,
		logical, intent(in)	FLAG_FCT_T,
		logical, intent(in)	FLAG_FCT_ALONG_STREAM,
		real(rp), dimension (ka), intent(in)	CDZ,
		real(rp), dimension (ka-1), intent(in)	FDZ,
		real(rp), dimension (ia-1), intent(in)	FDX,
		real(rp), dimension (ja-1), intent(in)	FDY,
		real(rp), dimension(ka), intent(in)	RCDZ,
		real(rp), dimension(ia), intent(in)	RCDX,
		real(rp), dimension(ja), intent(in)	RCDY,
		real(rp), dimension(ka-1), intent(in)	RFDZ,
		real(rp), dimension(ia-1), intent(in)	RFDX,
		real(rp), dimension(ja-1), intent(in)	RFDY,
		real(rp), dimension (ka,ia,ja), intent(in)	PHI,
		real(rp), dimension(ka,ia,ja,7), intent(in)	GSQRT,
		real(rp), dimension (ka,ia,ja,7), intent(in)	J13G,
		real(rp), dimension (ka,ia,ja,7), intent(in)	J23G,
		real(rp), intent(in)	J33G,
		real(rp), dimension (ia,ja,2,4), intent(in)	MAPF,
		real(rp), dimension(ka,ia,ja), intent(in)	REF_pres,
		real(rp), dimension(ka,ia,ja), intent(in)	REF_dens,
		logical, intent(in)	BND_W,
		logical, intent(in)	BND_E,
		logical, intent(in)	BND_S,
		logical, intent(in)	BND_N,
		real(rp), intent(in)	dt
	)

RK3.

Parameters

[in]	phi	geopotential
[in]	gsqrt	vertical metrics {G}^1/2
[in]	j13g	(1,3) element of Jacobian matrix
[in]	j23g	(2,3) element of Jacobian matrix
[in]	j33g	(3,3) element of Jacobian matrix
[in]	mapf	map factor
[in]	ref_pres	reference pressure

Definition at line 205 of file scale_atmos_dyn_tinteg_short_rk3.F90.

References scale_atmos_dyn_common::atmos_dyn_copy_boundary(), scale_atmos_dyn_tstep_short::atmos_dyn_tstep_short, scale_grid_index::ie, scale_grid_index::is, scale_grid_index::je, scale_grid_index::js, scale_grid_index::ke, scale_grid_index::ks, scale_prof::prof_rapend(), scale_prof::prof_rapstart(), and scale_index::va.

Referenced by scale_atmos_dyn_tinteg_short::atmos_dyn_tinteg_short_setup().

    use scale_comm, only: &
       comm_vars8, &
       comm_wait
    use scale_atmos_dyn_tstep_short, only: &
       atmos_dyn_tstep => atmos_dyn_tstep_short
    use scale_atmos_dyn_common, only: &
       atmos_dyn_copy_boundary
    implicit none

    real(RP), intent(inout) :: dens(ka,ia,ja)
    real(RP), intent(inout) :: momz(ka,ia,ja)
    real(RP), intent(inout) :: momx(ka,ia,ja)
    real(RP), intent(inout) :: momy(ka,ia,ja)
    real(RP), intent(inout) :: rhot(ka,ia,ja)
    real(RP), intent(inout) :: prog(ka,ia,ja,va)

    real(RP), intent(inout) :: mflx_hi(ka,ia,ja,3)
    real(RP), intent(inout) :: tflx_hi(ka,ia,ja,3)

    real(RP), intent(in)    :: dens_t(ka,ia,ja)
    real(RP), intent(in)    :: momz_t(ka,ia,ja)
    real(RP), intent(in)    :: momx_t(ka,ia,ja)
    real(RP), intent(in)    :: momy_t(ka,ia,ja)
    real(RP), intent(in)    :: rhot_t(ka,ia,ja)

    real(RP), intent(in)    :: rtot(ka,ia,ja)
    real(RP), intent(in)    :: cvtot(ka,ia,ja)
    real(RP), intent(in)    :: corioli(ia,ja)
    real(RP), intent(in)    :: num_diff(ka,ia,ja,5,3)
    real(RP), intent(in)    :: divdmp_coef
    real(RP), intent(in)    :: ddiv(ka,ia,ja)

    logical,  intent(in)    :: flag_fct_momentum
    logical,  intent(in)    :: flag_fct_t
    logical,  intent(in)    :: flag_fct_along_stream

    real(RP), intent(in)    :: cdz (ka)
    real(RP), intent(in)    :: fdz (ka-1)
    real(RP), intent(in)    :: fdx (ia-1)
    real(RP), intent(in)    :: fdy (ja-1)
    real(RP), intent(in)    :: rcdz(ka)
    real(RP), intent(in)    :: rcdx(ia)
    real(RP), intent(in)    :: rcdy(ja)
    real(RP), intent(in)    :: rfdz(ka-1)
    real(RP), intent(in)    :: rfdx(ia-1)
    real(RP), intent(in)    :: rfdy(ja-1)

    real(RP), intent(in)    :: phi  (ka,ia,ja)
    real(RP), intent(in)    :: gsqrt(ka,ia,ja,7)
    real(RP), intent(in)    :: j13g (ka,ia,ja,7)
    real(RP), intent(in)    :: j23g (ka,ia,ja,7)
    real(RP), intent(in)    :: j33g
    real(RP), intent(in)    :: mapf (ia,ja,2,4)

    real(RP), intent(in)    :: ref_pres(ka,ia,ja)
    real(RP), intent(in)    :: ref_dens(ka,ia,ja)

    logical,  intent(in)    :: bnd_w
    logical,  intent(in)    :: bnd_e
    logical,  intent(in)    :: bnd_s
    logical,  intent(in)    :: bnd_n

    real(RP), intent(in)    :: dt

    real(RP) :: dens0(ka,ia,ja)
    real(RP) :: momz0(ka,ia,ja)
    real(RP) :: momx0(ka,ia,ja)
    real(RP) :: momy0(ka,ia,ja)
    real(RP) :: rhot0(ka,ia,ja)
    real(RP) :: prog0(ka,ia,ja,va)

    real(RP) :: mflx_hi_rk(ka,ia,ja,3,2)
    real(RP) :: tflx_hi_rk(ka,ia,ja,3,2)

    real(RP) :: dtrk

    integer  :: i, j, k, iv, n
    !---------------------------------------------------------------------------

    call prof_rapstart("DYN_RK3_Prep",3)

#ifdef DEBUG
    dens_rk1(:,:,:) = undef
    momz_rk1(:,:,:) = undef
    momx_rk1(:,:,:) = undef
    momy_rk1(:,:,:) = undef
    rhot_rk1(:,:,:) = undef
    if ( va > 0 ) prog_rk1(:,:,:,:) = undef

    dens_rk2(:,:,:) = undef
    momz_rk2(:,:,:) = undef
    momx_rk2(:,:,:) = undef
    momy_rk2(:,:,:) = undef
    rhot_rk2(:,:,:) = undef
    if ( va > 0 ) prog_rk2(:,:,:,:) = undef

    mflx_hi(:,:,:,:) = undef
    tflx_hi(:,:,:,:) = undef

    mflx_hi_rk(:,:,:,:,:) = undef
    tflx_hi_rk(:,:,:,:,:) = undef
#endif

!OCL XFILL
    dens0 = dens
!OCL XFILL
    momz0 = momz
!OCL XFILL
    momx0 = momx
!OCL XFILL
    momy0 = momy
!OCL XFILL
    rhot0 = rhot
!OCL XFILL
    if ( va > 0 ) prog0 = prog

    if ( bnd_w ) then
       do j = js, je
       do k = ks, ke
          mflx_hi_rk(k,is-1,j,2,:) = mflx_hi(k,is-1,j,2)
       end do
       end do
    end if
    if ( bnd_e ) then
       do j = js, je
       do k = ks, ke
          mflx_hi_rk(k,ie,j,2,:) = mflx_hi(k,ie,j,2)
       end do
       end do
    end if
    if ( bnd_s ) then
       do i = is, ie
       do k = ks, ke
          mflx_hi_rk(k,i,js-1,3,:) = mflx_hi(k,i,js-1,3)
       end do
       end do
    end if
    if ( bnd_n ) then
       do i = is, ie
       do k = ks, ke
          mflx_hi_rk(k,i,je,3,:) = mflx_hi(k,i,je,3)
       end do
       end do
    end if

    call prof_rapend  ("DYN_RK3_Prep",3)

    !------------------------------------------------------------------------
    ! Start RK
    !------------------------------------------------------------------------

    !##### RK1 : PROG0,PROG->PROG_RK1 #####

    call prof_rapstart("DYN_RK3",3)

    dtrk = dt * fact_dt1

    call atmos_dyn_tstep( dens_rk1, momz_rk1, momx_rk1, momy_rk1, rhot_rk1, & ! [OUT]
                          prog_rk1,                                         & ! [OUT]
                          mflx_hi_rk(:,:,:,:,1), tflx_hi_rk(:,:,:,:,1),     & ! [INOUT]
                          dens0,    momz0,    momx0,    momy0,    rhot0,    & ! [IN]
                          dens,     momz,     momx,     momy,     rhot,     & ! [IN]
                          dens_t,   momz_t,   momx_t,   momy_t,   rhot_t,   & ! [IN]
                          prog0, prog,                                      & ! [IN]
                          rtot, cvtot, corioli,                             & ! [IN]
                          num_diff, divdmp_coef, ddiv,                      & ! [IN]
                          flag_fct_momentum, flag_fct_t,                    & ! [IN]
                          flag_fct_along_stream,                            & ! [IN]
                          cdz, fdz, fdx, fdy,                               & ! [IN]
                          rcdz, rcdx, rcdy, rfdz, rfdx, rfdy,               & ! [IN]
                          phi, gsqrt, j13g, j23g, j33g, mapf,               & ! [IN]
                          ref_pres, ref_dens,                               & ! [IN]
                          bnd_w, bnd_e, bnd_s, bnd_n,                       & ! [IN]
                          dtrk, dt                                          ) ! [IN]

    call prof_rapend  ("DYN_RK3",3)
    call prof_rapstart("DYN_RK3_BND",3)

    call atmos_dyn_copy_boundary( dens_rk1, momz_rk1, momx_rk1, momy_rk1, rhot_rk1, & ! [INOUT]
                                  prog_rk1,                                         & ! [INOUT]
                                  dens0,    momz0,    momx0,    momy0,    rhot0,    & ! [IN]
                                  prog0,                                            & ! [IN]
                                  bnd_w, bnd_e, bnd_s, bnd_n                        ) ! [IN]

    call prof_rapend  ("DYN_RK3_BND",3)

    call comm_vars8( dens_rk1(:,:,:), i_comm_dens_rk1 )
    call comm_vars8( momz_rk1(:,:,:), i_comm_momz_rk1 )
    call comm_vars8( momx_rk1(:,:,:), i_comm_momx_rk1 )
    call comm_vars8( momy_rk1(:,:,:), i_comm_momy_rk1 )
    call comm_vars8( rhot_rk1(:,:,:), i_comm_rhot_rk1 )
    do iv = 1, va
       call comm_vars8( prog_rk1(:,:,:,iv), i_comm_prog_rk1(iv) )
    enddo

    call comm_wait ( dens_rk1(:,:,:), i_comm_dens_rk1, .false. )
    call comm_wait ( momz_rk1(:,:,:), i_comm_momz_rk1, .false. )
    call comm_wait ( momx_rk1(:,:,:), i_comm_momx_rk1, .false. )
    call comm_wait ( momy_rk1(:,:,:), i_comm_momy_rk1, .false. )
    call comm_wait ( rhot_rk1(:,:,:), i_comm_rhot_rk1, .false. )
    do iv = 1, va
       call comm_wait ( prog_rk1(:,:,:,iv), i_comm_prog_rk1(iv), .false. )
    enddo

    !##### RK2 : PROG0,PROG_RK1->PROG_RK2 #####

    call prof_rapstart("DYN_RK3",3)

    dtrk = dt * fact_dt2

    call atmos_dyn_tstep( dens_rk2, momz_rk2, momx_rk2, momy_rk2, rhot_rk2, & ! [OUT]
                          prog_rk2,                                         & ! [OUT]
                          mflx_hi_rk(:,:,:,:,2), tflx_hi_rk(:,:,:,:,2),     & ! [INOUT]
                          dens0,    momz0,    momx0,    momy0,    rhot0,    & ! [IN]
                          dens_rk1, momz_rk1, momx_rk1, momy_rk1, rhot_rk1, & ! [IN]
                          dens_t,   momz_t,   momx_t,   momy_t,   rhot_t,   & ! [IN]
                          prog0, prog_rk1,                                  & ! [IN]
                          rtot, cvtot, corioli,                             & ! [IN]
                          num_diff, divdmp_coef, ddiv,                      & ! [IN]
                          flag_fct_momentum, flag_fct_t,                    & ! [IN]
                          flag_fct_along_stream,                            & ! [IN]
                          cdz, fdz, fdx, fdy,                               & ! [IN]
                          rcdz, rcdx, rcdy, rfdz, rfdx, rfdy,               & ! [IN]
                          phi, gsqrt, j13g, j23g, j33g, mapf,               & ! [IN]
                          ref_pres, ref_dens,                               & ! [IN]
                          bnd_w, bnd_e, bnd_s, bnd_n,                       & ! [IN]
                          dtrk, dt                                          ) ! [IN]

    call prof_rapend  ("DYN_RK3",3)
    call prof_rapstart("DYN_RK3_BND",3)

    call atmos_dyn_copy_boundary( dens_rk2, momz_rk2, momx_rk2, momy_rk2, rhot_rk2, & ! [INOUT]
                                  prog_rk2,                                         & ! [INOUT]
                                  dens0,    momz0,    momx0,    momy0,    rhot0,    & ! [IN]
                                  prog0,                                            & ! [IN]
                                  bnd_w, bnd_e, bnd_s, bnd_n                        ) ! [IN]

    call prof_rapend  ("DYN_RK3_BND",3)

    call comm_vars8( dens_rk2(:,:,:), i_comm_dens_rk2 )
    call comm_vars8( momz_rk2(:,:,:), i_comm_momz_rk2 )
    call comm_vars8( momx_rk2(:,:,:), i_comm_momx_rk2 )
    call comm_vars8( momy_rk2(:,:,:), i_comm_momy_rk2 )
    call comm_vars8( rhot_rk2(:,:,:), i_comm_rhot_rk2 )
    do iv = 1, va
       call comm_vars8( prog_rk2(:,:,:,iv), i_comm_prog_rk2(iv) )
    enddo

    call comm_wait ( dens_rk2(:,:,:), i_comm_dens_rk2, .false. )
    call comm_wait ( momz_rk2(:,:,:), i_comm_momz_rk2, .false. )
    call comm_wait ( momx_rk2(:,:,:), i_comm_momx_rk2, .false. )
    call comm_wait ( momy_rk2(:,:,:), i_comm_momy_rk2, .false. )
    call comm_wait ( rhot_rk2(:,:,:), i_comm_rhot_rk2, .false. )
    do iv = 1, va
       call comm_wait ( prog_rk2(:,:,:,iv), i_comm_prog_rk2(iv), .false. )
    enddo

    !##### RK3 : PROG0,PROG_RK2->PROG #####

    call prof_rapstart("DYN_RK3",3)

    dtrk = dt

    call atmos_dyn_tstep( dens,     momz,     momx,     momy,     rhot,     & ! [OUT]
                          prog,                                             & ! [OUT]
                          mflx_hi,  tflx_hi,                                & ! [INOUT]
                          dens0,    momz0,    momx0,    momy0,    rhot0,    & ! [IN]
                          dens_rk2, momz_rk2, momx_rk2, momy_rk2, rhot_rk2, & ! [IN]
                          dens_t,   momz_t,   momx_t,   momy_t,   rhot_t,   & ! [IN]
                          prog0, prog_rk2,                                  & ! [IN]
                          rtot, cvtot, corioli,                             & ! [IN]
                          num_diff, divdmp_coef, ddiv,                      & ! [IN]
                          flag_fct_momentum, flag_fct_t,                    & ! [IN]
                          flag_fct_along_stream,                            & ! [IN]
                          cdz, fdz, fdx, fdy,                               & ! [IN]
                          rcdz, rcdx, rcdy, rfdz, rfdx, rfdy,               & ! [IN]
                          phi, gsqrt, j13g, j23g, j33g, mapf,               & ! [IN]
                          ref_pres, ref_dens,                               & ! [IN]
                          bnd_w, bnd_e, bnd_s, bnd_n,                       & ! [IN]
                          dtrk, dt                                          ) ! [IN]

    if ( .NOT. flag_ws2002 ) then
       do j = js, je
       do i = is, ie
       do k = ks, ke
          dens(k,i,j) = ( dens_rk1(k,i,j) * 3.0_rp &
                        + dens(k,i,j) * 3.0_rp &
                        - dens0(k,i,j) * 2.0_rp ) / 4.0_rp
       enddo
       enddo
       enddo

       do j = js, je
       do i = is, ie
       do k = ks, ke-1
          momz(k,i,j) = ( momz_rk1(k,i,j) * 3.0_rp &
                        + momz(k,i,j) * 3.0_rp &
                        - momz0(k,i,j) * 2.0_rp ) / 4.0_rp
       enddo
       enddo
       enddo

       do j = js, je
       do i = is, ie
       do k = ks, ke
          momx(k,i,j) = ( momx_rk1(k,i,j) * 3.0_rp &
                        + momx(k,i,j) * 3.0_rp &
                        - momx0(k,i,j) * 2.0_rp ) / 4.0_rp
       enddo
       enddo
       enddo

       do j = js, je
       do i = is, ie
       do k = ks, ke
          momy(k,i,j) = ( momy_rk1(k,i,j) * 3.0_rp &
                        + momy(k,i,j) * 3.0_rp &
                        - momy0(k,i,j) * 2.0_rp ) / 4.0_rp
       enddo
       enddo
       enddo

       do j = js, je
       do i = is, ie
       do k = ks, ke
          rhot(k,i,j) = ( rhot_rk1(k,i,j) * 3.0_rp &
                        + rhot(k,i,j) * 3.0_rp &
                        - rhot0(k,i,j) * 2.0_rp ) / 4.0_rp
       enddo
       enddo
       enddo

       do iv = 1, va
       do j = js, je
       do i = is, ie
       do k = ks, ke
          prog(k,i,j,iv) = ( prog_rk1(k,i,j,iv) * 3.0_rp &
                           + prog(k,i,j,iv) * 3.0_rp &
                           - prog0(k,i,j,iv) * 2.0_rp ) / 4.0_rp
       enddo
       enddo
       enddo
       enddo

       do n = 1, 3
       do j = js, je
       do i = is, ie
       do k = ks, ke
          mflx_hi(k,i,j,n) = ( mflx_hi_rk(k,i,j,n,1) &
                             + mflx_hi(k,i,j,n  ) * 3.0_rp ) / 4.0_rp
       enddo
       enddo
       enddo
       enddo

       do n = 1, 3
       do j = js, je
       do i = is, ie
       do k = ks, ke
          tflx_hi(k,i,j,n) = ( tflx_hi_rk(k,i,j,n,1) &
                             + tflx_hi(k,i,j,n  ) * 3.0_rp ) / 4.0_rp
       enddo
       enddo
       enddo
       enddo

    endif

    call prof_rapend  ("DYN_RK3",3)

    return

Here is the call graph for this function:

Here is the caller graph for this function: