!WRF+/AD:MODEL_LAYER:DYNAMICS
!
MODULE a_module_em
USE module_model_constants
USE module_advect_em
USE module_big_step_utilities_em
USE module_state_description
USE module_damping_em
USE a_module_big_step_utilities_em
USE a_module_advect_em
CONTAINS
!------------------------------------------------------------------------
SUBROUTINE a_rk_step_prep(config_flags,rk_step,u,a_u,v,a_v,w,a_w,t,a_t,ph, &
a_ph,mu,a_mu,moist,a_moist,ru,a_ru,rv,a_rv,rw,a_rw,ww,a_ww,php,a_php, &
alt,a_alt,muu,a_muu,muv,a_muv,mub,mut,a_mut,phb,pb,p,a_p,al,a_al,alb,cqu, &
a_cqu,cqv,a_cqv,cqw,a_cqw,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,fnm, &
fnp,dnw,rdx,rdy,n_moist,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts, &
jte,kts,kte)
!PART I: DECLARATION OF VARIABLES
IMPLICIT NONE
INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
TYPE(grid_config_rec_type) :: config_flags
INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
INTEGER :: n_moist,rk_step
REAL :: rdx,rdy
REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: u,a_u,v,a_v,w,a_w,t,a_t,ph,a_ph, &
phb,pb,al,a_al,alb
REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: ru,a_ru,rv,a_rv,rw,a_rw,ww,a_ww, &
php,a_php,cqu,a_cqu,cqv,a_cqv,cqw,a_cqw,alt,a_alt
REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: p,a_p
REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist,a_moist
REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty,msfux,msfuy,msfvx,msfvx_inv,msfvy,mu, &
a_mu,mub
REAL,DIMENSION(ims:ime,jms:jme) :: muu,a_muu,muv,a_muv,mut,a_mut
REAL,DIMENSION(kms:kme) :: fnm,fnp,dnw
integer :: k
!PART II: CALCULATIONS OF B. S. TRAJECTORY
!!LPB[0]
! CALL calculate_full( mut, mub, mu, &
! ids, ide, jds, jde, 1, 2, &
! ims, ime, jms, jme, 1, 1, &
! its, ite, jts, jte, 1, 1 )
! CALL calc_mu_uv ( config_flags, &
! mu, mub, muu, muv, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL couple_momentum( muu, ru, u, msfuy, &
! muv, rv, v, msfvx, msfvx_inv, &
! mut, rw, w, msfty, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL calc_ww_cp ( u, v, mu, mub, ww, &
! rdx, rdy, msftx, msfty, &
! msfux, msfuy, msfvx, msfvx_inv, &
! msfvy, dnw, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL calc_cq ( moist, cqu, cqv, cqw, n_moist, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL calc_alt ( alt, al, alb, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL calc_php ( php, ph, phb, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
!PART IV: REVERSE/BACKWARD ACCUMULATIONS
!LPB[0]
CALL calculate_full(mut,mub,mu,ids,ide,jds,jde,1,2,ims,ime,jms,jme,1,1,its,ite, &
jts,jte,1,1)
CALL calc_mu_uv(config_flags,mu,mub,muu,muv,ids,ide,jds,jde,kds,kde,ims,ime,jms, &
jme,kms,kme,its,ite,jts,jte,kts,kte)
! Remarked by Ning Pan, 2010-07-13
! CALL couple_momentum(muu,ru,u,msfuy,muv,rv,v,msfvx,msfvx_inv,mut,rw,w,msfty,ids, &
! ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! CALL calc_ww_cp(u,v,mu,mub,ww,rdx,rdy,msftx,msfty,msfux,msfuy,msfvx,msfvx_inv, &
! msfvy,dnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! CALL calc_cq(moist,cqu,cqv,cqw,n_moist,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
! kms,kme,its,ite,jts,jte,kts,kte)
! CALL calc_alt(alt,al,alb,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite, &
! jts,jte,kts,kte)
! CALL calc_php(php,ph,phb,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite, &
! jts,jte,kts,kte)
CALL a_calc_php(php,a_php,ph,a_ph,phb,ids,ide,jds,jde,kds,kde,ims,ime,jms, &
jme,kms,kme,its,ite,jts,jte,kts,kte)
CALL a_calc_alt(alt,a_alt,al,a_al,alb,ids,ide,jds,jde,kds,kde,ims,ime,jms, &
jme,kms,kme,its,ite,jts,jte,kts,kte)
CALL a_calc_cq(moist,a_moist,cqu,a_cqu,cqv,a_cqv,cqw,a_cqw,n_moist,ids, &
ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
CALL a_calc_ww_cp(u,a_u,v,a_v,mu,a_mu,mub,ww,a_ww,rdx,rdy,msftx,msfty, &
msfux,msfuy,msfvx,msfvx_inv,msfvy,dnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
kme,its,ite,jts,jte,kts,kte)
! Revised by Ning Pan, 2010-07-13
! CALL a_couple_momentum(muu,a_muu,ru,a_ru,u,a_u,msfuy,muv,a_muv,rv, &
! a_rv,v,a_v,msfvx,msfvx_inv,mut,a_mut,rw,a_rw,w,a_w,msfty,ids,ide,jds,jde, &
! kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
CALL a_couple_momentum(muu,a_muu,a_ru,u,a_u,msfuy,muv,a_muv, &
a_rv,v,a_v,msfvx,msfvx_inv,mut,a_mut,a_rw,w,a_w,msfty,ids,ide,jds,jde, &
kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! Revised by Ning Pan, 2010-07-13
! CALL a_calc_mu_uv(config_flags,mu,a_mu,mub,muu,a_muu,muv,a_muv,ids,ide, &
! jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
CALL a_calc_mu_uv(config_flags,a_mu,a_muu,a_muv,ids,ide, &
jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! Revised by Ning Pan, 2010-07-13
! CALL a_calculate_full(mut,a_mut,mub,mu,a_mu,ids,ide,jds,jde,1,2,ims,ime,jms, &
! jme,1,1,its,ite,jts,jte,1,1)
CALL a_calculate_full(a_mut,a_mu,ids,ide,jds,jde,1,2,ims,ime,jms, &
jme,1,1,its,ite,jts,jte,1,1)
END SUBROUTINE a_rk_step_prep
!-------------------------------------------------------------------------------
SUBROUTINE a_rk_tendency(config_flags,rk_step,ru_tend,a_ru_tend,rv_tend, &
a_rv_tend,rw_tend,a_rw_tend,ph_tend,a_ph_tend,t_tend,a_t_tend,ru_tendf, &
a_ru_tendf,rv_tendf,a_rv_tendf,rw_tendf,a_rw_tendf,ph_tendf,a_ph_tendf, &
t_tendf,a_t_tendf,mu_tend,a_mu_tend,u_save,a_u_save,v_save,a_v_save,w_save, &
a_w_save,ph_save,a_ph_save,t_save,a_t_save,mu_save,a_mu_save,RTHFTEN, &
a_RTHFTEN,ru,a_ru,rv,a_rv,rw,a_rw,ww,a_ww,u,a_u,v,a_v,w,a_w,t,a_t, &
ph,a_ph,u_old,a_u_old,v_old,a_v_old,w_old,a_w_old,t_old,a_t_old,ph_old, &
! Revised by Ning Pan, 2010-07-30
! a_ph_old,h_diabatic,a_h_diabatic,phb,t_init,a_t_init,mu,a_mu,mut,a_mut,muu, &
a_ph_old,h_diabatic,a_h_diabatic,phb,t_init,mu,a_mu,mut,a_mut,muu, &
a_muu,muv,a_muv,mub,al,a_al,alt,a_alt,p,a_p,pb,php,a_php,cqu,a_cqu,cqv, &
a_cqv,cqw,a_cqw,u_base,v_base,t_base,qv_base,z_base,msfux,msfuy,msfvx,msfvx_inv, &
! Revised by Ning Pan, 2010-07-30
! msfvy,msftx,msfty,xlat,a_xlat,f,e,sina,cosa,fnm,fnp,rdn,rdnw,dt,rdx,rdy,khdif, &
! kvdif,xkmhd,a_xkmhd,xkhh,a_xkhh,diff_6th_opt,diff_6th_factor,a_diff_6th_factor, &
! dampcoef,a_dampcoef,zdamp,a_zdamp,damp_opt,cf1,cf2,cf3,cfn,cfn1,n_moist, &
! non_hydrostatic,top_lid,u_frame,a_u_frame,v_frame,a_v_frame,ids,ide,jds,jde,kds, &
! kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte,max_vert_cfl,a_max_vert_cfl, &
! max_horiz_cfl,a_max_horiz_cfl)
msfvy,msftx,msfty,xlat,f,e,sina,cosa,fnm,fnp,rdn,rdnw,dt,rdx,rdy,khdif, &
kvdif,xkmhd,a_xkmhd,xkhh,a_xkhh,diff_6th_opt,diff_6th_factor, &
dampcoef,zdamp,damp_opt,rad_nudge,cf1,cf2,cf3,cfn,cfn1,n_moist, &
non_hydrostatic,top_lid,u_frame,v_frame,ids,ide,jds,jde,kds, &
kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte,max_vert_cfl, &
max_horiz_cfl)
! PART I: DECLARATION OF VARIABLES
IMPLICIT NONE
INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
TYPE(grid_config_rec_type) :: config_flags
INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
LOGICAL :: non_hydrostatic,top_lid
INTEGER :: n_moist,rk_step
REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: ru,a_ru,rv,a_rv,rw,a_rw,ww,a_ww,u, &
a_u,v,a_v,w,a_w,t,a_t,ph,a_ph,u_old,a_u_old,v_old,a_v_old,w_old, &
a_w_old,t_old,a_t_old,ph_old,a_ph_old,phb,al,a_al,alt,a_alt,p,a_p,pb,php, &
! Revised by Ning Pan, 2010-07-30
! a_php,cqu,a_cqu,cqv,a_cqv,t_init,a_t_init,xkmhd,a_xkmhd,xkhh,a_xkhh, &
a_php,cqu,a_cqu,cqv,a_cqv,t_init,xkmhd,a_xkmhd,xkhh,a_xkhh, &
h_diabatic,a_h_diabatic
REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: ru_tend,a_ru_tend,rv_tend,a_rv_tend, &
rw_tend,a_rw_tend,t_tend,a_t_tend,ph_tend,a_ph_tend,RTHFTEN,a_RTHFTEN,u_save, &
a_u_save,v_save,a_v_save,w_save,a_w_save,ph_save,a_ph_save,t_save,a_t_save
REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: ru_tendf,a_ru_tendf,rv_tendf, &
a_rv_tendf,rw_tendf,a_rw_tendf,t_tendf,a_t_tendf,ph_tendf,a_ph_tendf,cqw,a_cqw
REAL,DIMENSION(ims:ime,jms:jme) :: mu_tend,a_mu_tend,mu_save,a_mu_save
REAL,DIMENSION(ims:ime,jms:jme) :: msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty, &
! Revised by Ning Pan, 2010-07-30
! xlat,a_xlat,f,e,sina,cosa,mu,a_mu,mut,a_mut,mub,muu,a_muu,muv,a_muv
xlat,f,e,sina,cosa,mu,a_mu,mut,a_mut,mub,muu,a_muu,muv,a_muv
REAL,DIMENSION(kms:kme) :: fnm,fnp,rdn,rdnw,u_base,v_base,t_base,qv_base,z_base
! Revised by Ning Pan, 2010-07-30
! REAL :: rdx,rdy,dt,u_frame,a_u_frame,v_frame,a_v_frame,khdif,kvdif
REAL :: rdx,rdy,dt,u_frame,v_frame,khdif,kvdif
INTEGER :: diff_6th_opt
! Revised by Ning Pan, 2010-07-30
! REAL :: diff_6th_factor,a_diff_6th_factor
REAL :: diff_6th_factor
INTEGER :: damp_opt,rad_nudge
! Revised by Ning Pan, 2010-07-30
! REAL :: zdamp,a_zdamp,dampcoef,a_dampcoef
! REAL :: max_horiz_cfl,a_max_horiz_cfl
! REAL :: max_vert_cfl,a_max_vert_cfl
REAL :: zdamp,dampcoef
REAL :: max_horiz_cfl
REAL :: max_vert_cfl
! Revised by Ning Pan, 2010-07-30
! REAL :: kdift,a_kdift,khdq,a_khdq,kvdq,a_kvdq,cfn,cfn1,cf1,cf2,cf3
REAL :: kdift,khdq,kvdq,cfn,cfn1,cf1,cf2,cf3
INTEGER :: i,j,k
INTEGER :: time_step
! Remarked by Ning Pan, 2010-07-30
! REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb0_u
! REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb0_v
! REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb1_w
! REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb1_rw_tend
! REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb2_t
! REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb2_t_tend
! REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb2_ru
! REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb2_rv
! REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb4_ph_tend
! REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb4_ru_tend
! REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb4_rv_tend
! REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb5_rw_tend
! REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb5_cqw
! REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb6_rw_tend
! REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb7_ru_tend
! REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb7_rv_tend
! REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb7_rw_tend
! REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb8_ru_tend
! REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb8_rv_tend
! REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb8_rw_tend
! REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb9_ru_tend
! REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb9_rv_tend
!! REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb11_ru_tendf
!! REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb11_rv_tendf
!! REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb11_rw_tendf
!! REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb11_t_tendf
! INTEGER :: IX1,IX2,IX3
! REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv400
! REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv401
! REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv402
! REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv403
! REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv404
! REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv405
! REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv406
! REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv407
! REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv408
! REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv409
! REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv4010
! REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv4011
! REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv4012
! REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv4013
! REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv4014
! REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv4015
! REAL :: Const_Diff_A0,Const_A0
! This line is fail to be recognized
CALL nl_get_time_step ( 1, time_step )
! Remarked by Ning Pan, 2010-07-30 : Part II is not needed
!! PART! II: CALCULATIONS OF B. S. TRAJECTORY
!! LPB[0]
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb0_u(IX1,IX2,IX3) =u(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb0_v(IX1,IX2,IX3) =v(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL zero_tend ( ru_tend, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL zero_tend ( rv_tend, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL zero_tend ( rw_tend, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL zero_tend ( t_tend, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL zero_tend ( ph_tend, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL zero_tend ( u_save, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL zero_tend ( v_save, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL zero_tend ( w_save, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL zero_tend ( ph_save, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL zero_tend ( t_save, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL zero_tend ( mu_tend, &
! ids, ide, jds, jde, 1, 1, &
! ims, ime, jms, jme, 1, 1, &
! its, ite, jts, jte, 1, 1 )
! CALL zero_tend ( mu_save, &
! ids, ide, jds, jde, 1, 1, &
! ims, ime, jms, jme, 1, 1, &
! its, ite, jts, jte, 1, 1 )
! CALL advect_u ( u, u , ru_tend, ru, rv, ww, &
! mut, time_step, config_flags, &
! msfux, msfuy, msfvx, msfvy, &
! msftx, msfty, &
! fnm, fnp, rdx, rdy, rdnw, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL advect_v ( v, v , rv_tend, ru, rv, ww, &
! mut, time_step, config_flags, &
! msfux, msfuy, msfvx, msfvy, &
! msftx, msfty, &
! fnm, fnp, rdx, rdy, rdnw, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
!LPB[1]
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb1_w(IX1,IX2,IX3) =w(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb1_rw_tend(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! IF (non_hydrostatic) &
! CALL advect_w ( w, w, rw_tend, ru, rv, ww, &
! mut, time_step, config_flags, &
! msfux, msfuy, msfvx, msfvy, &
! msftx, msfty, &
! fnm, fnp, rdx, rdy, rdn, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
!LPB[2]
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb2_t(IX1,IX2,IX3) =t(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb2_t_tend(IX1,IX2,IX3) =t_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb2_ru(IX1,IX2,IX3) =ru(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb2_rv(IX1,IX2,IX3) =rv(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL advect_scalar ( t, t, t_tend, ru, rv, ww, &
! mut, time_step, config_flags, &
! msfux, msfuy, msfvx, msfvy, &
! msftx, msfty, fnm, fnp, &
! rdx, rdy, rdnw, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
!LPB[3]
! IF ( config_flags%cu_physics == GDSCHEME .OR. &
! config_flags%cu_physics == G3SCHEME ) THEN
! CALL set_tend( RTHFTEN, t_tend, msfty, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! END IF
!LPB[4]
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb4_ph_tend(IX1,IX2,IX3) =ph_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb4_ru_tend(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb4_rv_tend(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL rhs_ph( ph_tend, u, v, ww, ph, ph, phb, w, &
! mut, muu, muv, &
! fnm, fnp, &
! rdnw, cfn, cfn1, rdx, rdy, &
! msfux, msfuy, msfvx, &
! msfvx_inv, msfvy, &
! msftx, msfty, &
! non_hydrostatic, &
! config_flags, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL horizontal_pressure_gradient( ru_tend,rv_tend, &
! ph,alt,p,pb,al,php,cqu,cqv, &
! muu,muv,mu,fnm,fnp,rdnw, &
! cf1,cf2,cf3,rdx,rdy,msfux,msfuy, &
! msfvx,msfvy,msftx,msfty, &
! config_flags, non_hydrostatic, &
! top_lid, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
!LPB[5]
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb5_rw_tend(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb5_cqw(IX1,IX2,IX3) =cqw(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! IF (non_hydrostatic) THEN
! CALL pg_buoy_w( rw_tend, p, cqw, mu, mub, &
! rdnw, rdn, g, msftx, msfty, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! ENDIF
!LPB[6]
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb6_rw_tend(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL w_damp ( rw_tend, max_vert_cfl, &
! max_horiz_cfl, &
! u, v, ww, w, mut, rdnw, &
! rdx, rdy, msfux, msfuy, msfvx, &
! msfvy, dt, config_flags, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
!LPB[7]
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb7_ru_tend(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb7_rv_tend(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb7_rw_tend(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! IF(config_flags%pert_coriolis) THEN
! CALL perturbation_coriolis ( ru, rv, rw, &
! ru_tend, rv_tend, rw_tend, &
! config_flags, &
! u_base, v_base, z_base, &
! muu, muv, phb, ph, &
! msftx, msfty, msfux, msfuy, &
! msfvx, msfvy, &
! f, e, sina, cosa, fnm, fnp, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! ELSE
! CALL coriolis ( ru, rv, rw, &
! ru_tend, rv_tend, rw_tend, &
! config_flags, &
! msftx, msfty, msfux, msfuy, &
! msfvx, msfvy, &
! f, e, sina, cosa, fnm, fnp, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! END IF
!LPB[8]
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb8_ru_tend(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb8_rv_tend(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb8_rw_tend(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL curvature ( ru, rv, rw, u, v, w, &
! ru_tend, rv_tend, rw_tend, &
! config_flags, &
! msfux, msfuy, msfvx, msfvy, &
! msftx, msfty, &
! xlat, fnm, fnp, rdx, rdy, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
!LPB[9]
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb9_ru_tend(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Keep_Lpb9_rv_tend(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! IF (config_flags%ra_lw_physics == HELDSUAREZ) THEN
! CALL held_suarez_damp ( ru_tend, rv_tend, &
! ru,rv,p,pb, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! END IF
!LPB[10]
!!LPB[11]
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
! ! Keep_Lpb11_ru_tendf(IX1,IX2,IX3) =ru_tendf(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
! ! Keep_Lpb11_rv_tendf(IX1,IX2,IX3) =rv_tendf(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
! ! Keep_Lpb11_rw_tendf(IX1,IX2,IX3) =rw_tendf(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
! ! Keep_Lpb11_t_tendf(IX1,IX2,IX3) =t_tendf(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!
! forward_step: IF( rk_step == 1 ) THEN
! diff_opt1 : IF (config_flags%diff_opt .eq. 1) THEN
! CALL horizontal_diffusion ('u', u, ru_tendf, mut, config_flags, &
! msfux, msfuy, msfvx, msfvx_inv, &
! msfvy,msftx, msfty, &
! khdif, xkmhd, rdx, rdy, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL horizontal_diffusion ('v', v, rv_tendf, mut, config_flags, &
! msfux, msfuy, msfvx, msfvx_inv, &
! msfvy,msftx, msfty, &
! khdif, xkmhd, rdx, rdy, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL horizontal_diffusion ('w', w, rw_tendf, mut, config_flags, &
! msfux, msfuy, msfvx, msfvx_inv, &
! msfvy,msftx, msfty, &
! khdif, xkmhd, rdx, rdy, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! khdq = 3.*khdif
! CALL horizontal_diffusion_3dmp ( 'm', t, t_tendf, mut, &
! config_flags, t_init, &
! msfux, msfuy, msfvx, msfvx_inv, &
! msfvy, msftx, msfty, &
! khdq , xkhh, rdx, rdy, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN
! CALL vertical_diffusion_u ( u, ru_tendf, config_flags, &
! u_base, &
! alt, muu, rdn, rdnw, kvdif, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL vertical_diffusion_v ( v, rv_tendf, config_flags, &
! v_base, &
! alt, muv, rdn, rdnw, kvdif, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! IF (non_hydrostatic) &
! CALL vertical_diffusion ( 'w', w, rw_tendf, config_flags, &
! alt, mut, rdn, rdnw, kvdif, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! kvdq = 3.*kvdif
! CALL vertical_diffusion_3dmp ( t, t_tendf, config_flags, t_init, &
! alt, mut, rdn, rdnw, kvdq , &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! ENDIF pbl_test
! END IF diff_opt1
! IF ( diff_6th_opt .NE. 0 ) THEN
! CALL sixth_order_diffusion( 'u', u, ru_tendf, mut, dt, &
! config_flags, &
! diff_6th_opt, diff_6th_factor, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL sixth_order_diffusion( 'v', v, rv_tendf, mut, dt, &
! config_flags, &
! diff_6th_opt, diff_6th_factor, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! IF (non_hydrostatic) &
! CALL sixth_order_diffusion( 'w', w, rw_tendf, mut, dt, &
! config_flags, &
! diff_6th_opt, diff_6th_factor, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! CALL sixth_order_diffusion( 'm', t, t_tendf, mut, dt, &
! config_flags, &
! diff_6th_opt, diff_6th_factor, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! ENDIF
! IF( damp_opt .eq. 2 ) &
! CALL rk_rayleigh_damp( ru_tendf, rv_tendf, &
! rw_tendf, t_tendf, &
! u, v, w, t, t_init, &
! mut, muu, muv, ph, phb, &
! u_base, v_base, t_base, z_base, &
! dampcoef, zdamp, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! END IF
!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
! Remarked by Ning Pan, 2010-07-30
! a_kdift =0.0
! a_khdq =0.0
! a_kvdq =0.0
!PART IV: REVERSE/BACKWARD ACCUMULATIONS
!LPB[11]
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! ru_tendf(IX1,IX2,IX3) =Keep_Lpb11_ru_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rv_tendf(IX1,IX2,IX3) =Keep_Lpb11_rv_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rw_tendf(IX1,IX2,IX3) =Keep_Lpb11_rw_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! t_tendf(IX1,IX2,IX3) =Keep_Lpb11_t_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! Remarked by Ning Pan, 2010-07-30
! IF( rk_step == 1 ) THEN
! IF(config_flags%diff_opt .eq. 1) THEN
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv400(IX1,IX2,IX3) =ru_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL horizontal_diffusion('u',u,ru_tendf,mut,config_flags,msfux,msfuy,msfvx, &
! msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms, &
! jme,kms,kme,its,ite,jts,jte,kts,kte)
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv401(IX1,IX2,IX3) =rv_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL horizontal_diffusion('v',v,rv_tendf,mut,config_flags,msfux,msfuy,msfvx, &
! msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms, &
! jme,kms,kme,its,ite,jts,jte,kts,kte)
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv402(IX1,IX2,IX3) =rw_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL horizontal_diffusion('w',w,rw_tendf,mut,config_flags,msfux,msfuy,msfvx, &
! msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms, &
! jme,kms,kme,its,ite,jts,jte,kts,kte)
! khdq =3.*khdif
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv403(IX1,IX2,IX3) =t_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL horizontal_diffusion_3dmp('m',t,t_tendf,mut,config_flags,t_init,msfux,msfuy, &
! msfvx,msfvx_inv,msfvy,msftx,msfty,khdq,xkhh,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime, &
! jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! IF(config_flags%bl_pbl_physics .eq. 0) THEN
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv404(IX1,IX2,IX3) =ru_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL vertical_diffusion_u(u,ru_tendf,config_flags,u_base,alt,muu,rdn,rdnw,kvdif, &
! ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv405(IX1,IX2,IX3) =rv_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL vertical_diffusion_v(v,rv_tendf,config_flags,v_base,alt,muv,rdn,rdnw,kvdif, &
! ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! IF(non_hydrostatic) THEN
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv406(IX1,IX2,IX3) =rw_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL vertical_diffusion('w',w,rw_tendf,config_flags,alt,mut,rdn,rdnw,kvdif,ids, &
! ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! END IF
! kvdq =3.*kvdif
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv407(IX1,IX2,IX3) =t_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL vertical_diffusion_3dmp(t,t_tendf,config_flags,t_init,alt,mut,rdn,rdnw,kvdq, &
! ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! ENDIF
! END IF
! IF( diff_6th_opt .NE. 0 ) THEN
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv408(IX1,IX2,IX3) =ru_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL sixth_order_diffusion('u',u,ru_tendf,mut,dt,config_flags,diff_6th_opt, &
! diff_6th_factor,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv409(IX1,IX2,IX3) =rv_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL sixth_order_diffusion('v',v,rv_tendf,mut,dt,config_flags,diff_6th_opt, &
! diff_6th_factor,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! IF(non_hydrostatic) THEN
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv4010(IX1,IX2,IX3) =rw_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL sixth_order_diffusion('w',w,rw_tendf,mut,dt,config_flags,diff_6th_opt, &
! diff_6th_factor,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! END IF
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv4011(IX1,IX2,IX3) =t_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL sixth_order_diffusion('m',t,t_tendf,mut,dt,config_flags,diff_6th_opt, &
! diff_6th_factor,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! ENDIF
! IF( damp_opt .eq. 2 ) THEN
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv4012(IX1,IX2,IX3) =ru_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv4013(IX1,IX2,IX3) =rv_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv4014(IX1,IX2,IX3) =rw_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv4015(IX1,IX2,IX3) =t_tendf(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL rk_rayleigh_damp(ru_tendf,rv_tendf,rw_tendf,t_tendf,u,v,w,t,t_init,mut,muu, &
! muv,ph,phb,u_base,v_base,t_base,z_base,dampcoef,zdamp,ids,ide,jds,jde,kds,kde,ims, &
! ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! END IF
! END IF
!! temp NING
IF( rk_step == 1 ) THEN
IF( rad_nudge .eq. 1 ) &
CALL a_theta_relaxation( t_tendf, a_t_tendf, t, a_t, t_init, &
mut, a_mut, ph, a_ph, phb, &
t_base, z_base, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte )
IF( damp_opt .eq. 2 ) THEN
! Remarked by Ning Pan, 2010-07-30
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! t_tendf(IX1,IX2,IX3) =Tmpv4015(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rw_tendf(IX1,IX2,IX3) =Tmpv4014(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rv_tendf(IX1,IX2,IX3) =Tmpv4013(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! ru_tendf(IX1,IX2,IX3) =Tmpv4012(IX1,IX2,IX3)
! END DO
! END DO
! END DO
CALL a_rk_rayleigh_damp(ru_tendf,a_ru_tendf,rv_tendf,a_rv_tendf,rw_tendf, &
! Revised by Ning Pan, 2010-07-23
! a_rw_tendf,t_tendf,a_t_tendf,u,a_u,v,a_v,w,a_w,t,a_t,t_init,a_t_init, &
a_rw_tendf,t_tendf,a_t_tendf,u,a_u,v,a_v,w,a_w,t,a_t,t_init, &
mut,a_mut,muu,a_muu,muv,a_muv,ph,a_ph,phb,u_base,v_base,t_base,z_base, &
! Revised by Ning Pan, 2010-07-30
! dampcoef,a_dampcoef,zdamp,a_zdamp,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
dampcoef,zdamp,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
kme,its,ite,jts,jte,kts,kte)
END IF
IF( diff_6th_opt .NE. 0 ) THEN
! Remarked by Ning Pan, 2010-07-30
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! t_tendf(IX1,IX2,IX3) =Tmpv4011(IX1,IX2,IX3)
! END DO
! END DO
! END DO
CALL a_sixth_order_diffusion('m',t,a_t,t_tendf,a_t_tendf,mut,a_mut,dt, &
! Revised by Ning Pan, 2010-07-30
! config_flags,diff_6th_opt,diff_6th_factor,a_diff_6th_factor,ids,ide,jds,jde,kds, &
config_flags,diff_6th_opt,diff_6th_factor,ids,ide,jds,jde,kds, &
kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
IF(non_hydrostatic) THEN
! Remarked by Ning Pan, 2010-07-30
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rw_tendf(IX1,IX2,IX3) =Tmpv4010(IX1,IX2,IX3)
! END DO
! END DO
! END DO
CALL a_sixth_order_diffusion('w',w,a_w,rw_tendf,a_rw_tendf,mut,a_mut,dt, &
! Revised by Ning Pan, 2010-07-30
! config_flags,diff_6th_opt,diff_6th_factor,a_diff_6th_factor,ids,ide,jds,jde,kds, &
config_flags,diff_6th_opt,diff_6th_factor,ids,ide,jds,jde,kds, &
kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
END IF
! Remarked by Ning Pan, 2010-07-30
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rv_tendf(IX1,IX2,IX3) =Tmpv409(IX1,IX2,IX3)
! END DO
! END DO
! END DO
CALL a_sixth_order_diffusion('v',v,a_v,rv_tendf,a_rv_tendf,mut,a_mut,dt, &
! Revised by Ning Pan, 2010-07-30
! config_flags,diff_6th_opt,diff_6th_factor,a_diff_6th_factor,ids,ide,jds,jde,kds, &
config_flags,diff_6th_opt,diff_6th_factor,ids,ide,jds,jde,kds, &
kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! Remarked by Ning Pan, 2010-07-30
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! ru_tendf(IX1,IX2,IX3) =Tmpv408(IX1,IX2,IX3)
! END DO
! END DO
! END DO
CALL a_sixth_order_diffusion('u',u,a_u,ru_tendf,a_ru_tendf,mut,a_mut,dt, &
! Revised by Ning Pan, 2010-07-30
! config_flags,diff_6th_opt,diff_6th_factor,a_diff_6th_factor,ids,ide,jds,jde,kds, &
config_flags,diff_6th_opt,diff_6th_factor,ids,ide,jds,jde,kds, &
kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
ENDIF
IF(config_flags%diff_opt .eq. 1) THEN
! Revised by Ning Pan, 2010-07-30 : reverse the adjoint computation order
! revise actual arguments
! remark useless recalculation
IF(config_flags%bl_pbl_physics .eq. 0) THEN
kvdq = 3.*kvdif
CALL a_vertical_diffusion_3dmp(t,a_t,t_tendf,a_t_tendf,config_flags,t_init, &
alt,a_alt,mut,a_mut,rdn,rdnw,kvdq,ids,ide,jds,jde,kds,kde, &
ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
IF(non_hydrostatic) THEN
CALL a_vertical_diffusion('w',w,a_w,rw_tendf,a_rw_tendf,config_flags,alt, &
a_alt,mut,a_mut,rdn,rdnw,kvdif,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
its,ite,jts,jte,kts,kte)
END IF
CALL a_vertical_diffusion_v(v,a_v,rv_tendf,a_rv_tendf,config_flags,v_base, &
alt,a_alt,muv,a_muv,rdn,rdnw,kvdif,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
kme,its,ite,jts,jte,kts,kte)
CALL a_vertical_diffusion_u(u,a_u,ru_tendf,a_ru_tendf,config_flags,u_base, &
alt,a_alt,muu,a_muu,rdn,rdnw,kvdif,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
kme,its,ite,jts,jte,kts,kte)
ENDIF
khdq = 3.*khdif
CALL a_horizontal_diffusion_3dmp('m',t,a_t,t_tendf,a_t_tendf,mut,a_mut, &
config_flags,t_init,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdq, &
xkhh,a_xkhh,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its, &
ite,jts,jte,kts,kte)
CALL a_horizontal_diffusion('w',w,a_w,rw_tendf,a_rw_tendf,mut,a_mut, &
config_flags,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,a_xkmhd,rdx, &
rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
CALL a_horizontal_diffusion('v',v,a_v,rv_tendf,a_rv_tendf,mut,a_mut, &
config_flags,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,a_xkmhd,rdx, &
rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
CALL a_horizontal_diffusion('u',u,a_u,ru_tendf,a_ru_tendf,mut,a_mut, &
config_flags,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,a_xkmhd,rdx, &
rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! ru_tendf(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL a_horizontal_diffusion('u',u,a_u,ru_tendf,a_ru_tendf,mut,a_mut, &
! config_flags,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,a_xkmhd,rdx, &
! rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rv_tendf(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL a_horizontal_diffusion('v',v,a_v,rv_tendf,a_rv_tendf,mut,a_mut, &
! config_flags,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,a_xkmhd,rdx, &
! rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rw_tendf(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL a_horizontal_diffusion('w',w,a_w,rw_tendf,a_rw_tendf,mut,a_mut, &
! config_flags,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,a_xkmhd,rdx, &
! rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! a_khdq =0.0
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! t_tendf(IX1,IX2,IX3) =Tmpv403(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL a_horizontal_diffusion_3dmp('m',t,a_t,t_tendf,a_t_tendf,mut,a_mut, &
! config_flags,t_init,a_t_init,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdq, &
! a_khdq,xkhh,a_xkhh,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its, &
! ite,jts,jte,kts,kte)
! IF(config_flags%bl_pbl_physics .eq. 0) THEN
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! ru_tendf(IX1,IX2,IX3) =Tmpv404(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL a_vertical_diffusion_u(u,a_u,ru_tendf,a_ru_tendf,config_flags,u_base, &
! alt,a_alt,muu,a_muu,rdn,rdnw,kvdif,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
! kme,its,ite,jts,jte,kts,kte)
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rv_tendf(IX1,IX2,IX3) =Tmpv405(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL a_vertical_diffusion_v(v,a_v,rv_tendf,a_rv_tendf,config_flags,v_base, &
! alt,a_alt,muv,a_muv,rdn,rdnw,kvdif,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
! kme,its,ite,jts,jte,kts,kte)
! IF(non_hydrostatic) THEN
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rw_tendf(IX1,IX2,IX3) =Tmpv406(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL a_vertical_diffusion('w',w,a_w,rw_tendf,a_rw_tendf,config_flags,alt, &
! a_alt,mut,a_mut,rdn,rdnw,kvdif,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
! its,ite,jts,jte,kts,kte)
! END IF
! a_kvdq =0.0
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! t_tendf(IX1,IX2,IX3) =Tmpv407(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL a_vertical_diffusion_3dmp(t,a_t,t_tendf,a_t_tendf,config_flags,t_init, &
! a_t_init,alt,a_alt,mut,a_mut,rdn,rdnw,kvdq,a_kvdq,ids,ide,jds,jde,kds,kde, &
! ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! ENDIF
END IF
END IF
!LPB[10]
!LPB[9]
! Remarked by Ning Pan, 2010-07-30
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! ru_tend(IX1,IX2,IX3) =Keep_Lpb9_ru_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rv_tend(IX1,IX2,IX3) =Keep_Lpb9_rv_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! IF(config_flags%ra_lw_physics == HELDSUAREZ) THEN
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv400(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv401(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL held_suarez_damp(ru_tend,rv_tend,ru,rv,p,pb,ids,ide,jds,jde,kds,kde,ims,ime, &
! jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! END IF
IF(config_flags%ra_lw_physics == HELDSUAREZ) THEN
! Remarked by Ning Pan, 2010-07-30
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rv_tend(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! ru_tend(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
! END DO
! END DO
! END DO
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! Reamarked by Ning Pan, 2010-07-30 : JUST FOR DEBUGGING DYNAMICS OF WRF+ !!!
!!! REMARK SHOULD BE REMOVED WHEN CONSTRUCTING PHYSICS OF WRF+ !!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! CALL a_held_suarez_damp(ru_tend,a_ru_tend,rv_tend,a_rv_tend,ru,a_ru,rv, &
! a_rv,p,a_p,pb,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
END IF
!LPB[8]
! Remarked by Ning Pan, 2010-07-30
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! ru_tend(IX1,IX2,IX3) =Keep_Lpb8_ru_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rv_tend(IX1,IX2,IX3) =Keep_Lpb8_rv_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rw_tend(IX1,IX2,IX3) =Keep_Lpb8_rw_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv400(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv401(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv402(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL curvature(ru,rv,rw,u,v,w,ru_tend,rv_tend,rw_tend,config_flags,msfux,msfuy, &
! msfvx,msfvy,msftx,msfty,xlat,fnm,fnp,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
! kms,kme,its,ite,jts,jte,kts,kte)
! Remarked by Ning Pan, 2010-07-30
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rw_tend(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rv_tend(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! ru_tend(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
! END DO
! END DO
! END DO
CALL a_curvature(ru,a_ru,rv,a_rv,rw,a_rw,u,a_u,v,a_v,w,a_w,ru_tend, &
a_ru_tend,rv_tend,a_rv_tend,rw_tend,a_rw_tend,config_flags,msfux,msfuy,msfvx, &
! Revised by Ning Pan, 2010-07-30
! msfvy,msftx,msfty,xlat,a_xlat,fnm,fnp,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms, &
msfvy,msftx,msfty,xlat,fnm,fnp,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms, &
jme,kms,kme,its,ite,jts,jte,kts,kte)
!LPB[7]
!! Remarked by Ning Pan, 2010-07-30
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! ru_tend(IX1,IX2,IX3) =Keep_Lpb7_ru_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! rv_tend(IX1,IX2,IX3) =Keep_Lpb7_rv_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! rw_tend(IX1,IX2,IX3) =Keep_Lpb7_rw_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! IF(config_flags%pert_coriolis) THEN
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv400(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv401(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv402(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! CALL perturbation_coriolis(ru,rv,rw,ru_tend,rv_tend,rw_tend,config_flags,u_base, &
!! v_base,z_base,muu,muv,phb,ph,msftx,msfty,msfux,msfuy,msfvx,msfvy,f,e,sina,cosa,fnm, &
!! fnp,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
!! ELSE
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv403(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv404(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv405(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! CALL coriolis(ru,rv,rw,ru_tend,rv_tend,rw_tend,config_flags,msftx,msfty,msfux, &
!! msfuy,msfvx,msfvy,f,e,sina,cosa,fnm,fnp,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
!! kme,its,ite,jts,jte,kts,kte)
!! END IF
IF(config_flags%pert_coriolis) THEN
!! Remarked by Ning Pan, 2010-07-30
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! rw_tend(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! rv_tend(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! ru_tend(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
CALL a_perturbation_coriolis(ru,a_ru,rv,a_rv,rw,a_rw,ru_tend,a_ru_tend, &
rv_tend,a_rv_tend,rw_tend,a_rw_tend,config_flags,u_base,v_base,z_base,muu, &
a_muu,muv,a_muv,phb,ph,a_ph,msftx,msfty,msfux,msfuy,msfvx,msfvy,f,e,sina,cosa, &
fnm,fnp,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
ELSE
!! Remarked by Ning Pan, 2010-07-30
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! rw_tend(IX1,IX2,IX3) =Tmpv405(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! rv_tend(IX1,IX2,IX3) =Tmpv404(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! ru_tend(IX1,IX2,IX3) =Tmpv403(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
CALL a_coriolis(ru,a_ru,rv,a_rv,rw,a_rw,ru_tend,a_ru_tend,rv_tend, &
a_rv_tend,rw_tend,a_rw_tend,config_flags,msftx,msfty,msfux,msfuy,msfvx,msfvy,f,e, &
sina,cosa,fnm,fnp,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
END IF
!LPB[6]
!! Remarked by Ning Pan, 2010-07-30
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! rw_tend(IX1,IX2,IX3) =Keep_Lpb6_rw_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv400(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! CALL w_damp(rw_tend,max_vert_cfl,max_horiz_cfl,u,v,ww,w,mut,rdnw,rdx,rdy,msfux, &
!! msfuy,msfvx,msfvy,dt,config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
!! its,ite,jts,jte,kts,kte)
!! Remarked by Ning Pan, 2010-07-30
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! rw_tend(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
! Revised by Ning Pan, 2010-07-30
! CALL a_w_damp(rw_tend,a_rw_tend,max_vert_cfl,a_max_vert_cfl,max_horiz_cfl, &
! a_max_horiz_cfl,u,a_u,v,a_v,ww,a_ww,w,a_w,mut,a_mut,rdnw,rdx,rdy,msfux, &
CALL a_w_damp(rw_tend,a_rw_tend,max_vert_cfl,max_horiz_cfl, &
u,a_u,v,a_v,ww,a_ww,w,a_w,mut,a_mut,rdnw,rdx,rdy,msfux, &
msfuy,msfvx,msfvy,dt,config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
its,ite,jts,jte,kts,kte)
!LPB[5]
!! Remarked by Ning Pan, 2010-07-30
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! rw_tend(IX1,IX2,IX3) =Keep_Lpb5_rw_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! cqw(IX1,IX2,IX3) =Keep_Lpb5_cqw(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! IF(non_hydrostatic) THEN
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv400(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv401(IX1,IX2,IX3) =cqw(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! CALL pg_buoy_w(rw_tend,p,cqw,mu,mub,rdnw,rdn,g,msftx,msfty,ids,ide,jds,jde,kds, &
!! kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
!! ENDIF
IF(non_hydrostatic) THEN
! Remarked by Ning Pan, 2010-07-30
! Const_A0=g
! Const_Diff_A0=0.0
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! cqw(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rw_tend(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
! END DO
! END DO
CALL a_pg_buoy_w(rw_tend,a_rw_tend,p,a_p,cqw,a_cqw,mu,a_mu,mub,rdnw,rdn, &
g,msftx,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! END DO ! Remarked by Ning Pan, 2010-07-30
ENDIF
!LPB[4]
!! Remarked by Ning Pan, 2010-07-30
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! ph_tend(IX1,IX2,IX3) =Keep_Lpb4_ph_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! ru_tend(IX1,IX2,IX3) =Keep_Lpb4_ru_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! rv_tend(IX1,IX2,IX3) =Keep_Lpb4_rv_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv400(IX1,IX2,IX3) =ph_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! CALL rhs_ph(ph_tend,u,v,ww,ph,ph,phb,w,mut,muu,muv,fnm,fnp,rdnw,cfn,cfn1,rdx,rdy, &
!! msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,non_hydrostatic,config_flags,ids,ide, &
!! jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv401(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv402(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! CALL horizontal_pressure_gradient(ru_tend,rv_tend,ph,alt,p,pb,al,php,cqu,cqv,muu, &
!! muv,mu,fnm,fnp,rdnw,cf1,cf2,cf3,rdx,rdy,msfux,msfuy,msfvx,msfvy,msftx,msfty, &
!! config_flags,non_hydrostatic,top_lid,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
!! its,ite,jts,jte,kts,kte)
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! rv_tend(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! ru_tend(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
CALL a_horizontal_pressure_gradient(ru_tend,a_ru_tend,rv_tend,a_rv_tend,ph, &
a_ph,alt,a_alt,p,a_p,pb,al,a_al,php,a_php,cqu,a_cqu,cqv,a_cqv,muu, &
a_muu,muv,a_muv,mu,a_mu,fnm,fnp,rdnw,cf1,cf2,cf3,rdx,rdy,msfux,msfuy,msfvx, &
! Revised by Ning Pan, 2010-07-30
! msfvy,msftx,msfty,config_flags,,,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its, &
msfvy,msftx,msfty,config_flags,non_hydrostatic,top_lid,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its, &
ite,jts,jte,kts,kte)
!! Remarked by Ning Pan, 2010-07-30
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! ph_tend(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
CALL a_rhs_ph(ph_tend,a_ph_tend,u,a_u,v,a_v,ww,a_ww,ph,a_ph,ph,a_ph, &
phb,w,a_w,mut,a_mut,muu,a_muu,muv,a_muv,fnm,fnp,rdnw,cfn,cfn1,rdx,rdy,msfux, &
! Remarked by Ning Pan, 2010-07-30
! msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,,config_flags,ids,ide,jds,jde,kds,kde,ims, &
msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,non_hydrostatic,config_flags,ids,ide,jds,jde,kds,kde,ims, &
ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
!LPB[3]
!! IF( config_flags%cu_physics == GDSCHEME .OR. config_flags%cu_physics == G3SCHEME ) THEN
!! CALL set_tend(RTHFTEN,t_tend,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
!! kme,its,ite,jts,jte,kts,kte)
!! END IF
IF( config_flags%cu_physics == GDSCHEME .OR. &
config_flags%cu_physics == G3SCHEME ) THEN
CALL a_set_tend(RTHFTEN,a_RTHFTEN,t_tend,a_t_tend,msfty,ids,ide,jds,jde,kds, &
kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
END IF
!LPB[2]
!! Remarked by Ning Pan, 2010-07-30
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! t(IX1,IX2,IX3) =Keep_Lpb2_t(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! t_tend(IX1,IX2,IX3) =Keep_Lpb2_t_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! ru(IX1,IX2,IX3) =Keep_Lpb2_ru(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! rv(IX1,IX2,IX3) =Keep_Lpb2_rv(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv400(IX1,IX2,IX3) =t(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv401(IX1,IX2,IX3) =t_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv402(IX1,IX2,IX3) =ru(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv403(IX1,IX2,IX3) =rv(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! CALL advect_scalar(t,t,t_tend,ru,rv,ww,mut,time_step,config_flags,msfux,msfuy, &
!! msfvx,msfvy,msftx,msfty,fnm,fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
!! kms,kme,its,ite,jts,jte,kts,kte)
!! Remarked by Ning Pan, 2010-07-30
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! rv(IX1,IX2,IX3) =Tmpv403(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! ru(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! t_tend(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! t(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
CALL a_advect_scalar(t,a_t,t,a_t,t_tend,a_t_tend,ru,a_ru,rv,a_rv,ww, &
a_ww,mut,a_mut,time_step,config_flags,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm, &
fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
!LPB[1]
!! Remarked by Ning Pan, 2010-07-30
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! w(IX1,IX2,IX3) =Keep_Lpb1_w(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! rw_tend(IX1,IX2,IX3) =Keep_Lpb1_rw_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! IF(non_hydrostatic) THEN
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv400(IX1,IX2,IX3) =w(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv401(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! CALL advect_w(w,w,rw_tend,ru,rv,ww,mut,time_step,config_flags,msfux,msfuy,msfvx, &
!! msfvy,msftx,msfty,fnm,fnp,rdx,rdy,rdn,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
!! kme,its,ite,jts,jte,kts,kte)
!! END IF
IF(non_hydrostatic) THEN
!! Remarked by Ning Pan, 2010-07-30
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! rw_tend(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! w(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
CALL a_advect_w(w,a_w,w,a_w,rw_tend,a_rw_tend,ru,a_ru,rv,a_rv,ww, &
a_ww,mut,time_step,config_flags,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm, &
fnp,rdx,rdy,rdn,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
END IF
!LPB[0]
!! Remarked by Ning Pan, 2010-07-30
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! u(IX1,IX2,IX3) =Keep_Lpb0_u(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! v(IX1,IX2,IX3) =Keep_Lpb0_v(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! CALL zero_tend(ru_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite, &
!! jts,jte,kts,kte)
!! CALL zero_tend(rv_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite, &
!! jts,jte,kts,kte)
!! CALL zero_tend(rw_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite, &
!! jts,jte,kts,kte)
!! CALL zero_tend(t_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts, &
!! jte,kts,kte)
!! CALL zero_tend(ph_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite, &
!! jts,jte,kts,kte)
!! CALL zero_tend(u_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts, &
!! jte,kts,kte)
!! CALL zero_tend(v_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts, &
!! jte,kts,kte)
!! CALL zero_tend(w_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts, &
!! jte,kts,kte)
!! CALL zero_tend(ph_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite, &
!! jts,jte,kts,kte)
!! CALL zero_tend(t_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts, &
!! jte,kts,kte)
!! CALL zero_tend(mu_tend,ids,ide,jds,jde,1,1,ims,ime,jms,jme,1,1,its,ite,jts,jte,1,1)
!! CALL zero_tend(mu_save,ids,ide,jds,jde,1,1,ims,ime,jms,jme,1,1,its,ite,jts,jte,1,1)
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv400(IX1,IX2,IX3) =u(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv401(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! CALL advect_u(u,u,ru_tend,ru,rv,ww,mut,time_step,config_flags,msfux,msfuy,msfvx, &
!! msfvy,msftx,msfty,fnm,fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
!! kme,its,ite,jts,jte,kts,kte)
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! Tmpv402(IX1,IX2,IX3) =v(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! CALL advect_v(v,v,rv_tend,ru,rv,ww,mut,time_step,config_flags,msfux,msfuy,msfvx, &
!! msfvy,msftx,msfty,fnm,fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
!! kme,its,ite,jts,jte,kts,kte)
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! v(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
CALL a_advect_v(v,a_v,v,a_v,rv_tend,a_rv_tend,ru,a_ru,rv,a_rv,ww, &
a_ww,mut,a_mut,time_step,config_flags,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm, &
fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
!! Remarked by Ning Pan, 2010-07-30
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! ru_tend(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
!! u(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
CALL a_advect_u(u,a_u,u,a_u,ru_tend,a_ru_tend,ru,a_ru,rv,a_rv,ww, &
a_ww,mut,a_mut,time_step,config_flags,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm, &
fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! Added by Ning Pan, 2010-07-30
CALL a_zero_tend(a_mu_save,ids,ide,jds,jde,1,1,ims,ime,jms,jme,1,1, &
its,ite,jts,jte,1,1)
CALL a_zero_tend(a_mu_tend,ids,ide,jds,jde,1,1,ims,ime,jms,jme,1,1, &
its,ite,jts,jte,1,1)
CALL a_zero_tend(a_t_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
kme,its,ite,jts,jte,kts,kte)
CALL a_zero_tend(a_ph_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
kms,kme,its,ite,jts,jte,kts,kte)
CALL a_zero_tend(a_w_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
kme,its,ite,jts,jte,kts,kte)
CALL a_zero_tend(a_v_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
kme,its,ite,jts,jte,kts,kte)
CALL a_zero_tend(a_u_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
kme,its,ite,jts,jte,kts,kte)
CALL a_zero_tend(a_ph_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
kms,kme,its,ite,jts,jte,kts,kte)
CALL a_zero_tend(a_t_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
kme,its,ite,jts,jte,kts,kte)
CALL a_zero_tend(a_rw_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
kms,kme,its,ite,jts,jte,kts,kte)
CALL a_zero_tend(a_rv_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
kms,kme,its,ite,jts,jte,kts,kte)
CALL a_zero_tend(a_ru_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
kms,kme,its,ite,jts,jte,kts,kte)
END SUBROUTINE a_rk_tendency
!-------------------------------------------------------------------------------
SUBROUTINE a_rk_addtend_dry ( a_ru_tend, a_rv_tend, &
a_rw_tend, a_ph_tend, a_t_tend, &
a_ru_tendf, a_rv_tendf, a_rw_tendf, &
a_ph_tendf, a_t_tendf, &
a_u_save, a_v_save, a_w_save, &
a_ph_save, a_t_save, &
a_mu_tend, a_mu_tendf, rk_step, &
h_diabatic, a_h_diabatic, mut, a_mut, msftx, msfty, msfux, msfuy, &
msfvx, msfvx_inv, msfvy, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
ips,ipe, jps,jpe, kps,kpe, &
its,ite, jts,jte, kts,kte )
IMPLICIT NONE
! Input data.
INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
ips, ipe, jps, jpe, kps, kpe, &
its, ite, jts, jte, kts, kte
INTEGER , INTENT(IN ) :: rk_step
REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN ) :: a_ru_tend, &
a_rv_tend, &
a_rw_tend, &
a_ph_tend, &
a_t_tend
REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: a_ru_tendf, &
a_rv_tendf, &
a_rw_tendf, &
a_ph_tendf, &
a_t_tendf
REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: a_mu_tend
REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: a_mu_tendf
REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: a_u_save, &
a_v_save, &
a_w_save, &
a_ph_save, &
a_t_save, &
a_h_diabatic
REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(IN ) :: h_diabatic
REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: a_mut
REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: mut
REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN ) :: msftx, &
msfty, &
msfux, &
msfuy, &
msfvx, &
msfvx_inv, &
msfvy
! Local
INTEGER :: i, j, k
!
!
! rk_addtend_dry constructs the full large-timestep tendency terms for
! momentum (u,v,w), theta and geopotential equations. This is accomplished
! by combining the physics tendencies (in *tendf; these are computed
! the first RK substep, held fixed thereafter) with the RK tendencies
! (in *tend, these include advection, pressure gradient, etc;
! these change each rk substep). Output is in *tend.
!
!
! Finally, add the forward-step tendency to the rk_tendency
! u/v/w/save contain bc tendency that needs to be multiplied by msf
! (u by msfuy, v by msfvx)
! before adding it to physics tendency (*tendf)
! For momentum we need the final tendency to include an inverse msf
! physics/bc tendency needs to be divided, advection tendency already has it
! For scalars we need the final tendency to include an inverse msf (msfty)
! advection tendency is OK, physics/bc tendency needs to be divided by msf
DO j = jts,MIN(jte,jde-1)
DO i = its,MIN(ite,ide-1)
a_mu_tendf(i,j) = a_mu_tendf(i,j) + a_mu_tend(i,j)
ENDDO
ENDDO
DO j = jts,MIN(jte,jde-1)
DO k = kts,kte-1
DO i = its,MIN(ite,ide-1)
! NPan 05/27/10 {
! If h_diabatic is an active variable, the statement for computing g_t_tend
! should be replaced with the commentted statement.
! g_t_tend(i,k,j) = g_t_tend(i,k,j) + g_t_tendf(i,k,j)/msfty(i,j) &
! + g_mut(i,j)*h_diabatic(i,k,j)/msfty(i,j)
! + mut(i,j)*g_h_diabatic(i,k,j)/msfty(i,j)
a_h_diabatic(i,k,j) = a_h_diabatic(i,k,j) + mut(i,j)*a_t_tend(i,k,j)/msfty(i,j)
a_t_tendf(i,k,j) = a_t_tendf(i,k,j) + a_t_tend(i,k,j)/msfty(i,j)
a_mut(i,j) = a_mut(i,j) + h_diabatic(i,k,j)/msfty(i,j) * a_t_tend(i,k,j)
! NPan }
IF(rk_step == 1)a_t_save(i,k,j) = a_t_save(i,k,j) + a_t_tendf(i,k,j)
ENDDO
ENDDO
ENDDO
DO j = jts,MIN(jte,jde-1)
DO k = kts,kte
DO i = its,MIN(ite,ide-1)
a_ph_tendf(i,k,j) = a_ph_tendf(i,k,j) + a_ph_tend(i,k,j)/msfty(i,j)
IF(rk_step == 1)a_ph_save(i,k,j) = a_ph_save(i,k,j) + a_ph_tendf(i,k,j)
a_rw_tendf(i,k,j) = a_rw_tendf(i,k,j) + a_rw_tend(i,k,j)/msfty(i,j)
IF(rk_step == 1)a_w_save(i,k,j) = a_w_save(i,k,j) + msfty(i,j) * a_rw_tendf(i,k,j)
ENDDO
ENDDO
ENDDO
DO j = jts,jte
DO k = kts,kte-1
DO i = its,MIN(ite,ide-1)
a_rv_tendf(i,k,j) = a_rv_tendf(i,k,j) + msfvx_inv(i,j) * a_rv_tend(i,k,j)
IF(rk_step == 1)a_v_save(i,k,j) = a_v_save(i,k,j) + msfvx(i,j) * a_rv_tendf(i,k,j)
ENDDO
ENDDO
ENDDO
DO j = jts,MIN(jte,jde-1)
DO k = kts,kte-1
DO i = its,ite
a_ru_tendf(i,k,j) = a_ru_tendf(i,k,j) + a_ru_tend(i,k,j)/msfuy(i,j)
IF(rk_step == 1)a_u_save(i,k,j) = a_u_save(i,k,j) + a_ru_tendf(i,k,j)*msfuy(i,j)
ENDDO
ENDDO
ENDDO
END SUBROUTINE a_rk_addtend_dry
!-------------------------------------------------------------------------------
! Revised by Ning Pan, 2010-08-02
! SUBROUTINE a_rk_scalar_tend(scs,sce,config_flags,rk_step,dt,a_dt,ru,a_ru,rv, &
SUBROUTINE a_rk_scalar_tend(scs,sce,config_flags,tenddec,rk_step,dt,ru,a_ru,rv, &
a_rv,ww,a_ww,mut,a_mut,mub,mu_old,a_mu_old,alt,a_alt,scalar_old, &
a_scalar_old,scalar,a_scalar,scalar_tends,a_scalar_tends,advect_tend, &
a_advect_tend,h_tendency,a_h_tendency,z_tendency,a_z_tendency, &
RQVFTEN,a_RQVFTEN,base,moist_step,fnm,fnp,msfux,msfuy,msfvx, &
msfvx_inv,msfvy,msftx,msfty,rdx,rdy,rdn,rdnw,khdif,kvdif,xkmhd,a_xkmhd, &
! Revised by Ning Pan, 2010-08-02
! diff_6th_opt,diff_6th_factor,a_diff_6th_factor,adv_opt,ids,ide,jds,jde,kds,kde,ims, &
diff_6th_opt,diff_6th_factor,adv_opt,ids,ide,jds,jde,kds,kde,ims, &
ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
!PART I: DECLARATION OF VARIABLES
IMPLICIT NONE
INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
TYPE(grid_config_rec_type) :: config_flags
LOGICAL :: tenddec
INTEGER :: rk_step,scs,sce
INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
LOGICAL :: moist_step
REAL,DIMENSION(ims:ime,kms:kme,jms:jme,scs:sce) :: scalar,a_scalar,scalar_old, &
a_scalar_old
REAL,DIMENSION(ims:ime,kms:kme,jms:jme,scs:sce) :: scalar_tends,a_scalar_tends
REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: advect_tend,a_advect_tend
REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: h_tendency, z_tendency
REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: a_h_tendency, a_z_tendency
REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: RQVFTEN,a_RQVFTEN
REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: ru,a_ru,rv,a_rv,ww,a_ww,xkmhd, &
a_xkmhd,alt,a_alt
REAL,DIMENSION(kms:kme) :: fnm,fnp,rdn,rdnw,base
REAL,DIMENSION(ims:ime,jms:jme) :: msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,mub, &
mut,a_mut,mu_old,a_mu_old
REAL :: rdx,rdy,khdif,kvdif
INTEGER :: diff_6th_opt
! Revised by Ning Pan, 2010-08-02
! REAL :: diff_6th_factor,a_diff_6th_factor
! REAL :: dt,a_dt
REAL :: diff_6th_factor
REAL :: dt
INTEGER :: adv_opt
INTEGER :: im,i,j,k
INTEGER :: time_step
REAL :: khdq,kvdq,tendency,a_tendency
! REAL,DIMENSION(ims:ime,kms:kme,jms:jme,scs:sce,ims:ime,kms:kme,jms:jme,scs:sce) &
! :: Keep_Lpb1_scalar
! REAL,DIMENSION(ims:ime,kms:kme,jms:jme,scs:sce,ims:ime,kms:kme,jms:jme,scs:sce) &
! :: Keep_Lpb1_scalar_old
! REAL,DIMENSION(scs:sce,ims:ime,kms:kme,jms:jme) :: Keep_Lpb1_ru
! REAL,DIMENSION(scs:sce,ims:ime,kms:kme,jms:jme) :: Keep_Lpb1_rv
! REAL,DIMENSION(ims:ime,kms:kme,jms:jme,scs:sce,ims:ime,kms:kme,jms:jme,scs:sce) &
! :: Keep_Lpb1_scalar_tends
INTEGER :: IX1,IX2,IX3,IX4
REAL :: Tmpv_1,Tmpv_2,Tmpv_3,Tmpv_4,Tmpv_5,Tmpv_6,Tmpv_7,Tmpv_8,Tmpv_9,Tmpv_10, &
Tmpv_11,Tmpv_12
REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv400
REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv401
!This line is fail to be recognized
! CALL nl_get_time_step ( 1, time_step ) ! Remarked by Ning Pan, 2010-08-02
!PART II: CALCULATIONS OF B. S. TRAJECTORY
!LPB[0]
khdq = khdif/prandtl
kvdq = kvdif/prandtl
!!LPB[1]
! scalar_loop : DO im = scs, sce
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
! ! Keep_Lpb1_ru(im,IX1,IX2,IX3) =ru(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
! ! Keep_Lpb1_rv(im,IX1,IX2,IX3) =rv(IX1,IX2,IX3)
!! END DO
!! END DO
!! END DO
!! DO IX4=scs,sce
!! DO IX3=jms,jme
!! DO IX2=kms,kme
!! DO IX1=ims,ime
! ! Keep_Lpb1_scalar_tends(ims,kms,jms,im,IX1,IX2,IX3,IX4) =scalar_tends(ims,kms,jms,im)(IX1,IX2,IX3,IX4)
!! END DO
!! END DO
!! END DO
!! END DO
! CALL zero_tend ( advect_tend(ims,kms,jms), &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! IF( (rk_step == 3) .and. (adv_opt == POSITIVEDEF) ) THEN
! CALL advect_scalar_pd ( scalar(ims,kms,jms,im), &
! scalar_old(ims,kms,jms,im), &
! advect_tend(ims,kms,jms), &
! ru, rv, ww, mut, mub, mu_old, &
! time_step, config_flags, &
! msfux, msfuy, msfvx, msfvy, &
! msftx, msfty, fnm, fnp, &
! rdx, rdy, rdnw,dt, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! ELSE IF( (rk_step == 3) .and. (adv_opt == MONOTONIC) ) THEN
! CALL advect_scalar_mono ( scalar(ims,kms,jms,im), &
! scalar_old(ims,kms,jms,im), &
! advect_tend(ims,kms,jms), &
! ru, rv, ww, mut, mub, mu_old, &
! config_flags, &
! msfux, msfuy, msfvx, msfvy, &
! msftx, msfty, fnm, fnp, &
! rdx, rdy, rdnw,dt, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! ELSE
! CALL advect_scalar ( scalar(ims,kms,jms,im), &
! scalar(ims,kms,jms,im), &
! advect_tend(ims,kms,jms), &
! ru, rv, ww, mut, time_step, &
! config_flags, &
! msfux, msfuy, msfvx, msfvy, &
! msftx, msfty, fnm, fnp, &
! rdx, rdy, rdnw, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! END IF
! IF((config_flags%cu_physics == GDSCHEME .OR. config_flags%cu_physics == G3SCHEME &
!) .and. moist_step .and. ( im == P_QV) ) THEN
! CALL set_tend( RQVFTEN, advect_tend, msfty, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! ENDIF
! rk_step_1: IF( rk_step == 1 ) THEN
! diff_opt1 : IF (config_flags%diff_opt .eq. 1) THEN
! CALL horizontal_diffusion ( 'm', scalar(ims,kms,jms,im), &
! scalar_tends(ims,kms,jms,im), mut, &
! config_flags, &
! msfux, msfuy, msfvx, msfvx_inv, &
! msfvy, msftx, msfty, &
! khdq , xkmhd, rdx, rdy, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN
! IF( (moist_step) .and. ( im == P_QV)) THEN
! CALL vertical_diffusion_mp ( scalar(ims,kms,jms,im), &
! scalar_tends(ims,kms,jms,im), &
! config_flags, base, &
! alt, mut, rdn, rdnw, kvdq , &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! ELSE
! CALL vertical_diffusion ( 'm', scalar(ims,kms,jms,im), &
! scalar_tends(ims,kms,jms,im), &
! config_flags, &
! alt, mut, rdn, rdnw, kvdq, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! END IF
! ENDIF pbl_test
! ENDIF diff_opt1
! IF ( diff_6th_opt .NE. 0 ) &
! CALL sixth_order_diffusion( 'm', scalar(ims,kms,jms,im), &
! scalar_tends(ims,kms,jms,im), &
! mut, dt, config_flags, &
! diff_6th_opt, diff_6th_factor, &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! ENDIF rk_step_1
! END DO scalar_loop
!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
! a_tendency =0.0 ! Remarked by Ning Pan, 2010-08-02
!PART IV: REVERSE/BACKWARD ACCUMULATIONS
!LPB[1]
DO im =sce, scs, -1
CALL nl_get_time_step ( 1, time_step ) ! Added by Ning Pan, 2010-08-02
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! ru(IX1,IX2,IX3) =Keep_Lpb1_ru(im,IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rv(IX1,IX2,IX3) =Keep_Lpb1_rv(im,IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX4=scs,sce
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! scalar_tends(ims,kms,jms,im)(IX1,IX2,IX3,IX4) =Keep_Lpb1_scalar_tends(ims,kms,jms,im,IX1,IX2,IX3,IX4)
! END DO
! END DO
! END DO
! END DO
! Remarked by Ning Pan, 2010-08-02 : useless recomputation
! CALL zero_tend(advect_tend(ims,kms,jms),ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
! kms,kme,its,ite,jts,jte,kts,kte)
! IF( (rk_step == 3) .and. (adv_opt == POSITIVEDEF) ) THEN
! Tmpv_1 =scalar(ims,kms,jms,im)
! Tmpv_2 =scalar_old(ims,kms,jms,im)
! Tmpv_3 =advect_tend(ims,kms,jms)
! CALL advect_scalar_pd(scalar(ims,kms,jms,im),scalar_old(ims,kms,jms,im) &
! ,advect_tend(ims,kms,jms),ru,rv,ww,mut,mub,mu_old,time_step,config_flags,msfux,msfuy, &
! msfvx,msfvy,msftx,msfty,fnm,fnp,rdx,rdy,rdnw,dt,ids,ide,jds,jde,kds,kde,ims,ime,jms, &
! jme,kms,kme,its,ite,jts,jte,kts,kte)
! ELSE IF( (rk_step == 3) .and. (adv_opt == MONOTONIC) ) THEN
! Tmpv_4 =scalar(ims,kms,jms,im)
! Tmpv_5 =scalar_old(ims,kms,jms,im)
! Tmpv_6 =advect_tend(ims,kms,jms)
! CALL advect_scalar_mono(scalar(ims,kms,jms,im),scalar_old(ims,kms,jms,im) &
! ,advect_tend(ims,kms,jms),ru,rv,ww,mut,mub,mu_old,config_flags,msfux,msfuy,msfvx, &
! msfvy,msftx,msfty,fnm,fnp,rdx,rdy,rdnw,dt,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
! kms,kme,its,ite,jts,jte,kts,kte)
! ELSE
! Tmpv_7 =scalar(ims,kms,jms,im)
! Tmpv_8 =advect_tend(ims,kms,jms)
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv400(IX1,IX2,IX3) =ru(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! Tmpv401(IX1,IX2,IX3) =rv(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! CALL advect_scalar(scalar(ims,kms,jms,im),scalar(ims,kms,jms,im),advect_tend(ims, &
! kms,jms),ru,rv,ww,mut,time_step,config_flags,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm, &
! fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! END IF
! IF((config_flags%cu_physics == GDSCHEME .OR. config_flags%cu_physics == G3SCHEME) .and. moist_step .and. ( im == P_QV) ) THEN
! CALL set_tend(RQVFTEN,advect_tend,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
! kms,kme,its,ite,jts,jte,kts,kte)
! ENDIF
! IF( rk_step == 1 ) THEN
! IF(config_flags%diff_opt .eq. 1) THEN
! Tmpv_9 =scalar_tends(ims,kms,jms,im)
! CALL horizontal_diffusion('m',scalar(ims,kms,jms,im),scalar_tends(ims,kms,jms,im) &
! ,mut,config_flags,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdq,xkmhd,rdx,rdy, &
! ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! IF(config_flags%bl_pbl_physics .eq. 0) THEN
! IF( (moist_step) .and. ( im == P_QV)) THEN
! Tmpv_10 =scalar_tends(ims,kms,jms,im)
! CALL vertical_diffusion_mp(scalar(ims,kms,jms,im),scalar_tends(ims,kms,jms,im) &
! ,config_flags,base,alt,mut,rdn,rdnw,kvdq,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
! kme,its,ite,jts,jte,kts,kte)
! ELSE
! Tmpv_11 =scalar_tends(ims,kms,jms,im)
! CALL vertical_diffusion('m',scalar(ims,kms,jms,im),scalar_tends(ims,kms,jms,im) &
! ,config_flags,alt,mut,rdn,rdnw,kvdq,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
! its,ite,jts,jte,kts,kte)
! END IF
! ENDIF
! ENDIF
! IF( diff_6th_opt .NE. 0 ) THEN
! Tmpv_12 =scalar_tends(ims,kms,jms,im)
! CALL sixth_order_diffusion('m',scalar(ims,kms,jms,im),scalar_tends(ims,kms,jms,im) &
! ,mut,dt,config_flags,diff_6th_opt,diff_6th_factor,ids,ide,jds,jde,kds,kde,ims,ime, &
! jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
! END IF
! ENDIF
IF( rk_step == 1 ) THEN
IF( diff_6th_opt .NE. 0 ) THEN
! scalar_tends(ims,kms,jms,im) =Tmpv_12 ! Remarked by Ning Pan, 2010-08-02
CALL a_sixth_order_diffusion('m',scalar(ims,kms,jms,im),a_scalar(ims,kms,jms, &
im),scalar_tends(ims,kms,jms,im),a_scalar_tends(ims,kms,jms,im),mut,a_mut,dt, &
! Revised by Ning Pan, 2010-08-02
! a_dt,config_flags,diff_6th_opt,diff_6th_factor,a_diff_6th_factor,ids,ide,jds,jde, &
config_flags,diff_6th_opt,diff_6th_factor,ids,ide,jds,jde, &
kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
END IF
IF(config_flags%diff_opt .eq. 1) THEN
IF(config_flags%bl_pbl_physics .eq. 0) THEN
! Added by Ning Pan, 2010-08-02
IF( (moist_step) .and. ( im == P_QV)) THEN
CALL a_vertical_diffusion_mp(scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im) &
,scalar_tends(ims,kms,jms,im),a_scalar_tends(ims,kms,jms,im),config_flags,base,alt, &
a_alt,mut,a_mut,rdn,rdnw,kvdq,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
its,ite,jts,jte,kts,kte)
ELSE
! scalar_tends(ims,kms,jms,im) =Tmpv_11 ! Remarked by Ning Pan, 2010-08-02
CALL a_vertical_diffusion('m',scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im) &
,scalar_tends(ims,kms,jms,im),a_scalar_tends(ims,kms,jms,im),config_flags,alt, &
a_alt,mut,a_mut,rdn,rdnw,kvdq,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
its,ite,jts,jte,kts,kte)
! Remarked by Ning Pan, 2010-08-02
! IF( (moist_step) .and. ( im == P_QV)) THEN
! scalar_tends(ims,kms,jms,im) =Tmpv_10
! CALL a_vertical_diffusion_mp(scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im) &
! ,scalar_tends(ims,kms,jms,im),a_scalar_tends(ims,kms,jms,im),config_flags,base,alt, &
! a_alt,mut,a_mut,rdn,rdnw,kvdq,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
! its,ite,jts,jte,kts,kte)
END IF
ENDIF
! scalar_tends(ims,kms,jms,im) =Tmpv_9 ! Remarked by Ning Pan, 2010-08-02
CALL a_horizontal_diffusion('m',scalar(ims,kms,jms,im),a_scalar(ims,kms,jms, &
im),scalar_tends(ims,kms,jms,im),a_scalar_tends(ims,kms,jms,im),mut,a_mut, &
config_flags,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdq,xkmhd,a_xkmhd,rdx, &
rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
ENDIF
ENDIF
IF((config_flags%cu_physics == GDSCHEME .OR. config_flags%cu_physics == G3SCHEME .OR. &
config_flags%cu_physics == KFETASCHEME .OR. & ! new trigger in KF
config_flags%cu_physics == TIEDTKESCHEME ) & ! Tiedtke
.and. moist_step .and. ( im == P_QV) ) THEN
CALL a_set_tend(RQVFTEN,a_RQVFTEN,advect_tend,a_advect_tend,msfty,ids,ide, &
jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
ENDIF
IF( (rk_step == 3) .and. (adv_opt == POSITIVEDEF) ) THEN
! advect_tend(ims,kms,jms) =Tmpv_3 ! Remarked by Ning Pan, 2010-08-02
! scalar_old(ims,kms,jms,im) =Tmpv_2 ! Remarked by Ning Pan, 2010-08-02
! scalar(ims,kms,jms,im) =Tmpv_1 ! Remarked by Ning Pan, 2010-08-02
CALL a_advect_scalar_pd(scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im) &
,scalar_old(ims,kms,jms,im),a_scalar_old(ims,kms,jms,im),advect_tend(ims,kms,jms) &
,a_advect_tend(ims,kms,jms),h_tendency(ims,kms,jms),a_h_tendency(ims,kms,jms),z_tendency(ims,kms,jms),a_z_tendency(ims,kms,jms) &
,ru,a_ru,rv,a_rv,ww,a_ww,mut,a_mut,mub,mu_old, &
a_mu_old,time_step,config_flags,tenddec,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm,fnp,rdx, &
! Revised by Ning Pan, 2010-08-02
! rdy,rdnw,dt,a_dt,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
rdy,rdnw,dt,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
ELSE IF( (rk_step == 3) .and. (adv_opt == MONOTONIC) ) THEN
! advect_tend(ims,kms,jms) =Tmpv_6 ! Remarked by Ning Pan, 2010-08-02
! scalar_old(ims,kms,jms,im) =Tmpv_5 ! Remarked by Ning Pan, 2010-08-02
! scalar(ims,kms,jms,im) =Tmpv_4 ! Remarked by Ning Pan, 2010-08-02
CALL a_advect_scalar_mono(scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im) &
,scalar_old(ims,kms,jms,im),a_scalar_old(ims,kms,jms,im),advect_tend(ims,kms,jms) &
,a_advect_tend(ims,kms,jms),h_tendency(ims,kms,jms),a_h_tendency(ims,kms,jms),z_tendency(ims,kms,jms),a_z_tendency(ims,kms,jms) &
,ru,a_ru,rv,a_rv,ww,a_ww,mut,a_mut,mub,mu_old, &
a_mu_old,config_flags,tenddec,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm,fnp,rdx,rdy,rdnw,dt, &
! Revised by Ning Pan, 2010-08-02
! a_dt,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
ELSE
! Remarked by Ning Pan, 2010-08-02
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! rv(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! DO IX3=jms,jme
! DO IX2=kms,kme
! DO IX1=ims,ime
! ru(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
! END DO
! END DO
! END DO
! advect_tend(ims,kms,jms) =Tmpv_8
! scalar(ims,kms,jms,im) =Tmpv_7
CALL a_advect_scalar(scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im) &
,scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im),advect_tend(ims,kms,jms) &
,a_advect_tend(ims,kms,jms),ru,a_ru,rv,a_rv,ww,a_ww,mut,a_mut,time_step, &
config_flags,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm,fnp,rdx,rdy,rdnw,ids,ide,jds, &
jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
END IF
! Added by Ning Pan, 2010-08-02
CALL a_zero_tend(a_advect_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
kms,kme,its,ite,jts,jte,kts,kte)
CALL a_zero_tend(a_h_tendency,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
kms,kme,its,ite,jts,jte,kts,kte)
CALL a_zero_tend(a_z_tendency,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
kms,kme,its,ite,jts,jte,kts,kte)
ENDDO
!LPB[0]
! khdq =khdif/prandtl
! kvdq =kvdif/prandtl
END SUBROUTINE a_rk_scalar_tend
!-------------------------------------------------------------------------------
SUBROUTINE a_rk_update_scalar ( scs, sce, &
scalar_1, a_scalar_1, scalar_2, a_scalar_2, sc_tend, a_sc_tend, &
advh_t, a_advh_t, advz_t, a_advz_t, &
advect_tend, a_advect_tend, &
h_tendency, a_h_tendency, z_tendency, a_z_tendency, &
msftx, msfty, &
mu_old, a_mu_old, mu_new, a_mu_new, mu_base, &
rk_step, dt, spec_zone, &
config_flags, &
tenddec, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte )
IMPLICIT NONE
! Input data.
TYPE(grid_config_rec_type), INTENT(IN) :: config_flags
LOGICAL :: tenddec
INTEGER, INTENT(IN) :: scs, sce, rk_step, spec_zone
INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte
REAL, INTENT(IN) :: dt
REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce), &
INTENT(INOUT) :: a_scalar_1, &
a_scalar_2
REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce), &
INTENT(IN) :: scalar_1, &
scalar_2
REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce), &
INTENT(INOUT) :: a_sc_tend
REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce), &
INTENT(IN) :: sc_tend
REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), &
INTENT(INOUT) :: a_advect_tend
REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), &
INTENT(IN) :: advect_tend
REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), OPTIONAL :: advh_t, advz_t ! accumulating for output
REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), OPTIONAL :: a_advh_t, a_advz_t ! accumulating for output
REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) :: h_tendency, z_tendency ! from rk_scalar_tend
REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) :: a_h_tendency, a_z_tendency ! from rk_scalar_tend
REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: a_mu_old, &
a_mu_new
REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN ) :: mu_old, &
mu_new, &
mu_base, &
msftx, &
msfty
INTEGER :: i,j,k,im
REAL :: sc_middle, msfsq
REAL, DIMENSION(its:ite) :: a_muold, a_r_munew
REAL, DIMENSION(its:ite) :: muold, r_munew
REAL, DIMENSION(its:ite, kts:kte, jts:jte ) :: a_tendency
REAL, DIMENSION(its:ite, kts:kte, jts:jte ) :: tendency
REAL, DIMENSION(ims:ime, kms:kme, jms:jme, scs:sce) :: scalar_old
INTEGER :: i_start,i_end,j_start,j_end,k_start,k_end
INTEGER :: i_start_spc,i_end_spc,j_start_spc,j_end_spc,k_start_spc,k_end_spc
! !
! Basic states: mu_old, mu_new, advect_tend, sc_tend, scalar_2(rk_step=1), scalar_1(rk_step/=1)
!
!
! Initilize local adjoint variables
a_muold = 0.0
a_r_munew = 0.0
a_tendency = 0.0
!
! set loop limits.
i_start = its
i_end = min(ite,ide-1)
j_start = jts
j_end = min(jte,jde-1)
k_start = kts
k_end = kte-1
i_start_spc = i_start
i_end_spc = i_end
j_start_spc = j_start
j_end_spc = j_end
k_start_spc = k_start
k_end_spc = k_end
IF( config_flags%nested .or. config_flags%specified ) THEN
IF( .NOT. config_flags%periodic_x)i_start = max( its,ids+spec_zone )
IF( .NOT. config_flags%periodic_x)i_end = min( ite,ide-spec_zone-1 )
j_start = max( jts,jds+spec_zone )
j_end = min( jte,jde-spec_zone-1 )
k_start = kts
k_end = min( kte, kde-1 )
ENDIF
IF ( rk_step == 1 ) THEN
DO im = sce,scs,-1
! Recalculate tendency
DO j = jts, min(jte,jde-1)
DO k = kts, min(kte,kde-1)
DO i = its, min(ite,ide-1)
tendency(i,k,j) = 0.
ENDDO
ENDDO
ENDDO
DO j = j_start,j_end
DO k = k_start,k_end
DO i = i_start,i_end
! scalar was coupled with my
tendency(i,k,j) = advect_tend(i,k,j) * msfty(i,j)
ENDDO
ENDDO
ENDDO
DO j = j_start_spc,j_end_spc
DO k = k_start_spc,k_end_spc
DO i = i_start_spc,i_end_spc
tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im)
ENDDO
ENDDO
ENDDO
DO j = jts, min(jte,jde-1)
! Recalculate muold and r_munew
DO i = its, min(ite,ide-1)
muold(i) = mu_old(i,j) + mu_base(i,j)
r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j))
ENDDO
DO k = kts, min(kte,kde-1)
DO i = its, min(ite,ide-1)
! Recalculate scalar_1 (i.e. scalar_old)
scalar_old(i,k,j,im) = scalar_2(i,k,j,im)
a_scalar_1(i,k,j,im) = a_scalar_1(i,k,j,im) + muold(i)*r_munew(i) * a_scalar_2(i,k,j,im)
a_muold(i) = a_muold(i) + scalar_old(i,k,j,im)*r_munew(i) * a_scalar_2(i,k,j,im)
a_tendency(i,k,j) = a_tendency(i,k,j) + dt*r_munew(i) * a_scalar_2(i,k,j,im)
a_r_munew(i) = a_r_munew(i) + (muold(i)*scalar_old(i,k,j,im)+dt*tendency(i,k,j)) * a_scalar_2(i,k,j,im)
a_scalar_2(i,k,j,im) = 0.0
a_scalar_2(i,k,j,im) = a_scalar_2(i,k,j,im) + a_scalar_1(i,k,j,im)
a_scalar_1(i,k,j,im) = 0.0
ENDDO !i
ENDDO !k
DO i = its, min(ite,ide-1)
a_mu_new(i,j) = a_mu_new(i,j) - a_r_munew(i) / ((mu_new(i,j)+mu_base(i,j))*(mu_new(i,j)+mu_base(i,j)))
a_r_munew(i) = 0.0
a_mu_old(i,j) = a_mu_old(i,j) + a_muold(i)
a_muold(i) = 0.0
ENDDO
ENDDO !j
DO j = j_start_spc,j_end_spc
DO k = k_start_spc,k_end_spc
DO i = i_start_spc,i_end_spc
a_sc_tend(i,k,j,im) = a_sc_tend(i,k,j,im) + a_tendency(i,k,j)
ENDDO
ENDDO
ENDDO
DO j = j_start,j_end
DO k = k_start,k_end
DO i = i_start,i_end
! scalar was coupled with my
a_advect_tend(i,k,j) = a_advect_tend(i,k,j) + msfty(i,j) * a_tendency(i,k,j)
a_tendency(i,k,j) = 0.0
ENDDO
ENDDO
ENDDO
DO j = jts, min(jte,jde-1)
DO k = kts, min(kte,kde-1)
DO i = its, min(ite,ide-1)
a_tendency(i,k,j) = 0.
ENDDO
ENDDO
ENDDO
ENDDO !im
ELSE
DO im = sce, scs, -1
! Recalculate tendency
DO j = jts, min(jte,jde-1)
DO k = kts, min(kte,kde-1)
DO i = its, min(ite,ide-1)
tendency(i,k,j) = 0.
ENDDO
ENDDO
ENDDO
DO j = j_start,j_end
DO k = k_start,k_end
DO i = i_start,i_end
! scalar was coupled with my
tendency(i,k,j) = advect_tend(i,k,j) * msfty(i,j)
ENDDO
ENDDO
ENDDO
DO j = j_start_spc,j_end_spc
DO k = k_start_spc,k_end_spc
DO i = i_start_spc,i_end_spc
tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im)
ENDDO
ENDDO
ENDDO
DO j = jts, min(jte,jde-1)
! Recalculate muold and r_munew
DO i = its, min(ite,ide-1)
muold(i) = mu_old(i,j) + mu_base(i,j)
r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j))
ENDDO
! This is separated from the k/i-loop above for better performance
IF ( PRESENT(advh_t) .AND. PRESENT(advz_t) .AND. PRESENT(a_advh_t) .AND. PRESENT(a_advz_t) ) THEN
IF (tenddec.and.rk_step.eq.config_flags%rk_ord) THEN
DO k = kts, min(kte,kde-1)
DO i = its, min(ite,ide-1)
a_h_tendency(i,k,j) = a_h_tendency(i,k,j) + dt*msfty(i,j)*r_munew(i)*a_advh_t(i,k,j)
a_r_munew(i) = a_r_munew(i) + (dt*h_tendency(i,k,j)* msfty(i,j))*a_advh_t(i,k,j)
a_z_tendency(i,k,j) = a_z_tendency(i,k,j) + dt*msfty(i,j)*r_munew(i)*a_advz_t(i,k,j)
a_r_munew(i) = a_r_munew(i) + (dt*z_tendency(i,k,j)* msfty(i,j))*a_advz_t(i,k,j)
ENDDO
ENDDO
END IF
END IF
DO k = kts, min(kte,kde-1)
DO i = its, min(ite,ide-1)
a_scalar_1(i,k,j,im) = a_scalar_1(i,k,j,im) + muold(i)*r_munew(i) * a_scalar_2(i,k,j,im)
a_muold(i) = a_muold(i) + scalar_1(i,k,j,im)*r_munew(i) * a_scalar_2(i,k,j,im)
a_tendency(i,k,j) = a_tendency(i,k,j) + dt*r_munew(i) * a_scalar_2(i,k,j,im)
a_r_munew(i) = a_r_munew(i) + (muold(i)*scalar_1(i,k,j,im)+dt*tendency(i,k,j)) * a_scalar_2(i,k,j,im)
a_scalar_2(i,k,j,im) = 0.0
ENDDO
ENDDO
DO i = its, min(ite,ide-1)
a_mu_new(i,j) = a_mu_new(i,j) - a_r_munew(i) / ((mu_new(i,j)+mu_base(i,j))*(mu_new(i,j)+mu_base(i,j)))
a_r_munew(i) = 0.0
a_mu_old(i,j) = a_mu_old(i,j) + a_muold(i)
a_muold(i) = 0.0
ENDDO
ENDDO !j
DO j = j_start_spc,j_end_spc
DO k = k_start_spc,k_end_spc
DO i = i_start_spc,i_end_spc
a_sc_tend(i,k,j,im) = a_sc_tend(i,k,j,im) + a_tendency(i,k,j)
ENDDO
ENDDO
ENDDO
DO j = j_start,j_end
DO k = k_start,k_end
DO i = i_start,i_end
! scalar was coupled with my
a_advect_tend(i,k,j) = a_advect_tend(i,k,j) + msfty(i,j) * a_tendency(i,k,j)
a_tendency(i,k,j) = 0.0
ENDDO
ENDDO
ENDDO
DO j = jts, min(jte,jde-1)
DO k = kts, min(kte,kde-1)
DO i = its, min(ite,ide-1)
a_tendency(i,k,j) = 0.
ENDDO
ENDDO
ENDDO
ENDDO !im
END IF
END SUBROUTINE a_rk_update_scalar
!-------------------------------------------------------------------------------
SUBROUTINE a_rk_update_scalar_pd(scs,sce,scalar,a_scalar,sc_tend,a_sc_tend, &
mu_old,a_mu_old,mu_new,a_mu_new,mu_base,rk_step,dt,spec_zone, &
config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
!PART I: DECLARATION OF VARIABLES
IMPLICIT NONE
INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
TYPE(grid_config_rec_type) :: config_flags
INTEGER :: scs,sce,rk_step,spec_zone
INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
REAL :: dt
REAL,DIMENSION(ims:ime,kms:kme,jms:jme,scs:sce) :: scalar,a_scalar,sc_tend,a_sc_tend
REAL,DIMENSION(ims:ime,jms:jme) :: mu_old,a_mu_old,mu_new,a_mu_new,mu_base
INTEGER :: i,j,k,im
REAL :: sc_middle,sfsq
REAL,DIMENSION(its:ite) :: muold,a_muold,r_munew,a_r_munew
REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: tendency,a_tendency
INTEGER :: i_start,i_end,j_start,j_end,k_start,k_end
INTEGER :: i_start_spc,i_end_spc,j_start_spc,j_end_spc,k_start_spc,k_end_spc
REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3
REAL,ALLOCATABLE,DIMENSION(:,:) :: Tmpv300
REAL,DIMENSION(its:min(ite, ide-1),jts:min(jte, jde-1)) :: Tmpv301
REAL,DIMENSION(its:min(ite, ide-1),kts:min(kte, kde-1),jts:min(jte, jde-1)) :: Tmpv400
!PART II: CALCULATIONS OF B. S. TRAJECTORY
!LPB[0]
i_start = its
i_end = min(ite,ide-1)
j_start = jts
j_end = min(jte,jde-1)
k_start = kts
k_end = kte-1
i_start_spc = i_start
i_end_spc = i_end
j_start_spc = j_start
j_end_spc = j_end
k_start_spc = k_start
k_end_spc = k_end
!LPB[1]
IF( config_flags%nested .or. config_flags%specified ) THEN
IF( .NOT. config_flags%periodic_x)i_start = max( its,ids+spec_zone )
IF( .NOT. config_flags%periodic_x)i_end = min( ite,ide-spec_zone-1 )
j_start = max( jts,jds+spec_zone )
j_end = min( jte,jde-spec_zone-1 )
k_start = kts
k_end = min( kte, kde-1 )
ENDIF
!PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
a_muold =0.
a_r_munew =0.
!PART IV: REVERSE/BACKWARD ACCUMULATIONS
!LPB[2]
DO im =sce, scs, -1
tendency(its:min(ite,ide-1),kts:min(kte,kde-1),jts:min(jte,jde-1)) =0.
tendency(i_start_spc:i_end_spc,k_start_spc:k_end_spc,j_start_spc:j_end_spc) =tendency&
(i_start_spc:i_end_spc,k_start_spc:k_end_spc,j_start_spc:j_end_spc) +sc_tend&
(i_start_spc:i_end_spc,k_start_spc:k_end_spc,j_start_spc:j_end_spc,im)
sc_tend(i_start_spc:i_end_spc,k_start_spc:k_end_spc,j_start_spc:j_end_spc,im) =0.
ALLOCATE (Tmpv300(its:min(ite, ide-1),jts:min(jte, jde-1)))
DO j =jts, min(jte, jde-1)
DO i =its, min(ite, ide-1)
Tmpv300(i,j) =mu_old(i,j) +mu_base(i,j)
ENDDO
DO k =kts, min(kte, kde-1)
DO i =its, min(ite, ide-1)
Tmpv400(i,k,j) =Tmpv300(i,j)*scalar(i,k,j,im)+dt*tendency(i,k,j)
ENDDO
ENDDO
ENDDO
DO j =min(jte, jde-1), jts, -1
DO k =kts, min(kte, kde-1)
DO i =its, min(ite, ide-1)
a_r_munew(i) =a_r_munew(i) +Tmpv400(i,k,j)*a_scalar(i,k,j,im)
a_Tmpv1 = a_scalar(i,k,j,im)/(mu_new(i,j)+mu_base(i,j))
a_tendency(i,k,j) =dt*a_Tmpv1
a_muold(i) =a_muold(i) +scalar(i,k,j,im)*a_Tmpv1
a_scalar(i,k,j,im) =Tmpv300(i,j)*a_Tmpv1
ENDDO
ENDDO
DO i =its, min(ite, ide-1)
a_mu_new(i,j) =a_mu_new(i,j)-a_r_munew(i)/(mu_new(i,j)+mu_base(i,j))/(mu_new(i,j)+mu_base(i,j))
ENDDO
a_r_munew(its:min(ite,ide-1)) =0.0
a_mu_old(its:min(ite,ide-1),j) =a_mu_old(its:min(ite,ide-1),j) +a_muold(its:min(ite,ide-1))
a_muold(its:min(ite,ide-1)) =0.0
ENDDO
a_sc_tend(i_start_spc:i_end_spc,k_start_spc:k_end_spc,j_start_spc:j_end_spc,im) =a_tendency(&
i_start_spc:i_end_spc,k_start_spc:k_end_spc,j_start_spc:j_end_spc)
ENDDO
DEALLOCATE (Tmpv300)
END SUBROUTINE a_rk_update_scalar_pd
!------------------------------------------------------------
SUBROUTINE a_init_zero_tendency(a_ru_tendf, &
a_rv_tendf, &
a_rw_tendf, &
a_ph_tendf, &
a_t_tendf, &
a_tke_tendf, &
a_mu_tendf, &
a_moist_tendf, &
! NPan - 05/26/10 {
! Uncomment the corresponding args when chem or tracer is needed.
! a_chem_tendf, &
a_scalar_tendf, &
! a_tracer_tendf, &
! NPan }
n_tracer, &
n_moist,n_chem,n_scalar,rk_step, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte )
!-----------------------------------------------------------------------
IMPLICIT NONE
!-----------------------------------------------------------------------
INTEGER , INTENT(IN ) :: ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte
INTEGER , INTENT(IN ) :: n_moist,n_chem,n_scalar,n_tracer,rk_step
REAL , DIMENSION( ims:ime , kms:kme, jms:jme ) , INTENT(INOUT) :: &
a_ru_tendf, &
a_rv_tendf, &
a_rw_tendf, &
a_ph_tendf, &
a_t_tendf, &
a_tke_tendf
REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT) :: a_mu_tendf
REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),INTENT(INOUT)::&
a_moist_tendf
! NPan - 05/26/10 {
! Uncomment the corresponding definations when chem or tracer is needed.
! REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_chem ),INTENT(INOUT)::&
! a_chem_tendf
! REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_tracer ),INTENT(INOUT)::&
! a_tracer_tendf
REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar ),INTENT(INOUT)::&
a_scalar_tendf
! NPan }
! LOCAL VARS
INTEGER :: im, ic, is
!
!
! init_zero_tendency
! sets tendency arrays to zero for all prognostic variables.
!
!
CALL a_zero_tend ( a_ru_tendf, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte )
CALL a_zero_tend ( a_rv_tendf, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte )
CALL a_zero_tend ( a_rw_tendf, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte )
CALL a_zero_tend ( a_ph_tendf, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte )
CALL a_zero_tend ( a_t_tendf, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte )
CALL a_zero_tend ( a_tke_tendf, &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte )
CALL a_zero_tend ( a_mu_tendf, &
ids, ide, jds, jde, kds, kds, &
ims, ime, jms, jme, kms, kms, &
its, ite, jts, jte, kts, kts )
! DO im=PARAM_FIRST_SCALAR,n_moist
DO im=1,n_moist ! make sure first one is zero too
CALL a_zero_tend ( a_moist_tendf(ims,kms,jms,im), &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte )
ENDDO
! NPan - 05/26/10 {
! Uncomment the corresponding statements when chem or tracer is needed.
!! DO ic=PARAM_FIRST_SCALAR,n_chem
! DO ic=1,n_chem !! make sure first one is zero too
! CALL a_zero_tend ( a_chem_tendf(ims,kms,jms,ic), &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! ENDDO
!! DO ic=PARAM_FIRST_SCALAR,n_tracer
! DO ic=1,n_tracer !! make sure first one is zero too
! CALL a_zero_tend ( a_tracer_tendf(ims,kms,jms,ic), &
! ids, ide, jds, jde, kds, kde, &
! ims, ime, jms, jme, kms, kme, &
! its, ite, jts, jte, kts, kte )
! ENDDO
! DO ic=PARAM_FIRST_SCALAR,n_scalar
DO ic=1,n_scalar ! make sure first one is zero too
CALL a_zero_tend ( a_scalar_tendf(ims,kms,jms,ic), &
ids, ide, jds, jde, kds, kde, &
ims, ime, jms, jme, kms, kme, &
its, ite, jts, jte, kts, kte )
ENDDO
! NPan }
END SUBROUTINE a_init_zero_tendency
!-----------------------------------------------------------------------
! Revised by Ning Pan, 2010-08-03
! SUBROUTINE a_bound_tke(tke,a_tke,tke_upper_bound,a_tke_upper_bound,ids,ide,jds, &
SUBROUTINE a_bound_tke(tke,a_tke,tke_upper_bound,ids,ide,jds, &
jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
!PART I: DECLARATION OF VARIABLES
IMPLICIT NONE
INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tke,a_tke
! Revised by Ning Pan, 2010-08-03
! REAL :: tke_upper_bound,a_tke_upper_bound
REAL :: tke_upper_bound
INTEGER :: i,k,j
REAL :: a_Tmpv1,Tmpv001
!PART IV: REVERSE/BACKWARD ACCUMULATIONS
!LPB[0]
DO j =min(jte, jde-1), jts, -1
! DO k =kts, kte-1
! DO i =its, min(ite, ide-1)
! Tmpv001 =min(tke_upper_bound, max(tke(i,k,j), 0.))
! tke(i,k,j) =Tmpv001
! ENDDO
! ENDDO
DO k =kte-1, kts, -1
DO i =min(ite, ide-1), its, -1
a_Tmpv1 =a_tke(i,k,j)
a_tke(i,k,j) =0.0
! Remarked by Ning Pan, 2010-08-03
! a_tke_upper_bound =a_tke_upper_bound +(1.0 -sign(1.0, tke_upper_bound -max( &
! tke(i,k,j), 0.)))*0.5*1.0*a_Tmpv1
a_tke(i,k,j) =a_tke(i,k,j) +(1.0 +sign(1.0, tke_upper_bound -max(tke(i,k,j) &
, 0.)))*0.5*(1.0 +(1.0)*sign(1.0, tke(i,k,j) -0.))*0.5*a_Tmpv1
ENDDO
ENDDO
ENDDO
END SUBROUTINE a_bound_tke
END MODULE a_module_em