Merge remote-tracking branch 'origin/release-v4.5.2'
[WRF.git] / wrftladj / module_em_ad.F
blob7a99a7521b3f341724be9798efaf41117b508bc3
1 !WRF+/AD:MODEL_LAYER:DYNAMICS
4 MODULE a_module_em
6    USE module_model_constants
7   
8    USE a_module_advect_em, only: a_advect_u, a_advect_v, a_advect_w, a_advect_scalar, a_advect_scalar_pd, a_advect_scalar_mono, &
9         a_advect_weno_u, a_advect_weno_v, a_advect_weno_w, a_advect_scalar_weno,  a_advect_scalar_wenopd
10    
11    USE module_big_step_utilities_em, only: calculate_full, calc_mu_uv
12    USE a_module_big_step_utilities_em, only: grid_config_rec_type, a_calculate_full, a_couple_momentum, a_calc_mu_uv, a_calc_ww_cp, a_calc_cq, a_calc_alt, a_calc_php, a_set_tend, a_rhs_ph, &
13         a_horizontal_pressure_gradient, a_pg_buoy_w, a_w_damp, a_perturbation_coriolis, a_coriolis, a_curvature, a_horizontal_diffusion, a_horizontal_diffusion_3dmp, a_vertical_diffusion_u, &
14         a_vertical_diffusion_v, a_vertical_diffusion, a_vertical_diffusion_3dmp, a_sixth_order_diffusion, a_rk_rayleigh_damp, a_theta_relaxation, a_vertical_diffusion_mp, a_zero_tend, a_zero_tend2d
16    USE module_state_description, only: param_first_scalar, p_qr, p_qv, p_qc, p_qg, p_qi, p_qs, tiedtkescheme, ntiedtkescheme, heldsuarez, positivedef, &
17         gdscheme, g3scheme, kfetascheme, mskfscheme, monotonic, wenopd_scalar, weno_scalar, weno_mom
19    !USE module_damping_em, only: held_suarez_damp
21 CONTAINS
23 !------------------------------------------------------------------------
25    SUBROUTINE a_rk_step_prep(config_flags,rk_step,u,a_u,v,a_v,w,a_w,t,a_t,ph, &
26    a_ph,mu,a_mu,moist,a_moist,ru,a_ru,rv,a_rv,rw,a_rw,ww,a_ww,php,a_php, &
27    alt,a_alt,muu,a_muu,muv,a_muv,mub,mut,a_mut,phb,pb,p,a_p,al,a_al,alb,cqu, &
28    a_cqu,cqv,a_cqv,cqw,a_cqw,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,fnm, &
29    fnp,dnw,rdx,rdy,n_moist,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts, &
30    jte,kts,kte)
32 !PART I: DECLARATION OF VARIABLES
34    IMPLICIT NONE
36    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
37    TYPE(grid_config_rec_type) :: config_flags
38    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
39    INTEGER :: n_moist,rk_step
40    REAL :: rdx,rdy
41    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: u,a_u,v,a_v,w,a_w,t,a_t,ph,a_ph, &
42    phb,pb,al,a_al,alb
43    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: ru,a_ru,rv,a_rv,rw,a_rw,ww,a_ww, &
44    php,a_php,cqu,a_cqu,cqv,a_cqv,cqw,a_cqw,alt,a_alt
45    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: p,a_p
46    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist,a_moist
47    REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty,msfux,msfuy,msfvx,msfvx_inv,msfvy,mu, &
48    a_mu,mub
49    REAL,DIMENSION(ims:ime,jms:jme) :: muu,a_muu,muv,a_muv,mut,a_mut
50    REAL,DIMENSION(kms:kme) :: fnm,fnp,dnw
51    integer :: k
53 !PART II: CALCULATIONS OF B. S. TRAJECTORY
55 !!LPB[0]
56 !      CALL calculate_full( mut, mub, mu,               &
57 !                           ids, ide, jds, jde, 1, 2,   &
58 !                           ims, ime, jms, jme, 1, 1,   &
59 !                           its, ite, jts, jte, 1, 1 )
60 !      CALL calc_mu_uv ( config_flags,                    &
61 !                        mu, mub, muu, muv,               &
62 !                        ids, ide, jds, jde, kds, kde,    &
63 !                        ims, ime, jms, jme, kms, kme,    &
64 !                        its, ite, jts, jte, kts, kte  )
65 !      CALL couple_momentum( muu, ru, u, msfuy,               &
66 !                            muv, rv, v, msfvx, msfvx_inv,    &
67 !                            mut, rw, w, msfty,               &
68 !                            ids, ide, jds, jde, kds, kde,    &
69 !                            ims, ime, jms, jme, kms, kme,    &
70 !                            its, ite, jts, jte, kts, kte  )
71 !      CALL calc_ww_cp ( u, v, mu, mub, ww,                 &
72 !                        rdx, rdy, msftx, msfty,            &
73 !                        msfux, msfuy, msfvx, msfvx_inv,    &
74 !                        msfvy, dnw,                        &
75 !                        ids, ide, jds, jde, kds, kde,      &
76 !                        ims, ime, jms, jme, kms, kme,      &
77 !                        its, ite, jts, jte, kts, kte    )
78 !      CALL calc_cq ( moist, cqu, cqv, cqw, n_moist,   &
79 !                     ids, ide, jds, jde, kds, kde,    &
80 !                     ims, ime, jms, jme, kms, kme,    &
81 !                     its, ite, jts, jte, kts, kte  )
82 !      CALL calc_alt ( alt, al, alb,                   &
83 !                      ids, ide, jds, jde, kds, kde,   &
84 !                      ims, ime, jms, jme, kms, kme,   &
85 !                      its, ite, jts, jte, kts, kte )
86 !      CALL calc_php ( php, ph, phb,                   &
87 !                      ids, ide, jds, jde, kds, kde,   &
88 !                      ims, ime, jms, jme, kms, kme,   &
89 !                      its, ite, jts, jte, kts, kte )
91 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
93 !LPB[0]
94    CALL calculate_full(mut,mub,mu,ids,ide,jds,jde,1,2,ims,ime,jms,jme,1,1,its,ite,  &
95    jts,jte,1,1)
97    CALL calc_mu_uv(config_flags,mu,mub,muu,muv,ids,ide,jds,jde,kds,kde,ims,ime,jms,  &
98    jme,kms,kme,its,ite,jts,jte,kts,kte)
100 !  Remarked by Ning Pan, 2010-07-13
101 !   CALL couple_momentum(muu,ru,u,msfuy,muv,rv,v,msfvx,msfvx_inv,mut,rw,w,msfty,ids,  &
102 !   ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
104 !   CALL calc_ww_cp(u,v,mu,mub,ww,rdx,rdy,msftx,msfty,msfux,msfuy,msfvx,msfvx_inv,  &
105 !   msfvy,dnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
107 !   CALL calc_cq(moist,cqu,cqv,cqw,n_moist,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
108 !   kms,kme,its,ite,jts,jte,kts,kte)
110 !   CALL calc_alt(alt,al,alb,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,  &
111 !   jts,jte,kts,kte)
113 !   CALL calc_php(php,ph,phb,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,  &
114 !   jts,jte,kts,kte)
116    CALL a_calc_php(php,a_php,ph,a_ph,phb,ids,ide,jds,jde,kds,kde,ims,ime,jms,  &
117    jme,kms,kme,its,ite,jts,jte,kts,kte)
118    CALL a_calc_alt(alt,a_alt,al,a_al,alb,ids,ide,jds,jde,kds,kde,ims,ime,jms,  &
119    jme,kms,kme,its,ite,jts,jte,kts,kte)
120    CALL a_calc_cq(moist,a_moist,cqu,a_cqu,cqv,a_cqv,cqw,a_cqw,n_moist,ids,  &
121    ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
122    CALL a_calc_ww_cp(u,a_u,v,a_v,mu,a_mu,mub,ww,a_ww,rdx,rdy,msftx,msfty,  &
123    msfux,msfuy,msfvx,msfvx_inv,msfvy,dnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
124    kme,its,ite,jts,jte,kts,kte)
125 !   Revised by Ning Pan, 2010-07-13
126 !   CALL a_couple_momentum(muu,a_muu,ru,a_ru,u,a_u,msfuy,muv,a_muv,rv,  &
127 !   a_rv,v,a_v,msfvx,msfvx_inv,mut,a_mut,rw,a_rw,w,a_w,msfty,ids,ide,jds,jde,  &
128 !   kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
129    CALL a_couple_momentum(muu,a_muu,a_ru,u,a_u,msfuy,muv,a_muv,  &
130    a_rv,v,a_v,msfvx,msfvx_inv,mut,a_mut,a_rw,w,a_w,msfty,ids,ide,jds,jde,  &
131    kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
132 !  Revised by Ning Pan, 2010-07-13
133 !   CALL a_calc_mu_uv(config_flags,mu,a_mu,mub,muu,a_muu,muv,a_muv,ids,ide,  &
134 !   jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
135    CALL a_calc_mu_uv(config_flags,a_mu,a_muu,a_muv,ids,ide,  &
136    jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
137 !  Revised by Ning Pan, 2010-07-13
138 !   CALL a_calculate_full(mut,a_mut,mub,mu,a_mu,ids,ide,jds,jde,1,2,ims,ime,jms,  &
139 !   jme,1,1,its,ite,jts,jte,1,1)
140    CALL a_calculate_full(a_mut,a_mu,ids,ide,jds,jde,1,2,ims,ime,jms,  &
141    jme,1,1,its,ite,jts,jte,1,1)
143    END SUBROUTINE a_rk_step_prep
145 !-------------------------------------------------------------------------------
147    SUBROUTINE a_rk_tendency(config_flags,rk_step,ru_tend,a_ru_tend,rv_tend, &
148    a_rv_tend,rw_tend,a_rw_tend,ph_tend,a_ph_tend,t_tend,a_t_tend,ru_tendf, &
149    a_ru_tendf,rv_tendf,a_rv_tendf,rw_tendf,a_rw_tendf,ph_tendf,a_ph_tendf, &
150    t_tendf,a_t_tendf,mu_tend,a_mu_tend,u_save,a_u_save,v_save,a_v_save,w_save, &
151    a_w_save,ph_save,a_ph_save,t_save,a_t_save,mu_save,a_mu_save,RTHFTEN, &
152    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, &
153    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, &
154 ! Revised by Ning Pan, 2010-07-30
155 !   a_ph_old,h_diabatic,a_h_diabatic,phb,t_init,a_t_init,mu,a_mu,mut,a_mut,muu, &
156    a_ph_old,h_diabatic,a_h_diabatic,phb,t_init,mu,a_mu,mut,a_mut,muu, &
157    a_muu,muv,a_muv,mub,al,a_al,alt,a_alt,p,a_p,pb,php,a_php,cqu,a_cqu,cqv, &
158    a_cqv,cqw,a_cqw,u_base,v_base,t_base,qv_base,z_base,msfux,msfuy,msfvx,msfvx_inv, &
159 ! Revised by Ning Pan, 2010-07-30
160 !   msfvy,msftx,msfty,xlat,a_xlat,f,e,sina,cosa,fnm,fnp,rdn,rdnw,dt,rdx,rdy,khdif, &
161 !   kvdif,xkmhd,a_xkmhd,xkhh,a_xkhh,diff_6th_opt,diff_6th_factor,a_diff_6th_factor, &
162 !   dampcoef,a_dampcoef,zdamp,a_zdamp,damp_opt,cf1,cf2,cf3,cfn,cfn1,n_moist, &
163 !   non_hydrostatic,top_lid,u_frame,a_u_frame,v_frame,a_v_frame,ids,ide,jds,jde,kds, &
164 !   kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte,max_vert_cfl,a_max_vert_cfl, &
165 !   max_horiz_cfl,a_max_horiz_cfl)
166    msfvy,msftx,msfty,xlat,f,e,sina,cosa,fnm,fnp,rdn,rdnw,dt,rdx,rdy,khdif, &
167    kvdif,xkmhd,a_xkmhd,xkhh,a_xkhh,diff_6th_opt,diff_6th_factor, &
168    adv_opt,dampcoef,zdamp,damp_opt,rad_nudge,cf1,cf2,cf3,cfn,cfn1,n_moist, &
169    non_hydrostatic,top_lid,u_frame,v_frame,ids,ide,jds,jde,kds, &
170    kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte,max_vert_cfl, &
171    max_horiz_cfl)
173 ! PART I: DECLARATION OF VARIABLES
175    IMPLICIT NONE
177    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
178    TYPE(grid_config_rec_type) :: config_flags
179    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
180    LOGICAL :: non_hydrostatic,top_lid
181    INTEGER :: n_moist,rk_step
182    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: ru,a_ru,rv,a_rv,rw,a_rw,ww,a_ww,u, &
183    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, &
184    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, &
185 ! Revised by Ning Pan, 2010-07-30
186 !   a_php,cqu,a_cqu,cqv,a_cqv,t_init,a_t_init,xkmhd,a_xkmhd,xkhh,a_xkhh, &
187    a_php,cqu,a_cqu,cqv,a_cqv,t_init,xkmhd,a_xkmhd,xkhh,a_xkhh, &
188    h_diabatic,a_h_diabatic
189    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: ru_tend,a_ru_tend,rv_tend,a_rv_tend, &
190    rw_tend,a_rw_tend,t_tend,a_t_tend,ph_tend,a_ph_tend,RTHFTEN,a_RTHFTEN,u_save, &
191    a_u_save,v_save,a_v_save,w_save,a_w_save,ph_save,a_ph_save,t_save,a_t_save
192    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: ru_tendf,a_ru_tendf,rv_tendf, &
193    a_rv_tendf,rw_tendf,a_rw_tendf,t_tendf,a_t_tendf,ph_tendf,a_ph_tendf,cqw,a_cqw
194    REAL,DIMENSION(ims:ime,jms:jme) :: mu_tend,a_mu_tend,mu_save,a_mu_save
195    REAL,DIMENSION(ims:ime,jms:jme) :: msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty, &
196 ! Revised by Ning Pan, 2010-07-30
197 !   xlat,a_xlat,f,e,sina,cosa,mu,a_mu,mut,a_mut,mub,muu,a_muu,muv,a_muv
198    xlat,f,e,sina,cosa,mu,a_mu,mut,a_mut,mub,muu,a_muu,muv,a_muv
199    REAL,DIMENSION(kms:kme) :: fnm,fnp,rdn,rdnw,u_base,v_base,t_base,qv_base,z_base
200 ! Revised by Ning Pan, 2010-07-30
201 !   REAL :: rdx,rdy,dt,u_frame,a_u_frame,v_frame,a_v_frame,khdif,kvdif
202    REAL :: rdx,rdy,dt,u_frame,v_frame,khdif,kvdif
203    INTEGER :: diff_6th_opt
204 ! Revised by Ning Pan, 2010-07-30
205 !   REAL :: diff_6th_factor,a_diff_6th_factor
206    REAL :: diff_6th_factor
207    INTEGER :: adv_opt
208    INTEGER :: damp_opt,rad_nudge
209 ! Revised by Ning Pan, 2010-07-30
210 !   REAL :: zdamp,a_zdamp,dampcoef,a_dampcoef
211 !   REAL :: max_horiz_cfl,a_max_horiz_cfl
212 !   REAL :: max_vert_cfl,a_max_vert_cfl
213    REAL :: zdamp,dampcoef
214    REAL :: max_horiz_cfl
215    REAL :: max_vert_cfl
216 ! Revised by Ning Pan, 2010-07-30
217 !   REAL :: kdift,a_kdift,khdq,a_khdq,kvdq,a_kvdq,cfn,cfn1,cf1,cf2,cf3
218    REAL :: kdift,khdq,kvdq,cfn,cfn1,cf1,cf2,cf3
219    INTEGER :: i,j,k
220    INTEGER :: time_step
222 ! Remarked by Ning Pan, 2010-07-30
223 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb0_u
224 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb0_v
225 !   REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb1_w   
226 !   REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb1_rw_tend
227 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb2_t   
228 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb2_t_tend
229 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb2_ru
230 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb2_rv   
231 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb4_ph_tend   
232 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb4_ru_tend   
233 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb4_rv_tend   
234 !   REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb5_rw_tend   
235 !   REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb5_cqw   
236 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb6_rw_tend   
237 !   REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb7_ru_tend   
238 !   REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb7_rv_tend   
239 !   REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb7_rw_tend   
240 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb8_ru_tend   
241 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb8_rv_tend   
242 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb8_rw_tend   
243 !   REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb9_ru_tend   
244 !   REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb9_rv_tend   
245 !!  REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb11_ru_tendf   
246 !!  REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb11_rv_tendf   
247 !!  REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb11_rw_tendf   
248 !!  REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb11_t_tendf   
249 !   INTEGER :: IX1,IX2,IX3
250 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv400
251 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv401
252 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv402
253 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv403
254 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv404
255 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv405
256 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv406
257 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv407
258 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv408
259 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv409
260 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv4010
261 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv4011
262 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv4012
263 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv4013
264 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv4014
265 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv4015
267 !   REAL :: Const_Diff_A0,Const_A0
269 ! This line is fail to be recognized
270       CALL nl_get_time_step ( 1, time_step )
272 ! Remarked by Ning Pan, 2010-07-30 : Part II is not needed
273 !! PART! II: CALCULATIONS OF B. S. TRAJECTORY
275 !! LPB[0]
276 !   DO IX3=jms,jme
277 !   DO IX2=kms,kme
278 !   DO IX1=ims,ime
279 !       Keep_Lpb0_u(IX1,IX2,IX3) =u(IX1,IX2,IX3)
280 !   END DO
281 !   END DO
282 !   END DO
283 !   DO IX3=jms,jme
284 !   DO IX2=kms,kme
285 !   DO IX1=ims,ime
286 !       Keep_Lpb0_v(IX1,IX2,IX3) =v(IX1,IX2,IX3)
287 !   END DO
288 !   END DO
289 !   END DO
291 !      CALL zero_tend ( ru_tend,                        &
292 !                       ids, ide, jds, jde, kds, kde,   &
293 !                       ims, ime, jms, jme, kms, kme,   &
294 !                       its, ite, jts, jte, kts, kte )
295 !      CALL zero_tend ( rv_tend,                        &
296 !                       ids, ide, jds, jde, kds, kde,   &
297 !                       ims, ime, jms, jme, kms, kme,   &
298 !                       its, ite, jts, jte, kts, kte )
299 !      CALL zero_tend ( rw_tend,                        &
300 !                       ids, ide, jds, jde, kds, kde,   &
301 !                       ims, ime, jms, jme, kms, kme,   &
302 !                       its, ite, jts, jte, kts, kte )
303 !      CALL zero_tend ( t_tend,                         &
304 !                       ids, ide, jds, jde, kds, kde,   &
305 !                       ims, ime, jms, jme, kms, kme,   &
306 !                       its, ite, jts, jte, kts, kte )
307 !      CALL zero_tend ( ph_tend,                        &
308 !                       ids, ide, jds, jde, kds, kde,   &
309 !                       ims, ime, jms, jme, kms, kme,   &
310 !                       its, ite, jts, jte, kts, kte )
311 !      CALL zero_tend ( u_save,                         &
312 !                       ids, ide, jds, jde, kds, kde,   &
313 !                       ims, ime, jms, jme, kms, kme,   &
314 !                       its, ite, jts, jte, kts, kte )
315 !      CALL zero_tend ( v_save,                         &
316 !                       ids, ide, jds, jde, kds, kde,   &
317 !                       ims, ime, jms, jme, kms, kme,   &
318 !                       its, ite, jts, jte, kts, kte )
319 !      CALL zero_tend ( w_save,                         &
320 !                       ids, ide, jds, jde, kds, kde,   &
321 !                       ims, ime, jms, jme, kms, kme,   &
322 !                       its, ite, jts, jte, kts, kte )
323 !      CALL zero_tend ( ph_save,                         &
324 !                       ids, ide, jds, jde, kds, kde,   &
325 !                       ims, ime, jms, jme, kms, kme,   &
326 !                       its, ite, jts, jte, kts, kte )
327 !      CALL zero_tend ( t_save,                         &
328 !                       ids, ide, jds, jde, kds, kde,   &
329 !                       ims, ime, jms, jme, kms, kme,   &
330 !                       its, ite, jts, jte, kts, kte )
331 !      CALL zero_tend ( mu_tend,                    &
332 !                       ids, ide, jds, jde, 1, 1,   &
333 !                       ims, ime, jms, jme, 1, 1,   &
334 !                       its, ite, jts, jte, 1, 1 )
335 !      CALL zero_tend ( mu_save,                    &
336 !                       ids, ide, jds, jde, 1, 1,   &
337 !                       ims, ime, jms, jme, 1, 1,   &
338 !                       its, ite, jts, jte, 1, 1 )
339 !      CALL advect_u ( u, u , ru_tend, ru, rv, ww,     &
340 !                      mut, time_step, config_flags,   &
341 !                      msfux, msfuy, msfvx, msfvy,     &
342 !                      msftx, msfty,                   &
343 !                      fnm, fnp, rdx, rdy, rdnw,       &
344 !                      ids, ide, jds, jde, kds, kde,   &
345 !                      ims, ime, jms, jme, kms, kme,   &
346 !                      its, ite, jts, jte, kts, kte )
347 !      CALL advect_v ( v, v , rv_tend, ru, rv, ww,     &
348 !                      mut, time_step, config_flags,   &
349 !                      msfux, msfuy, msfvx, msfvy,     &
350 !                      msftx, msfty,                   &
351 !                      fnm, fnp, rdx, rdy, rdnw,       &
352 !                      ids, ide, jds, jde, kds, kde,   &
353 !                      ims, ime, jms, jme, kms, kme,   &
354 !                      its, ite, jts, jte, kts, kte )
356 !LPB[1]
357 !   DO IX3=jms,jme
358 !   DO IX2=kms,kme
359 !   DO IX1=ims,ime
360 !       Keep_Lpb1_w(IX1,IX2,IX3) =w(IX1,IX2,IX3)
361 !   END DO
362 !   END DO
363 !   END DO
364 !   DO IX3=jms,jme
365 !   DO IX2=kms,kme
366 !   DO IX1=ims,ime
367 !       Keep_Lpb1_rw_tend(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
368 !   END DO
369 !   END DO
370 !   END DO
372 !   IF (non_hydrostatic)                            &
373 !     CALL advect_w ( w, w, rw_tend, ru, rv, ww,      &
374 !                     mut, time_step, config_flags,   &
375 !                     msfux, msfuy, msfvx, msfvy,     &
376 !                     msftx, msfty,                   &
377 !                     fnm, fnp, rdx, rdy, rdn,        &
378 !                     ids, ide, jds, jde, kds, kde,   &
379 !                     ims, ime, jms, jme, kms, kme,   &
380 !                     its, ite, jts, jte, kts, kte )
382 !LPB[2]
383 !   DO IX3=jms,jme
384 !   DO IX2=kms,kme
385 !   DO IX1=ims,ime
386 !       Keep_Lpb2_t(IX1,IX2,IX3) =t(IX1,IX2,IX3)
387 !   END DO
388 !   END DO
389 !   END DO
390 !   DO IX3=jms,jme
391 !   DO IX2=kms,kme
392 !   DO IX1=ims,ime
393 !       Keep_Lpb2_t_tend(IX1,IX2,IX3) =t_tend(IX1,IX2,IX3)
394 !   END DO
395 !   END DO
396 !   END DO
397 !   DO IX3=jms,jme
398 !   DO IX2=kms,kme
399 !   DO IX1=ims,ime
400 !       Keep_Lpb2_ru(IX1,IX2,IX3) =ru(IX1,IX2,IX3)
401 !   END DO
402 !   END DO
403 !   END DO
404 !   DO IX3=jms,jme
405 !   DO IX2=kms,kme
406 !   DO IX1=ims,ime
407 !       Keep_Lpb2_rv(IX1,IX2,IX3) =rv(IX1,IX2,IX3)
408 !   END DO
409 !   END DO
410 !   END DO
412 !        CALL advect_scalar ( t, t, t_tend, ru, rv, ww,       &
413 !                             mut, time_step, config_flags,   &
414 !                             msfux, msfuy, msfvx, msfvy,     &
415 !                             msftx, msfty, fnm, fnp,         &
416 !                             rdx, rdy, rdnw,                 &
417 !                             ids, ide, jds, jde, kds, kde,   &
418 !                             ims, ime, jms, jme, kms, kme,   &
419 !                             its, ite, jts, jte, kts, kte ) 
421 !LPB[3]
422 !     IF ( config_flags%cu_physics == GDSCHEME  .OR.       &
423 !          config_flags%cu_physics == G3SCHEME ) THEN
425 !            CALL set_tend( RTHFTEN, t_tend, msfty,            &
426 !                           ids, ide, jds, jde, kds, kde,      &
427 !                           ims, ime, jms, jme, kms, kme,      &
428 !                           its, ite, jts, jte, kts, kte     )
430 !   END IF
432 !LPB[4]
433 !   DO IX3=jms,jme
434 !   DO IX2=kms,kme
435 !   DO IX1=ims,ime
436 !       Keep_Lpb4_ph_tend(IX1,IX2,IX3) =ph_tend(IX1,IX2,IX3)
437 !   END DO
438 !   END DO
439 !   END DO
440 !   DO IX3=jms,jme
441 !   DO IX2=kms,kme
442 !   DO IX1=ims,ime
443 !       Keep_Lpb4_ru_tend(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
444 !   END DO
445 !   END DO
446 !   END DO
447 !   DO IX3=jms,jme
448 !   DO IX2=kms,kme
449 !   DO IX1=ims,ime
450 !       Keep_Lpb4_rv_tend(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
451 !   END DO
452 !   END DO
453 !   END DO
455 !        CALL rhs_ph( ph_tend, u, v, ww, ph, ph, phb, w,   &
456 !                     mut, muu, muv,                       &
457 !                     fnm, fnp,                            &
458 !                     rdnw, cfn, cfn1, rdx, rdy,           &
459 !                     msfux, msfuy, msfvx,                 &
460 !                     msfvx_inv, msfvy,                    &
461 !                     msftx, msfty,                        &
462 !                     non_hydrostatic,                     &
463 !                     config_flags,                        &
464 !                     ids, ide, jds, jde, kds, kde,        &
465 !                     ims, ime, jms, jme, kms, kme,        &
466 !                     its, ite, jts, jte, kts, kte      )
467 !        CALL horizontal_pressure_gradient( ru_tend,rv_tend,                  &
468 !                                            ph,alt,p,pb,al,php,cqu,cqv,       &
469 !                                            muu,muv,mu,fnm,fnp,rdnw,          &
470 !                                            cf1,cf2,cf3,cfn,cfn1,             &
471 !                                            rdx,rdy,msfux,msfuy,              &
472 !                                            msfvx,msfvy,msftx,msfty,          &
473 !                                            config_flags, non_hydrostatic,    &
474 !                                            top_lid,                          &
475 !                                            ids, ide, jds, jde, kds, kde,     &
476 !                                            ims, ime, jms, jme, kms, kme,     &
477 !                                            its, ite, jts, jte, kts, kte   )
479 !LPB[5]
480 !   DO IX3=jms,jme
481 !   DO IX2=kms,kme
482 !   DO IX1=ims,ime
483 !       Keep_Lpb5_rw_tend(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
484 !   END DO
485 !   END DO
486 !   END DO
487 !   DO IX3=jms,jme
488 !   DO IX2=kms,kme
489 !   DO IX1=ims,ime
490 !       Keep_Lpb5_cqw(IX1,IX2,IX3) =cqw(IX1,IX2,IX3)
491 !   END DO
492 !   END DO
493 !   END DO
495 !     IF (non_hydrostatic) THEN
497 !             CALL pg_buoy_w( rw_tend, p, cqw, mu, mub,         &
498 !                             rdnw, rdn, g, msftx, msfty,       &
499 !                             ids, ide, jds, jde, kds, kde,     &
500 !                             ims, ime, jms, jme, kms, kme,     &
501 !                             its, ite, jts, jte, kts, kte   )
503 !   ENDIF
505 !LPB[6]
506 !   DO IX3=jms,jme
507 !   DO IX2=kms,kme
508 !   DO IX1=ims,ime
509 !       Keep_Lpb6_rw_tend(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
510 !   END DO
511 !   END DO
512 !   END DO
514 !        CALL w_damp   ( rw_tend, max_vert_cfl,              &
515 !                         max_horiz_cfl,                    &
516 !                         u, v, ww, w, mut, rdnw,           &
517 !                         rdx, rdy, msfux, msfuy, msfvx,    &
518 !                         msfvy, dt, config_flags,          &
519 !                         ids, ide, jds, jde, kds, kde,     &
520 !                         ims, ime, jms, jme, kms, kme,     &
521 !                         its, ite, jts, jte, kts, kte   )
523 !LPB[7]
524 !   DO IX3=jms,jme
525 !   DO IX2=kms,kme
526 !   DO IX1=ims,ime
527 !       Keep_Lpb7_ru_tend(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
528 !   END DO
529 !   END DO
530 !   END DO
531 !   DO IX3=jms,jme
532 !   DO IX2=kms,kme
533 !   DO IX1=ims,ime
534 !       Keep_Lpb7_rv_tend(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
535 !   END DO
536 !   END DO
537 !   END DO
538 !   DO IX3=jms,jme
539 !   DO IX2=kms,kme
540 !   DO IX1=ims,ime
541 !       Keep_Lpb7_rw_tend(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
542 !   END DO
543 !   END DO
544 !   END DO
546 !     IF(config_flags%pert_coriolis) THEN
548 !             CALL perturbation_coriolis ( ru, rv, rw,                     &
549 !                                          ru_tend,  rv_tend,  rw_tend,    &
550 !                                          config_flags,                   &
551 !                                          u_base, v_base, z_base,         &
552 !                                          muu, muv, phb, ph,              &
553 !                                          msftx, msfty, msfux, msfuy,     &
554 !                                          msfvx, msfvy,                   &
555 !                                          f, e, sina, cosa, fnm, fnp,     &
556 !                                          ids, ide, jds, jde, kds, kde,   &
557 !                                          ims, ime, jms, jme, kms, kme,   &
558 !                                          its, ite, jts, jte, kts, kte )
559 !        ELSE
560 !             CALL coriolis ( ru, rv, rw,                     &
561 !                             ru_tend,  rv_tend,  rw_tend,    &
562 !                             config_flags,                   &
563 !                             msftx, msfty, msfux, msfuy,     &
564 !                             msfvx, msfvy,                   &
565 !                             f, e, sina, cosa, fnm, fnp,     &
566 !                             ids, ide, jds, jde, kds, kde,   &
567 !                             ims, ime, jms, jme, kms, kme,   &
568 !                             its, ite, jts, jte, kts, kte )
570 !   END IF
572 !LPB[8]
573 !   DO IX3=jms,jme
574 !   DO IX2=kms,kme
575 !   DO IX1=ims,ime
576 !       Keep_Lpb8_ru_tend(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
577 !   END DO
578 !   END DO
579 !   END DO
580 !   DO IX3=jms,jme
581 !   DO IX2=kms,kme
582 !   DO IX1=ims,ime
583 !       Keep_Lpb8_rv_tend(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
584 !   END DO
585 !   END DO
586 !   END DO
587 !   DO IX3=jms,jme
588 !   DO IX2=kms,kme
589 !   DO IX1=ims,ime
590 !       Keep_Lpb8_rw_tend(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
591 !   END DO
592 !   END DO
593 !   END DO
595 !        CALL curvature ( ru, rv, rw, u, v, w,              &
596 !                          ru_tend,  rv_tend,  rw_tend,      &
597 !                          config_flags,                     &
598 !                          msfux, msfuy, msfvx, msfvy,       &
599 !                          msftx, msfty,                     &
600 !                          xlat, fnm, fnp, rdx, rdy,         &
601 !                          ids, ide, jds, jde, kds, kde,     &
602 !                          ims, ime, jms, jme, kms, kme,     &
603 !                          its, ite, jts, jte, kts, kte   )
605 !LPB[9]
606 !   DO IX3=jms,jme
607 !   DO IX2=kms,kme
608 !   DO IX1=ims,ime
609 !       Keep_Lpb9_ru_tend(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
610 !   END DO
611 !   END DO
612 !   END DO
613 !   DO IX3=jms,jme
614 !   DO IX2=kms,kme
615 !   DO IX1=ims,ime
616 !       Keep_Lpb9_rv_tend(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
617 !   END DO
618 !   END DO
619 !   END DO
621 !      IF (config_flags%ra_lw_physics == HELDSUAREZ) THEN
623 !            CALL held_suarez_damp ( ru_tend, rv_tend,                    &
624 !                                    ru,rv,p,pb,                       &
625 !                                    ids, ide, jds, jde, kds, kde,     &
626 !                                    ims, ime, jms, jme, kms, kme,     &
627 !                                    its, ite, jts, jte, kts, kte   )
629 !   END IF
631 !LPB[10]
633 !!LPB[11]
634 !!  DO IX3=jms,jme
635 !!  DO IX2=kms,kme
636 !!  DO IX1=ims,ime
637 !    !  Keep_Lpb11_ru_tendf(IX1,IX2,IX3) =ru_tendf(IX1,IX2,IX3)
638 !!  END DO
639 !!  END DO
640 !!  END DO
641 !!  DO IX3=jms,jme
642 !!  DO IX2=kms,kme
643 !!  DO IX1=ims,ime
644 !    !  Keep_Lpb11_rv_tendf(IX1,IX2,IX3) =rv_tendf(IX1,IX2,IX3)
645 !!  END DO
646 !!  END DO
647 !!  END DO
648 !!  DO IX3=jms,jme
649 !!  DO IX2=kms,kme
650 !!  DO IX1=ims,ime
651 !    !  Keep_Lpb11_rw_tendf(IX1,IX2,IX3) =rw_tendf(IX1,IX2,IX3)
652 !!  END DO
653 !!  END DO
654 !!  END DO
655 !!  DO IX3=jms,jme
656 !!  DO IX2=kms,kme
657 !!  DO IX1=ims,ime
658 !    !  Keep_Lpb11_t_tendf(IX1,IX2,IX3) =t_tendf(IX1,IX2,IX3)
659 !!  END DO
660 !!  END DO
661 !!  END DO
663 !   
664 !  forward_step: IF( rk_step == 1 ) THEN
666 !    diff_opt1 : IF (config_flags%diff_opt .eq. 1) THEN
668 !           CALL horizontal_diffusion ('u', u, ru_tendf, mut, config_flags,   &
669 !                                           msfux, msfuy, msfvx, msfvx_inv,   &
670 !                                           msfvy,msftx, msfty,               &
671 !                                           khdif, xkmhd, rdx, rdy,           &
672 !                                           ids, ide, jds, jde, kds, kde,     &
673 !                                           ims, ime, jms, jme, kms, kme,     &
674 !                                           its, ite, jts, jte, kts, kte   )
675 !           CALL horizontal_diffusion ('v', v, rv_tendf, mut, config_flags,   &
676 !                                           msfux, msfuy, msfvx, msfvx_inv,   &
677 !                                           msfvy,msftx, msfty,               &
678 !                                           khdif, xkmhd, rdx, rdy,           &
679 !                                           ids, ide, jds, jde, kds, kde,     &
680 !                                           ims, ime, jms, jme, kms, kme,     &
681 !                                           its, ite, jts, jte, kts, kte   )
682 !           CALL horizontal_diffusion ('w', w, rw_tendf, mut, config_flags,   &
683 !                                           msfux, msfuy, msfvx, msfvx_inv,   &
684 !                                           msfvy,msftx, msfty,               &
685 !                                           khdif, xkmhd, rdx, rdy,           &
686 !                                           ids, ide, jds, jde, kds, kde,     &
687 !                                           ims, ime, jms, jme, kms, kme,     &
688 !                                           its, ite, jts, jte, kts, kte   )
689 !           khdq = 3.*khdif
690 !           CALL horizontal_diffusion_3dmp ( 'm', t, t_tendf, mut,              &
691 !                                            config_flags, t_init,              &
692 !                                            msfux, msfuy, msfvx, msfvx_inv,    &
693 !                                            msfvy, msftx, msfty,               &
694 !                                            khdq , xkhh, rdx, rdy,             &
695 !                                            ids, ide, jds, jde, kds, kde,      &
696 !                                            ims, ime, jms, jme, kms, kme,      &
697 !                                            its, ite, jts, jte, kts, kte    )
698 !        pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN
700 !             CALL vertical_diffusion_u ( u, ru_tendf, config_flags,        &
701 !                                         u_base,                           &
702 !                                         alt, muu, rdn, rdnw, kvdif,       &
703 !                                         ids, ide, jds, jde, kds, kde,     &
704 !                                         ims, ime, jms, jme, kms, kme,     &
705 !                                         its, ite, jts, jte, kts, kte   )
706 !             CALL vertical_diffusion_v ( v, rv_tendf, config_flags,        &
707 !                                         v_base,                           &
708 !                                         alt, muv, rdn, rdnw, kvdif,       &
709 !                                         ids, ide, jds, jde, kds, kde,     &
710 !                                         ims, ime, jms, jme, kms, kme,     &
711 !                                         its, ite, jts, jte, kts, kte   )
712 !          IF (non_hydrostatic)                                             &
713 !          CALL vertical_diffusion ( 'w', w, rw_tendf, config_flags,        &
714 !                                    alt, mut, rdn, rdnw, kvdif,            &
715 !                                    ids, ide, jds, jde, kds, kde,          &
716 !                                    ims, ime, jms, jme, kms, kme,          &
717 !                                    its, ite, jts, jte, kts, kte        )
719 !             kvdq = 3.*kvdif
720 !             CALL vertical_diffusion_3dmp ( t, t_tendf, config_flags, t_init,       &
721 !                                            alt, mut, rdn, rdnw, kvdq ,             &
722 !                                            ids, ide, jds, jde, kds, kde,           &
723 !                                            ims, ime, jms, jme, kms, kme,           &
724 !                                            its, ite, jts, jte, kts, kte         )
725 !           ENDIF pbl_test
726 !       END IF diff_opt1
727 !    IF ( diff_6th_opt .NE. 0 ) THEN
729 !         CALL sixth_order_diffusion( 'u', u, ru_tendf, mut, dt,            &
730 !                                          config_flags,                    &
731 !                                          diff_6th_opt, diff_6th_factor,   &
732 !                                          ids, ide, jds, jde, kds, kde,    &
733 !                                          ims, ime, jms, jme, kms, kme,    &
734 !                                          its, ite, jts, jte, kts, kte )
735 !         CALL sixth_order_diffusion( 'v', v, rv_tendf, mut, dt,            &
736 !                                          config_flags,                    &
737 !                                          diff_6th_opt, diff_6th_factor,   &
738 !                                          ids, ide, jds, jde, kds, kde,    &
739 !                                          ims, ime, jms, jme, kms, kme,    &
740 !                                          its, ite, jts, jte, kts, kte )
741 !      IF (non_hydrostatic)                                               &
742 !      CALL sixth_order_diffusion( 'w', w, rw_tendf, mut, dt,            &
743 !                                       config_flags,                    &
744 !                                       diff_6th_opt, diff_6th_factor,   &
745 !                                       ids, ide, jds, jde, kds, kde,    &
746 !                                       ims, ime, jms, jme, kms, kme,    &
747 !                                       its, ite, jts, jte, kts, kte )
749 !         CALL sixth_order_diffusion( 'm', t,  t_tendf, mut, dt,            &
750 !                                          config_flags,                    &
751 !                                          diff_6th_opt, diff_6th_factor,   &
752 !                                          ids, ide, jds, jde, kds, kde,    &
753 !                                          ims, ime, jms, jme, kms, kme,    &
754 !                                          its, ite, jts, jte, kts, kte )
755 !       ENDIF
756 !    IF( damp_opt .eq. 2 )                                        &
757 !       CALL rk_rayleigh_damp( ru_tendf, rv_tendf,                &
758 !                              rw_tendf, t_tendf,                 &
759 !                              u, v, w, t, t_init,                &
760 !                              mut, muu, muv, ph, phb,            &
761 !                              u_base, v_base, t_base, z_base,    &
762 !                              dampcoef, zdamp,                   &
763 !                              ids, ide, jds, jde, kds, kde,      &
764 !                              ims, ime, jms, jme, kms, kme,      &
765 !                              its, ite, jts, jte, kts, kte   )
767 !   END IF
769 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
771 ! Remarked by Ning Pan, 2010-07-30
772 !   a_kdift =0.0
773 !   a_khdq =0.0
774 !   a_kvdq =0.0
776 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
778 !LPB[11]
779 !  DO IX3=jms,jme
780 !  DO IX2=kms,kme
781 !  DO IX1=ims,ime
782 !  ru_tendf(IX1,IX2,IX3) =Keep_Lpb11_ru_tendf(IX1,IX2,IX3)
783 !  END DO
784 !  END DO
785 !  END DO
786 !  DO IX3=jms,jme
787 !  DO IX2=kms,kme
788 !  DO IX1=ims,ime
789 !  rv_tendf(IX1,IX2,IX3) =Keep_Lpb11_rv_tendf(IX1,IX2,IX3)
790 !  END DO
791 !  END DO
792 !  END DO
793 !  DO IX3=jms,jme
794 !  DO IX2=kms,kme
795 !  DO IX1=ims,ime
796 !  rw_tendf(IX1,IX2,IX3) =Keep_Lpb11_rw_tendf(IX1,IX2,IX3)
797 !  END DO
798 !  END DO
799 !  END DO
800 !  DO IX3=jms,jme
801 !  DO IX2=kms,kme
802 !  DO IX1=ims,ime
803 !  t_tendf(IX1,IX2,IX3) =Keep_Lpb11_t_tendf(IX1,IX2,IX3)
804 !  END DO
805 !  END DO
806 !  END DO
808 ! Remarked by Ning Pan, 2010-07-30
809 !   IF( rk_step == 1 ) THEN
810 !   IF(config_flags%diff_opt .eq. 1) THEN
811 !   DO IX3=jms,jme
812 !   DO IX2=kms,kme
813 !   DO IX1=ims,ime
814 !   Tmpv400(IX1,IX2,IX3) =ru_tendf(IX1,IX2,IX3)
815 !   END DO
816 !   END DO
817 !   END DO
819 !   CALL horizontal_diffusion('u',u,ru_tendf,mut,config_flags,msfux,msfuy,msfvx,  &
820 !   msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,  &
821 !   jme,kms,kme,its,ite,jts,jte,kts,kte)
823 !   DO IX3=jms,jme
824 !   DO IX2=kms,kme
825 !   DO IX1=ims,ime
826 !   Tmpv401(IX1,IX2,IX3) =rv_tendf(IX1,IX2,IX3)
827 !   END DO
828 !   END DO
829 !   END DO
831 !   CALL horizontal_diffusion('v',v,rv_tendf,mut,config_flags,msfux,msfuy,msfvx,  &
832 !   msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,  &
833 !   jme,kms,kme,its,ite,jts,jte,kts,kte)
835 !   DO IX3=jms,jme
836 !   DO IX2=kms,kme
837 !   DO IX1=ims,ime
838 !   Tmpv402(IX1,IX2,IX3) =rw_tendf(IX1,IX2,IX3)
839 !   END DO
840 !   END DO
841 !   END DO
843 !   CALL horizontal_diffusion('w',w,rw_tendf,mut,config_flags,msfux,msfuy,msfvx,  &
844 !   msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,  &
845 !   jme,kms,kme,its,ite,jts,jte,kts,kte)
847 !   khdq =3.*khdif
849 !   DO IX3=jms,jme
850 !   DO IX2=kms,kme
851 !   DO IX1=ims,ime
852 !   Tmpv403(IX1,IX2,IX3) =t_tendf(IX1,IX2,IX3)
853 !   END DO
854 !   END DO
855 !   END DO
857 !   CALL horizontal_diffusion_3dmp('m',t,t_tendf,mut,config_flags,t_init,msfux,msfuy,  &
858 !   msfvx,msfvx_inv,msfvy,msftx,msfty,khdq,xkhh,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,  &
859 !   jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
861 !   IF(config_flags%bl_pbl_physics .eq. 0) THEN
862 !   DO IX3=jms,jme
863 !   DO IX2=kms,kme
864 !   DO IX1=ims,ime
865 !   Tmpv404(IX1,IX2,IX3) =ru_tendf(IX1,IX2,IX3)
866 !   END DO
867 !   END DO
868 !   END DO
870 !   CALL vertical_diffusion_u(u,ru_tendf,config_flags,u_base,alt,muu,rdn,rdnw,kvdif,  &
871 !   ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
873 !   DO IX3=jms,jme
874 !   DO IX2=kms,kme
875 !   DO IX1=ims,ime
876 !   Tmpv405(IX1,IX2,IX3) =rv_tendf(IX1,IX2,IX3)
877 !   END DO
878 !   END DO
879 !   END DO
881 !   CALL vertical_diffusion_v(v,rv_tendf,config_flags,v_base,alt,muv,rdn,rdnw,kvdif,  &
882 !   ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
884 !   IF(non_hydrostatic) THEN
885 !   DO IX3=jms,jme
886 !   DO IX2=kms,kme
887 !   DO IX1=ims,ime
888 !   Tmpv406(IX1,IX2,IX3) =rw_tendf(IX1,IX2,IX3)
889 !   END DO
890 !   END DO
891 !   END DO
893 !   CALL vertical_diffusion('w',w,rw_tendf,config_flags,alt,mut,rdn,rdnw,kvdif,ids,  &
894 !   ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
896 !   END IF
897 !   kvdq =3.*kvdif
899 !   DO IX3=jms,jme
900 !   DO IX2=kms,kme
901 !   DO IX1=ims,ime
902 !   Tmpv407(IX1,IX2,IX3) =t_tendf(IX1,IX2,IX3)
903 !   END DO
904 !   END DO
905 !   END DO
907 !   CALL vertical_diffusion_3dmp(t,t_tendf,config_flags,t_init,alt,mut,rdn,rdnw,kvdq,  &
908 !   ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
910 !   ENDIF
911 !   END IF
912 !   IF( diff_6th_opt .NE. 0 ) THEN
913 !   DO IX3=jms,jme
914 !   DO IX2=kms,kme
915 !   DO IX1=ims,ime
916 !   Tmpv408(IX1,IX2,IX3) =ru_tendf(IX1,IX2,IX3)
917 !   END DO
918 !   END DO
919 !   END DO
921 !   CALL sixth_order_diffusion('u',u,ru_tendf,mut,dt,config_flags,diff_6th_opt,  &
922 !   diff_6th_factor,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
924 !   DO IX3=jms,jme
925 !   DO IX2=kms,kme
926 !   DO IX1=ims,ime
927 !   Tmpv409(IX1,IX2,IX3) =rv_tendf(IX1,IX2,IX3)
928 !   END DO
929 !   END DO
930 !   END DO
932 !   CALL sixth_order_diffusion('v',v,rv_tendf,mut,dt,config_flags,diff_6th_opt,  &
933 !   diff_6th_factor,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
935 !   IF(non_hydrostatic) THEN
936 !   DO IX3=jms,jme
937 !   DO IX2=kms,kme
938 !   DO IX1=ims,ime
939 !   Tmpv4010(IX1,IX2,IX3) =rw_tendf(IX1,IX2,IX3)
940 !   END DO
941 !   END DO
942 !   END DO
944 !   CALL sixth_order_diffusion('w',w,rw_tendf,mut,dt,config_flags,diff_6th_opt,  &
945 !   diff_6th_factor,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
947 !   END IF
948 !   DO IX3=jms,jme
949 !   DO IX2=kms,kme
950 !   DO IX1=ims,ime
951 !   Tmpv4011(IX1,IX2,IX3) =t_tendf(IX1,IX2,IX3)
952 !   END DO
953 !   END DO
954 !   END DO
956 !   CALL sixth_order_diffusion('m',t,t_tendf,mut,dt,config_flags,diff_6th_opt,  &
957 !   diff_6th_factor,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
959 !   ENDIF
960 !   IF( damp_opt .eq. 2 ) THEN
961 !   DO IX3=jms,jme
962 !   DO IX2=kms,kme
963 !   DO IX1=ims,ime
964 !   Tmpv4012(IX1,IX2,IX3) =ru_tendf(IX1,IX2,IX3)
965 !   END DO
966 !   END DO
967 !   END DO
969 !   DO IX3=jms,jme
970 !   DO IX2=kms,kme
971 !   DO IX1=ims,ime
972 !   Tmpv4013(IX1,IX2,IX3) =rv_tendf(IX1,IX2,IX3)
973 !   END DO
974 !   END DO
975 !   END DO
977 !   DO IX3=jms,jme
978 !   DO IX2=kms,kme
979 !   DO IX1=ims,ime
980 !   Tmpv4014(IX1,IX2,IX3) =rw_tendf(IX1,IX2,IX3)
981 !   END DO
982 !   END DO
983 !   END DO
985 !   DO IX3=jms,jme
986 !   DO IX2=kms,kme
987 !   DO IX1=ims,ime
988 !   Tmpv4015(IX1,IX2,IX3) =t_tendf(IX1,IX2,IX3)
989 !   END DO
990 !   END DO
991 !   END DO
993 !   CALL rk_rayleigh_damp(ru_tendf,rv_tendf,rw_tendf,t_tendf,u,v,w,t,t_init,mut,muu,  &
994 !   muv,ph,phb,u_base,v_base,t_base,z_base,dampcoef,zdamp,ids,ide,jds,jde,kds,kde,ims,  &
995 !   ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
997 !   END IF
998 !   END IF
1000 !! temp NING
1001    IF( rk_step == 1 ) THEN
1003    IF( rad_nudge .eq. 1 )                                     &
1004        CALL a_theta_relaxation( t_tendf, a_t_tendf, t, a_t, t_init,  &
1005                               mut, a_mut, ph, a_ph, phb,       &
1006                               t_base, z_base,                  &
1007                               ids, ide, jds, jde, kds, kde,    &
1008                               ims, ime, jms, jme, kms, kme,    &
1009                               its, ite, jts, jte, kts, kte   )
1011    IF( damp_opt .eq. 2 ) THEN
1013 ! Remarked by Ning Pan, 2010-07-30
1014 !   DO IX3=jms,jme
1015 !   DO IX2=kms,kme
1016 !   DO IX1=ims,ime
1017 !   t_tendf(IX1,IX2,IX3) =Tmpv4015(IX1,IX2,IX3)
1018 !   END DO
1019 !   END DO
1020 !   END DO
1022 !   DO IX3=jms,jme
1023 !   DO IX2=kms,kme
1024 !   DO IX1=ims,ime
1025 !   rw_tendf(IX1,IX2,IX3) =Tmpv4014(IX1,IX2,IX3)
1026 !   END DO
1027 !   END DO
1028 !   END DO
1030 !   DO IX3=jms,jme
1031 !   DO IX2=kms,kme
1032 !   DO IX1=ims,ime
1033 !   rv_tendf(IX1,IX2,IX3) =Tmpv4013(IX1,IX2,IX3)
1034 !   END DO
1035 !   END DO
1036 !   END DO
1038 !   DO IX3=jms,jme
1039 !   DO IX2=kms,kme
1040 !   DO IX1=ims,ime
1041 !   ru_tendf(IX1,IX2,IX3) =Tmpv4012(IX1,IX2,IX3)
1042 !   END DO
1043 !   END DO
1044 !   END DO
1046    CALL a_rk_rayleigh_damp(ru_tendf,a_ru_tendf,rv_tendf,a_rv_tendf,rw_tendf,  &
1047 ! Revised by Ning Pan, 2010-07-23
1048 !   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,  &
1049    a_rw_tendf,t_tendf,a_t_tendf,u,a_u,v,a_v,w,a_w,t,a_t,t_init,  &
1050    mut,a_mut,muu,a_muu,muv,a_muv,ph,a_ph,phb,u_base,v_base,t_base,z_base,  &
1051 ! Revised by Ning Pan, 2010-07-30
1052 !   dampcoef,a_dampcoef,zdamp,a_zdamp,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
1053    dampcoef,zdamp,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
1054    kme,its,ite,jts,jte,kts,kte)
1056    END IF
1058    IF( diff_6th_opt .NE. 0 ) THEN
1060 ! Remarked by Ning Pan, 2010-07-30
1061 !   DO IX3=jms,jme
1062 !   DO IX2=kms,kme
1063 !   DO IX1=ims,ime
1064 !   t_tendf(IX1,IX2,IX3) =Tmpv4011(IX1,IX2,IX3)
1065 !   END DO
1066 !   END DO
1067 !   END DO
1069    CALL a_sixth_order_diffusion('m',t,a_t,t_tendf,a_t_tendf,mut,a_mut,dt,  &
1070 ! Revised by Ning Pan, 2010-07-30
1071 !   config_flags,diff_6th_opt,diff_6th_factor,a_diff_6th_factor,ids,ide,jds,jde,kds,  &
1072    config_flags,diff_6th_opt,diff_6th_factor,ids,ide,jds,jde,kds,  &
1073    kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1075    IF(non_hydrostatic) THEN
1077 ! Remarked by Ning Pan, 2010-07-30
1078 !   DO IX3=jms,jme
1079 !   DO IX2=kms,kme
1080 !   DO IX1=ims,ime
1081 !   rw_tendf(IX1,IX2,IX3) =Tmpv4010(IX1,IX2,IX3)
1082 !   END DO
1083 !   END DO
1084 !   END DO
1086    CALL a_sixth_order_diffusion('w',w,a_w,rw_tendf,a_rw_tendf,mut,a_mut,dt,  &
1087 ! Revised by Ning Pan, 2010-07-30
1088 !   config_flags,diff_6th_opt,diff_6th_factor,a_diff_6th_factor,ids,ide,jds,jde,kds,  &
1089    config_flags,diff_6th_opt,diff_6th_factor,ids,ide,jds,jde,kds,  &
1090    kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1092    END IF
1094 ! Remarked by Ning Pan, 2010-07-30
1095 !   DO IX3=jms,jme
1096 !   DO IX2=kms,kme
1097 !   DO IX1=ims,ime
1098 !   rv_tendf(IX1,IX2,IX3) =Tmpv409(IX1,IX2,IX3)
1099 !   END DO
1100 !   END DO
1101 !   END DO
1103    CALL a_sixth_order_diffusion('v',v,a_v,rv_tendf,a_rv_tendf,mut,a_mut,dt,  &
1104 ! Revised by Ning Pan, 2010-07-30
1105 !   config_flags,diff_6th_opt,diff_6th_factor,a_diff_6th_factor,ids,ide,jds,jde,kds,  &
1106    config_flags,diff_6th_opt,diff_6th_factor,ids,ide,jds,jde,kds,  &
1107    kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1109 ! Remarked by Ning Pan, 2010-07-30
1110 !   DO IX3=jms,jme
1111 !   DO IX2=kms,kme
1112 !   DO IX1=ims,ime
1113 !   ru_tendf(IX1,IX2,IX3) =Tmpv408(IX1,IX2,IX3)
1114 !   END DO
1115 !   END DO
1116 !   END DO
1118    CALL a_sixth_order_diffusion('u',u,a_u,ru_tendf,a_ru_tendf,mut,a_mut,dt,  &
1119 ! Revised by Ning Pan, 2010-07-30
1120 !   config_flags,diff_6th_opt,diff_6th_factor,a_diff_6th_factor,ids,ide,jds,jde,kds,  &
1121    config_flags,diff_6th_opt,diff_6th_factor,ids,ide,jds,jde,kds,  &
1122    kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1124    ENDIF
1126    IF(config_flags%diff_opt .eq. 1) THEN
1128 ! Revised by Ning Pan, 2010-07-30 : reverse the adjoint computation order
1129 !                                   revise actual arguments
1130 !                                   remark useless recalculation
1131    IF(config_flags%bl_pbl_physics .eq. 0) THEN
1133    kvdq = 3.*kvdif
1134    CALL a_vertical_diffusion_3dmp(t,a_t,t_tendf,a_t_tendf,config_flags,t_init,  &
1135    alt,a_alt,mut,a_mut,rdn,rdnw,kvdq,ids,ide,jds,jde,kds,kde,  &
1136    ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1138    IF(non_hydrostatic) THEN
1139       CALL a_vertical_diffusion('w',w,a_w,rw_tendf,a_rw_tendf,config_flags,alt,  &
1140    a_alt,mut,a_mut,rdn,rdnw,kvdif,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
1141    its,ite,jts,jte,kts,kte)
1142    END IF
1144    CALL a_vertical_diffusion_v(v,a_v,rv_tendf,a_rv_tendf,config_flags,v_base,  &
1145    alt,a_alt,muv,a_muv,rdn,rdnw,kvdif,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
1146    kme,its,ite,jts,jte,kts,kte)
1148    CALL a_vertical_diffusion_u(u,a_u,ru_tendf,a_ru_tendf,config_flags,u_base,  &
1149    alt,a_alt,muu,a_muu,rdn,rdnw,kvdif,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
1150    kme,its,ite,jts,jte,kts,kte)
1152    ENDIF
1154    khdq = 3.*khdif
1155    CALL a_horizontal_diffusion_3dmp('m',t,a_t,t_tendf,a_t_tendf,mut,a_mut,  &
1156    config_flags,t_init,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdq,  &
1157    xkhh,a_xkhh,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,  &
1158    ite,jts,jte,kts,kte)
1160    CALL a_horizontal_diffusion('w',w,a_w,rw_tendf,a_rw_tendf,mut,a_mut,  &
1161    config_flags,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,a_xkmhd,rdx,  &
1162    rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1164    CALL a_horizontal_diffusion('v',v,a_v,rv_tendf,a_rv_tendf,mut,a_mut,  &
1165    config_flags,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,a_xkmhd,rdx,  &
1166    rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1168    CALL a_horizontal_diffusion('u',u,a_u,ru_tendf,a_ru_tendf,mut,a_mut,  &
1169    config_flags,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,a_xkmhd,rdx,  &
1170    rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1172 !   DO IX3=jms,jme
1173 !   DO IX2=kms,kme
1174 !   DO IX1=ims,ime
1175 !   ru_tendf(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
1176 !   END DO
1177 !   END DO
1178 !   END DO
1180 !   CALL a_horizontal_diffusion('u',u,a_u,ru_tendf,a_ru_tendf,mut,a_mut,  &
1181 !   config_flags,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,a_xkmhd,rdx,  &
1182 !   rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1184 !   DO IX3=jms,jme
1185 !   DO IX2=kms,kme
1186 !   DO IX1=ims,ime
1187 !   rv_tendf(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
1188 !   END DO
1189 !   END DO
1190 !   END DO
1192 !   CALL a_horizontal_diffusion('v',v,a_v,rv_tendf,a_rv_tendf,mut,a_mut,  &
1193 !   config_flags,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,a_xkmhd,rdx,  &
1194 !   rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1196 !   DO IX3=jms,jme
1197 !   DO IX2=kms,kme
1198 !   DO IX1=ims,ime
1199 !   rw_tendf(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
1200 !   END DO
1201 !   END DO
1202 !   END DO
1204 !   CALL a_horizontal_diffusion('w',w,a_w,rw_tendf,a_rw_tendf,mut,a_mut,  &
1205 !   config_flags,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdif,xkmhd,a_xkmhd,rdx,  &
1206 !   rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1207 !   a_khdq =0.0
1209 !   DO IX3=jms,jme
1210 !   DO IX2=kms,kme
1211 !   DO IX1=ims,ime
1212 !   t_tendf(IX1,IX2,IX3) =Tmpv403(IX1,IX2,IX3)
1213 !   END DO
1214 !   END DO
1215 !   END DO
1217 !   CALL a_horizontal_diffusion_3dmp('m',t,a_t,t_tendf,a_t_tendf,mut,a_mut,  &
1218 !   config_flags,t_init,a_t_init,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdq,  &
1219 !   a_khdq,xkhh,a_xkhh,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,  &
1220 !   ite,jts,jte,kts,kte)
1222 !   IF(config_flags%bl_pbl_physics .eq. 0) THEN
1224 !   DO IX3=jms,jme
1225 !   DO IX2=kms,kme
1226 !   DO IX1=ims,ime
1227 !   ru_tendf(IX1,IX2,IX3) =Tmpv404(IX1,IX2,IX3)
1228 !   END DO
1229 !   END DO
1230 !   END DO
1232 !   CALL a_vertical_diffusion_u(u,a_u,ru_tendf,a_ru_tendf,config_flags,u_base,  &
1233 !   alt,a_alt,muu,a_muu,rdn,rdnw,kvdif,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
1234 !   kme,its,ite,jts,jte,kts,kte)
1236 !   DO IX3=jms,jme
1237 !   DO IX2=kms,kme
1238 !   DO IX1=ims,ime
1239 !   rv_tendf(IX1,IX2,IX3) =Tmpv405(IX1,IX2,IX3)
1240 !   END DO
1241 !   END DO
1242 !   END DO
1244 !   CALL a_vertical_diffusion_v(v,a_v,rv_tendf,a_rv_tendf,config_flags,v_base,  &
1245 !   alt,a_alt,muv,a_muv,rdn,rdnw,kvdif,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
1246 !   kme,its,ite,jts,jte,kts,kte)
1248 !   IF(non_hydrostatic) THEN
1250 !   DO IX3=jms,jme
1251 !   DO IX2=kms,kme
1252 !   DO IX1=ims,ime
1253 !   rw_tendf(IX1,IX2,IX3) =Tmpv406(IX1,IX2,IX3)
1254 !   END DO
1255 !   END DO
1256 !   END DO
1258 !   CALL a_vertical_diffusion('w',w,a_w,rw_tendf,a_rw_tendf,config_flags,alt,  &
1259 !   a_alt,mut,a_mut,rdn,rdnw,kvdif,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
1260 !   its,ite,jts,jte,kts,kte)
1262 !   END IF
1263 !   a_kvdq =0.0
1265 !   DO IX3=jms,jme
1266 !   DO IX2=kms,kme
1267 !   DO IX1=ims,ime
1268 !   t_tendf(IX1,IX2,IX3) =Tmpv407(IX1,IX2,IX3)
1269 !   END DO
1270 !   END DO
1271 !   END DO
1273 !   CALL a_vertical_diffusion_3dmp(t,a_t,t_tendf,a_t_tendf,config_flags,t_init,  &
1274 !   a_t_init,alt,a_alt,mut,a_mut,rdn,rdnw,kvdq,a_kvdq,ids,ide,jds,jde,kds,kde,  &
1275 !   ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1277 !   ENDIF
1279    END IF
1281    END IF
1283 !LPB[10]
1285 !LPB[9]
1286 ! Remarked by Ning Pan, 2010-07-30
1287 !   DO IX3=jms,jme
1288 !   DO IX2=kms,kme
1289 !   DO IX1=ims,ime
1290 !   ru_tend(IX1,IX2,IX3) =Keep_Lpb9_ru_tend(IX1,IX2,IX3)
1291 !   END DO
1292 !   END DO
1293 !   END DO
1294 !   DO IX3=jms,jme
1295 !   DO IX2=kms,kme
1296 !   DO IX1=ims,ime
1297 !   rv_tend(IX1,IX2,IX3) =Keep_Lpb9_rv_tend(IX1,IX2,IX3)
1298 !   END DO
1299 !   END DO
1300 !   END DO
1302 !  IF(config_flags%ra_lw_physics == HELDSUAREZ) THEN
1303 !  DO IX3=jms,jme
1304 !  DO IX2=kms,kme
1305 !  DO IX1=ims,ime
1306 !  Tmpv400(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
1307 !  END DO
1308 !  END DO
1309 !  END DO
1311 !  DO IX3=jms,jme
1312 !  DO IX2=kms,kme
1313 !  DO IX1=ims,ime
1314 !  Tmpv401(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
1315 !  END DO
1316 !  END DO
1317 !  END DO
1319 !  CALL held_suarez_damp(ru_tend,rv_tend,ru,rv,p,pb,ids,ide,jds,jde,kds,kde,ims,ime,  &
1320 !  jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1322 !  END IF
1324    IF(config_flags%ra_lw_physics == HELDSUAREZ) THEN
1326 ! Remarked by Ning Pan, 2010-07-30
1327 !   DO IX3=jms,jme
1328 !   DO IX2=kms,kme
1329 !   DO IX1=ims,ime
1330 !   rv_tend(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
1331 !   END DO
1332 !   END DO
1333 !   END DO
1335 !   DO IX3=jms,jme
1336 !   DO IX2=kms,kme
1337 !   DO IX1=ims,ime
1338 !   ru_tend(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
1339 !   END DO
1340 !   END DO
1341 !   END DO
1343 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1344 !!! Reamarked by Ning Pan, 2010-07-30 : JUST FOR DEBUGGING DYNAMICS OF WRF+   !!!
1345 !!!              REMARK SHOULD BE REMOVED WHEN CONSTRUCTING PHYSICS OF WRF+   !!!
1346 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
1347 !   CALL a_held_suarez_damp(ru_tend,a_ru_tend,rv_tend,a_rv_tend,ru,a_ru,rv,  &
1348 !   a_rv,p,a_p,pb,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1350    END IF
1352 !LPB[8]
1353 ! Remarked by Ning Pan, 2010-07-30
1354 !   DO IX3=jms,jme
1355 !   DO IX2=kms,kme
1356 !   DO IX1=ims,ime
1357 !   ru_tend(IX1,IX2,IX3) =Keep_Lpb8_ru_tend(IX1,IX2,IX3)
1358 !   END DO
1359 !   END DO
1360 !   END DO
1361 !   DO IX3=jms,jme
1362 !   DO IX2=kms,kme
1363 !   DO IX1=ims,ime
1364 !   rv_tend(IX1,IX2,IX3) =Keep_Lpb8_rv_tend(IX1,IX2,IX3)
1365 !   END DO
1366 !   END DO
1367 !   END DO
1368 !   DO IX3=jms,jme
1369 !   DO IX2=kms,kme
1370 !   DO IX1=ims,ime
1371 !   rw_tend(IX1,IX2,IX3) =Keep_Lpb8_rw_tend(IX1,IX2,IX3)
1372 !   END DO
1373 !   END DO
1374 !   END DO
1376 !  DO IX3=jms,jme
1377 !  DO IX2=kms,kme
1378 !  DO IX1=ims,ime
1379 !  Tmpv400(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
1380 !  END DO
1381 !  END DO
1382 !  END DO
1384 !  DO IX3=jms,jme
1385 !  DO IX2=kms,kme
1386 !  DO IX1=ims,ime
1387 !  Tmpv401(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
1388 !  END DO
1389 !  END DO
1390 !  END DO
1392 !  DO IX3=jms,jme
1393 !  DO IX2=kms,kme
1394 !  DO IX1=ims,ime
1395 !  Tmpv402(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
1396 !  END DO
1397 !  END DO
1398 !  END DO
1400 !  CALL curvature(ru,rv,rw,u,v,w,ru_tend,rv_tend,rw_tend,config_flags,msfux,msfuy,  &
1401 !  msfvx,msfvy,msftx,msfty,xlat,fnm,fnp,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
1402 !  kms,kme,its,ite,jts,jte,kts,kte)
1404 ! Remarked by Ning Pan, 2010-07-30
1405 !   DO IX3=jms,jme
1406 !   DO IX2=kms,kme
1407 !   DO IX1=ims,ime
1408 !   rw_tend(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
1409 !   END DO
1410 !   END DO
1411 !   END DO
1413 !   DO IX3=jms,jme
1414 !   DO IX2=kms,kme
1415 !   DO IX1=ims,ime
1416 !   rv_tend(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
1417 !   END DO
1418 !   END DO
1419 !   END DO
1421 !   DO IX3=jms,jme
1422 !   DO IX2=kms,kme
1423 !   DO IX1=ims,ime
1424 !   ru_tend(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
1425 !   END DO
1426 !   END DO
1427 !   END DO
1429    CALL a_curvature(ru,a_ru,rv,a_rv,rw,a_rw,u,a_u,v,a_v,w,ru_tend,  &
1430    a_ru_tend,rv_tend,a_rv_tend,rw_tend,a_rw_tend,config_flags,msfux,msfuy,msfvx,  &
1431 ! Revised by Ning Pan, 2010-07-30
1432 !   msfvy,msftx,msfty,xlat,a_xlat,fnm,fnp,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,  &
1433    msfvy,msftx,msfty,xlat,fnm,fnp,rdx,rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,  &
1434    jme,kms,kme,its,ite,jts,jte,kts,kte)
1436 !LPB[7]
1437 !! Remarked by Ning Pan, 2010-07-30
1438 !!   DO IX3=jms,jme
1439 !!   DO IX2=kms,kme
1440 !!   DO IX1=ims,ime
1441 !!   ru_tend(IX1,IX2,IX3) =Keep_Lpb7_ru_tend(IX1,IX2,IX3)
1442 !!   END DO
1443 !!   END DO
1444 !!   END DO
1445 !!   DO IX3=jms,jme
1446 !!   DO IX2=kms,kme
1447 !!   DO IX1=ims,ime
1448 !!   rv_tend(IX1,IX2,IX3) =Keep_Lpb7_rv_tend(IX1,IX2,IX3)
1449 !!   END DO
1450 !!   END DO
1451 !!   END DO
1452 !!   DO IX3=jms,jme
1453 !!   DO IX2=kms,kme
1454 !!   DO IX1=ims,ime
1455 !!   rw_tend(IX1,IX2,IX3) =Keep_Lpb7_rw_tend(IX1,IX2,IX3)
1456 !!   END DO
1457 !!   END DO
1458 !!   END DO
1460 !!   IF(config_flags%pert_coriolis) THEN
1461 !!   DO IX3=jms,jme
1462 !!   DO IX2=kms,kme
1463 !!   DO IX1=ims,ime
1464 !!   Tmpv400(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
1465 !!   END DO
1466 !!   END DO
1467 !!   END DO
1469 !!   DO IX3=jms,jme
1470 !!   DO IX2=kms,kme
1471 !!   DO IX1=ims,ime
1472 !!   Tmpv401(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
1473 !!   END DO
1474 !!   END DO
1475 !!   END DO
1477 !!   DO IX3=jms,jme
1478 !!   DO IX2=kms,kme
1479 !!   DO IX1=ims,ime
1480 !!   Tmpv402(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
1481 !!   END DO
1482 !!   END DO
1483 !!   END DO
1485 !!   CALL perturbation_coriolis(ru,rv,rw,ru_tend,rv_tend,rw_tend,config_flags,u_base,  &
1486 !!   v_base,z_base,muu,muv,phb,ph,msftx,msfty,msfux,msfuy,msfvx,msfvy,f,e,sina,cosa,fnm,  &
1487 !!   fnp,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1489 !!   ELSE
1490 !!   DO IX3=jms,jme
1491 !!   DO IX2=kms,kme
1492 !!   DO IX1=ims,ime
1493 !!   Tmpv403(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
1494 !!   END DO
1495 !!   END DO
1496 !!   END DO
1498 !!   DO IX3=jms,jme
1499 !!   DO IX2=kms,kme
1500 !!   DO IX1=ims,ime
1501 !!   Tmpv404(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
1502 !!   END DO
1503 !!   END DO
1504 !!   END DO
1506 !!   DO IX3=jms,jme
1507 !!   DO IX2=kms,kme
1508 !!   DO IX1=ims,ime
1509 !!   Tmpv405(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
1510 !!   END DO
1511 !!   END DO
1512 !!   END DO
1514 !!   CALL coriolis(ru,rv,rw,ru_tend,rv_tend,rw_tend,config_flags,msftx,msfty,msfux,  &
1515 !!   msfuy,msfvx,msfvy,f,e,sina,cosa,fnm,fnp,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
1516 !!   kme,its,ite,jts,jte,kts,kte)
1518 !!   END IF
1520    IF(config_flags%pert_coriolis) THEN
1522 !! Remarked by Ning Pan, 2010-07-30
1523 !!   DO IX3=jms,jme
1524 !!   DO IX2=kms,kme
1525 !!   DO IX1=ims,ime
1526 !!   rw_tend(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
1527 !!   END DO
1528 !!   END DO
1529 !!   END DO
1531 !!   DO IX3=jms,jme
1532 !!   DO IX2=kms,kme
1533 !!   DO IX1=ims,ime
1534 !!   rv_tend(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
1535 !!   END DO
1536 !!   END DO
1537 !!   END DO
1539 !!   DO IX3=jms,jme
1540 !!   DO IX2=kms,kme
1541 !!   DO IX1=ims,ime
1542 !!   ru_tend(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
1543 !!   END DO
1544 !!   END DO
1545 !!   END DO
1547    CALL a_perturbation_coriolis(ru,a_ru,rv,a_rv,rw,a_rw,ru_tend,a_ru_tend,  &
1548    rv_tend,a_rv_tend,rw_tend,a_rw_tend,config_flags,u_base,v_base,z_base,muu,  &
1549    a_muu,muv,a_muv,phb,ph,a_ph,msftx,msfty,msfux,msfuy,msfvx,msfvy,f,e,sina,cosa,  &
1550    fnm,fnp,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1552    ELSE
1554 !! Remarked by Ning Pan, 2010-07-30
1555 !!   DO IX3=jms,jme
1556 !!   DO IX2=kms,kme
1557 !!   DO IX1=ims,ime
1558 !!   rw_tend(IX1,IX2,IX3) =Tmpv405(IX1,IX2,IX3)
1559 !!   END DO
1560 !!   END DO
1561 !!   END DO
1563 !!   DO IX3=jms,jme
1564 !!   DO IX2=kms,kme
1565 !!   DO IX1=ims,ime
1566 !!   rv_tend(IX1,IX2,IX3) =Tmpv404(IX1,IX2,IX3)
1567 !!   END DO
1568 !!   END DO
1569 !!   END DO
1571 !!   DO IX3=jms,jme
1572 !!   DO IX2=kms,kme
1573 !!   DO IX1=ims,ime
1574 !!   ru_tend(IX1,IX2,IX3) =Tmpv403(IX1,IX2,IX3)
1575 !!   END DO
1576 !!   END DO
1577 !!   END DO
1579    CALL a_coriolis(ru,a_ru,rv,a_rv,rw,a_rw,ru_tend,a_ru_tend,rv_tend,  &
1580    a_rv_tend,rw_tend,a_rw_tend,config_flags,msftx,msfty,msfux,msfuy,msfvx,msfvy,f,e,  &
1581    sina,cosa,fnm,fnp,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1583    END IF
1585 !LPB[6]
1586 !! Remarked by Ning Pan, 2010-07-30
1587 !!   DO IX3=jms,jme
1588 !!   DO IX2=kms,kme
1589 !!   DO IX1=ims,ime
1590 !!   rw_tend(IX1,IX2,IX3) =Keep_Lpb6_rw_tend(IX1,IX2,IX3)
1591 !!   END DO
1592 !!   END DO
1593 !!   END DO
1595 !!  DO IX3=jms,jme
1596 !!  DO IX2=kms,kme
1597 !!  DO IX1=ims,ime
1598 !!  Tmpv400(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
1599 !!  END DO
1600 !!  END DO
1601 !!  END DO
1603 !!  CALL w_damp(rw_tend,max_vert_cfl,max_horiz_cfl,u,v,ww,w,mut,rdnw,rdx,rdy,msfux,  &
1604 !!  msfuy,msfvx,msfvy,dt,config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
1605 !!  its,ite,jts,jte,kts,kte)
1607 !! Remarked by Ning Pan, 2010-07-30
1608 !!   DO IX3=jms,jme
1609 !!   DO IX2=kms,kme
1610 !!   DO IX1=ims,ime
1611 !!   rw_tend(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
1612 !!   END DO
1613 !!   END DO
1614 !!   END DO
1616 ! Revised by Ning Pan, 2010-07-30
1617 !   CALL a_w_damp(rw_tend,a_rw_tend,max_vert_cfl,a_max_vert_cfl,max_horiz_cfl,  &
1618 !   a_max_horiz_cfl,u,a_u,v,a_v,ww,a_ww,w,a_w,mut,a_mut,rdnw,rdx,rdy,msfux,  &
1619    CALL a_w_damp(rw_tend,a_rw_tend,max_vert_cfl,max_horiz_cfl,  &
1620    u,a_u,v,a_v,ww,a_ww,w,a_w,mut,a_mut,rdnw,rdx,rdy,msfux,  &
1621    msfuy,msfvx,msfvy,dt,config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
1622    its,ite,jts,jte,kts,kte)
1624 !LPB[5]
1625 !! Remarked by Ning Pan, 2010-07-30
1626 !!   DO IX3=jms,jme
1627 !!   DO IX2=kms,kme
1628 !!   DO IX1=ims,ime
1629 !!   rw_tend(IX1,IX2,IX3) =Keep_Lpb5_rw_tend(IX1,IX2,IX3)
1630 !!   END DO
1631 !!   END DO
1632 !!   END DO
1633 !!   DO IX3=jms,jme
1634 !!   DO IX2=kms,kme
1635 !!   DO IX1=ims,ime
1636 !!   cqw(IX1,IX2,IX3) =Keep_Lpb5_cqw(IX1,IX2,IX3)
1637 !!   END DO
1638 !!   END DO
1639 !!   END DO
1641 !!  IF(non_hydrostatic) THEN
1642 !!  DO IX3=jms,jme
1643 !!  DO IX2=kms,kme
1644 !!  DO IX1=ims,ime
1645 !!  Tmpv400(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
1646 !!  END DO
1647 !!  END DO
1648 !!  END DO
1650 !!  DO IX3=jms,jme
1651 !!  DO IX2=kms,kme
1652 !!  DO IX1=ims,ime
1653 !!  Tmpv401(IX1,IX2,IX3) =cqw(IX1,IX2,IX3)
1654 !!  END DO
1655 !!  END DO
1656 !!  END DO
1658 !!  CALL pg_buoy_w(rw_tend,p,cqw,mu,mub,rdnw,rdn,g,msftx,msfty,ids,ide,jds,jde,kds,  &
1659 !!  kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1661 !!  ENDIF
1663    IF(non_hydrostatic) THEN
1665 ! Remarked by Ning Pan, 2010-07-30
1666 !         Const_A0=g
1667 !   Const_Diff_A0=0.0
1669 !   DO IX3=jms,jme
1670 !   DO IX2=kms,kme
1671 !   DO IX1=ims,ime
1672 !   cqw(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
1673 !   END DO
1674 !   END DO
1675 !   END DO
1677 !   DO IX3=jms,jme
1678 !   DO IX2=kms,kme
1679 !   DO IX1=ims,ime
1680 !   rw_tend(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
1681 !   END DO
1682 !   END DO
1683    CALL a_pg_buoy_w(rw_tend,a_rw_tend,p,a_p,cqw,a_cqw,mu,a_mu,mub,rdnw,rdn,  &
1684    g,msftx,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1685 !   END DO  ! Remarked by Ning Pan, 2010-07-30
1687    ENDIF
1689 !LPB[4]
1690 !! Remarked by Ning Pan, 2010-07-30
1691 !!   DO IX3=jms,jme
1692 !!   DO IX2=kms,kme
1693 !!   DO IX1=ims,ime
1694 !!   ph_tend(IX1,IX2,IX3) =Keep_Lpb4_ph_tend(IX1,IX2,IX3)
1695 !!   END DO
1696 !!   END DO
1697 !!   END DO
1698 !!   DO IX3=jms,jme
1699 !!   DO IX2=kms,kme
1700 !!   DO IX1=ims,ime
1701 !!   ru_tend(IX1,IX2,IX3) =Keep_Lpb4_ru_tend(IX1,IX2,IX3)
1702 !!   END DO
1703 !!   END DO
1704 !!   END DO
1705 !!   DO IX3=jms,jme
1706 !!   DO IX2=kms,kme
1707 !!   DO IX1=ims,ime
1708 !!   rv_tend(IX1,IX2,IX3) =Keep_Lpb4_rv_tend(IX1,IX2,IX3)
1709 !!   END DO
1710 !!   END DO
1711 !!   END DO
1713 !!   DO IX3=jms,jme
1714 !!   DO IX2=kms,kme
1715 !!   DO IX1=ims,ime
1716 !!   Tmpv400(IX1,IX2,IX3) =ph_tend(IX1,IX2,IX3)
1717 !!   END DO
1718 !!   END DO
1719 !!   END DO
1721 !!   CALL rhs_ph(ph_tend,u,v,ww,ph,ph,phb,w,mut,muu,muv,fnm,fnp,rdnw,cfn,cfn1,rdx,rdy,  &
1722 !!   msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,non_hydrostatic,config_flags,ids,ide,  &
1723 !!   jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1725 !!   DO IX3=jms,jme
1726 !!   DO IX2=kms,kme
1727 !!   DO IX1=ims,ime
1728 !!   Tmpv401(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
1729 !!   END DO
1730 !!   END DO
1731 !!   END DO
1733 !!   DO IX3=jms,jme
1734 !!   DO IX2=kms,kme
1735 !!   DO IX1=ims,ime
1736 !!   Tmpv402(IX1,IX2,IX3) =rv_tend(IX1,IX2,IX3)
1737 !!   END DO
1738 !!   END DO
1739 !!   END DO
1741 !!   CALL horizontal_pressure_gradient(ru_tend,rv_tend,ph,alt,p,pb,al,php,cqu,cqv,muu,  &
1742 !!   muv,mu,fnm,fnp,rdnw,cf1,cf2,cf3,cfn,cfn1,rdx,rdy,msfux,msfuy,msfvx,msfvy,msftx,msfty,  &
1743 !!   config_flags,non_hydrostatic,top_lid,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
1744 !!   its,ite,jts,jte,kts,kte)
1746 !!   DO IX3=jms,jme
1747 !!   DO IX2=kms,kme
1748 !!   DO IX1=ims,ime
1749 !!   rv_tend(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
1750 !!   END DO
1751 !!   END DO
1752 !!   END DO
1754 !!   DO IX3=jms,jme
1755 !!   DO IX2=kms,kme
1756 !!   DO IX1=ims,ime
1757 !!   ru_tend(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
1758 !!   END DO
1759 !!   END DO
1760 !!   END DO
1762    CALL a_horizontal_pressure_gradient(ru_tend,a_ru_tend,rv_tend,a_rv_tend,ph,  &
1763    a_ph,alt,a_alt,p,a_p,pb,al,a_al,php,a_php,cqu,a_cqu,cqv,a_cqv,muu,  &
1764    a_muu,muv,a_muv,mu,a_mu,fnm,fnp,rdnw,cf1,cf2,cf3,cfn,cfn1,rdx,rdy,msfux,msfuy,msfvx,  &
1765 ! Revised by Ning Pan, 2010-07-30
1766 !   msfvy,msftx,msfty,config_flags,,,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,  &
1767    msfvy,msftx,msfty,config_flags,non_hydrostatic,top_lid,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,  &
1768    ite,jts,jte,kts,kte)
1770 !! Remarked by Ning Pan, 2010-07-30
1771 !!   DO IX3=jms,jme
1772 !!   DO IX2=kms,kme
1773 !!   DO IX1=ims,ime
1774 !!   ph_tend(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
1775 !!   END DO
1776 !!   END DO
1777 !!   END DO
1779    CALL a_rhs_ph(ph_tend,a_ph_tend,u,a_u,v,a_v,ww,a_ww,ph,a_ph,ph,a_ph,  &
1780    phb,w,a_w,mut,a_mut,muu,a_muu,muv,a_muv,fnm,fnp,rdnw,cfn,cfn1,rdx,rdy,msfux,  &
1781 ! Remarked by Ning Pan, 2010-07-30
1782 !   msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,,config_flags,ids,ide,jds,jde,kds,kde,ims,  &
1783    msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,non_hydrostatic,config_flags,ids,ide,jds,jde,kds,kde,ims,  &
1784    ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1786 !LPB[3]
1788 !!  IF( config_flags%cu_physics == GDSCHEME  .OR.                 config_flags%cu_physics == G3SCHEME ) THEN
1789 !!  CALL set_tend(RTHFTEN,t_tend,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
1790 !!  kme,its,ite,jts,jte,kts,kte)
1792 !!  END IF
1794    IF( config_flags%cu_physics == GDSCHEME  .OR.       &
1795        config_flags%cu_physics == G3SCHEME  .OR.       &
1796        config_flags%cu_physics == NTIEDTKESCHEME ) THEN
1798    CALL a_set_tend(RTHFTEN,a_RTHFTEN,t_tend,a_t_tend,msfty,ids,ide,jds,jde,kds,  &
1799    kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1801    END IF
1803 !LPB[2]
1804 !! Remarked by Ning Pan, 2010-07-30
1805 !!   DO IX3=jms,jme
1806 !!   DO IX2=kms,kme
1807 !!   DO IX1=ims,ime
1808 !!   t(IX1,IX2,IX3) =Keep_Lpb2_t(IX1,IX2,IX3)
1809 !!   END DO
1810 !!   END DO
1811 !!   END DO
1812 !!   DO IX3=jms,jme
1813 !!   DO IX2=kms,kme
1814 !!   DO IX1=ims,ime
1815 !!   t_tend(IX1,IX2,IX3) =Keep_Lpb2_t_tend(IX1,IX2,IX3)
1816 !!   END DO
1817 !!   END DO
1818 !!   END DO
1819 !!   DO IX3=jms,jme
1820 !!   DO IX2=kms,kme
1821 !!   DO IX1=ims,ime
1822 !!   ru(IX1,IX2,IX3) =Keep_Lpb2_ru(IX1,IX2,IX3)
1823 !!   END DO
1824 !!   END DO
1825 !!   END DO
1826 !!   DO IX3=jms,jme
1827 !!   DO IX2=kms,kme
1828 !!   DO IX1=ims,ime
1829 !!   rv(IX1,IX2,IX3) =Keep_Lpb2_rv(IX1,IX2,IX3)
1830 !!   END DO
1831 !!   END DO
1832 !!   END DO
1834 !!  DO IX3=jms,jme
1835 !!  DO IX2=kms,kme
1836 !!  DO IX1=ims,ime
1837 !!  Tmpv400(IX1,IX2,IX3) =t(IX1,IX2,IX3)
1838 !!  END DO
1839 !!  END DO
1840 !!  END DO
1842 !!  DO IX3=jms,jme
1843 !!  DO IX2=kms,kme
1844 !!  DO IX1=ims,ime
1845 !!  Tmpv401(IX1,IX2,IX3) =t_tend(IX1,IX2,IX3)
1846 !!  END DO
1847 !!  END DO
1848 !!  END DO
1850 !!  DO IX3=jms,jme
1851 !!  DO IX2=kms,kme
1852 !!  DO IX1=ims,ime
1853 !!  Tmpv402(IX1,IX2,IX3) =ru(IX1,IX2,IX3)
1854 !!  END DO
1855 !!  END DO
1856 !!  END DO
1858 !!  DO IX3=jms,jme
1859 !!  DO IX2=kms,kme
1860 !!  DO IX1=ims,ime
1861 !!  Tmpv403(IX1,IX2,IX3) =rv(IX1,IX2,IX3)
1862 !!  END DO
1863 !!  END DO
1864 !!  END DO
1866 !!  CALL advect_scalar(t,t,t_tend,ru,rv,ww,mut,time_step,config_flags,msfux,msfuy,  &
1867 !!  msfvx,msfvy,msftx,msfty,fnm,fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
1868 !!  kms,kme,its,ite,jts,jte,kts,kte)
1870 !! Remarked by Ning Pan, 2010-07-30
1871 !!   DO IX3=jms,jme
1872 !!   DO IX2=kms,kme
1873 !!   DO IX1=ims,ime
1874 !!   rv(IX1,IX2,IX3) =Tmpv403(IX1,IX2,IX3)
1875 !!   END DO
1876 !!   END DO
1877 !!   END DO
1879 !!   DO IX3=jms,jme
1880 !!   DO IX2=kms,kme
1881 !!   DO IX1=ims,ime
1882 !!   ru(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
1883 !!   END DO
1884 !!   END DO
1885 !!   END DO
1887 !!   DO IX3=jms,jme
1888 !!   DO IX2=kms,kme
1889 !!   DO IX1=ims,ime
1890 !!   t_tend(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
1891 !!   END DO
1892 !!   END DO
1893 !!   END DO
1895 !!   DO IX3=jms,jme
1896 !!   DO IX2=kms,kme
1897 !!   DO IX1=ims,ime
1898 !!   t(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
1899 !!   END DO
1900 !!   END DO
1901 !!   END DO
1903 !hcl 11/2016 ERM: Use WENO for theta flux on 3rd RK step if using WENO_SCALAR or WENOPD_SCALAR
1904 ! to be consistent with other scalar fluxes
1905  IF(  ( config_flags%scalar_adv_opt == WENO_SCALAR           &
1906          .or. config_flags%scalar_adv_opt == WENOPD_SCALAR   &
1907          .or. config_flags%moist_adv_opt == WENO_SCALAR      &
1908          .or. config_flags%moist_adv_opt == WENOPD_SCALAR    &
1909                        )  .and. (rk_step == 3) ) THEN
1911    CALL a_advect_scalar_weno(t,a_t,t,a_t,t_tend,a_t_tend,ru,a_ru,rv,a_rv,ww,  &
1912    a_ww,mut,time_step,config_flags,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm,  &
1913    fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1915  ELSE
1917    CALL a_advect_scalar(t,a_t,t,a_t,t_tend,a_t_tend,ru,a_ru,rv,a_rv,ww,  &
1918    a_ww,mut,time_step,config_flags,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm,  &
1919    fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1921  ENDIF
1923 !LPB[1]
1924 !! Remarked by Ning Pan, 2010-07-30
1925 !!   DO IX3=jms,jme
1926 !!   DO IX2=kms,kme
1927 !!   DO IX1=ims,ime
1928 !!   w(IX1,IX2,IX3) =Keep_Lpb1_w(IX1,IX2,IX3)
1929 !!   END DO
1930 !!   END DO
1931 !!   END DO
1932 !!   DO IX3=jms,jme
1933 !!   DO IX2=kms,kme
1934 !!   DO IX1=ims,ime
1935 !!   rw_tend(IX1,IX2,IX3) =Keep_Lpb1_rw_tend(IX1,IX2,IX3)
1936 !!   END DO
1937 !!   END DO
1938 !!   END DO
1940 !!  IF(non_hydrostatic) THEN
1941 !!  DO IX3=jms,jme
1942 !!  DO IX2=kms,kme
1943 !!  DO IX1=ims,ime
1944 !!  Tmpv400(IX1,IX2,IX3) =w(IX1,IX2,IX3)
1945 !!  END DO
1946 !!  END DO
1947 !!  END DO
1949 !!  DO IX3=jms,jme
1950 !!  DO IX2=kms,kme
1951 !!  DO IX1=ims,ime
1952 !!  Tmpv401(IX1,IX2,IX3) =rw_tend(IX1,IX2,IX3)
1953 !!  END DO
1954 !!  END DO
1955 !!  END DO
1957 !!  CALL advect_w(w,w,rw_tend,ru,rv,ww,mut,time_step,config_flags,msfux,msfuy,msfvx,  &
1958 !!  msfvy,msftx,msfty,fnm,fnp,rdx,rdy,rdn,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
1959 !!  kme,its,ite,jts,jte,kts,kte)
1961 !!  END IF
1963    IF(non_hydrostatic) THEN
1965 !! Remarked by Ning Pan, 2010-07-30
1966 !!   DO IX3=jms,jme
1967 !!   DO IX2=kms,kme
1968 !!   DO IX1=ims,ime
1969 !!   rw_tend(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
1970 !!   END DO
1971 !!   END DO
1972 !!   END DO
1974 !!   DO IX3=jms,jme
1975 !!   DO IX2=kms,kme
1976 !!   DO IX1=ims,ime
1977 !!   w(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
1978 !!   END DO
1979 !!   END DO
1980 !!   END DO
1982    IF( (rk_step == 3) .and. ( adv_opt == WENO_MOM ) ) THEN
1983    CALL a_advect_weno_w ( w, a_w, w, a_w, rw_tend, a_rw_tend, &
1984                      ru, a_ru, rv, a_rv, ww, a_ww, &
1985                      mut, time_step, config_flags, &
1986                      msfux, msfuy, msfvx, msfvy,   &
1987                      msftx, msfty,                 &
1988                      fnm, fnp, rdx, rdy, rdn,      &
1989                      ids, ide, jds, jde, kds, kde, &
1990                      ims, ime, jms, jme, kms, kme, &
1991                      its, ite, jts, jte, kts, kte )
1993    ELSE
1995    CALL a_advect_w(w,a_w,w,a_w,rw_tend,a_rw_tend,ru,a_ru,rv,a_rv,ww,  &
1996    a_ww,mut,time_step,config_flags,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm,  &
1997    fnp,rdx,rdy,rdn,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
1999    END IF
2001    END IF
2003 !LPB[0]
2004 !! Remarked by Ning Pan, 2010-07-30
2005 !!   DO IX3=jms,jme
2006 !!   DO IX2=kms,kme
2007 !!   DO IX1=ims,ime
2008 !!   u(IX1,IX2,IX3) =Keep_Lpb0_u(IX1,IX2,IX3)
2009 !!   END DO
2010 !!   END DO
2011 !!   END DO
2012 !!   DO IX3=jms,jme
2013 !!   DO IX2=kms,kme
2014 !!   DO IX1=ims,ime
2015 !!   v(IX1,IX2,IX3) =Keep_Lpb0_v(IX1,IX2,IX3)
2016 !!   END DO
2017 !!   END DO
2018 !!   END DO
2020 !!   CALL zero_tend(ru_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,  &
2021 !!   jts,jte,kts,kte)
2023 !!   CALL zero_tend(rv_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,  &
2024 !!   jts,jte,kts,kte)
2026 !!   CALL zero_tend(rw_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,  &
2027 !!   jts,jte,kts,kte)
2029 !!   CALL zero_tend(t_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,  &
2030 !!   jte,kts,kte)
2032 !!   CALL zero_tend(ph_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,  &
2033 !!   jts,jte,kts,kte)
2035 !!   CALL zero_tend(u_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,  &
2036 !!   jte,kts,kte)
2038 !!   CALL zero_tend(v_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,  &
2039 !!   jte,kts,kte)
2041 !!   CALL zero_tend(w_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,  &
2042 !!   jte,kts,kte)
2044 !!   CALL zero_tend(ph_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,  &
2045 !!   jts,jte,kts,kte)
2047 !!   CALL zero_tend(t_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,  &
2048 !!   jte,kts,kte)
2050 !!   CALL zero_tend(mu_tend,ids,ide,jds,jde,1,1,ims,ime,jms,jme,1,1,its,ite,jts,jte,1,1)
2052 !!   CALL zero_tend(mu_save,ids,ide,jds,jde,1,1,ims,ime,jms,jme,1,1,its,ite,jts,jte,1,1)
2054 !!   DO IX3=jms,jme
2055 !!   DO IX2=kms,kme
2056 !!   DO IX1=ims,ime
2057 !!   Tmpv400(IX1,IX2,IX3) =u(IX1,IX2,IX3)
2058 !!   END DO
2059 !!   END DO
2060 !!   END DO
2062 !!   DO IX3=jms,jme
2063 !!   DO IX2=kms,kme
2064 !!   DO IX1=ims,ime
2065 !!   Tmpv401(IX1,IX2,IX3) =ru_tend(IX1,IX2,IX3)
2066 !!   END DO
2067 !!   END DO
2068 !!   END DO
2070 !!   CALL advect_u(u,u,ru_tend,ru,rv,ww,mut,time_step,config_flags,msfux,msfuy,msfvx,  &
2071 !!   msfvy,msftx,msfty,fnm,fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
2072 !!   kme,its,ite,jts,jte,kts,kte)
2074 !!   DO IX3=jms,jme
2075 !!   DO IX2=kms,kme
2076 !!   DO IX1=ims,ime
2077 !!   Tmpv402(IX1,IX2,IX3) =v(IX1,IX2,IX3)
2078 !!   END DO
2079 !!   END DO
2080 !!   END DO
2082 !!   CALL advect_v(v,v,rv_tend,ru,rv,ww,mut,time_step,config_flags,msfux,msfuy,msfvx,  &
2083 !!   msfvy,msftx,msfty,fnm,fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
2084 !!   kme,its,ite,jts,jte,kts,kte)
2086 !!   DO IX3=jms,jme
2087 !!   DO IX2=kms,kme
2088 !!   DO IX1=ims,ime
2089 !!   v(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
2090 !!   END DO
2091 !!   END DO
2092 !!   END DO
2094    IF( (rk_step == 3) .and. ( adv_opt == WENO_MOM ) ) THEN
2096    CALL a_advect_weno_v ( v, a_v, v, a_v, rv_tend, a_rv_tend, &
2097                  ru, a_ru, rv, a_rv, ww, a_ww, &
2098                  mut, a_mut, time_step, config_flags, &
2099                  msfux, msfuy, msfvx, msfvy,   &
2100                  msftx, msfty,                 &
2101                  fnm, fnp, rdx, rdy, rdnw,     &
2102                  ids, ide, jds, jde, kds, kde, &
2103                  ims, ime, jms, jme, kms, kme, &
2104                  its, ite, jts, jte, kts, kte )
2106    ELSE
2108    CALL a_advect_v(v,a_v,v,a_v,rv_tend,a_rv_tend,ru,a_ru,rv,a_rv,ww,  &
2109    a_ww,mut,a_mut,time_step,config_flags,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm,  &
2110    fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
2112    ENDIF
2114 !! Remarked by Ning Pan, 2010-07-30
2115 !!   DO IX3=jms,jme
2116 !!   DO IX2=kms,kme
2117 !!   DO IX1=ims,ime
2118 !!   ru_tend(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
2119 !!   END DO
2120 !!   END DO
2121 !!   END DO
2123 !!   DO IX3=jms,jme
2124 !!   DO IX2=kms,kme
2125 !!   DO IX1=ims,ime
2126 !!   u(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
2127 !!   END DO
2128 !!   END DO
2129 !!   END DO
2132    IF( (rk_step == 3) .and. ( adv_opt == WENO_MOM ) ) THEN
2134    CALL a_advect_weno_u ( u, a_u, u, a_u, ru_tend, a_ru_tend, &
2135                ru, a_ru, rv, a_rv, ww, a_ww, &
2136                mut, a_mut, time_step, config_flags, &
2137                msfux, msfuy, msfvx, msfvy,   &
2138                msftx, msfty,                 &
2139                fnm, fnp, rdx, rdy, rdnw,     &
2140                ids, ide, jds, jde, kds, kde, &
2141                ims, ime, jms, jme, kms, kme, &
2142                its, ite, jts, jte, kts, kte )
2143    ELSE
2145    CALL a_advect_u(u,a_u,u,a_u,ru_tend,a_ru_tend,ru,a_ru,rv,a_rv,ww,  &
2146    a_ww,mut,a_mut,time_step,config_flags,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm,  &
2147    fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
2149    ENDIF
2151 ! Added by Ning Pan, 2010-07-30
2152    CALL a_zero_tend2d(a_mu_save,ids,ide,jds,jde,1,1,ims,ime,jms,jme,1,1,  &
2153    its,ite,jts,jte,1,1)
2154    CALL a_zero_tend2d(a_mu_tend,ids,ide,jds,jde,1,1,ims,ime,jms,jme,1,1,  &
2155    its,ite,jts,jte,1,1)
2156    CALL a_zero_tend(a_t_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
2157    kme,its,ite,jts,jte,kts,kte)
2158    CALL a_zero_tend(a_ph_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
2159    kms,kme,its,ite,jts,jte,kts,kte)
2160    CALL a_zero_tend(a_w_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
2161    kme,its,ite,jts,jte,kts,kte)
2162    CALL a_zero_tend(a_v_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
2163    kme,its,ite,jts,jte,kts,kte)
2164    CALL a_zero_tend(a_u_save,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
2165    kme,its,ite,jts,jte,kts,kte)
2166    CALL a_zero_tend(a_ph_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
2167    kms,kme,its,ite,jts,jte,kts,kte)
2168    CALL a_zero_tend(a_t_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
2169    kme,its,ite,jts,jte,kts,kte)
2170    CALL a_zero_tend(a_rw_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
2171    kms,kme,its,ite,jts,jte,kts,kte)
2172    CALL a_zero_tend(a_rv_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
2173    kms,kme,its,ite,jts,jte,kts,kte)
2174    CALL a_zero_tend(a_ru_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
2175    kms,kme,its,ite,jts,jte,kts,kte)
2177    END SUBROUTINE a_rk_tendency
2179 !-------------------------------------------------------------------------------
2181 !        Generated by TAPENADE     (INRIA, Tropics team)
2182 !  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
2184 !  Differentiation of rk_addtend_dry in reverse (adjoint) mode:
2185 !   gradient     of useful results: ph_tendf rw_tendf u_save ph_save
2186 !                w_save mu_tend rv_tendf ru_tend rw_tend h_diabatic
2187 !                ru_tendf t_tend mu_tendf t_save v_save rv_tend
2188 !                t_tendf mut ph_tend
2189 !   with respect to varying inputs: ph_tendf rw_tendf u_save ph_save
2190 !                w_save mu_tend rv_tendf ru_tend rw_tend h_diabatic
2191 !                ru_tendf t_tend mu_tendf t_save v_save rv_tend
2192 !                t_tendf mut ph_tend
2193 !   RW status of diff variables: ph_tendf:in-out rw_tendf:in-out
2194 !                u_save:incr ph_save:incr w_save:incr mu_tend:in-out
2195 !                rv_tendf:in-out ru_tend:in-out rw_tend:in-out
2196 !                h_diabatic:incr ru_tendf:in-out t_tend:in-out
2197 !                mu_tendf:incr t_save:incr v_save:incr rv_tend:in-out
2198 !                t_tendf:in-out mut:incr ph_tend:in-out
2199 SUBROUTINE A_RK_ADDTEND_DRY(ru_tend, ru_tendb, rv_tend, rv_tendb, &
2200 &  rw_tend, rw_tendb, ph_tend, ph_tendb, t_tend, t_tendb, ru_tendf, &
2201 &  ru_tendfb, rv_tendf, rv_tendfb, rw_tendf, rw_tendfb, ph_tendf, &
2202 &  ph_tendfb, t_tendf, t_tendfb, u_save, u_saveb, v_save, v_saveb, w_save&
2203 &  , w_saveb, ph_save, ph_saveb, t_save, t_saveb, mu_tend, mu_tendb, &
2204 &  mu_tendf, mu_tendfb, rk_step, h_diabatic, h_diabaticb, mut, mutb, &
2205 &  msftx, msfty, msfux, msfuy, msfvx, msfvx_inv, msfvy, ids, ide, jds, &
2206 &  jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, &
2207 &  kpe, its, ite, jts, jte, kts, kte)
2208   IMPLICIT NONE
2209 !  Input data.
2210   INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
2211 &  jme, kms, kme, ips, ipe, jps, jpe, kps, kpe, its, ite, jts, jte, kts, &
2212 &  kte
2213   INTEGER, INTENT(IN) :: rk_step
2214   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: ru_tend, &
2215 &  rv_tend, rw_tend, ph_tend, t_tend, ru_tendf, rv_tendf, rw_tendf, &
2216 &  ph_tendf, t_tendf
2217   REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: ru_tendb, rv_tendb, &
2218 &  rw_tendb, ph_tendb, t_tendb, ru_tendfb, rv_tendfb, rw_tendfb, &
2219 &  ph_tendfb, t_tendfb
2220   REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: mu_tend, mu_tendf
2221   REAL, DIMENSION(ims:ime, jms:jme) :: mu_tendb, mu_tendfb
2222   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: u_save, &
2223 &  v_save, w_save, ph_save, t_save, h_diabatic
2224   REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: u_saveb, v_saveb, &
2225 &  w_saveb, ph_saveb, t_saveb, h_diabaticb
2226   REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mut, msftx, msfty, &
2227 &  msfux, msfuy, msfvx, msfvx_inv, msfvy
2228   REAL, DIMENSION(ims:ime, jms:jme) :: mutb
2229 ! Local
2230   INTEGER :: i, j, k
2231   INTEGER :: branch
2232   INTEGER :: ad_to
2233   INTEGER :: ad_to0
2234   INTEGER :: ad_to1
2235   INTEGER :: ad_to2
2236   INTEGER :: min8
2237   INTEGER :: min7
2238   INTEGER :: min6
2239   INTEGER :: min5
2240   INTEGER :: min4
2241   INTEGER :: min3
2242   INTEGER :: min2
2243   INTEGER :: min1
2244   IF (jte .GT. jde - 1) THEN
2245     min1 = jde - 1
2246   ELSE
2247     min1 = jte
2248   END IF
2249 !<DESCRIPTION>
2251 ! rk_addtend_dry constructs the full large-timestep tendency terms for
2252 ! momentum (u,v,w), theta and geopotential equations.   This is accomplished
2253 ! by combining the physics tendencies (in *tendf; these are computed 
2254 ! the first RK substep, held fixed thereafter) with the RK tendencies 
2255 ! (in *tend, these include advection, pressure gradient, etc; 
2256 ! these change each rk substep).  Output is in *tend.
2258 !</DESCRIPTION>
2259 !  Finally, add the forward-step tendency to the rk_tendency
2260 ! u/v/w/save contain bc tendency that needs to be multiplied by msf
2261 ! (u by msfuy, v by msfvx)
2262 !  before adding it to physics tendency (*tendf)
2263 ! For momentum we need the final tendency to include an inverse msf
2264 ! physics/bc tendency needs to be divided, advection tendency already has it
2265 ! For scalars we need the final tendency to include an inverse msf (msfty)
2266 ! advection tendency is OK, physics/bc tendency needs to be divided by msf
2267   DO j=jts,min1
2268     DO k=kts,kte-1
2269       DO i=its,ite
2270 ! multiply by my to uncouple u
2271         IF (rk_step .EQ. 1) THEN
2272           CALL PUSHCONTROL1B(0)
2273         ELSE
2274           CALL PUSHCONTROL1B(1)
2275         END IF
2276       END DO
2277     END DO
2278   END DO
2279   DO j=jts,jte
2280     DO k=kts,kte-1
2281       IF (ite .GT. ide - 1) THEN
2282         min2 = ide - 1
2283       ELSE
2284         min2 = ite
2285       END IF
2286       DO i=its,min2
2287 ! multiply by mx to uncouple v
2288         IF (rk_step .EQ. 1) THEN
2289           CALL PUSHCONTROL1B(0)
2290         ELSE
2291           CALL PUSHCONTROL1B(1)
2292         END IF
2293       END DO
2294       CALL PUSHINTEGER4(i - 1)
2295     END DO
2296   END DO
2297   IF (jte .GT. jde - 1) THEN
2298     min3 = jde - 1
2299   ELSE
2300     min3 = jte
2301   END IF
2302   DO j=jts,min3
2303     DO k=kts,kte
2304       IF (ite .GT. ide - 1) THEN
2305         min4 = ide - 1
2306       ELSE
2307         min4 = ite
2308       END IF
2309       DO i=its,min4
2310 ! multiply by my to uncouple w
2311         IF (rk_step .EQ. 1) THEN
2312           CALL PUSHCONTROL1B(0)
2313         ELSE
2314           CALL PUSHCONTROL1B(1)
2315         END IF
2316 ! divide by my to couple w
2317         IF (rk_step .EQ. 1) THEN
2318           CALL PUSHCONTROL1B(0)
2319         ELSE
2320           CALL PUSHCONTROL1B(1)
2321         END IF
2322       END DO
2323       CALL PUSHINTEGER4(i - 1)
2324     END DO
2325   END DO
2326   IF (jte .GT. jde - 1) THEN
2327     min5 = jde - 1
2328   ELSE
2329     min5 = jte
2330   END IF
2331   DO j=jts,min5
2332     DO k=kts,kte-1
2333       IF (ite .GT. ide - 1) THEN
2334         min6 = ide - 1
2335       ELSE
2336         min6 = ite
2337       END IF
2338       DO i=its,min6
2339         IF (rk_step .EQ. 1) THEN
2340           CALL PUSHCONTROL1B(0)
2341         ELSE
2342           CALL PUSHCONTROL1B(1)
2343         END IF
2344       END DO
2345       CALL PUSHINTEGER4(i - 1)
2346     END DO
2347   END DO
2348   IF (jte .GT. jde - 1) THEN
2349     min7 = jde - 1
2350   ELSE
2351     min7 = jte
2352   END IF
2353 ! divide by my to couple heating
2354   DO j=jts,min7
2355     IF (ite .GT. ide - 1) THEN
2356       min8 = ide - 1
2357     ELSE
2358       min8 = ite
2359     END IF
2360     i = min8 + 1
2361     CALL PUSHINTEGER4(i - 1)
2362   END DO
2363   DO j=min7,jts,-1
2364     CALL POPINTEGER4(ad_to2)
2365     DO i=ad_to2,its,-1
2366       mu_tendfb(i, j) = mu_tendfb(i, j) + mu_tendb(i, j)
2367     END DO
2368   END DO
2369   DO j=min5,jts,-1
2370     DO k=kte-1,kts,-1
2371       CALL POPINTEGER4(ad_to1)
2372       DO i=ad_to1,its,-1
2373         t_tendfb(i, k, j) = t_tendfb(i, k, j) + t_tendb(i, k, j)/msfty(i&
2374 &          , j)
2375         h_diabaticb(i, k, j) = h_diabaticb(i, k, j) + mut(i, j)*t_tendb(&
2376 &          i, k, j)/msfty(i, j)
2377         mutb(i, j) = mutb(i, j) + h_diabatic(i, k, j)*t_tendb(i, k, j)/&
2378 &          msfty(i, j)
2379         CALL POPCONTROL1B(branch)
2380         IF (branch .EQ. 0) t_saveb(i, k, j) = t_saveb(i, k, j) + &
2381 &            t_tendfb(i, k, j)
2382       END DO
2383     END DO
2384   END DO
2385   DO j=min3,jts,-1
2386     DO k=kte,kts,-1
2387       CALL POPINTEGER4(ad_to0)
2388       DO i=ad_to0,its,-1
2389         ph_tendfb(i, k, j) = ph_tendfb(i, k, j) + ph_tendb(i, k, j)/&
2390 &          msfty(i, j)
2391         CALL POPCONTROL1B(branch)
2392         IF (branch .EQ. 0) ph_saveb(i, k, j) = ph_saveb(i, k, j) + &
2393 &            ph_tendfb(i, k, j)
2394         rw_tendfb(i, k, j) = rw_tendfb(i, k, j) + rw_tendb(i, k, j)/&
2395 &          msfty(i, j)
2396         CALL POPCONTROL1B(branch)
2397         IF (branch .EQ. 0) w_saveb(i, k, j) = w_saveb(i, k, j) + msfty(i&
2398 &            , j)*rw_tendfb(i, k, j)
2399       END DO
2400     END DO
2401   END DO
2402   DO j=jte,jts,-1
2403     DO k=kte-1,kts,-1
2404       CALL POPINTEGER4(ad_to)
2405       DO i=ad_to,its,-1
2406         rv_tendfb(i, k, j) = rv_tendfb(i, k, j) + msfvx_inv(i, j)*&
2407 &          rv_tendb(i, k, j)
2408         CALL POPCONTROL1B(branch)
2409         IF (branch .EQ. 0) v_saveb(i, k, j) = v_saveb(i, k, j) + msfvx(i&
2410 &            , j)*rv_tendfb(i, k, j)
2411       END DO
2412     END DO
2413   END DO
2414   DO j=min1,jts,-1
2415     DO k=kte-1,kts,-1
2416       DO i=ite,its,-1
2417         ru_tendfb(i, k, j) = ru_tendfb(i, k, j) + ru_tendb(i, k, j)/&
2418 &          msfuy(i, j)
2419         CALL POPCONTROL1B(branch)
2420         IF (branch .EQ. 0) u_saveb(i, k, j) = u_saveb(i, k, j) + msfuy(i&
2421 &            , j)*ru_tendfb(i, k, j)
2422       END DO
2423     END DO
2424   END DO
2425 END SUBROUTINE A_RK_ADDTEND_DRY
2426 !-------------------------------------------------------------------------------
2428 ! Revised by Ning Pan, 2010-08-02
2429 !   SUBROUTINE a_rk_scalar_tend(scs,sce,config_flags,rk_step,dt,a_dt,ru,a_ru,rv, &
2430    SUBROUTINE a_rk_scalar_tend(scs,sce,config_flags,tenddec,rk_step,dt,ru,a_ru,rv, &
2431    a_rv,ww,a_ww,mut,a_mut,mub,mu_old,a_mu_old,alt,a_alt,scalar_old, &
2432    a_scalar_old,scalar,a_scalar,scalar_tends,a_scalar_tends,advect_tend, &
2433    a_advect_tend,h_tendency,a_h_tendency,z_tendency,a_z_tendency, &
2434    RQVFTEN,a_RQVFTEN,base,moist_step,fnm,fnp,msfux,msfuy,msfvx, &
2435    msfvx_inv,msfvy,msftx,msfty,rdx,rdy,rdn,rdnw,khdif,kvdif,xkmhd,a_xkmhd, &
2436 ! Revised by Ning Pan, 2010-08-02
2437 !   diff_6th_opt,diff_6th_factor,a_diff_6th_factor,adv_opt,ids,ide,jds,jde,kds,kde,ims, &
2438    diff_6th_opt,diff_6th_factor,adv_opt,ids,ide,jds,jde,kds,kde,ims, &
2439    ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
2441 !PART I: DECLARATION OF VARIABLES
2443    IMPLICIT NONE
2445    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
2446    TYPE(grid_config_rec_type) :: config_flags
2447    LOGICAL :: tenddec
2448    INTEGER :: rk_step,scs,sce
2449    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
2450    LOGICAL :: moist_step
2451    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,scs:sce) :: scalar,a_scalar,scalar_old, &
2452    a_scalar_old
2453    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,scs:sce) :: scalar_tends,a_scalar_tends
2454    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: advect_tend,a_advect_tend
2455    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: h_tendency, z_tendency 
2456    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: a_h_tendency, a_z_tendency 
2457    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: RQVFTEN,a_RQVFTEN
2458    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: ru,a_ru,rv,a_rv,ww,a_ww,xkmhd, &
2459    a_xkmhd,alt,a_alt
2460    REAL,DIMENSION(kms:kme) :: fnm,fnp,rdn,rdnw,base
2461    REAL,DIMENSION(ims:ime,jms:jme) :: msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,mub, &
2462    mut,a_mut,mu_old,a_mu_old
2463    REAL :: rdx,rdy,khdif,kvdif
2464    INTEGER :: diff_6th_opt
2465 ! Revised by Ning Pan, 2010-08-02
2466 !   REAL :: diff_6th_factor,a_diff_6th_factor
2467 !   REAL :: dt,a_dt
2468    REAL :: diff_6th_factor
2469    REAL :: dt
2470    INTEGER :: adv_opt
2471    INTEGER :: im,i,j,k
2472    INTEGER :: time_step
2473    REAL :: khdq,kvdq,tendency,a_tendency
2475 !  REAL,DIMENSION(ims:ime,kms:kme,jms:jme,scs:sce,ims:ime,kms:kme,jms:jme,scs:sce) &
2476 !    :: Keep_Lpb1_scalar   
2477 !  REAL,DIMENSION(ims:ime,kms:kme,jms:jme,scs:sce,ims:ime,kms:kme,jms:jme,scs:sce) &
2478 !    :: Keep_Lpb1_scalar_old   
2479 !  REAL,DIMENSION(scs:sce,ims:ime,kms:kme,jms:jme) :: Keep_Lpb1_ru   
2480 !  REAL,DIMENSION(scs:sce,ims:ime,kms:kme,jms:jme) :: Keep_Lpb1_rv   
2481 !  REAL,DIMENSION(ims:ime,kms:kme,jms:jme,scs:sce,ims:ime,kms:kme,jms:jme,scs:sce) &
2482 !    :: Keep_Lpb1_scalar_tends   
2483    INTEGER :: IX1,IX2,IX3,IX4
2485    REAL :: Tmpv_1,Tmpv_2,Tmpv_3,Tmpv_4,Tmpv_5,Tmpv_6,Tmpv_7,Tmpv_8,Tmpv_9,Tmpv_10, &
2486    Tmpv_11,Tmpv_12
2487    REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv400
2488    REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv401
2490 !This line is fail to be recognized
2491 !        CALL nl_get_time_step ( 1, time_step )  ! Remarked by Ning Pan, 2010-08-02
2493 !PART II: CALCULATIONS OF B. S. TRAJECTORY
2495 !LPB[0]
2496       khdq = khdif/prandtl
2497       kvdq = kvdif/prandtl
2499 !!LPB[1]
2500 !      scalar_loop : DO im = scs, sce
2502 !!  DO IX3=jms,jme
2503 !!  DO IX2=kms,kme
2504 !!  DO IX1=ims,ime
2505 !    !  Keep_Lpb1_ru(im,IX1,IX2,IX3) =ru(IX1,IX2,IX3)
2506 !!  END DO
2507 !!  END DO
2508 !!  END DO
2509 !!  DO IX3=jms,jme
2510 !!  DO IX2=kms,kme
2511 !!  DO IX1=ims,ime
2512 !    !  Keep_Lpb1_rv(im,IX1,IX2,IX3) =rv(IX1,IX2,IX3)
2513 !!  END DO
2514 !!  END DO
2515 !!  END DO
2516 !!  DO IX4=scs,sce
2517 !!  DO IX3=jms,jme
2518 !!  DO IX2=kms,kme
2519 !!  DO IX1=ims,ime
2520 !    !  Keep_Lpb1_scalar_tends(ims,kms,jms,im,IX1,IX2,IX3,IX4) =scalar_tends(ims,kms,jms,im)(IX1,IX2,IX3,IX4)
2521 !!  END DO
2522 !!  END DO
2523 !!  END DO
2524 !!  END DO
2526 !        CALL zero_tend ( advect_tend(ims,kms,jms),       &
2527 !                         ids, ide, jds, jde, kds, kde,   &
2528 !                         ims, ime, jms, jme, kms, kme,   &
2529 !                         its, ite, jts, jte, kts, kte )
2530 !      IF( (rk_step == 3) .and. (adv_opt == POSITIVEDEF) ) THEN
2532 !           CALL advect_scalar_pd       ( scalar(ims,kms,jms,im),               &
2533 !                                         scalar_old(ims,kms,jms,im),           &
2534 !                                         advect_tend(ims,kms,jms),             &
2535 !                                         ru, rv, ww, mut, mub, mu_old,         &
2536 !                                         time_step, config_flags,              &
2537 !                                         msfux, msfuy, msfvx, msfvy,           &
2538 !                                         msftx, msfty, fnm, fnp,               &
2539 !                                         rdx, rdy, rdnw,dt,                    &
2540 !                                         ids, ide, jds, jde, kds, kde,         &
2541 !                                         ims, ime, jms, jme, kms, kme,         &
2542 !                                         its, ite, jts, jte, kts, kte     )
2543 !         ELSE IF( (rk_step == 3) .and. (adv_opt == MONOTONIC) ) THEN
2544 !           CALL advect_scalar_mono       ( scalar(ims,kms,jms,im),               &
2545 !                                           scalar_old(ims,kms,jms,im),           &
2546 !                                           advect_tend(ims,kms,jms),             &
2547 !                                           ru, rv, ww, mut, mub, mu_old,         &
2548 !                                           config_flags,                         &
2549 !                                           msfux, msfuy, msfvx, msfvy,           &
2550 !                                           msftx, msfty, fnm, fnp,               &
2551 !                                           rdx, rdy, rdnw,dt,                    &
2552 !                                           ids, ide, jds, jde, kds, kde,         &
2553 !                                           ims, ime, jms, jme, kms, kme,         &
2554 !                                           its, ite, jts, jte, kts, kte     )
2555 !         ELSE
2556 !           CALL advect_scalar     ( scalar(ims,kms,jms,im),          &
2557 !                                    scalar(ims,kms,jms,im),          &
2558 !                                    advect_tend(ims,kms,jms),        &
2559 !                                    ru, rv, ww, mut, time_step,      &
2560 !                                    config_flags,                    &
2561 !                                    msfux, msfuy, msfvx, msfvy,      &
2562 !                                    msftx, msfty, fnm, fnp,          &
2563 !                                    rdx, rdy, rdnw,                  &
2564 !                                    ids, ide, jds, jde, kds, kde,    &
2565 !                                    ims, ime, jms, jme, kms, kme,    &
2566 !                                    its, ite, jts, jte, kts, kte  )
2567 !         END IF
2568 !     IF((config_flags%cu_physics == GDSCHEME .OR. config_flags%cu_physics == G3SCHEME &
2569 !)                        .and. moist_step .and. ( im == P_QV) ) THEN
2571 !           CALL set_tend( RQVFTEN, advect_tend, msfty,      &
2572 !                          ids, ide, jds, jde, kds, kde,     &
2573 !                          ims, ime, jms, jme, kms, kme,     &
2574 !                          its, ite, jts, jte, kts, kte      )
2575 !        ENDIF
2576 !     rk_step_1: IF( rk_step == 1 ) THEN
2578 !       diff_opt1 : IF (config_flags%diff_opt .eq. 1) THEN
2580 !          CALL horizontal_diffusion ( 'm', scalar(ims,kms,jms,im),              &
2581 !                                           scalar_tends(ims,kms,jms,im), mut,   &
2582 !                                           config_flags,                        &
2583 !                                           msfux, msfuy, msfvx, msfvx_inv,      &
2584 !                                           msfvy, msftx, msfty,                 &
2585 !                                           khdq , xkmhd, rdx, rdy,              &
2586 !                                           ids, ide, jds, jde, kds, kde,        &
2587 !                                           ims, ime, jms, jme, kms, kme,        &
2588 !                                           its, ite, jts, jte, kts, kte      )
2589 !       pbl_test : IF (config_flags%bl_pbl_physics .eq. 0) THEN
2591 !         IF( (moist_step) .and. ( im == P_QV)) THEN
2593 !               CALL vertical_diffusion_mp ( scalar(ims,kms,jms,im),         &
2594 !                                            scalar_tends(ims,kms,jms,im),   &
2595 !                                            config_flags, base,             &
2596 !                                            alt, mut, rdn, rdnw, kvdq ,     &
2597 !                                            ids, ide, jds, jde, kds, kde,   &
2598 !                                            ims, ime, jms, jme, kms, kme,   &
2599 !                                            its, ite, jts, jte, kts, kte )
2600 !            ELSE 
2601 !               CALL vertical_diffusion (  'm', scalar(ims,kms,jms,im),         &
2602 !                                               scalar_tends(ims,kms,jms,im),   &
2603 !                                               config_flags,                   &
2604 !                                               alt, mut, rdn, rdnw, kvdq,      &
2605 !                                               ids, ide, jds, jde, kds, kde,   &
2606 !                                               ims, ime, jms, jme, kms, kme,   &
2607 !                                               its, ite, jts, jte, kts, kte )
2608 !            END IF
2609 !         ENDIF pbl_test
2610 !       ENDIF diff_opt1
2611 !    IF ( diff_6th_opt .NE. 0 )                                          &
2612 !      CALL sixth_order_diffusion( 'm', scalar(ims,kms,jms,im),          &
2613 !                                       scalar_tends(ims,kms,jms,im),    &
2614 !                                       mut, dt, config_flags,           &
2615 !                                       diff_6th_opt, diff_6th_factor,   &
2616 !                                       ids, ide, jds, jde, kds, kde,    &
2617 !                                       ims, ime, jms, jme, kms, kme,    &
2618 !                                       its, ite, jts, jte, kts, kte )
2620 !     ENDIF rk_step_1
2622 !    END DO scalar_loop
2624 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
2626 !   a_tendency =0.0  ! Remarked by Ning Pan, 2010-08-02
2628 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
2630 !LPB[1]
2631    DO im =sce, scs, -1
2632    CALL nl_get_time_step ( 1, time_step )  ! Added by Ning Pan, 2010-08-02
2634 !  DO IX3=jms,jme
2635 !  DO IX2=kms,kme
2636 !  DO IX1=ims,ime
2637 !  ru(IX1,IX2,IX3) =Keep_Lpb1_ru(im,IX1,IX2,IX3)
2638 !  END DO
2639 !  END DO
2640 !  END DO
2641 !  DO IX3=jms,jme
2642 !  DO IX2=kms,kme
2643 !  DO IX1=ims,ime
2644 !  rv(IX1,IX2,IX3) =Keep_Lpb1_rv(im,IX1,IX2,IX3)
2645 !  END DO
2646 !  END DO
2647 !  END DO
2648 !  DO IX4=scs,sce
2649 !  DO IX3=jms,jme
2650 !  DO IX2=kms,kme
2651 !  DO IX1=ims,ime
2652 !  scalar_tends(ims,kms,jms,im)(IX1,IX2,IX3,IX4) =Keep_Lpb1_scalar_tends(ims,kms,jms,im,IX1,IX2,IX3,IX4)
2653 !  END DO
2654 !  END DO
2655 !  END DO
2656 !  END DO
2658 ! Remarked by Ning Pan, 2010-08-02 : useless recomputation
2659 !   CALL zero_tend(advect_tend(ims,kms,jms),ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
2660 !   kms,kme,its,ite,jts,jte,kts,kte)
2662 !   IF( (rk_step == 3) .and. (adv_opt == POSITIVEDEF) ) THEN
2663 !   Tmpv_1 =scalar(ims,kms,jms,im)
2664 !   Tmpv_2 =scalar_old(ims,kms,jms,im)
2665 !   Tmpv_3 =advect_tend(ims,kms,jms)
2666 !   CALL advect_scalar_pd(scalar(ims,kms,jms,im),scalar_old(ims,kms,jms,im)  &
2667 !   ,advect_tend(ims,kms,jms),ru,rv,ww,mut,mub,mu_old,time_step,config_flags,msfux,msfuy,  &
2668 !   msfvx,msfvy,msftx,msfty,fnm,fnp,rdx,rdy,rdnw,dt,ids,ide,jds,jde,kds,kde,ims,ime,jms,  &
2669 !   jme,kms,kme,its,ite,jts,jte,kts,kte)
2671 !   ELSE IF( (rk_step == 3) .and. (adv_opt == MONOTONIC) ) THEN
2672 !   Tmpv_4 =scalar(ims,kms,jms,im)
2673 !   Tmpv_5 =scalar_old(ims,kms,jms,im)
2674 !   Tmpv_6 =advect_tend(ims,kms,jms)
2675 !   CALL advect_scalar_mono(scalar(ims,kms,jms,im),scalar_old(ims,kms,jms,im)  &
2676 !   ,advect_tend(ims,kms,jms),ru,rv,ww,mut,mub,mu_old,config_flags,msfux,msfuy,msfvx,  &
2677 !   msfvy,msftx,msfty,fnm,fnp,rdx,rdy,rdnw,dt,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
2678 !   kms,kme,its,ite,jts,jte,kts,kte)
2680 !   ELSE
2681 !   Tmpv_7 =scalar(ims,kms,jms,im)
2682 !   Tmpv_8 =advect_tend(ims,kms,jms)
2683 !   DO IX3=jms,jme
2684 !   DO IX2=kms,kme
2685 !   DO IX1=ims,ime
2686 !   Tmpv400(IX1,IX2,IX3) =ru(IX1,IX2,IX3)
2687 !   END DO
2688 !   END DO
2689 !   END DO
2691 !   DO IX3=jms,jme
2692 !   DO IX2=kms,kme
2693 !   DO IX1=ims,ime
2694 !   Tmpv401(IX1,IX2,IX3) =rv(IX1,IX2,IX3)
2695 !   END DO
2696 !   END DO
2697 !   END DO
2699 !   CALL advect_scalar(scalar(ims,kms,jms,im),scalar(ims,kms,jms,im),advect_tend(ims,  &
2700 !   kms,jms),ru,rv,ww,mut,time_step,config_flags,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm,  &
2701 !   fnp,rdx,rdy,rdnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
2703 !   END IF
2704 !   IF((config_flags%cu_physics == GDSCHEME .OR. config_flags%cu_physics == G3SCHEME)                                .and. moist_step .and. ( im == P_QV) ) THEN
2705 !   CALL set_tend(RQVFTEN,advect_tend,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
2706 !   kms,kme,its,ite,jts,jte,kts,kte)
2708 !   ENDIF
2709 !   IF( rk_step == 1 ) THEN
2710 !   IF(config_flags%diff_opt .eq. 1) THEN
2711 !   Tmpv_9 =scalar_tends(ims,kms,jms,im)
2712 !   CALL horizontal_diffusion('m',scalar(ims,kms,jms,im),scalar_tends(ims,kms,jms,im)  &
2713 !   ,mut,config_flags,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdq,xkmhd,rdx,rdy,  &
2714 !   ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
2716 !   IF(config_flags%bl_pbl_physics .eq. 0) THEN
2717 !   IF( (moist_step) .and. ( im == P_QV)) THEN
2718 !   Tmpv_10 =scalar_tends(ims,kms,jms,im)
2719 !   CALL vertical_diffusion_mp(scalar(ims,kms,jms,im),scalar_tends(ims,kms,jms,im)  &
2720 !   ,config_flags,base,alt,mut,rdn,rdnw,kvdq,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
2721 !   kme,its,ite,jts,jte,kts,kte)
2723 !   ELSE
2724 !   Tmpv_11 =scalar_tends(ims,kms,jms,im)
2725 !   CALL vertical_diffusion('m',scalar(ims,kms,jms,im),scalar_tends(ims,kms,jms,im)  &
2726 !   ,config_flags,alt,mut,rdn,rdnw,kvdq,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
2727 !   its,ite,jts,jte,kts,kte)
2729 !   END IF
2730 !   ENDIF
2731 !   ENDIF
2732 !   IF( diff_6th_opt .NE. 0 ) THEN
2733 !   Tmpv_12 =scalar_tends(ims,kms,jms,im)
2734 !   CALL sixth_order_diffusion('m',scalar(ims,kms,jms,im),scalar_tends(ims,kms,jms,im)  &
2735 !   ,mut,dt,config_flags,diff_6th_opt,diff_6th_factor,ids,ide,jds,jde,kds,kde,ims,ime,  &
2736 !   jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
2738 !   END IF
2739 !   ENDIF
2741    IF( rk_step == 1 ) THEN
2743    IF( diff_6th_opt .NE. 0 ) THEN
2745 !   scalar_tends(ims,kms,jms,im) =Tmpv_12  ! Remarked by Ning Pan, 2010-08-02
2747    CALL a_sixth_order_diffusion('m',scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,  &
2748    im),scalar_tends(ims,kms,jms,im),a_scalar_tends(ims,kms,jms,im),mut,a_mut,dt,  &
2749 ! Revised by Ning Pan, 2010-08-02
2750 !   a_dt,config_flags,diff_6th_opt,diff_6th_factor,a_diff_6th_factor,ids,ide,jds,jde,  &
2751    config_flags,diff_6th_opt,diff_6th_factor,ids,ide,jds,jde,  &
2752    kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
2754    END IF
2756    IF(config_flags%diff_opt .eq. 1) THEN
2758    IF(config_flags%bl_pbl_physics .eq. 0) THEN
2760 ! Added by Ning Pan, 2010-08-02
2761    IF( (moist_step) .and. ( im == P_QV)) THEN
2762    CALL a_vertical_diffusion_mp(scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im)  &
2763    ,scalar_tends(ims,kms,jms,im),a_scalar_tends(ims,kms,jms,im),config_flags,base,alt,  &
2764    a_alt,mut,a_mut,rdn,rdnw,kvdq,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
2765    its,ite,jts,jte,kts,kte)
2767    ELSE
2769 !   scalar_tends(ims,kms,jms,im) =Tmpv_11  ! Remarked by Ning Pan, 2010-08-02
2771    CALL a_vertical_diffusion('m',scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im)  &
2772    ,scalar_tends(ims,kms,jms,im),a_scalar_tends(ims,kms,jms,im),config_flags,alt,  &
2773    a_alt,mut,a_mut,rdn,rdnw,kvdq,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
2774    its,ite,jts,jte,kts,kte)
2776 ! Remarked by Ning Pan, 2010-08-02
2777 !   IF( (moist_step) .and. ( im == P_QV)) THEN
2779 !   scalar_tends(ims,kms,jms,im) =Tmpv_10
2781 !   CALL a_vertical_diffusion_mp(scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im)  &
2782 !   ,scalar_tends(ims,kms,jms,im),a_scalar_tends(ims,kms,jms,im),config_flags,base,alt,  &
2783 !   a_alt,mut,a_mut,rdn,rdnw,kvdq,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
2784 !   its,ite,jts,jte,kts,kte)
2786    END IF
2788    ENDIF
2790 !   scalar_tends(ims,kms,jms,im) =Tmpv_9  ! Remarked by Ning Pan, 2010-08-02
2792    CALL a_horizontal_diffusion('m',scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,  &
2793    im),scalar_tends(ims,kms,jms,im),a_scalar_tends(ims,kms,jms,im),mut,a_mut,  &
2794    config_flags,msfux,msfuy,msfvx,msfvx_inv,msfvy,msftx,msfty,khdq,xkmhd,a_xkmhd,rdx,  &
2795    rdy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
2797    ENDIF
2799    ENDIF
2801     IF((config_flags%cu_physics == GDSCHEME .OR. config_flags%cu_physics == G3SCHEME .OR. &
2802          config_flags%cu_physics == KFETASCHEME .OR. &      ! new trigger in KF
2803          config_flags%cu_physics == MSKFSCHEME  .OR. &
2804          config_flags%cu_physics == TIEDTKESCHEME .OR. &    ! Tiedtke
2805          config_flags%cu_physics == NTIEDTKESCHEME)    &    ! new Tiedtke
2806          .and. moist_step .and. ( im == P_QV) ) THEN
2808    CALL a_set_tend(RQVFTEN,a_RQVFTEN,advect_tend,a_advect_tend,msfty,ids,ide,  &
2809    jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
2811    ENDIF
2813    IF( (rk_step == 3) .and. (adv_opt == POSITIVEDEF) ) THEN
2815 !   advect_tend(ims,kms,jms) =Tmpv_3  ! Remarked by Ning Pan, 2010-08-02
2817 !   scalar_old(ims,kms,jms,im) =Tmpv_2  ! Remarked by Ning Pan, 2010-08-02
2819 !   scalar(ims,kms,jms,im) =Tmpv_1  ! Remarked by Ning Pan, 2010-08-02
2821    CALL a_advect_scalar_pd(scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im)  &
2822    ,scalar_old(ims,kms,jms,im),a_scalar_old(ims,kms,jms,im),advect_tend(ims,kms,jms)  &
2823    ,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) &
2824    ,ru,a_ru,rv,a_rv,ww,a_ww,mut,a_mut,mub,mu_old,  &
2825    a_mu_old,time_step,config_flags,tenddec,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm,fnp,rdx,  &
2826 ! Revised by Ning Pan, 2010-08-02
2827 !   rdy,rdnw,dt,a_dt,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
2828    rdy,rdnw,dt,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
2830    ELSE IF( (rk_step == 3) .and. (adv_opt == MONOTONIC) ) THEN
2832 !   advect_tend(ims,kms,jms) =Tmpv_6  ! Remarked by Ning Pan, 2010-08-02
2834 !   scalar_old(ims,kms,jms,im) =Tmpv_5  ! Remarked by Ning Pan, 2010-08-02
2836 !   scalar(ims,kms,jms,im) =Tmpv_4  ! Remarked by Ning Pan, 2010-08-02
2838    CALL a_advect_scalar_mono(scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im)  &
2839    ,scalar_old(ims,kms,jms,im),a_scalar_old(ims,kms,jms,im),advect_tend(ims,kms,jms)  &
2840    ,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) &
2841    ,ru,a_ru,rv,a_rv,ww,a_ww,mut,a_mut,mub,mu_old,  &
2842    a_mu_old,config_flags,tenddec,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm,fnp,rdx,rdy,rdnw,dt,  &
2843 ! Revised by Ning Pan, 2010-08-02
2844 !   a_dt,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
2845    ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
2847    ELSE IF( (rk_step == 3) .and. (adv_opt == WENO_SCALAR) ) THEN
2849    CALL a_advect_scalar_weno ( scalar(ims,kms,jms,im),        &
2850                                a_scalar(ims,kms,jms,im),      &
2851                                scalar(ims,kms,jms,im),        &
2852                                a_scalar(ims,kms,jms,im),      &
2853                                advect_tend(ims,kms,jms),      &
2854                                a_advect_tend(ims,kms,jms),    &
2855                                ru, a_ru, rv, a_rv, ww, a_ww,  &
2856                                mut, time_step,    &
2857                                config_flags,                  &
2858                                msfux, msfuy, msfvx, msfvy,    &
2859                                msftx, msfty, fnm, fnp,        &
2860                                rdx, rdy, rdnw,                &
2861                                ids, ide, jds, jde, kds, kde,  &
2862                                ims, ime, jms, jme, kms, kme,  &
2863                                its, ite, jts, jte, kts, kte  )
2865    ELSEIF( (rk_step == 3) .and. (adv_opt == WENOPD_SCALAR) ) THEN
2867    CALL a_advect_scalar_wenopd   ( scalar(ims,kms,jms,im),             &  
2868                                  a_scalar(ims,kms,jms,im),           &
2869                                  scalar_old(ims,kms,jms,im),         &    
2870                                  a_scalar_old(ims,kms,jms,im),       &
2871                                  advect_tend(ims,kms,jms),           &    
2872                                  a_advect_tend(ims,kms,jms),         &
2873                                  ru, a_ru, rv, a_rv, ww, a_ww,       &
2874                                  mut, a_mut, mub, mu_old, a_mu_old,  &
2875                                  time_step, config_flags,            &    
2876                                  msfux, msfuy, msfvx, msfvy,         &    
2877                                  msftx, msfty, fnm, fnp,             &    
2878                                  rdx, rdy, rdnw,dt,                  &    
2879                                  ids, ide, jds, jde, kds, kde,       &    
2880                                  ims, ime, jms, jme, kms, kme,       &    
2881                                  its, ite, jts, jte, kts, kte     )    
2883    ELSE
2885 ! Remarked by Ning Pan, 2010-08-02
2886 !   DO IX3=jms,jme
2887 !   DO IX2=kms,kme
2888 !   DO IX1=ims,ime
2889 !   rv(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
2890 !   END DO
2891 !   END DO
2892 !   END DO
2894 !   DO IX3=jms,jme
2895 !   DO IX2=kms,kme
2896 !   DO IX1=ims,ime
2897 !   ru(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
2898 !   END DO
2899 !   END DO
2900 !   END DO
2902 !   advect_tend(ims,kms,jms) =Tmpv_8
2904 !   scalar(ims,kms,jms,im) =Tmpv_7
2906    CALL a_advect_scalar(scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im)  &
2907    ,scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im),advect_tend(ims,kms,jms)  &
2908    ,a_advect_tend(ims,kms,jms),ru,a_ru,rv,a_rv,ww,a_ww,mut,time_step,  &
2909    config_flags,msfux,msfuy,msfvx,msfvy,msftx,msfty,fnm,fnp,rdx,rdy,rdnw,ids,ide,jds,  &
2910    jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
2912    END IF
2914 ! Added by Ning Pan, 2010-08-02
2915    CALL a_zero_tend(a_advect_tend,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
2916    kms,kme,its,ite,jts,jte,kts,kte)
2917    CALL a_zero_tend(a_h_tendency,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
2918    kms,kme,its,ite,jts,jte,kts,kte)
2919    CALL a_zero_tend(a_z_tendency,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
2920    kms,kme,its,ite,jts,jte,kts,kte)
2922    ENDDO
2924 !LPB[0]
2925 !  khdq =khdif/prandtl
2926 !  kvdq =kvdif/prandtl
2928    END SUBROUTINE a_rk_scalar_tend
2930 !-------------------------------------------------------------------------------
2931 !        Generated by TAPENADE     (INRIA, Tropics team)
2932 !  Tapenade 3.10 (r5498) - 20 Jan 2015 09:48
2934 !  Differentiation of q_diabatic_add in reverse (adjoint) mode:
2935 !   gradient     of useful results: qc_diabatic qv_diabatic scalar_tends
2936 !                mu
2937 !   with respect to varying inputs: qc_diabatic qv_diabatic scalar_tends
2938 !                mu
2939 !   RW status of diff variables: qc_diabatic:incr qv_diabatic:incr
2940 !                scalar_tends:in-out mu:incr
2941 SUBROUTINE a_Q_DIABATIC_ADD(scs, sce, dt, mu, mub, qv_diabatic, &
2942 & qv_diabaticb, qc_diabatic, qc_diabaticb, scalar_tends, scalar_tendsb, &
2943 & ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, &
2944 & jts, jte, kts, kte)
2945   IMPLICIT NONE
2946 !  Input data.
2947   INTEGER, INTENT(IN) :: scs, sce
2948   INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
2949 & jme, kms, kme, its, ite, jts, jte, kts, kte
2950   REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mu
2951   REAL, DIMENSION(ims:ime, jms:jme) :: mub
2952   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: qv_diabatic&
2953 & , qc_diabatic
2954   REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: qv_diabaticb, &
2955 & qc_diabaticb
2956   REAL, DIMENSION(ims:ime, kms:kme, jms:jme, scs:sce), INTENT(INOUT) :: &
2957 & scalar_tends
2958   REAL, DIMENSION(ims:ime, kms:kme, jms:jme, scs:sce), INTENT(INOUT) :: &
2959 & scalar_tendsb
2960   REAL, INTENT(IN) :: dt
2961 ! Local data
2962   INTEGER :: im, i, j, k
2963   INTEGER :: ad_to
2964   INTEGER :: ad_to0
2965   INTEGER :: ad_to1
2966   INTEGER :: ad_to2
2967   INTEGER :: branch
2968   INTEGER :: min4
2969   INTEGER :: min3
2970   INTEGER :: min2
2971   INTEGER :: min1
2972 scalar_loop:DO im=scs,sce
2973     IF (im .EQ. p_qv) THEN
2974       IF (jte .GT. jde - 1) THEN
2975         min1 = jde - 1
2976       ELSE
2977         min1 = jte
2978       END IF
2979       DO j=jts,min1
2980         DO k=kts,kte-1
2981           IF (ite .GT. ide - 1) THEN
2982             min2 = ide - 1
2983           ELSE
2984             min2 = ite
2985           END IF
2986           i = min2 + 1
2987           CALL PUSHINTEGER4(i - 1)
2988         END DO
2989       END DO
2990       CALL PUSHINTEGER4(j - 1)
2991       CALL PUSHCONTROL1B(0)
2992     ELSE
2993       CALL PUSHCONTROL1B(1)
2994     END IF
2995     IF (im .EQ. p_qc) THEN
2996       IF (jte .GT. jde - 1) THEN
2997         min3 = jde - 1
2998       ELSE
2999         min3 = jte
3000       END IF
3001       DO j=jts,min3
3002         DO k=kts,kte-1
3003           IF (ite .GT. ide - 1) THEN
3004             min4 = ide - 1
3005           ELSE
3006             min4 = ite
3007           END IF
3008           i = min4 + 1
3009           CALL PUSHINTEGER4(i - 1)
3010         END DO
3011       END DO
3012       CALL PUSHINTEGER4(j - 1)
3013       CALL PUSHCONTROL1B(1)
3014     ELSE
3015       CALL PUSHCONTROL1B(0)
3016     END IF
3017   END DO scalar_loop
3018   DO im=sce,scs,-1
3019     CALL POPCONTROL1B(branch)
3020     IF (branch .NE. 0) THEN
3021       CALL POPINTEGER4(ad_to2)
3022       DO j=ad_to2,jts,-1
3023         DO k=kte-1,kts,-1
3024           CALL POPINTEGER4(ad_to1)
3025           DO i=ad_to1,its,-1
3026             qc_diabaticb(i,k,j) = qc_diabaticb(i,k,j) + &
3027                                   mu(i,j)*scalar_tendsb(i,k,j,im)
3028             mub(i,j) = mub(i,j) + &
3029                        qc_diabatic(i,k,j)*scalar_tendsb(i,k,j,im)
3030           END DO
3031         END DO
3032       END DO
3033     END IF
3034     CALL POPCONTROL1B(branch)
3035     IF (branch .EQ. 0) THEN
3036       CALL POPINTEGER4(ad_to0)
3037       DO j=ad_to0,jts,-1
3038         DO k=kte-1,kts,-1
3039           CALL POPINTEGER4(ad_to)
3040           DO i=ad_to,its,-1
3041             qv_diabaticb(i,k,j) = qv_diabaticb(i,k,j) + &
3042                                   mu(i,j)*scalar_tendsb(i,k,j,im)
3043             mub(i,j) = mub(i,j) + &
3044                        qv_diabatic(i,k,j)*scalar_tendsb(i,k,j,im)
3045           END DO
3046         END DO
3047       END DO
3048     END IF
3049   END DO
3050 END SUBROUTINE a_Q_DIABATIC_ADD
3052 !-------------------------------------------------------------------------------
3053 !        Generated by TAPENADE     (INRIA, Tropics team)
3054 !  Tapenade 3.10 (r5498) - 20 Jan 2015 09:48
3056 !  Differentiation of q_diabatic_subtr in reverse (adjoint) mode:
3057 !   gradient     of useful results: qc_diabatic qv_diabatic scalar
3058 !   with respect to varying inputs: qc_diabatic qv_diabatic scalar
3059 !   RW status of diff variables: qc_diabatic:incr qv_diabatic:incr
3060 !                scalar:in-out
3061 SUBROUTINE a_Q_DIABATIC_SUBTR(scs, sce, dt, qv_diabatic, qv_diabaticb, &
3062 & qc_diabatic, qc_diabaticb, scalar, scalarb, ids, ide, jds, jde, kds, &
3063 & kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
3064   IMPLICIT NONE
3065 !  Input data.
3066   INTEGER, INTENT(IN) :: scs, sce
3067   INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
3068 & jme, kms, kme, its, ite, jts, jte, kts, kte
3069   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: qv_diabatic&
3070 & , qc_diabatic
3071   REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: qv_diabaticb, &
3072 & qc_diabaticb
3073   REAL, DIMENSION(ims:ime, kms:kme, jms:jme, scs:sce), INTENT(INOUT) :: &
3074 & scalar
3075   REAL, DIMENSION(ims:ime, kms:kme, jms:jme, scs:sce), INTENT(INOUT) :: &
3076 & scalarb
3077   REAL, INTENT(IN) :: dt
3078 ! Local data
3079   INTEGER :: im, i, j, k
3080   INTEGER :: ad_to
3081   INTEGER :: ad_to0
3082   INTEGER :: ad_to1
3083   INTEGER :: ad_to2
3084   INTEGER :: branch
3085   INTEGER :: min4
3086   INTEGER :: min3
3087   INTEGER :: min2
3088   INTEGER :: min1
3089 scalar_loop:DO im=scs,sce
3090     IF (im .EQ. p_qv) THEN
3091       IF (jte .GT. jde - 1) THEN
3092         min1 = jde - 1
3093       ELSE
3094         min1 = jte
3095       END IF
3096       DO j=jts,min1
3097         DO k=kts,kte-1
3098           IF (ite .GT. ide - 1) THEN
3099             min2 = ide - 1
3100           ELSE
3101             min2 = ite
3102           END IF
3103           i = min2 + 1
3104           CALL PUSHINTEGER4(i - 1)
3105         END DO
3106       END DO
3107       CALL PUSHINTEGER4(j - 1)
3108       CALL PUSHCONTROL1B(0)
3109     ELSE
3110       CALL PUSHCONTROL1B(1)
3111     END IF
3112     IF (im .EQ. p_qc) THEN
3113       IF (jte .GT. jde - 1) THEN
3114         min3 = jde - 1
3115       ELSE
3116         min3 = jte
3117       END IF
3118       DO j=jts,min3
3119         DO k=kts,kte-1
3120           IF (ite .GT. ide - 1) THEN
3121             min4 = ide - 1
3122           ELSE
3123             min4 = ite
3124           END IF
3125           i = min4 + 1
3126           CALL PUSHINTEGER4(i - 1)
3127         END DO
3128       END DO
3129       CALL PUSHINTEGER4(j - 1)
3130       CALL PUSHCONTROL1B(1)
3131     ELSE
3132       CALL PUSHCONTROL1B(0)
3133     END IF
3134   END DO scalar_loop
3135   DO im=sce,scs,-1
3136     CALL POPCONTROL1B(branch)
3137     IF (branch .NE. 0) THEN
3138       CALL POPINTEGER4(ad_to2)
3139       DO j=ad_to2,jts,-1
3140         DO k=kte-1,kts,-1
3141           CALL POPINTEGER4(ad_to1)
3142           DO i=ad_to1,its,-1
3143             qc_diabaticb(i,k,j) = qc_diabaticb(i,k,j) - &
3144                                   dt*scalarb(i,k,j,im)
3145           END DO
3146         END DO
3147       END DO
3148     END IF
3149     CALL POPCONTROL1B(branch)
3150     IF (branch .EQ. 0) THEN
3151       CALL POPINTEGER4(ad_to0)
3152       DO j=ad_to0,jts,-1
3153         DO k=kte-1,kts,-1
3154           CALL POPINTEGER4(ad_to)
3155           DO i=ad_to,its,-1
3156             qv_diabaticb(i,k,j) = qv_diabaticb(i,k,j) - &
3157                                   dt*scalarb(i,k,j,im)
3158           END DO
3159         END DO
3160       END DO
3161     END IF
3162   END DO
3163 END SUBROUTINE a_Q_DIABATIC_SUBTR
3165 !-------------------------------------------------------------------------------
3167 SUBROUTINE a_rk_update_scalar ( scs, sce,                      &
3168                                 scalar_1, a_scalar_1, scalar_2, a_scalar_2, sc_tend, a_sc_tend,  &
3169                                 advh_t, a_advh_t, advz_t,  a_advz_t,             & 
3170                                 advect_tend, a_advect_tend,    &
3171                                 h_tendency, a_h_tendency, z_tendency, a_z_tendency,  & 
3172                                 msftx, msfty,                  &
3173                                 mu_old, a_mu_old, mu_new, a_mu_new, mu_base,  &
3174                                 rk_step, dt, spec_zone,        &
3175                                 config_flags,                  &
3176                                 tenddec,                       &
3177                                 ids, ide, jds, jde, kds, kde,  &
3178                                 ims, ime, jms, jme, kms, kme,  &
3179                                 its, ite, jts, jte, kts, kte  )
3181    IMPLICIT NONE
3183    !  Input data.
3185    TYPE(grid_config_rec_type), INTENT(IN) :: config_flags
3186    LOGICAL :: tenddec
3188    INTEGER, INTENT(IN) :: scs, sce, rk_step, spec_zone
3189    INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, &
3190                           ims, ime, jms, jme, kms, kme, &
3191                           its, ite, jts, jte, kts, kte
3193    REAL,    INTENT(IN) :: dt
3195    REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce),                &
3196          INTENT(INOUT)                                  :: a_scalar_1,  &
3197                                                            a_scalar_2
3198    REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce),                &
3199          INTENT(IN)                                     :: scalar_1,    &
3200                                                            scalar_2
3202    REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce),                &
3203          INTENT(INOUT)                                  :: a_sc_tend
3204    REAL, DIMENSION(ims:ime, kms:kme, jms:jme , scs:sce),                &
3205          INTENT(IN)                                     :: sc_tend
3207    REAL, DIMENSION(ims:ime, kms:kme, jms:jme ),                &
3208          INTENT(INOUT)                               :: a_advect_tend
3209    REAL, DIMENSION(ims:ime, kms:kme, jms:jme ),                &
3210          INTENT(IN)                                  :: advect_tend
3212    REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), OPTIONAL :: advh_t,  advz_t ! accumulating for output
3213    REAL, DIMENSION(ims:ime, kms:kme, jms:jme ), OPTIONAL :: a_advh_t,  a_advz_t ! accumulating for output
3214    REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) :: h_tendency, z_tendency ! from rk_scalar_tend
3215    REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) :: a_h_tendency, a_z_tendency ! from rk_scalar_tend
3217    REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) ::  a_mu_old,  &
3218                                                         a_mu_new
3219    REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN   ) ::  mu_old,  &
3220                                                         mu_new,  &
3221                                                         mu_base, &
3222                                                         msftx,   &
3223                                                         msfty
3225    INTEGER :: i,j,k,im
3226    REAL    :: sc_middle, msfsq
3227    REAL, DIMENSION(its:ite) :: a_muold, a_r_munew
3228    REAL, DIMENSION(its:ite) :: muold, r_munew
3230    REAL, DIMENSION(its:ite, kts:kte, jts:jte  ) :: a_tendency
3231    REAL, DIMENSION(its:ite, kts:kte, jts:jte  ) :: tendency
3233    REAL, DIMENSION(ims:ime, kms:kme, jms:jme, scs:sce) :: scalar_old
3235    INTEGER :: i_start,i_end,j_start,j_end,k_start,k_end
3236    INTEGER :: i_start_spc,i_end_spc,j_start_spc,j_end_spc,k_start_spc,k_end_spc
3238 !<DESCRIPTION> !
3239 !  Basic states: mu_old, mu_new, advect_tend, sc_tend, scalar_2(rk_step=1), scalar_1(rk_step/=1)
3241 !</DESCRIPTION>
3243 !  Initilize local adjoint variables
3244    a_muold = 0.0
3245    a_r_munew = 0.0
3246    a_tendency = 0.0
3248 !  set loop limits.
3250       i_start = its
3251       i_end   = min(ite,ide-1)
3252       j_start = jts
3253       j_end   = min(jte,jde-1)
3254       k_start = kts
3255       k_end   = kte-1
3257       i_start_spc = i_start
3258       i_end_spc   = i_end
3259       j_start_spc = j_start
3260       j_end_spc   = j_end
3261       k_start_spc = k_start
3262       k_end_spc   = k_end
3264     IF( config_flags%nested .or. config_flags%specified ) THEN
3265       IF( .NOT. config_flags%periodic_x)i_start = max( its,ids+spec_zone )
3266       IF( .NOT. config_flags%periodic_x)i_end   = min( ite,ide-spec_zone-1 )
3267       j_start = max( jts,jds+spec_zone )
3268       j_end   = min( jte,jde-spec_zone-1 )
3269       k_start = kts
3270       k_end   = min( kte, kde-1 )
3271     ENDIF
3273     IF ( rk_step == 1 ) THEN
3275      DO  im = sce,scs,-1
3277 !     Recalculate tendency
3278       DO  j = jts, min(jte,jde-1)
3279       DO  k = kts, min(kte,kde-1)
3280       DO  i = its, min(ite,ide-1)
3281           tendency(i,k,j) = 0.
3282       ENDDO
3283       ENDDO
3284       ENDDO
3286       DO  j = j_start,j_end
3287       DO  k = k_start,k_end
3288       DO  i = i_start,i_end
3289          ! scalar was coupled with my
3290           tendency(i,k,j) = advect_tend(i,k,j) * msfty(i,j)
3291       ENDDO
3292       ENDDO
3293       ENDDO
3295       DO  j = j_start_spc,j_end_spc
3296       DO  k = k_start_spc,k_end_spc
3297       DO  i = i_start_spc,i_end_spc
3298           tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im)
3299       ENDDO
3300       ENDDO
3301       ENDDO
3303       DO  j = jts, min(jte,jde-1)
3305 !     Recalculate muold and r_munew
3306       DO  i = its, min(ite,ide-1)
3307         muold(i) = mu_old(i,j) + mu_base(i,j)
3308         r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j))
3309       ENDDO
3311       DO  k = kts, min(kte,kde-1)
3312       DO  i = its, min(ite,ide-1)
3313 !       Recalculate scalar_1 (i.e. scalar_old)
3314         scalar_old(i,k,j,im) = scalar_2(i,k,j,im)
3316         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)
3317         a_muold(i) = a_muold(i) + scalar_old(i,k,j,im)*r_munew(i) * a_scalar_2(i,k,j,im)
3318         a_tendency(i,k,j) = a_tendency(i,k,j) + dt*r_munew(i) * a_scalar_2(i,k,j,im)
3319         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)
3320         a_scalar_2(i,k,j,im) = 0.0
3322         a_scalar_2(i,k,j,im) = a_scalar_2(i,k,j,im) + a_scalar_1(i,k,j,im)
3323         a_scalar_1(i,k,j,im) = 0.0
3324       ENDDO !i
3325       ENDDO !k
3327       DO  i = its, min(ite,ide-1)
3328         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)))
3329         a_r_munew(i) = 0.0
3331         a_mu_old(i,j) = a_mu_old(i,j) + a_muold(i)
3332         a_muold(i) = 0.0
3333       ENDDO
3335       ENDDO !j
3337       DO  j = j_start_spc,j_end_spc
3338       DO  k = k_start_spc,k_end_spc
3339       DO  i = i_start_spc,i_end_spc
3340           a_sc_tend(i,k,j,im) = a_sc_tend(i,k,j,im) + a_tendency(i,k,j)
3341       ENDDO
3342       ENDDO
3343       ENDDO
3345       DO  j = j_start,j_end
3346       DO  k = k_start,k_end
3347       DO  i = i_start,i_end
3348          ! scalar was coupled with my
3349           a_advect_tend(i,k,j) = a_advect_tend(i,k,j) + msfty(i,j) * a_tendency(i,k,j)
3350           a_tendency(i,k,j) = 0.0
3351       ENDDO
3352       ENDDO
3353       ENDDO
3355       DO  j = jts, min(jte,jde-1)
3356       DO  k = kts, min(kte,kde-1)
3357       DO  i = its, min(ite,ide-1)
3358           a_tendency(i,k,j) = 0.
3359       ENDDO
3360       ENDDO
3361       ENDDO
3363      ENDDO !im
3365     ELSE
3367      DO  im = sce, scs, -1
3369 !     Recalculate tendency
3370       DO  j = jts, min(jte,jde-1)
3371       DO  k = kts, min(kte,kde-1)
3372       DO  i = its, min(ite,ide-1)
3373           tendency(i,k,j) = 0.
3374       ENDDO
3375       ENDDO
3376       ENDDO
3378       DO  j = j_start,j_end
3379       DO  k = k_start,k_end
3380       DO  i = i_start,i_end
3381          ! scalar was coupled with my
3382           tendency(i,k,j) = advect_tend(i,k,j) * msfty(i,j)
3383       ENDDO
3384       ENDDO
3385       ENDDO
3387       DO  j = j_start_spc,j_end_spc
3388       DO  k = k_start_spc,k_end_spc
3389       DO  i = i_start_spc,i_end_spc
3390           tendency(i,k,j) = tendency(i,k,j) + sc_tend(i,k,j,im)
3391       ENDDO
3392       ENDDO
3393       ENDDO
3395       DO  j = jts, min(jte,jde-1)
3397 !     Recalculate muold and r_munew
3398       DO  i = its, min(ite,ide-1)
3399         muold(i) = mu_old(i,j) + mu_base(i,j)
3400         r_munew(i) = 1./(mu_new(i,j) + mu_base(i,j))
3401       ENDDO
3403       ! This is separated from the k/i-loop above for better performance
3404       IF ( PRESENT(advh_t) .AND. PRESENT(advz_t) .AND. PRESENT(a_advh_t) .AND. PRESENT(a_advz_t) ) THEN
3405          IF (tenddec.and.rk_step.eq.config_flags%rk_ord) THEN
3406             DO k = kts, min(kte,kde-1)
3407             DO i = its, min(ite,ide-1)
3409                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)
3410                a_r_munew(i) = a_r_munew(i) + (dt*h_tendency(i,k,j)* msfty(i,j))*a_advh_t(i,k,j)
3411                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)
3412                a_r_munew(i) = a_r_munew(i) + (dt*z_tendency(i,k,j)* msfty(i,j))*a_advz_t(i,k,j)
3414             ENDDO
3415             ENDDO
3416          END IF
3417       END IF
3419       DO  k = kts, min(kte,kde-1)
3420       DO  i = its, min(ite,ide-1)
3422         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)
3423         a_muold(i) = a_muold(i) + scalar_1(i,k,j,im)*r_munew(i) * a_scalar_2(i,k,j,im)
3424         a_tendency(i,k,j) = a_tendency(i,k,j) + dt*r_munew(i) * a_scalar_2(i,k,j,im)
3425         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)
3427         a_scalar_2(i,k,j,im) = 0.0
3429       ENDDO
3430       ENDDO
3432       DO  i = its, min(ite,ide-1)
3433         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)))
3434         a_r_munew(i) = 0.0
3436         a_mu_old(i,j) = a_mu_old(i,j) + a_muold(i)
3437         a_muold(i) = 0.0
3438       ENDDO
3440       ENDDO !j
3442        DO  j = j_start_spc,j_end_spc
3443        DO  k = k_start_spc,k_end_spc
3444        DO  i = i_start_spc,i_end_spc
3445           a_sc_tend(i,k,j,im) = a_sc_tend(i,k,j,im) + a_tendency(i,k,j)
3446        ENDDO
3447        ENDDO
3448        ENDDO
3450        DO  j = j_start,j_end
3451        DO  k = k_start,k_end
3452        DO  i = i_start,i_end
3453           ! scalar was coupled with my
3454           a_advect_tend(i,k,j) = a_advect_tend(i,k,j) + msfty(i,j) * a_tendency(i,k,j)
3455           a_tendency(i,k,j) = 0.0
3456        ENDDO
3457        ENDDO
3458        ENDDO
3460        DO  j = jts, min(jte,jde-1)
3461        DO  k = kts, min(kte,kde-1)
3462        DO  i = its, min(ite,ide-1)
3463            a_tendency(i,k,j) = 0.
3464        ENDDO
3465        ENDDO
3466        ENDDO
3468       ENDDO !im
3470     END IF
3472 END SUBROUTINE a_rk_update_scalar
3474 !-------------------------------------------------------------------------------
3476    SUBROUTINE a_rk_update_scalar_pd(scs,sce,scalar,a_scalar,sc_tend,a_sc_tend, &
3477    mu_old,a_mu_old,mu_new,a_mu_new,mu_base,rk_step,dt,spec_zone, &
3478    config_flags,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
3480 !PART I: DECLARATION OF VARIABLES
3482    IMPLICIT NONE
3484    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
3485    TYPE(grid_config_rec_type) :: config_flags
3486    INTEGER :: scs,sce,rk_step,spec_zone
3487    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
3488    REAL :: dt
3489    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,scs:sce) :: scalar,a_scalar,sc_tend,a_sc_tend
3490    REAL,DIMENSION(ims:ime,jms:jme) :: mu_old,a_mu_old,mu_new,a_mu_new,mu_base
3491    INTEGER :: i,j,k,im
3492    REAL :: sc_middle,sfsq
3493    REAL,DIMENSION(its:ite) :: muold,a_muold,r_munew,a_r_munew
3494    REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: tendency,a_tendency
3495    INTEGER :: i_start,i_end,j_start,j_end,k_start,k_end
3496    INTEGER :: i_start_spc,i_end_spc,j_start_spc,j_end_spc,k_start_spc,k_end_spc
3498    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3
3499    REAL,ALLOCATABLE,DIMENSION(:,:) :: Tmpv300
3500    REAL,DIMENSION(its:min(ite, ide-1),jts:min(jte, jde-1)) :: Tmpv301
3501    REAL,DIMENSION(its:min(ite, ide-1),kts:min(kte, kde-1),jts:min(jte, jde-1)) :: Tmpv400
3503 !PART II: CALCULATIONS OF B. S. TRAJECTORY
3505 !LPB[0]
3507          i_start = its
3508          i_end   = min(ite,ide-1)
3509          j_start = jts
3510          j_end   = min(jte,jde-1)
3511          k_start = kts
3512          k_end   = kte-1
3514          i_start_spc = i_start
3515          i_end_spc   = i_end
3516          j_start_spc = j_start
3517          j_end_spc   = j_end
3518          k_start_spc = k_start
3519          k_end_spc   = k_end
3521 !LPB[1]
3522     IF( config_flags%nested .or. config_flags%specified ) THEN
3523       IF( .NOT. config_flags%periodic_x)i_start = max( its,ids+spec_zone )
3524       IF( .NOT. config_flags%periodic_x)i_end   = min( ite,ide-spec_zone-1 )
3525          j_start = max( jts,jds+spec_zone )
3526          j_end   = min( jte,jde-spec_zone-1 )
3527          k_start = kts
3528          k_end   = min( kte, kde-1 )
3529    ENDIF
3531 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
3533    a_muold =0.
3534    a_r_munew =0.
3536 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
3538 !LPB[2]
3539    DO im =sce, scs, -1
3541    tendency(its:min(ite,ide-1),kts:min(kte,kde-1),jts:min(jte,jde-1)) =0.
3543    tendency(i_start_spc:i_end_spc,k_start_spc:k_end_spc,j_start_spc:j_end_spc) =tendency&
3544    (i_start_spc:i_end_spc,k_start_spc:k_end_spc,j_start_spc:j_end_spc) +sc_tend&
3545    (i_start_spc:i_end_spc,k_start_spc:k_end_spc,j_start_spc:j_end_spc,im)
3547    sc_tend(i_start_spc:i_end_spc,k_start_spc:k_end_spc,j_start_spc:j_end_spc,im) =0.
3549    ALLOCATE (Tmpv300(its:min(ite, ide-1),jts:min(jte, jde-1)))
3551    DO j =jts, min(jte, jde-1)
3552      DO i =its, min(ite, ide-1)
3553      Tmpv300(i,j) =mu_old(i,j) +mu_base(i,j)
3554      ENDDO
3556      DO k =kts, min(kte, kde-1)
3557      DO i =its, min(ite, ide-1)
3558      Tmpv400(i,k,j) =Tmpv300(i,j)*scalar(i,k,j,im)+dt*tendency(i,k,j)
3559      ENDDO
3560      ENDDO
3561    ENDDO
3563    DO j =min(jte, jde-1), jts, -1
3565    DO k =kts, min(kte, kde-1)
3566    DO i =its, min(ite, ide-1)
3567    a_r_munew(i) =a_r_munew(i) +Tmpv400(i,k,j)*a_scalar(i,k,j,im)
3568    a_Tmpv1 = a_scalar(i,k,j,im)/(mu_new(i,j)+mu_base(i,j))
3569    a_tendency(i,k,j) =dt*a_Tmpv1
3570    a_muold(i) =a_muold(i) +scalar(i,k,j,im)*a_Tmpv1
3571    a_scalar(i,k,j,im) =Tmpv300(i,j)*a_Tmpv1
3572    ENDDO
3573    ENDDO
3575    DO i =its, min(ite, ide-1)
3576    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))
3577    ENDDO
3579    a_r_munew(its:min(ite,ide-1)) =0.0
3580    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))
3581    a_muold(its:min(ite,ide-1)) =0.0
3583    ENDDO
3585    a_sc_tend(i_start_spc:i_end_spc,k_start_spc:k_end_spc,j_start_spc:j_end_spc,im) =a_tendency(&
3586    i_start_spc:i_end_spc,k_start_spc:k_end_spc,j_start_spc:j_end_spc)
3588    ENDDO
3590    DEALLOCATE (Tmpv300)
3592    END SUBROUTINE a_rk_update_scalar_pd
3594 !------------------------------------------------------------
3596 !        Generated by TAPENADE     (INRIA, Tropics team)
3597 !  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
3599 !  Differentiation of calculate_phy_tend in reverse (adjoint) mode:
3600 !   gradient     of useful results: rthndgdten rublten rqvndgdten
3601 !                rthraten rqccuten rthcuten rqicuten rvndgdten
3602 !                rqscuten rqrshten rqvshten rucuten rvshten rqvblten
3603 !                rvblten rqcshten rthshten rqgshten rqishten rqcblten
3604 !                rthblten rqrcuten rqiblten rqsshten rqvcuten rvcuten
3605 !                rushten muu muv rundgdten mu
3606 !   with respect to varying inputs: rthndgdten rublten rqvndgdten
3607 !                rthraten rqccuten rthcuten rqicuten rvndgdten
3608 !                rqscuten rqrshten rqvshten rucuten rvshten rqvblten
3609 !                rvblten rqcshten rthshten rqgshten rqishten rqcblten
3610 !                rthblten rqrcuten rqiblten rqsshten rqvcuten rvcuten
3611 !                rushten muu muv rundgdten mu
3612 !   RW status of diff variables: rthndgdten:in-out rublten:in-out
3613 !                rqvndgdten:in-out rthraten:in-out rqccuten:in-out
3614 !                rthcuten:in-out rqicuten:in-out rvndgdten:in-out
3615 !                rqscuten:in-out rqrshten:in-out rqvshten:in-out
3616 !                rucuten:in-out rvshten:in-out rqvblten:in-out
3617 !                rvblten:in-out rqcshten:in-out rthshten:in-out
3618 !                rqgshten:in-out rqishten:in-out rqcblten:in-out
3619 !                rthblten:in-out rqrcuten:in-out rqiblten:in-out
3620 !                rqsshten:in-out rqvcuten:in-out rvcuten:in-out
3621 !                rushten:in-out muu:incr muv:incr rundgdten:in-out
3622 !                mu:incr
3623 SUBROUTINE A_CALCULATE_PHY_TEND(config_flags, mu, mub, muu, muub, muv, &
3624 &  muvb, pi3d, rthraten, rthratenb, rublten, rubltenb, rvblten, rvbltenb&
3625 &  , rthblten, rthbltenb, rqvblten, rqvbltenb, rqcblten, rqcbltenb, &
3626 &  rqiblten, rqibltenb, rucuten, rucutenb, rvcuten, rvcutenb, rthcuten, &
3627 &  rthcutenb, rqvcuten, rqvcutenb, rqccuten, rqccutenb, rqrcuten, &
3628 &  rqrcutenb, rqicuten, rqicutenb, rqscuten, rqscutenb, rushten, rushtenb&
3629 &  , rvshten, rvshtenb, rthshten, rthshtenb, rqvshten, rqvshtenb, &
3630 &  rqcshten, rqcshtenb, rqrshten, rqrshtenb, rqishten, rqishtenb, &
3631 &  rqsshten, rqsshtenb, rqgshten, rqgshtenb, rundgdten, rundgdtenb, &
3632 &  rvndgdten, rvndgdtenb, rthndgdten, rthndgdtenb, rqvndgdten, &
3633 &  rqvndgdtenb, rmundgdten, ids, ide, jds, jde, kds, kde, ims, ime, jms, &
3634 &  jme, kms, kme, its, ite, jts, jte, kts, kte)
3635   IMPLICIT NONE
3636   TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
3637   INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
3638 &  jme, kms, kme, its, ite, jts, jte, kts, kte
3639   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: pi3d
3640   REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: mu, muu, muv
3641   REAL, DIMENSION(ims:ime, jms:jme) :: mub, muub, muvb
3642 ! radiation
3643   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rthraten
3644   REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rthratenb
3645 ! cumulus
3646   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rucuten, &
3647 &  rvcuten, rthcuten, rqvcuten, rqccuten, rqrcuten, rqicuten, rqscuten, &
3648 &  rushten, rvshten, rthshten, rqvshten, rqcshten, rqrshten, rqishten, &
3649 &  rqsshten, rqgshten
3650   REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rucutenb, rvcutenb, &
3651 &  rthcutenb, rqvcutenb, rqccutenb, rqrcutenb, rqicutenb, rqscutenb, &
3652 &  rushtenb, rvshtenb, rthshtenb, rqvshtenb, rqcshtenb, rqrshtenb, &
3653 &  rqishtenb, rqsshtenb, rqgshtenb
3654 ! pbl
3655   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rublten, &
3656 &  rvblten, rthblten, rqvblten, rqcblten, rqiblten
3657   REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rubltenb, rvbltenb, &
3658 &  rthbltenb, rqvbltenb, rqcbltenb, rqibltenb
3659 ! fdda
3660   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rundgdten&
3661 &  , rvndgdten, rthndgdten, rqvndgdten
3662   REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rundgdtenb, rvndgdtenb, &
3663 &  rthndgdtenb, rqvndgdtenb
3664   REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: rmundgdten
3665   INTEGER :: i, k, j
3666   INTEGER :: itf, ktf, jtf, itsu, jtsv
3667   INTEGER :: branch
3668   IF (ite .GT. ide - 1) THEN
3669     itf = ide - 1
3670   ELSE
3671     itf = ite
3672   END IF
3673   IF (jte .GT. jde - 1) THEN
3674     jtf = jde - 1
3675   ELSE
3676     jtf = jte
3677   END IF
3678   IF (kte .GT. kde - 1) THEN
3679     ktf = kde - 1
3680   ELSE
3681     ktf = kte
3682   END IF
3683   IF (its .LT. ids + 1) THEN
3684     itsu = ids + 1
3685   ELSE
3686     itsu = its
3687   END IF
3688   IF (jts .LT. jds + 1) THEN
3689     jtsv = jds + 1
3690   ELSE
3691     jtsv = jts
3692   END IF
3693 ! radiation
3694   IF (config_flags%ra_lw_physics .GT. 0 .OR. config_flags%ra_sw_physics &
3695 &      .GT. 0) THEN
3696     CALL PUSHCONTROL1B(0)
3697   ELSE
3698     CALL PUSHCONTROL1B(1)
3699   END IF
3700 ! cumulus
3701   IF (config_flags%cu_physics .GT. 0) THEN
3702     IF (p_qc .GE. param_first_scalar) THEN
3703       CALL PUSHCONTROL1B(0)
3704     ELSE
3705       CALL PUSHCONTROL1B(1)
3706     END IF
3707     IF (p_qr .GE. param_first_scalar) THEN
3708       CALL PUSHCONTROL1B(0)
3709     ELSE
3710       CALL PUSHCONTROL1B(1)
3711     END IF
3712     IF (p_qi .GE. param_first_scalar) THEN
3713       CALL PUSHCONTROL1B(0)
3714     ELSE
3715       CALL PUSHCONTROL1B(1)
3716     END IF
3717     IF (p_qs .GE. param_first_scalar) THEN
3718       CALL PUSHCONTROL2B(0)
3719     ELSE
3720       CALL PUSHCONTROL2B(1)
3721     END IF
3722   ELSE
3723     CALL PUSHCONTROL2B(2)
3724   END IF
3725 ! shallow cumulus
3726   IF (config_flags%shcu_physics .GT. 0) THEN
3727     IF (p_qc .GE. param_first_scalar) THEN
3728       CALL PUSHCONTROL1B(0)
3729     ELSE
3730       CALL PUSHCONTROL1B(1)
3731     END IF
3732     IF (p_qr .GE. param_first_scalar) THEN
3733       CALL PUSHCONTROL1B(0)
3734     ELSE
3735       CALL PUSHCONTROL1B(1)
3736     END IF
3737     IF (p_qi .GE. param_first_scalar) THEN
3738       CALL PUSHCONTROL1B(0)
3739     ELSE
3740       CALL PUSHCONTROL1B(1)
3741     END IF
3742     IF (p_qs .GE. param_first_scalar) THEN
3743       CALL PUSHCONTROL1B(0)
3744     ELSE
3745       CALL PUSHCONTROL1B(1)
3746     END IF
3747     IF (p_qg .GE. param_first_scalar) THEN
3748       CALL PUSHCONTROL2B(0)
3749     ELSE
3750       CALL PUSHCONTROL2B(1)
3751     END IF
3752   ELSE
3753     CALL PUSHCONTROL2B(2)
3754   END IF
3755 ! pbl
3756   IF (config_flags%bl_pbl_physics .GT. 0) THEN
3757     IF (p_qv .GE. param_first_scalar) THEN
3758       CALL PUSHCONTROL1B(0)
3759     ELSE
3760       CALL PUSHCONTROL1B(1)
3761     END IF
3762     IF (p_qc .GE. param_first_scalar) THEN
3763       CALL PUSHCONTROL1B(0)
3764     ELSE
3765       CALL PUSHCONTROL1B(1)
3766     END IF
3767     IF (p_qi .GE. param_first_scalar) THEN
3768       CALL PUSHCONTROL2B(0)
3769     ELSE
3770       CALL PUSHCONTROL2B(1)
3771     END IF
3772   ELSE
3773     CALL PUSHCONTROL2B(2)
3774   END IF
3775 ! fdda
3776 ! note fdda u and v tendencies are staggered, also only interior points have muu/muv,
3777 !   so only couple those
3778   IF (config_flags%grid_fdda .GT. 0) THEN
3779 !        RMUNDGDTEN(I,J) - no coupling
3780 !     if( i == itf/2 .AND. j == jtf/2 .AND. k == ktf/2 ) &
3781 !     write(*,'(a,3i6,e15.5)') 'th after=',i,k,j, RTHNDGDTEN(I,K,J)
3782     IF (p_qv .GE. param_first_scalar) THEN
3783       DO j=jtf,jts,-1
3784         DO k=ktf,kts,-1
3785           DO i=itf,its,-1
3786             mub(i, j) = mub(i, j) + rqvndgdten(i, k, j)*rqvndgdtenb(i, k&
3787 &              , j)
3788             rqvndgdtenb(i, k, j) = mu(i, j)*rqvndgdtenb(i, k, j)
3789           END DO
3790         END DO
3791       END DO
3792     END IF
3793     DO j=jtf,jts,-1
3794       DO k=ktf,kts,-1
3795         DO i=itf,its,-1
3796           mub(i, j) = mub(i, j) + rthndgdten(i, k, j)*rthndgdtenb(i, k, &
3797 &            j)
3798           rthndgdtenb(i, k, j) = mu(i, j)*rthndgdtenb(i, k, j)
3799         END DO
3800       END DO
3801     END DO
3802     DO j=jtf,jtsv,-1
3803       DO k=ktf,kts,-1
3804         DO i=itf,its,-1
3805           muvb(i, j) = muvb(i, j) + rvndgdten(i, k, j)*rvndgdtenb(i, k, &
3806 &            j)
3807           rvndgdtenb(i, k, j) = muv(i, j)*rvndgdtenb(i, k, j)
3808         END DO
3809       END DO
3810     END DO
3811     DO j=jtf,jts,-1
3812       DO k=ktf,kts,-1
3813         DO i=itf,itsu,-1
3814           muub(i, j) = muub(i, j) + rundgdten(i, k, j)*rundgdtenb(i, k, &
3815 &            j)
3816           rundgdtenb(i, k, j) = muu(i, j)*rundgdtenb(i, k, j)
3817         END DO
3818       END DO
3819     END DO
3820   END IF
3821   CALL POPCONTROL2B(branch)
3822   IF (branch .EQ. 0) THEN
3823     DO j=jtf,jts,-1
3824       DO k=ktf,kts,-1
3825         DO i=itf,its,-1
3826           mub(i, j) = mub(i, j) + rqiblten(i, k, j)*rqibltenb(i, k, j)
3827           rqibltenb(i, k, j) = mu(i, j)*rqibltenb(i, k, j)
3828         END DO
3829       END DO
3830     END DO
3831   ELSE IF (branch .NE. 1) THEN
3832     GOTO 100
3833   END IF
3834   CALL POPCONTROL1B(branch)
3835   IF (branch .EQ. 0) THEN
3836     DO j=jtf,jts,-1
3837       DO k=ktf,kts,-1
3838         DO i=itf,its,-1
3839           mub(i, j) = mub(i, j) + rqcblten(i, k, j)*rqcbltenb(i, k, j)
3840           rqcbltenb(i, k, j) = mu(i, j)*rqcbltenb(i, k, j)
3841         END DO
3842       END DO
3843     END DO
3844   END IF
3845   CALL POPCONTROL1B(branch)
3846   IF (branch .EQ. 0) THEN
3847     DO j=jtf,jts,-1
3848       DO k=ktf,kts,-1
3849         DO i=itf,its,-1
3850           mub(i, j) = mub(i, j) + rqvblten(i, k, j)*rqvbltenb(i, k, j)
3851           rqvbltenb(i, k, j) = mu(i, j)*rqvbltenb(i, k, j)
3852         END DO
3853       END DO
3854     END DO
3855   END IF
3856   DO j=jtf,jts,-1
3857     DO k=ktf,kts,-1
3858       DO i=itf,its,-1
3859         mub(i, j) = mub(i, j) + rvblten(i, k, j)*rvbltenb(i, k, j) + &
3860 &          rublten(i, k, j)*rubltenb(i, k, j) + rthblten(i, k, j)*&
3861 &          rthbltenb(i, k, j)
3862         rthbltenb(i, k, j) = mu(i, j)*rthbltenb(i, k, j)
3863         rvbltenb(i, k, j) = mu(i, j)*rvbltenb(i, k, j)
3864         rubltenb(i, k, j) = mu(i, j)*rubltenb(i, k, j)
3865       END DO
3866     END DO
3867   END DO
3868  100 CALL POPCONTROL2B(branch)
3869   IF (branch .EQ. 0) THEN
3870     DO j=jtf,jts,-1
3871       DO i=itf,its,-1
3872         DO k=ktf,kts,-1
3873           mub(i, j) = mub(i, j) + rqgshten(i, k, j)*rqgshtenb(i, k, j)
3874           rqgshtenb(i, k, j) = mu(i, j)*rqgshtenb(i, k, j)
3875         END DO
3876       END DO
3877     END DO
3878   ELSE IF (branch .NE. 1) THEN
3879     GOTO 110
3880   END IF
3881   CALL POPCONTROL1B(branch)
3882   IF (branch .EQ. 0) THEN
3883     DO j=jtf,jts,-1
3884       DO i=itf,its,-1
3885         DO k=ktf,kts,-1
3886           mub(i, j) = mub(i, j) + rqsshten(i, k, j)*rqsshtenb(i, k, j)
3887           rqsshtenb(i, k, j) = mu(i, j)*rqsshtenb(i, k, j)
3888         END DO
3889       END DO
3890     END DO
3891   END IF
3892   CALL POPCONTROL1B(branch)
3893   IF (branch .EQ. 0) THEN
3894     DO j=jtf,jts,-1
3895       DO i=itf,its,-1
3896         DO k=ktf,kts,-1
3897           mub(i, j) = mub(i, j) + rqishten(i, k, j)*rqishtenb(i, k, j)
3898           rqishtenb(i, k, j) = mu(i, j)*rqishtenb(i, k, j)
3899         END DO
3900       END DO
3901     END DO
3902   END IF
3903   CALL POPCONTROL1B(branch)
3904   IF (branch .EQ. 0) THEN
3905     DO j=jtf,jts,-1
3906       DO i=itf,its,-1
3907         DO k=ktf,kts,-1
3908           mub(i, j) = mub(i, j) + rqrshten(i, k, j)*rqrshtenb(i, k, j)
3909           rqrshtenb(i, k, j) = mu(i, j)*rqrshtenb(i, k, j)
3910         END DO
3911       END DO
3912     END DO
3913   END IF
3914   CALL POPCONTROL1B(branch)
3915   IF (branch .EQ. 0) THEN
3916     DO j=jtf,jts,-1
3917       DO i=itf,its,-1
3918         DO k=ktf,kts,-1
3919           mub(i, j) = mub(i, j) + rqcshten(i, k, j)*rqcshtenb(i, k, j)
3920           rqcshtenb(i, k, j) = mu(i, j)*rqcshtenb(i, k, j)
3921         END DO
3922       END DO
3923     END DO
3924   END IF
3925   DO j=jtf,jts,-1
3926     DO i=itf,its,-1
3927       DO k=ktf,kts,-1
3928         mub(i, j) = mub(i, j) + rthshten(i, k, j)*rthshtenb(i, k, j) + &
3929 &          rushten(i, k, j)*rushtenb(i, k, j) + rvshten(i, k, j)*rvshtenb&
3930 &          (i, k, j) + rqvshten(i, k, j)*rqvshtenb(i, k, j)
3931         rqvshtenb(i, k, j) = mu(i, j)*rqvshtenb(i, k, j)
3932         rthshtenb(i, k, j) = mu(i, j)*rthshtenb(i, k, j)
3933         rvshtenb(i, k, j) = mu(i, j)*rvshtenb(i, k, j)
3934         rushtenb(i, k, j) = mu(i, j)*rushtenb(i, k, j)
3935       END DO
3936     END DO
3937   END DO
3938  110 CALL POPCONTROL2B(branch)
3939   IF (branch .EQ. 0) THEN
3940     DO j=jtf,jts,-1
3941       DO i=itf,its,-1
3942         DO k=ktf,kts,-1
3943           mub(i, j) = mub(i, j) + rqscuten(i, k, j)*rqscutenb(i, k, j)
3944           rqscutenb(i, k, j) = mu(i, j)*rqscutenb(i, k, j)
3945         END DO
3946       END DO
3947     END DO
3948   ELSE IF (branch .NE. 1) THEN
3949     GOTO 120
3950   END IF
3951   CALL POPCONTROL1B(branch)
3952   IF (branch .EQ. 0) THEN
3953     DO j=jtf,jts,-1
3954       DO i=itf,its,-1
3955         DO k=ktf,kts,-1
3956           mub(i, j) = mub(i, j) + rqicuten(i, k, j)*rqicutenb(i, k, j)
3957           rqicutenb(i, k, j) = mu(i, j)*rqicutenb(i, k, j)
3958         END DO
3959       END DO
3960     END DO
3961   END IF
3962   CALL POPCONTROL1B(branch)
3963   IF (branch .EQ. 0) THEN
3964     DO j=jtf,jts,-1
3965       DO i=itf,its,-1
3966         DO k=ktf,kts,-1
3967           mub(i, j) = mub(i, j) + rqrcuten(i, k, j)*rqrcutenb(i, k, j)
3968           rqrcutenb(i, k, j) = mu(i, j)*rqrcutenb(i, k, j)
3969         END DO
3970       END DO
3971     END DO
3972   END IF
3973   CALL POPCONTROL1B(branch)
3974   IF (branch .EQ. 0) THEN
3975     DO j=jtf,jts,-1
3976       DO i=itf,its,-1
3977         DO k=ktf,kts,-1
3978           mub(i, j) = mub(i, j) + rqccuten(i, k, j)*rqccutenb(i, k, j)
3979           rqccutenb(i, k, j) = mu(i, j)*rqccutenb(i, k, j)
3980         END DO
3981       END DO
3982     END DO
3983   END IF
3984   DO j=jtf,jts,-1
3985     DO i=itf,its,-1
3986       DO k=ktf,kts,-1
3987         mub(i, j) = mub(i, j) + rthcuten(i, k, j)*rthcutenb(i, k, j) + &
3988 &          rucuten(i, k, j)*rucutenb(i, k, j) + rvcuten(i, k, j)*rvcutenb&
3989 &          (i, k, j) + rqvcuten(i, k, j)*rqvcutenb(i, k, j)
3990         rqvcutenb(i, k, j) = mu(i, j)*rqvcutenb(i, k, j)
3991         rthcutenb(i, k, j) = mu(i, j)*rthcutenb(i, k, j)
3992         rvcutenb(i, k, j) = mu(i, j)*rvcutenb(i, k, j)
3993         rucutenb(i, k, j) = mu(i, j)*rucutenb(i, k, j)
3994       END DO
3995     END DO
3996   END DO
3997  120 CALL POPCONTROL1B(branch)
3998   IF (branch .EQ. 0) THEN
3999     DO j=jtf,jts,-1
4000       DO k=ktf,kts,-1
4001         DO i=itf,its,-1
4002           mub(i, j) = mub(i, j) + rthraten(i, k, j)*rthratenb(i, k, j)
4003           rthratenb(i, k, j) = mu(i, j)*rthratenb(i, k, j)
4004         END DO
4005       END DO
4006     END DO
4007   END IF
4008 END SUBROUTINE A_CALCULATE_PHY_TEND
4010 !-----------------------------------------------------------
4012 SUBROUTINE a_init_zero_tendency(a_ru_tendf, &
4013                                 a_rv_tendf, &
4014                                 a_rw_tendf, &
4015                                 a_ph_tendf, &
4016                                 a_t_tendf,  &
4017                                 a_tke_tendf, &
4018                                 a_mu_tendf,  &
4019                                 a_moist_tendf,  &
4020 !  NPan - 05/26/10 {
4021 !  Uncomment the corresponding args when chem or tracer is needed.   
4022 !                                a_chem_tendf,   &
4023                                 a_scalar_tendf, &
4024                                 a_tracer_tendf, &
4025 !  NPan }
4026                                 n_tracer,                   &
4027                                 n_moist,n_chem,n_scalar,rk_step,         &
4028                                 ids, ide, jds, jde, kds, kde,            &
4029                                 ims, ime, jms, jme, kms, kme,            &
4030                                 its, ite, jts, jte, kts, kte             )
4031 !-----------------------------------------------------------------------
4032    IMPLICIT NONE
4033 !-----------------------------------------------------------------------
4035    INTEGER ,       INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
4036                                     ims, ime, jms, jme, kms, kme, &
4037                                     its, ite, jts, jte, kts, kte
4039    INTEGER ,       INTENT(IN   ) :: n_moist,n_chem,n_scalar,n_tracer,rk_step
4041    REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) , INTENT(INOUT) ::  &
4042                                                              a_ru_tendf, &
4043                                                              a_rv_tendf, &
4044                                                              a_rw_tendf, &
4045                                                              a_ph_tendf, &
4046                                                               a_t_tendf, &
4047                                                             a_tke_tendf
4049    REAL , DIMENSION( ims:ime , jms:jme  ) , INTENT(INOUT) ::  a_mu_tendf
4051    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),INTENT(INOUT)::&
4052                                                           a_moist_tendf
4054 !  NPan - 05/26/10 {
4055 !  Uncomment the corresponding definations when chem is needed.   
4056 !   REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_chem ),INTENT(INOUT)::&
4057 !                                                          a_chem_tendf
4058    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_tracer ),INTENT(INOUT)::&
4059                                                           a_tracer_tendf
4060    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar ),INTENT(INOUT)::&
4061                                                           a_scalar_tendf
4062 !  NPan } 
4064 ! LOCAL VARS
4066    INTEGER :: im, ic, is
4068 !<DESCRIPTION>
4070 ! init_zero_tendency 
4071 ! sets tendency arrays to zero for all prognostic variables.
4073 !</DESCRIPTION>
4076    CALL a_zero_tend ( a_ru_tendf,            &
4077                       ids, ide, jds, jde, kds, kde,    &
4078                       ims, ime, jms, jme, kms, kme,    &
4079                       its, ite, jts, jte, kts, kte     )
4081    CALL a_zero_tend ( a_rv_tendf,            &
4082                       ids, ide, jds, jde, kds, kde,    &
4083                       ims, ime, jms, jme, kms, kme,    &
4084                       its, ite, jts, jte, kts, kte     )
4086    CALL a_zero_tend ( a_rw_tendf,            &
4087                       ids, ide, jds, jde, kds, kde,    &
4088                       ims, ime, jms, jme, kms, kme,    &
4089                       its, ite, jts, jte, kts, kte     )
4091    CALL a_zero_tend ( a_ph_tendf,            &
4092                       ids, ide, jds, jde, kds, kde,    &
4093                       ims, ime, jms, jme, kms, kme,    &
4094                       its, ite, jts, jte, kts, kte     )
4096    CALL a_zero_tend ( a_t_tendf,            &
4097                       ids, ide, jds, jde, kds, kde,    &
4098                       ims, ime, jms, jme, kms, kme,    &
4099                       its, ite, jts, jte, kts, kte     )
4101    CALL a_zero_tend ( a_tke_tendf,            &
4102                       ids, ide, jds, jde, kds, kde,    &
4103                       ims, ime, jms, jme, kms, kme,    &
4104                       its, ite, jts, jte, kts, kte     )
4106    CALL a_zero_tend2d ( a_mu_tendf,            &
4107                       ids, ide, jds, jde, kds, kds,    &
4108                       ims, ime, jms, jme, kms, kms,    &
4109                       its, ite, jts, jte, kts, kts     )
4111 !   DO im=PARAM_FIRST_SCALAR,n_moist
4112    DO im=1,n_moist                      ! make sure first one is zero too
4113       CALL a_zero_tend ( a_moist_tendf(ims,kms,jms,im), &
4114                          ids, ide, jds, jde, kds, kde, &
4115                          ims, ime, jms, jme, kms, kme, &
4116                          its, ite, jts, jte, kts, kte  )
4117    ENDDO
4119 !  NPan - 05/26/10 {
4120 !  Uncomment the corresponding statements when chem is needed.   
4121 !!   DO ic=PARAM_FIRST_SCALAR,n_chem
4122 !   DO ic=1,n_chem                       !! make sure first one is zero too
4123 !      CALL a_zero_tend ( a_chem_tendf(ims,kms,jms,ic), &
4124 !                         ids, ide, jds, jde, kds, kde, &
4125 !                         ims, ime, jms, jme, kms, kme, &
4126 !                         its, ite, jts, jte, kts, kte  )
4127 !   ENDDO
4129 !   DO ic=PARAM_FIRST_SCALAR,n_tracer
4130    DO ic=1,n_tracer                     !! make sure first one is zero too
4131       CALL a_zero_tend ( a_tracer_tendf(ims,kms,jms,ic), &
4132                          ids, ide, jds, jde, kds, kde, &
4133                          ims, ime, jms, jme, kms, kme, &
4134                          its, ite, jts, jte, kts, kte  )
4135    ENDDO
4137 !   DO ic=PARAM_FIRST_SCALAR,n_scalar
4138    DO ic=1,n_scalar                       ! make sure first one is zero too
4139       CALL a_zero_tend ( a_scalar_tendf(ims,kms,jms,ic), &
4140                          ids, ide, jds, jde, kds, kde, &
4141                          ims, ime, jms, jme, kms, kme, &
4142                          its, ite, jts, jte, kts, kte  )
4143    ENDDO
4144 !  NPan }
4146 END SUBROUTINE a_init_zero_tendency
4148 !-----------------------------------------------------------------------
4150 ! Revised by Ning Pan, 2010-08-03
4151 !   SUBROUTINE a_bound_tke(tke,a_tke,tke_upper_bound,a_tke_upper_bound,ids,ide,jds, &
4152    SUBROUTINE a_bound_tke(tke,a_tke,tke_upper_bound,ids,ide,jds, &
4153    jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
4155 !PART I: DECLARATION OF VARIABLES
4157    IMPLICIT NONE
4159    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
4160    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
4161    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tke,a_tke
4162 ! Revised by Ning Pan, 2010-08-03
4163 !   REAL :: tke_upper_bound,a_tke_upper_bound
4164    REAL :: tke_upper_bound
4165    INTEGER :: i,k,j
4167    REAL :: a_Tmpv1,Tmpv001
4169 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
4171 !LPB[0]
4172    DO j =min(jte, jde-1), jts, -1
4174 !  DO k =kts, kte-1
4175 !  DO i =its, min(ite, ide-1)
4176 !  Tmpv001 =min(tke_upper_bound, max(tke(i,k,j), 0.))
4177 !  tke(i,k,j) =Tmpv001
4179 !  ENDDO
4180 !  ENDDO
4182    DO k =kte-1, kts, -1
4183    DO i =min(ite, ide-1), its, -1
4184    a_Tmpv1 =a_tke(i,k,j)
4185    a_tke(i,k,j) =0.0
4186 ! Remarked by Ning Pan, 2010-08-03
4187 !   a_tke_upper_bound =a_tke_upper_bound  +(1.0 -sign(1.0, tke_upper_bound -max(  &
4188 !   tke(i,k,j), 0.)))*0.5*1.0*a_Tmpv1
4189    a_tke(i,k,j) =a_tke(i,k,j)  +(1.0 +sign(1.0, tke_upper_bound -max(tke(i,k,j)  &
4190    , 0.)))*0.5*(1.0 +(1.0)*sign(1.0, tke(i,k,j) -0.))*0.5*a_Tmpv1
4191    ENDDO
4192    ENDDO
4194    ENDDO
4196    END SUBROUTINE a_bound_tke
4199 END MODULE a_module_em