wrftladj/module_diffusion_em_ad.F

   1
   2 ! ======================================================================================
   3 ! This file was generated by the version 4.3.7 of ADG on 08/10/2010. The Adjoint Code
   4 ! Generator (ADG) was developed and sponsored by LASG of IAP (1999-2010)
   5 ! The Copyright of the ADG system was declared by Walls at LASG, 1999-2010
   6 ! ======================================================================================
   7
   8 MODULE a_module_diffusion_em
   9
  10    USE a_module_bc, only: a_set_physical_bc3d
  11    USE module_state_description, only: p_m23, p_m13, p_m22, p_m33, p_r23, p_r13, p_r12, p_m12, p_m11
  12    USE module_big_step_utilities_em, only: grid_config_rec_type, param_first_scalar, p_qv, p_qi, p_qc
  13
  14    USE module_model_constants
  15    USE module_diffusion_em ! Added by Ning Pan, 2010-08-10
  16
  17 CONTAINS
  18
  19    SUBROUTINE a_cal_deform_and_div(config_flags,u,a_u,v,a_v,w,a_w,div,a_div, &
  20    defor11,a_defor11,defor22,a_defor22,defor33,a_defor33,defor12,a_defor12, &
  21    defor13,a_defor13,defor23,a_defor23,nba_rij,a_nba_rij,n_nba_rij,u_base,v_base, &
  22    msfux,msfuy,msfvx,msfvy,msftx,msfty,rdx,rdy,dn,dnw,rdz,a_rdz,rdzw,a_rdzw,fnm,fnp, &
  23    cf1,cf2,cf3,zx,a_zx,zy,a_zy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its, &
  24    ite,jts,jte,kts,kte)
  25
  26 !PART I: DECLARATION OF VARIABLES
  27
  28    IMPLICIT NONE
  29
  30    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
  31    TYPE(grid_config_rec_type) :: config_flags
  32    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
  33    REAL :: rdx,rdy,cf1,cf2,cf3
  34    REAL,DIMENSION(kms:kme) :: fnm,fnp,dn,dnw,u_base,v_base
  35    REAL,DIMENSION(ims:ime,jms:jme) :: msfux,msfuy,msfvx,msfvy,msftx,msfty
  36    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: u,a_u,v,a_v,w,a_w,zx,a_zx,zy, &
  37    a_zy,rdz,a_rdz,rdzw,a_rdzw
  38    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor11,a_defor11,defor22,a_defor22, &
  39    defor33,a_defor33,defor12,a_defor12,defor13,a_defor13,defor23,a_defor23,div,a_div
  40    INTEGER :: n_nba_rij
  41    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_rij) :: nba_rij,a_nba_rij
  42    INTEGER :: i,j,k,ktf,ktes1,ktes2,i_start,i_end,j_start,j_end
  43    REAL :: tmp,a_tmp,tmpzx,a_tmpzx,tmpzy,a_tmpzy,tmpzeta_z,a_tmpzeta_z,cft1, &
  44    a_cft1,cft2,a_cft2
  45    REAL,DIMENSION(its:ite,jts:jte) :: mm,a_mm,zzavg,a_zzavg,zeta_zd12,a_zeta_zd12
  46    REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: tmp1,a_tmp1,hat,a_hat,hatavg, &
  47    a_hatavg
  48
  49 !BIG ERRORS, ADDED BY WALLS
  50 !BIG ERRORS, ADDED BY WALLS
  51    REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Keep_Lpb5_hatavg
  52    REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Keep_Lpb12_hatavg
  53    REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Keep_Lpb35_hatavg
  54    REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Keep_Lpb40_hatavg
  55    REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Keep_Lpb60_hatavg
  56
  57 !BIG ERRORS, ADDED BY WALLS
  58 !BIG ERRORS, ADDED BY WALLS
  59    REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Keep_Lpb2_hat
  60    REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Keep_Lpb9_hat
  61    REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Keep_Lpb32_hat
  62    REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Keep_Lpb37_hat
  63    REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Keep_Lpb54_hat
  64
  65 !BIG ERRORS, ADDED BY WALLS
  66 !BIG ERRORS, ADDED BY WALLS
  67    REAL,DIMENSION(its:ite,jts:jte) :: Keep_Lpb1_mm
  68    REAL,DIMENSION(its:ite,jts:jte) :: Keep_Lpb31_mm
  69    REAL,DIMENSION(its:ite,jts:jte) :: Keep_Lpb53_mm
  70
  71 !BIG ERRORS, ADDED BY WALLS
  72 !BIG ERRORS, ADDED BY WALLS
  73    REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Keep_Lpb35_tmp1
  74    REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Keep_Lpb40_tmp1
  75    REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Keep_Lpb60_tmp1
  76
  77    REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Keep_Lpb6_tmp1
  78    REAL,DIMENSION(its-2:ite+2,kts:kte,jts-2:jte+2) :: Keep_Lpb13_tmp1
  79    REAL,DIMENSION(max(jds+1,jts):min(jde-1,jte)) :: Keep_Lpb35_tmpzy
  80    REAL,DIMENSION(max(jds+1,jts):min(jde-1,jte)) :: Keep_Lpb40_tmpzx
  81
  82    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
  83    a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007
  84    REAL,DIMENSION(its:max0(min(ite,ide-1),ite)) :: Tmpv200
  85    REAL,DIMENSION(its:max0(min(ite,ide-1),ite)) :: Tmpv201
  86    REAL,DIMENSION(its:max0(min(ite,ide-1),ite,min(ite,ide)),min0(kts,kts+1) &
  87    :min(kte,kde-1)) :: Tmpv300
  88    REAL,DIMENSION(its:max0(min(ite,ide-1),ite,min(ite,ide)),min0(kts,kts+1) &
  89    :min(kte,kde-1)) :: Tmpv301
  90    REAL,DIMENSION(its:max0(min(ite,ide-1),ite,min(ite,ide)),min0(kts,kts+1) &
  91    :min(kte,kde-1)) :: Tmpv302
  92    REAL,DIMENSION(its:ite,kts:min(kte,kde-1)) :: Tmpv303
  93    REAL,DIMENSION(its:max0(ite,min(ite,ide),min(ite,ide-1)),min0(kts,kts+1) &
  94    :min(kte,kde-1),max(jds+1,jts):max0(min(jde-1,jte),min(jte,jde))) :: Tmpv400
  95    REAL,DIMENSION(its:max0(ite,min(ite,ide),min(ite,ide-1)),min0(kts,kts+1) &
  96    :min(kte,kde-1),max(jds+1,jts):max0(min(jde-1,jte),min(jte,jde))) :: Tmpv401
  97    REAL,DIMENSION(its:max0(ite,min(ite,ide),min(ite,ide-1)),min0(kts,kts+1) &
  98    :min(kte,kde-1),max(jds+1,jts):max0(min(jde-1,jte),min(jte,jde))) :: Tmpv402
  99    REAL,DIMENSION(its:max0(min(ite,ide),min(ite,ide-1)),kts+1:min(kte,kde-1) &
 100    ,max(jds+1,jts):min(jte,jde)) :: Tmpv403
 101
 102
 103 !PART II: CALCULATIONS OF B. S. TRAJECTORY
 104
 105 !LPB[0]
 106        ktes1   = kte-1
 107        ktes2   = kte-2
 108        cft2    = - 0.5 * dnw(ktes1) / dn(ktes1)
 109        cft1    = 1.0 - cft2
 110        ktf     = MIN( kte, kde-1 )
 111        i_start = its
 112        i_end   = MIN( ite, ide-1 )
 113        j_start = jts
 114        j_end   = MIN( jte, jde-1 )
 115
 116 !LPB[1]
 117        DO j = j_start, j_end
 118
 119        DO i = i_start, i_end
 120          mm(i,j) = msftx(i,j) * msfty(i,j)
 121        END DO
 122
 123        END DO
 124
 125 !BIG ERRORS, REVISED BY WALLS
 126        Keep_Lpb1_mm =mm
 127
 128 !LPB[2]
 129        DO j = j_start, j_end
 130
 131        DO k = kts, ktf
 132        DO i = i_start, i_end+1
 133          hat(i,k,j) = u(i,k,j) / msfuy(i,j)
 134        END DO
 135        END DO
 136
 137        END DO
 138
 139 !BIG ERRORS, REVISED BY WALLS
 140 !       Keep_Lpb2_hat =hat  ! Remarked by Ning Pan, 2010-08-31
 141
 142 !LPB[3]
 143        DO j=j_start,j_end
 144
 145        DO k=kts+1,ktf
 146        DO i=i_start,i_end
 147          hatavg(i,k,j) = 0.5 *    &
 148                        ( fnm(k) * ( hat(i,k  ,j) + hat(i+1,  k,j) ) +    &
 149                          fnp(k) * ( hat(i,k-1,j) + hat(i+1,k-1,j) ) )
 150        END DO
 151        END DO
 152
 153        END DO
 154
 155 !LPB[4]
 156        DO j = j_start, j_end
 157
 158        DO i = i_start, i_end
 159          hatavg(i,1,j)   =  0.5 * (    &
 160                             cf1 * hat(i  ,1,j) +    &
 161                             cf2 * hat(i  ,2,j) +    &
 162                             cf3 * hat(i  ,3,j) +    &
 163                             cf1 * hat(i+1,1,j) +    &
 164                             cf2 * hat(i+1,2,j) +    &
 165                             cf3 * hat(i+1,3,j) )
 166          hatavg(i,kte,j) =  0.5 * (    &
 167                            cft1 * ( hat(i,ktes1,j) + hat(i+1,ktes1,j) )  +    &
 168                            cft2 * ( hat(i,ktes2,j) + hat(i+1,ktes2,j) ) )
 169        END DO
 170
 171        END DO
 172
 173 !LPB[5]
 174        DO j = j_start, j_end
 175
 176        DO k = kts, ktf
 177        DO i = i_start, i_end
 178          tmpzx       = 0.25 * (    &
 179                        zx(i,k  ,j) + zx(i+1,k  ,j) +    &
 180                        zx(i,k+1,j) + zx(i+1,k+1,j) )
 181 !BIG ERRORS, ADDED BY WALLS
 182 !BIG ERRORS, ADDED BY WALLS
 183          Keep_Lpb5_hatavg(i,k,j) =hatavg(i,k+1,j) - hatavg(i,k,j)
 184          tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) *tmpzx * rdzw(i,k,j)
 185        END DO
 186        END DO
 187
 188        END DO
 189
 190 ! Remarked by Ning Pan, 2010-08-31 : LPB[6]-[8]
 191 !LPB[6]
 192 !       DO j = j_start, j_end
 193
 194 !REVISED! BY WALLS
 195 !!      DO k=kts, min(kte,kde-1)
 196 !!      DO i=its, min(ite,ide-1)
 197 !       DO k=kts, ktf
 198 !       DO i=i_start, i_end
 199 !       Keep_Lpb6_tmp1(i,k,j) =tmp1(i,k,j)
 200 !       END DO
 201 !       END DO
 202
 203 !       DO k = kts, ktf
 204 !       DO i = i_start, i_end
 205 !         tmp1(i,k,j) = mm(i,j) * ( rdx * ( hat(i+1,k,j) - hat(i,k,j) ) -    &
 206 !                       tmp1(i,k,j))
 207 !       END DO
 208 !       END DO
 209
 210 !       END DO
 211
 212 !LPB[7]
 213 !       DO j = j_start, j_end
 214
 215 !       DO k = kts, ktf
 216 !       DO i = i_start, i_end
 217 !         defor11(i,k,j) = 2.0 * tmp1(i,k,j)
 218 !       END DO
 219 !       END DO
 220
 221 !       END DO
 222
 223 !LPB[8]
 224 !       DO j = j_start, j_end
 225
 226 !       DO k = kts, ktf
 227 !       DO i = i_start, i_end
 228 !         div(i,k,j) = tmp1(i,k,j)
 229 !       END DO
 230 !       END DO
 231
 232 !       END DO
 233
 234 !LPB[9]
 235        DO j = j_start, j_end+1
 236
 237        DO k = kts, ktf
 238        DO i = i_start, i_end
 239       IF ((config_flags%polar) .AND. ((j == jds) .OR. (j == jde))) THEN
 240
 241             hat(i,k,j) = 0.
 242          ELSE
 243          hat(i,k,j) = v(i,k,j) / msfvx(i,j)
 244          ENDIF
 245        END DO
 246        END DO
 247
 248        END DO
 249
 250 !BIG ERRORS, REVISED BY WALLS
 251 !       Keep_Lpb9_hat =hat  ! Remarked by Ning Pan, 2010-08-31
 252
 253 !LPB[10]
 254        DO j=j_start,j_end
 255
 256        DO k=kts+1,ktf
 257        DO i=i_start,i_end
 258          hatavg(i,k,j) = 0.5 * (    &
 259                          fnm(k) * ( hat(i,k  ,j) + hat(i,k  ,j+1) ) +    &
 260                          fnp(k) * ( hat(i,k-1,j) + hat(i,k-1,j+1) ) )
 261        END DO
 262        END DO
 263
 264        END DO
 265
 266 !LPB[11]
 267        DO j = j_start, j_end
 268
 269        DO i = i_start, i_end
 270          hatavg(i,1,j)   =  0.5 * (    &
 271                             cf1 * hat(i,1,j  ) +    &
 272                             cf2 * hat(i,2,j  ) +    &
 273                             cf3 * hat(i,3,j  ) +    &
 274                             cf1 * hat(i,1,j+1) +    &
 275                             cf2 * hat(i,2,j+1) +    &
 276                             cf3 * hat(i,3,j+1) )
 277          hatavg(i,kte,j) =  0.5 * (    &
 278                            cft1 * ( hat(i,ktes1,j) + hat(i,ktes1,j+1) ) +    &
 279                            cft2 * ( hat(i,ktes2,j) + hat(i,ktes2,j+1) ) )
 280        END DO
 281
 282        END DO
 283
 284 !LPB[12]
 285        DO j = j_start, j_end
 286
 287        DO k = kts, ktf
 288        DO i = i_start, i_end
 289          tmpzy       =  0.25 * (    &
 290                         zy(i,k  ,j) + zy(i,k  ,j+1) +    &
 291                         zy(i,k+1,j) + zy(i,k+1,j+1)  )
 292 !BIG ERRORS, ADDED BY WALLS
 293 !BIG ERRORS, ADDED BY WALLS
 294          Keep_Lpb12_hatavg(i,k,j) =hatavg(i,k+1,j) - hatavg(i,k,j)
 295          tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) * tmpzy * rdzw(i,k,j)
 296        END DO
 297        END DO
 298
 299        END DO
 300
 301 ! Remarked by Ning Pan, 2010-08-31 : LPB[13]-[18]
 302 !LPB[13]
 303 !       DO j = j_start, j_end
 304
 305 !       DO k=kts, min(kte,kde-1)
 306 !       DO i=its, min(ite,ide-1)
 307 !       Keep_Lpb13_tmp1(i,k,j) =tmp1(i,k,j)
 308 !       END DO
 309 !       END DO
 310
 311 !       DO k = kts, ktf
 312 !       DO i = i_start, i_end
 313 !         tmp1(i,k,j) = mm(i,j) * (    &
 314 !                       rdy * ( hat(i,k,j+1) - hat(i,k,j) ) - tmp1(i,k,j) )
 315 !       END DO
 316 !       END DO
 317
 318 !       END DO
 319
 320 !LPB[14]
 321 !       DO j = j_start, j_end
 322
 323 !       DO k = kts, ktf
 324 !       DO i = i_start, i_end
 325 !         defor22(i,k,j) = 2.0 * tmp1(i,k,j)
 326 !       END DO
 327 !       END DO
 328
 329 !       END DO
 330
 331 !LPB[15]
 332 !       DO j = j_start, j_end
 333
 334 !       DO k = kts, ktf
 335 !       DO i = i_start, i_end
 336 !         div(i,k,j) = div(i,k,j) + tmp1(i,k,j)
 337 !       END DO
 338 !       END DO
 339
 340 !       END DO
 341
 342 !LPB[16]
 343 !       DO j = j_start, j_end
 344
 345 !       DO k = kts, ktf
 346 !       DO i = i_start, i_end
 347 !         tmp1(i,k,j) = ( w(i,k+1,j) - w(i,k,j) ) * rdzw(i,k,j)
 348 !       END DO
 349 !       END DO
 350
 351 !       END DO
 352
 353 !LPB[17]
 354 !       DO j = j_start, j_end
 355
 356 !       DO k = kts, ktf
 357 !       DO i = i_start, i_end
 358 !         defor33(i,k,j) = 2.0 * tmp1(i,k,j)
 359 !       END DO
 360 !       END DO
 361
 362 !       END DO
 363
 364 !LPB[18]
 365 !       DO j = j_start, j_end
 366
 367 !       DO k = kts, ktf
 368 !       DO i = i_start, i_end
 369 !         div(i,k,j) = div(i,k,j) + tmp1(i,k,j)
 370 !       END DO
 371 !       END DO
 372
 373 !       END DO
 374
 375 !LPB[19]
 376        i_start = its
 377        i_end   = ite
 378        j_start = jts
 379        j_end   = jte
 380
 381 !LPB[20]
 382     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
 383          config_flags%nested) i_start = MAX( ids+1, its )
 384
 385 !LPB[21]
 386
 387 !LPB[22]
 388     IF ( config_flags%open_xe .OR. config_flags%specified .OR.    &
 389          config_flags%nested) i_end   = MIN( ide-1, ite )
 390
 391 !LPB[23]
 392
 393 !LPB[24]
 394     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
 395          config_flags%nested) j_start = MAX( jds+1, jts )
 396
 397 !LPB[25]
 398
 399 !LPB[26]
 400     IF ( config_flags%open_ye .OR. config_flags%specified .OR.   &
 401          config_flags%nested) j_end   = MIN( jde-1, jte )
 402
 403 !LPB[27]
 404
 405 !LPB[28]
 406       IF ( config_flags%periodic_x ) i_start = its
 407
 408 !LPB[29]
 409
 410 !LPB[30]
 411       IF ( config_flags%periodic_x ) i_end = ite
 412
 413 !LPB[31]
 414        DO j = j_start, j_end
 415
 416        DO i = i_start, i_end
 417          mm(i,j) = 0.25 * ( msfux(i,j-1) + msfux(i,j) ) * ( msfvy(i-1,j) + msfvy(i,j) )
 418        END DO
 419
 420        END DO
 421
 422 !BIG ERRORS, REVISED BY WALLS
 423        Keep_Lpb31_mm =mm
 424
 425 !LPB[32]
 426        DO j =j_start-1, j_end
 427
 428        DO k =kts, ktf
 429        DO i =i_start, i_end
 430          hat(i,k,j) = u(i,k,j) / msfux(i,j)
 431        END DO
 432        END DO
 433
 434        END DO
 435
 436 !BIG ERRORS, REVISED BY WALLS
 437 !       Keep_Lpb32_hat =hat  ! Remarked by Ning Pan, 2010-08-31
 438
 439 !LPB[33]
 440        DO j=j_start,j_end
 441
 442        DO k=kts+1,ktf
 443        DO i=i_start,i_end
 444          hatavg(i,k,j) = 0.5 * (    &
 445                          fnm(k) * ( hat(i,k  ,j-1) + hat(i,k  ,j) ) +    &
 446                          fnp(k) * ( hat(i,k-1,j-1) + hat(i,k-1,j) ) )
 447        END DO
 448        END DO
 449
 450        END DO
 451
 452 !LPB[34]
 453        DO j = j_start, j_end
 454
 455        DO i = i_start, i_end
 456          hatavg(i,1,j)   =  0.5 * (    &
 457                             cf1 * hat(i,1,j-1) +    &
 458                             cf2 * hat(i,2,j-1) +    &
 459                             cf3 * hat(i,3,j-1) +    &
 460                             cf1 * hat(i,1,j  ) +    &
 461                             cf2 * hat(i,2,j  ) +    &
 462                             cf3 * hat(i,3,j  ) )
 463          hatavg(i,kte,j) =  0.5 * (    &
 464                            cft1 * ( hat(i,ktes1,j-1) + hat(i,ktes1,j) ) +    &
 465                            cft2 * ( hat(i,ktes2,j-1) + hat(i,ktes2,j) ) )
 466        END DO
 467
 468        END DO
 469
 470 !LPB[35]
 471        DO j = j_start, j_end
 472
 473 !       Keep_Lpb35_tmpzy(j) =tmpzy  ! Remarked by Ning Pan, 2010-08-31
 474
 475        DO k = kts, ktf
 476        DO i = i_start, i_end
 477          tmpzy       = 0.25 * (    &
 478                        zy(i-1,k  ,j) + zy(i,k  ,j) +    &
 479                        zy(i-1,k+1,j) + zy(i,k+1,j) )
 480 !BIG ERRORS, ADDED BY WALLS
 481 !BIG ERRORS, ADDED BY WALLS
 482          Keep_Lpb35_hatavg(i,k,j) =hatavg(i,k+1,j) - hatavg(i,k,j)
 483          tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) *    &
 484                        0.25 * tmpzy * ( rdzw(i,k,j) + rdzw(i-1,k,j) +   &
 485                                         rdzw(i-1,k,j-1) + rdzw(i,k,j-1) )
 486        END DO
 487        END DO
 488
 489        END DO
 490
 491 !BIG ERRORS, ADDED BY WALLS
 492 !       Keep_Lpb35_tmp1 =tmp1  ! Remarked by Ning Pan, 2010-08-31
 493
 494 ! Remarked by Ning Pan, 2010-08-31 : LPB[36]
 495 !LPB[36]
 496 !       DO j = j_start, j_end
 497
 498 !       DO k = kts, ktf
 499 !       DO i = i_start, i_end
 500 !         defor12(i,k,j) = mm(i,j) * (    &
 501 !                          rdy * ( hat(i,k,j) - hat(i,k,j-1) ) - tmp1(i,k,j) )
 502 !       END DO
 503 !       END DO
 504
 505 !       END DO
 506
 507 !LPB[37]
 508        DO j = j_start, j_end
 509
 510        DO k = kts, ktf
 511        DO i = i_start-1, i_end
 512           hat(i,k,j) = v(i,k,j) / msfvy(i,j)
 513        END DO
 514        END DO
 515
 516        END DO
 517
 518 !BIG ERRORS, REVISED BY WALLS
 519 !       Keep_Lpb37_hat =hat  ! Remarked by Ning Pan, 2010-08-31
 520
 521 !LPB[38]
 522        DO j = j_start, j_end
 523
 524        DO k = kts+1, ktf
 525        DO i = i_start, i_end
 526          hatavg(i,k,j) = 0.5 * (    &
 527                          fnm(k) * ( hat(i-1,k  ,j) + hat(i,k  ,j) ) +    &
 528                          fnp(k) * ( hat(i-1,k-1,j) + hat(i,k-1,j) ) )
 529        END DO
 530        END DO
 531
 532        END DO
 533
 534 !LPB[39]
 535        DO j = j_start, j_end
 536
 537        DO i = i_start, i_end
 538           hatavg(i,1,j)   =  0.5 * (    &
 539                              cf1 * hat(i-1,1,j) +    &
 540                              cf2 * hat(i-1,2,j) +    &
 541                              cf3 * hat(i-1,3,j) +    &
 542                              cf1 * hat(i  ,1,j) +    &
 543                              cf2 * hat(i  ,2,j) +    &
 544                              cf3 * hat(i  ,3,j) )
 545           hatavg(i,kte,j) =  0.5 * (    &
 546                             cft1 * ( hat(i,ktes1,j) + hat(i-1,ktes1,j) ) +    &
 547                             cft2 * ( hat(i,ktes2,j) + hat(i-1,ktes2,j) ) )
 548        END DO
 549
 550        END DO
 551
 552 !LPB[40]
 553        DO j = j_start, j_end
 554
 555 !       Keep_Lpb40_tmpzx(j) =tmpzx  ! Remarked by Ning Pan, 2010-08-31
 556
 557        DO k = kts, ktf
 558        DO i = i_start, i_end
 559          tmpzx       = 0.25 * (    &
 560                        zx(i,k  ,j-1) + zx(i,k  ,j) +    &
 561                        zx(i,k+1,j-1) + zx(i,k+1,j) )
 562 !BIG ERRORS, ADDED BY WALLS
 563 !BIG ERRORS, ADDED BY WALLS
 564          Keep_Lpb40_hatavg(i,k,j) =hatavg(i,k+1,j) - hatavg(i,k,j)
 565          tmp1(i,k,j) = ( hatavg(i,k+1,j) - hatavg(i,k,j) ) *    &
 566                        0.25 * tmpzx * ( rdzw(i,k,j) + rdzw(i,k,j-1) +   &
 567                                         rdzw(i-1,k,j-1) + rdzw(i-1,k,j) )
 568        END DO
 569        END DO
 570
 571        END DO
 572
 573 !BIG ERRORS, ADDED BY WALLS
 574 !       Keep_Lpb40_tmp1 =tmp1  ! Remarked by Ning Pan, 2010-08-31
 575
 576 !LPB[41]
 577
 578 ! Remarked by Ning Pan, 2010-08-31
 579 !LPB[42]
 580 !  IF ( config_flags%sfs_opt .GT. 0 ) THEN
 581
 582 !       DO j = j_start, j_end
 583 !       DO k = kts, ktf
 584 !       DO i = i_start, i_end
 585 !         nba_rij(i,k,j,P_r12) = defor12(i,k,j) -        &
 586 !                                mm(i,j) * (                                 &
 587 !                                rdx * ( hat(i,k,j) - hat(i-1,k,j) ) - tmp1(i,k,j) )
 588 !         defor12(i,k,j) = defor12(i,k,j) +    &
 589 !                          mm(i,j) * (    &
 590 !                          rdx * ( hat(i,k,j) - hat(i-1,k,j) ) - tmp1(i,k,j) )
 591 !       END DO
 592 !       END DO
 593 !       END DO
 594 !    IF ( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1 ) THEN
 595
 596 !         DO j = jts, jte
 597 !         DO k = kts, kte
 598 !           defor12(ids,k,j) = defor12(ids+1,k,j)
 599 !           nba_rij(ids,k,j,P_r12) = nba_rij(ids+1,k,j,P_r12)
 600 !         END DO
 601 !         END DO
 602 !       END IF
 603 !    IF ( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN
 604
 605 !         DO k = kts, kte
 606 !         DO i = its, ite
 607 !           defor12(i,k,jds) = defor12(i,k,jds+1)
 608 !           nba_rij(i,k,jds,P_r12) = nba_rij(i,k,jds+1,P_r12)
 609 !         END DO
 610 !         END DO
 611 !       END IF
 612 !    IF ( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN
 613
 614 !         DO j = jts, jte
 615 !         DO k = kts, kte
 616 !           defor12(ide,k,j) = defor12(ide-1,k,j)
 617 !           nba_rij(ide,k,j,P_r12) = nba_rij(ide-1,k,j,P_r12)
 618 !         END DO
 619 !         END DO
 620 !       END IF
 621 !    IF ( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN
 622
 623 !         DO k = kts, kte
 624 !         DO i = its, ite
 625 !           defor12(i,k,jde) = defor12(i,k,jde-1)
 626 !           nba_rij(i,k,jde,P_r12) = nba_rij(i,k,jde-1,P_r12)
 627 !         END DO
 628 !         END DO
 629 !       END IF
 630 !     ELSE
 631
 632 !       DO j = j_start, j_end
 633 !       DO k = kts, ktf
 634 !       DO i = i_start, i_end
 635 !         defor12(i,k,j) = defor12(i,k,j) +    &
 636 !                          mm(i,j) * (    &
 637 !                          rdx * ( hat(i,k,j) - hat(i-1,k,j) ) - tmp1(i,k,j) )
 638 !       END DO
 639 !       END DO
 640 !       END DO
 641 !    IF ( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1 ) THEN
 642
 643 !         DO j = jts, jte
 644 !         DO k = kts, kte
 645 !           defor12(ids,k,j) = defor12(ids+1,k,j)
 646 !         END DO
 647 !         END DO
 648 !       END IF
 649 !    IF ( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN
 650
 651 !         DO k = kts, kte
 652 !         DO i = its, ite
 653 !           defor12(i,k,jds) = defor12(i,k,jds+1)
 654 !         END DO
 655 !         END DO
 656 !       END IF
 657 !    IF ( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN
 658
 659 !         DO j = jts, jte
 660 !         DO k = kts, kte
 661 !           defor12(ide,k,j) = defor12(ide-1,k,j)
 662 !         END DO
 663 !         END DO
 664 !       END IF
 665 !    IF ( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN
 666
 667 !         DO k = kts, kte
 668 !         DO i = its, ite
 669 !           defor12(i,k,jde) = defor12(i,k,jde-1)
 670 !         END DO
 671 !         END DO
 672 !       END IF
 673
 674 !   ENDIF
 675
 676 !LPB[43]
 677
 678        i_start = its
 679        i_end   = MIN( ite, ide-1 )
 680        j_start = jts
 681        j_end   = MIN( jte, jde-1 )
 682
 683 !LPB[44]
 684     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
 685          config_flags%nested) i_start = MAX( ids+1, its )
 686
 687 !LPB[45]
 688
 689 !LPB[46]
 690     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
 691          config_flags%nested) j_start = MAX( jds+1, jts )
 692
 693 !LPB[47]
 694
 695 !LPB[48]
 696     IF ( config_flags%periodic_x ) i_start = its
 697
 698 !LPB[49]
 699
 700 !LPB[50]
 701     IF ( config_flags%periodic_x ) i_end = MIN( ite, ide )
 702
 703 !LPB[51]
 704
 705 !LPB[52]
 706     IF ( config_flags%periodic_y ) j_end = MIN( jte, jde )
 707
 708 !LPB[53]
 709        DO j = jts, jte
 710
 711        DO i = its, ite
 712          mm(i,j) = msfux(i,j) * msfuy(i,j)
 713        END DO
 714
 715        END DO
 716
 717 !BIG ERRORS, REVISED BY WALLS
 718        Keep_Lpb53_mm =mm
 719 !LPB[54]
 720        DO j = j_start, j_end
 721
 722        DO k = kts, kte
 723        DO i = i_start, i_end
 724          hat(i,k,j) = w(i,k,j) / msfty(i,j)
 725        END DO
 726        END DO
 727
 728        END DO
 729
 730 !LPB[55]
 731        i = i_start-1
 732
 733 !LPB[56]
 734        DO j = j_start, MIN( jte, jde-1 )
 735
 736        DO k = kts, kte
 737          hat(i,k,j) = w(i,k,j) / msfty(i,j)
 738        END DO
 739
 740        END DO
 741
 742 !LPB[57]
 743        j = j_start-1
 744
 745 !LPB[58]
 746        DO k = kts, kte
 747
 748        DO i = i_start, MIN( ite, ide-1 )
 749          hat(i,k,j) = w(i,k,j) / msfty(i,j)
 750        END DO
 751
 752        END DO
 753
 754 !BIG ERRORS, REVISED BY WALLS
 755 !       Keep_Lpb54_hat =hat  ! Remarked by Ning Pan, 2010-08-31
 756
 757 !LPB[59]
 758        DO j = j_start, j_end
 759
 760        DO k = kts, ktf
 761        DO i = i_start, i_end
 762          hatavg(i,k,j) = 0.25 * (    &
 763                          hat(i  ,k  ,j) +    &
 764                          hat(i  ,k+1,j) +    &
 765                          hat(i-1,k  ,j) +    &
 766                          hat(i-1,k+1,j) )
 767        END DO
 768        END DO
 769
 770        END DO
 771
 772 !LPB[60]
 773        DO j = j_start, j_end
 774
 775        DO k = kts+1, ktf
 776        DO i = i_start, i_end
 777 !BIG ERRORS, ADDED BY WALLS
 778 !BIG ERRORS, ADDED BY WALLS
 779          Keep_Lpb60_hatavg(i,k,j) =hatavg(i,k,j) - hatavg(i,k-1,j)
 780          tmp1(i,k,j) = ( hatavg(i,k,j) - hatavg(i,k-1,j) ) * zx(i,k,j) *    &
 781                        0.5 * ( rdz(i,k,j) + rdz(i-1,k,j) )
 782        END DO
 783        END DO
 784
 785        END DO
 786
 787 !BIG ERRORS, ADDED BY WALLS
 788 !       Keep_Lpb60_tmp1 =tmp1  ! Remarked by Ning Pan, 2010-08-31
 789
 790 ! Remarked by Ning Pan, 2010-08-31 : LPB[61]-[66]
 791 !LPB[61]
 792 !       DO j = j_start, j_end
 793
 794 !       DO k = kts+1, ktf
 795 !       DO i = i_start, i_end
 796 !         defor13(i,k,j) = mm(i,j) * (    &
 797 !                          rdx * ( hat(i,k,j) - hat(i-1,k,j) ) - tmp1(i,k,j) )
 798 !       END DO
 799 !       END DO
 800
 801 !       END DO
 802
 803 !LPB[62]
 804 !       DO j = j_start, j_end
 805
 806 !       DO i = i_start, i_end
 807 !         defor13(i,kts,j  ) = 0.0
 808 !         defor13(i,ktf+1,j) = 0.0
 809 !       END DO
 810
 811 !       END DO
 812
 813 !LPB[63]
 814
 815 !LPB[64]
 816 !    IF ( config_flags%mix_full_fields ) THEN
 817
 818 !         DO j = j_start, j_end
 819 !         DO k = kts+1, ktf
 820 !         DO i = i_start, i_end
 821 !           tmp1(i,k,j) = ( u(i,k,j) - u(i,k-1,j) ) *    &
 822 !                         0.5 * ( rdz(i,k,j) + rdz(i-1,k,j) )
 823 !         END DO
 824 !         END DO
 825 !         END DO
 826 !       ELSE
 827
 828 !         DO j = j_start, j_end
 829 !         DO k = kts+1, ktf
 830 !         DO i = i_start, i_end
 831 !           tmp1(i,k,j) = ( u(i,k,j) - u_base(k) - u(i,k-1,j) + u_base(k-1) ) *    &
 832 !                         0.5 * ( rdz(i,k,j) + rdz(i-1,k,j) )
 833 !         END DO
 834 !         END DO
 835 !         END DO
 836
 837 !   END IF
 838
 839 !LPB[65]
 840
 841 !LPB[66]
 842
 843 !  IF ( config_flags%sfs_opt .GT. 0 ) THEN
 844
 845 !       DO j = j_start, j_end
 846 !       DO k = kts+1, ktf
 847 !       DO i = i_start, i_end
 848 !         nba_rij(i,k,j,P_r13) =  tmp1(i,k,j) - defor13(i,k,j)
 849 !         defor13(i,k,j) = defor13(i,k,j) + tmp1(i,k,j)
 850 !       END DO
 851 !       END DO
 852 !       END DO
 853
 854 !       DO j = j_start, j_end
 855 !       DO i = i_start, i_end
 856 !         nba_rij(i,kts  ,j,P_r13) = 0.0
 857 !         nba_rij(i,ktf+1,j,P_r13) = 0.0
 858 !       END DO
 859 !       END DO
 860 !     ELSE
 861
 862 !       DO j = j_start, j_end
 863 !       DO k = kts+1, ktf
 864 !       DO i = i_start, i_end
 865 !         defor13(i,k,j) = defor13(i,k,j) + tmp1(i,k,j)
 866 !       END DO
 867 !       END DO
 868 !       END DO
 869
 870 !   ENDIF
 871
 872 !LPB[67]
 873
 874        i_start = its
 875        i_end   = MIN( ite, ide-1 )
 876        j_start = jts
 877        j_end   = MIN( jte, jde-1 )
 878
 879 !LPB[68]
 880     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
 881          config_flags%nested) i_start = MAX( ids+1, its )
 882
 883 !LPB[69]
 884
 885 !LPB[70]
 886     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
 887          config_flags%nested) j_start = MAX( jds+1, jts )
 888
 889 !LPB[71]
 890
 891 !LPB[72]
 892     IF ( config_flags%periodic_y ) j_end = MIN( jte, jde )
 893
 894 !LPB[73]
 895
 896 !LPB[74]
 897       IF ( config_flags%periodic_x ) i_start = its
 898
 899 !LPB[75]
 900
 901 !LPB[76]
 902       IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
 903
 904 !LPB[77]
 905        DO j = jts, jte
 906
 907        DO i = its, ite
 908          mm(i,j) = msfvx(i,j) * msfvy(i,j)
 909        END DO
 910
 911        END DO
 912
 913 !LPB[78]
 914        DO j = j_start, j_end
 915
 916        DO k = kts, kte
 917        DO i = i_start, i_end
 918          hat(i,k,j) = w(i,k,j) / msftx(i,j)
 919        END DO
 920        END DO
 921
 922        END DO
 923
 924 !LPB[79]
 925        i = i_start-1
 926
 927 !LPB[80]
 928        DO j = j_start, MIN( jte, jde-1 )
 929
 930        DO k = kts, kte
 931          hat(i,k,j) = w(i,k,j) / msftx(i,j)
 932        END DO
 933
 934        END DO
 935
 936 !LPB[81]
 937        j = j_start-1
 938
 939 !LPB[82]
 940        DO k = kts, kte
 941
 942        DO i = i_start, MIN( ite, ide-1 )
 943          hat(i,k,j) = w(i,k,j) / msftx(i,j)
 944        END DO
 945
 946        END DO
 947
 948 !LPB[83]
 949        DO j = j_start, j_end
 950
 951        DO k = kts, ktf
 952        DO i = i_start, i_end
 953          hatavg(i,k,j) = 0.25 * (    &
 954                          hat(i,k  ,j  ) +    &
 955                          hat(i,k+1,j  ) +    &
 956                          hat(i,k  ,j-1) +    &
 957                          hat(i,k+1,j-1) )
 958        END DO
 959        END DO
 960
 961        END DO
 962
 963 ! Remarked by Ning Pan, 2010-08-31 : LPB[84]-[86]
 964 !LPB[84]
 965 !       DO j = j_start, j_end
 966
 967 !       DO k = kts+1, ktf
 968 !       DO i = i_start, i_end
 969 !         tmp1(i,k,j) = ( hatavg(i,k,j) - hatavg(i,k-1,j) ) * zy(i,k,j) *    &
 970 !                       0.5 * ( rdz(i,k,j) + rdz(i,k,j-1) )
 971 !       END DO
 972 !       END DO
 973
 974 !       END DO
 975
 976 !LPB[85]
 977 !       DO j = j_start, j_end
 978
 979 !       DO k = kts+1, ktf
 980 !       DO i = i_start, i_end
 981 !         defor23(i,k,j) = mm(i,j) * (    &
 982 !                          rdy * ( hat(i,k,j) - hat(i,k,j-1) ) - tmp1(i,k,j) )
 983 !       END DO
 984 !       END DO
 985
 986 !       END DO
 987
 988 !!LPB[86]
 989 !       DO j = j_start, j_end
 990
 991 !       DO i = i_start, i_end
 992 !         defor23(i,kts,j  ) = 0.0
 993 !         defor23(i,ktf+1,j) = 0.0
 994 !       END DO
 995
 996 !       END DO
 997
 998 !!LPB[87]
 999
1000 !!LPB[88]
1001 !    IF ( config_flags%mix_full_fields ) THEN
1002
1003 !         DO j = j_start, j_end
1004 !         DO k = kts+1, ktf
1005 !         DO i = i_start, i_end
1006 !           tmp1(i,k,j) = ( v(i,k,j) - v(i,k-1,j) ) *    &
1007 !                         0.5 * ( rdz(i,k,j) + rdz(i,k,j-1) )
1008 !         END DO
1009 !         END DO
1010 !         END DO
1011 !       ELSE
1012
1013 !         DO j = j_start, j_end
1014 !         DO k = kts+1, ktf
1015 !         DO i = i_start, i_end
1016 !           tmp1(i,k,j) = ( v(i,k,j) - v_base(k) - v(i,k-1,j) + v_base(k-1) ) *    &
1017 !                         0.5 * ( rdz(i,k,j) + rdz(i,k,j-1) )
1018 !         END DO
1019 !         END DO
1020 !         END DO
1021
1022 !   END IF
1023
1024 !!LPB[89]
1025
1026 !!LPB[90]
1027 !
1028 !  IF ( config_flags%sfs_opt .GT. 0 ) THEN
1029
1030 !       DO j = j_start, j_end
1031 !       DO k = kts+1, ktf
1032 !       DO i = i_start, i_end
1033 !         nba_rij(i,k,j,P_r23) = tmp1(i,k,j) - defor23(i,k,j)
1034 !         defor23(i,k,j) = defor23(i,k,j) + tmp1(i,k,j)
1035 !       END DO
1036 !       END DO
1037 !       END DO
1038
1039 !       DO j = j_start, j_end
1040 !         DO i = i_start, i_end
1041 !           nba_rij(i,kts  ,j,P_r23) = 0.0
1042 !           nba_rij(i,ktf+1,j,P_r23) = 0.0
1043 !         END DO
1044 !       END DO
1045 !    IF ( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1) THEN
1046
1047 !         DO j = jts, jte
1048 !         DO k = kts, kte
1049 !           defor13(ids,k,j) = defor13(ids+1,k,j)
1050 !           defor23(ids,k,j) = defor23(ids+1,k,j)
1051 !           nba_rij(ids,k,j,P_r13) = nba_rij(ids+1,k,j,P_r13)
1052 !           nba_rij(ids,k,j,P_r23) = nba_rij(ids+1,k,j,P_r23)
1053 !         END DO
1054 !         END DO
1055 !       END IF
1056 !    IF ( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN
1057
1058 !         DO k = kts, kte
1059 !         DO i = its, ite
1060 !           defor13(i,k,jds) = defor13(i,k,jds+1)
1061 !           defor23(i,k,jds) = defor23(i,k,jds+1)
1062 !           nba_rij(i,k,jds,P_r13) = nba_rij(i,k,jds+1,P_r13)
1063 !           nba_rij(i,k,jds,P_r23) = nba_rij(i,k,jds+1,P_r23)
1064 !         END DO
1065 !         END DO
1066 !       END IF
1067 !    IF ( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN
1068
1069 !         DO j = jts, jte
1070 !         DO k = kts, kte
1071 !           defor13(ide,k,j) = defor13(ide-1,k,j)
1072 !           defor23(ide,k,j) = defor23(ide-1,k,j)
1073 !           nba_rij(ide,k,j,P_r13) = nba_rij(ide-1,k,j,P_r13)
1074 !           nba_rij(ide,k,j,P_r23) = nba_rij(ide-1,k,j,P_r23)
1075 !         END DO
1076 !         END DO
1077 !       END IF
1078 !    IF ( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN
1079
1080 !         DO k = kts, kte
1081 !         DO i = its, ite
1082 !           defor13(i,k,jde) = defor13(i,k,jde-1)
1083 !           defor23(i,k,jde) = defor23(i,k,jde-1)
1084 !           nba_rij(i,k,jde,P_r13) = nba_rij(i,k,jde-1,P_r13)
1085 !           nba_rij(i,k,jde,P_r23) = nba_rij(i,k,jde-1,P_r23)
1086 !         END DO
1087 !         END DO
1088 !       END IF
1089 !     ELSE
1090
1091 !       DO j = j_start, j_end
1092 !       DO k = kts+1, ktf
1093 !       DO i = i_start, i_end
1094 !         defor23(i,k,j) = defor23(i,k,j) + tmp1(i,k,j)
1095 !       END DO
1096 !       END DO
1097 !       END DO
1098 !    IF ( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1) THEN
1099
1100 !         DO j = jts, jte
1101 !         DO k = kts, kte
1102 !           defor13(ids,k,j) = defor13(ids+1,k,j)
1103 !           defor23(ids,k,j) = defor23(ids+1,k,j)
1104 !         END DO
1105 !         END DO
1106 !       END IF
1107 !    IF ( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN
1108
1109 !         DO k = kts, kte
1110 !         DO i = its, ite
1111 !           defor13(i,k,jds) = defor13(i,k,jds+1)
1112 !           defor23(i,k,jds) = defor23(i,k,jds+1)
1113 !         END DO
1114 !         END DO
1115 !       END IF
1116 !    IF ( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN
1117
1118 !         DO j = jts, jte
1119 !         DO k = kts, kte
1120 !           defor13(ide,k,j) = defor13(ide-1,k,j)
1121 !           defor23(ide,k,j) = defor23(ide-1,k,j)
1122 !         END DO
1123 !         END DO
1124 !       END IF
1125 !    IF ( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN
1126
1127 !         DO k = kts, kte
1128 !         DO i = its, ite
1129 !           defor13(i,k,jde) = defor13(i,k,jde-1)
1130 !           defor23(i,k,jde) = defor23(i,k,jde-1)
1131 !         END DO
1132 !         END DO
1133 !       END IF
1134
1135 !   ENDIF
1136
1137 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
1138
1139    a_tmp =0.0
1140    a_tmpzx =0.0
1141    a_tmpzy =0.0
1142    a_tmpzeta_z =0.0
1143 ! Remarked by Ning Pan, 2010-08-31
1144 !   a_cft1 =0.0
1145 !   a_cft2 =0.0
1146
1147 ! Remarked by Ning Pan, 2010-08-31
1148 !   Do K1_ADJ =jts, jte
1149 !   Do K0_ADJ =its, ite
1150 !   a_mm(K0_ADJ,K1_ADJ) =0.0
1151 !   End Do
1152 !   End Do
1153
1154 ! Remarked by Ning Pan, 2010-08-31
1155 !   Do K1_ADJ =jts, jte
1156 !   Do K0_ADJ =its, ite
1157 !   a_zzavg(K0_ADJ,K1_ADJ) =0.0
1158 !   End Do
1159 !   End Do
1160
1161 ! Remarked by Ning Pan, 2010-08-31
1162 !   Do K1_ADJ =jts, jte
1163 !   Do K0_ADJ =its, ite
1164 !   a_zeta_zd12(K0_ADJ,K1_ADJ) =0.0
1165 !   End Do
1166 !   End Do
1167
1168    Do K2_ADJ =jts-2, jte+2
1169    Do K1_ADJ =kts, kte
1170    Do K0_ADJ =its-2, ite+2
1171    a_tmp1(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1172    End Do
1173    End Do
1174    End Do
1175
1176    Do K2_ADJ =jts-2, jte+2
1177    Do K1_ADJ =kts, kte
1178    Do K0_ADJ =its-2, ite+2
1179    a_hat(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1180    End Do
1181    End Do
1182    End Do
1183
1184    Do K2_ADJ =jts-2, jte+2
1185    Do K1_ADJ =kts, kte
1186    Do K0_ADJ =its-2, ite+2
1187    a_hatavg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
1188    End Do
1189    End Do
1190    End Do
1191
1192 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
1193
1194 !LPB[90]
1195
1196 !  IF( config_flags%sfs_opt .GT. 0 ) THEN
1197 !  DO j =j_start, j_end
1198 !  DO k =kts+1, ktf
1199 !  DO i =i_start, i_end
1200 !  Tmpv001 =tmp1(i,k,j) -defor23(i,k,j)
1201 !  nba_rij(i,k,j,P_r23) =Tmpv001
1202
1203 !  Tmpv001 =defor23(i,k,j) +tmp1(i,k,j)
1204 !  defor23(i,k,j) =Tmpv001
1205
1206 !  ENDDO
1207 !  ENDDO
1208 !  ENDDO
1209 !  DO j =j_start, j_end
1210 !  DO i =i_start, i_end
1211 !  nba_rij(i,kts,j,P_r23) =0.0
1212
1213 !  nba_rij(i,ktf+1,j,P_r23) =0.0
1214
1215 !  ENDDO
1216 !  ENDDO
1217 !  IF( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1) THEN
1218 !  DO j =jts, jte
1219 !  DO k =kts, kte
1220 !  defor13(ids,k,j) =defor13(ids+1,k,j)
1221
1222 !  defor23(ids,k,j) =defor23(ids+1,k,j)
1223
1224 !  nba_rij(ids,k,j,P_r13) =nba_rij(ids+1,k,j,P_r13)
1225
1226 !  nba_rij(ids,k,j,P_r23) =nba_rij(ids+1,k,j,P_r23)
1227
1228 !  ENDDO
1229 !  ENDDO
1230 !  END IF
1231 !  IF( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN
1232 !  DO k =kts, kte
1233 !  DO i =its, ite
1234 !  defor13(i,k,jds) =defor13(i,k,jds+1)
1235
1236 !  defor23(i,k,jds) =defor23(i,k,jds+1)
1237
1238 !  nba_rij(i,k,jds,P_r13) =nba_rij(i,k,jds+1,P_r13)
1239
1240 !  nba_rij(i,k,jds,P_r23) =nba_rij(i,k,jds+1,P_r23)
1241
1242 !  ENDDO
1243 !  ENDDO
1244 !  END IF
1245 !  IF( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN
1246 !  DO j =jts, jte
1247 !  DO k =kts, kte
1248 !  defor13(ide,k,j) =defor13(ide-1,k,j)
1249
1250 !  defor23(ide,k,j) =defor23(ide-1,k,j)
1251
1252 !  nba_rij(ide,k,j,P_r13) =nba_rij(ide-1,k,j,P_r13)
1253
1254 !  nba_rij(ide,k,j,P_r23) =nba_rij(ide-1,k,j,P_r23)
1255
1256 !  ENDDO
1257 !  ENDDO
1258 !  END IF
1259 !  IF( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN
1260 !  DO k =kts, kte
1261 !  DO i =its, ite
1262 !  defor13(i,k,jde) =defor13(i,k,jde-1)
1263
1264 !  defor23(i,k,jde) =defor23(i,k,jde-1)
1265
1266 !  nba_rij(i,k,jde,P_r13) =nba_rij(i,k,jde-1,P_r13)
1267
1268 !  nba_rij(i,k,jde,P_r23) =nba_rij(i,k,jde-1,P_r23)
1269
1270 !  ENDDO
1271 !  ENDDO
1272 !  END IF
1273 !  ELSE
1274 !  DO j =j_start, j_end
1275 !  DO k =kts+1, ktf
1276 !  DO i =i_start, i_end
1277 !  Tmpv001 =defor23(i,k,j) +tmp1(i,k,j)
1278 !  defor23(i,k,j) =Tmpv001
1279
1280 !  ENDDO
1281 !  ENDDO
1282 !  ENDDO
1283 !  IF( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1) THEN
1284 !  DO j =jts, jte
1285 !  DO k =kts, kte
1286 !  defor13(ids,k,j) =defor13(ids+1,k,j)
1287
1288 !  defor23(ids,k,j) =defor23(ids+1,k,j)
1289
1290 !  ENDDO
1291 !  ENDDO
1292 !  END IF
1293 !  IF( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN
1294 !  DO k =kts, kte
1295 !  DO i =its, ite
1296 !  defor13(i,k,jds) =defor13(i,k,jds+1)
1297
1298 !  defor23(i,k,jds) =defor23(i,k,jds+1)
1299
1300 !  ENDDO
1301 !  ENDDO
1302 !  END IF
1303 !  IF( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN
1304 !  DO j =jts, jte
1305 !  DO k =kts, kte
1306 !  defor13(ide,k,j) =defor13(ide-1,k,j)
1307
1308 !  defor23(ide,k,j) =defor23(ide-1,k,j)
1309
1310 !  ENDDO
1311 !  ENDDO
1312 !  END IF
1313 !  IF( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN
1314 !  DO k =kts, kte
1315 !  DO i =its, ite
1316 !  defor13(i,k,jde) =defor13(i,k,jde-1)
1317
1318 !  defor23(i,k,jde) =defor23(i,k,jde-1)
1319
1320 !  ENDDO
1321 !  ENDDO
1322 !  END IF
1323 !  ENDIF
1324
1325    IF( config_flags%sfs_opt .GT. 0 ) THEN
1326
1327    IF( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN
1328
1329    DO k =kte, kts, -1
1330    DO i =ite, its, -1
1331    a_nba_rij(i,k,jde-1,P_r23) =a_nba_rij(i,k,jde-1,P_r23) +a_nba_rij(i,k,jde,P_r23)
1332    a_nba_rij(i,k,jde,P_r23) =0.0
1333    a_nba_rij(i,k,jde-1,P_r13) =a_nba_rij(i,k,jde-1,P_r13) +a_nba_rij(i,k,jde,P_r13)
1334    a_nba_rij(i,k,jde,P_r13) =0.0
1335    a_defor23(i,k,jde-1) =a_defor23(i,k,jde-1) +a_defor23(i,k,jde)
1336    a_defor23(i,k,jde) =0.0
1337    a_defor13(i,k,jde-1) =a_defor13(i,k,jde-1) +a_defor13(i,k,jde)
1338    a_defor13(i,k,jde) =0.0
1339    ENDDO
1340    ENDDO
1341
1342    END IF
1343
1344    IF( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN
1345
1346    DO j =jte, jts, -1
1347    DO k =kte, kts, -1
1348    a_nba_rij(ide-1,k,j,P_r23) =a_nba_rij(ide-1,k,j,P_r23) +a_nba_rij(ide,k,j,P_r23)
1349    a_nba_rij(ide,k,j,P_r23) =0.0
1350    a_nba_rij(ide-1,k,j,P_r13) =a_nba_rij(ide-1,k,j,P_r13) +a_nba_rij(ide,k,j,P_r13)
1351    a_nba_rij(ide,k,j,P_r13) =0.0
1352    a_defor23(ide-1,k,j) =a_defor23(ide-1,k,j) +a_defor23(ide,k,j)
1353    a_defor23(ide,k,j) =0.0
1354    a_defor13(ide-1,k,j) =a_defor13(ide-1,k,j) +a_defor13(ide,k,j)
1355    a_defor13(ide,k,j) =0.0
1356    ENDDO
1357    ENDDO
1358
1359    END IF
1360
1361    IF( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN
1362
1363    DO k =kte, kts, -1
1364    DO i =ite, its, -1
1365    a_nba_rij(i,k,jds+1,P_r23) =a_nba_rij(i,k,jds+1,P_r23) +a_nba_rij(i,k,jds,P_r23)
1366    a_nba_rij(i,k,jds,P_r23) =0.0
1367    a_nba_rij(i,k,jds+1,P_r13) =a_nba_rij(i,k,jds+1,P_r13) +a_nba_rij(i,k,jds,P_r13)
1368    a_nba_rij(i,k,jds,P_r13) =0.0
1369    a_defor23(i,k,jds+1) =a_defor23(i,k,jds+1) +a_defor23(i,k,jds)
1370    a_defor23(i,k,jds) =0.0
1371    a_defor13(i,k,jds+1) =a_defor13(i,k,jds+1) +a_defor13(i,k,jds)
1372    a_defor13(i,k,jds) =0.0
1373    ENDDO
1374    ENDDO
1375
1376    END IF
1377
1378    IF( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1) THEN
1379
1380    DO j =jte, jts, -1
1381    DO k =kte, kts, -1
1382    a_nba_rij(ids+1,k,j,P_r23) =a_nba_rij(ids+1,k,j,P_r23) +a_nba_rij(ids,k,j,P_r23)
1383    a_nba_rij(ids,k,j,P_r23) =0.0
1384    a_nba_rij(ids+1,k,j,P_r13) =a_nba_rij(ids+1,k,j,P_r13) +a_nba_rij(ids,k,j,P_r13)
1385    a_nba_rij(ids,k,j,P_r13) =0.0
1386    a_defor23(ids+1,k,j) =a_defor23(ids+1,k,j) +a_defor23(ids,k,j)
1387    a_defor23(ids,k,j) =0.0
1388    a_defor13(ids+1,k,j) =a_defor13(ids+1,k,j) +a_defor13(ids,k,j)
1389    a_defor13(ids,k,j) =0.0
1390    ENDDO
1391    ENDDO
1392
1393    END IF
1394    DO j =j_end, j_start, -1
1395    DO i =i_end, i_start, -1
1396    a_nba_rij(i,ktf+1,j,P_r23) =0.0
1397    a_nba_rij(i,kts,j,P_r23) =0.0
1398    ENDDO
1399    ENDDO
1400    DO j =j_end, j_start, -1
1401    DO k =ktf, kts+1, -1
1402    DO i =i_end, i_start, -1
1403    a_Tmpv1 =a_defor23(i,k,j)
1404    a_defor23(i,k,j) =0.0
1405    a_defor23(i,k,j) =a_defor23(i,k,j) +a_Tmpv1
1406    a_tmp1(i,k,j) =a_tmp1(i,k,j) +a_Tmpv1
1407    a_Tmpv1 =a_nba_rij(i,k,j,P_r23)
1408    a_nba_rij(i,k,j,P_r23) =0.0
1409    a_tmp1(i,k,j) =a_tmp1(i,k,j) +a_Tmpv1
1410    a_defor23(i,k,j) =a_defor23(i,k,j) -a_Tmpv1
1411    ENDDO
1412    ENDDO
1413    ENDDO
1414
1415    ELSE
1416
1417    IF( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN
1418
1419    DO k =kte, kts, -1
1420    DO i =ite, its, -1
1421    a_defor23(i,k,jde-1) =a_defor23(i,k,jde-1) +a_defor23(i,k,jde)
1422    a_defor23(i,k,jde) =0.0
1423    a_defor13(i,k,jde-1) =a_defor13(i,k,jde-1) +a_defor13(i,k,jde)
1424    a_defor13(i,k,jde) =0.0
1425    ENDDO
1426    ENDDO
1427
1428    END IF
1429
1430    IF( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN
1431
1432    DO j =jte, jts, -1
1433    DO k =kte, kts, -1
1434    a_defor23(ide-1,k,j) =a_defor23(ide-1,k,j) +a_defor23(ide,k,j)
1435    a_defor23(ide,k,j) =0.0
1436    a_defor13(ide-1,k,j) =a_defor13(ide-1,k,j) +a_defor13(ide,k,j)
1437    a_defor13(ide,k,j) =0.0
1438    ENDDO
1439    ENDDO
1440
1441    END IF
1442
1443    IF( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN
1444
1445    DO k =kte, kts, -1
1446    DO i =ite, its, -1
1447    a_defor23(i,k,jds+1) =a_defor23(i,k,jds+1) +a_defor23(i,k,jds)
1448    a_defor23(i,k,jds) =0.0
1449    a_defor13(i,k,jds+1) =a_defor13(i,k,jds+1) +a_defor13(i,k,jds)
1450    a_defor13(i,k,jds) =0.0
1451    ENDDO
1452    ENDDO
1453
1454    END IF
1455
1456    IF( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1) THEN
1457
1458    DO j =jte, jts, -1
1459    DO k =kte, kts, -1
1460    a_defor23(ids+1,k,j) =a_defor23(ids+1,k,j) +a_defor23(ids,k,j)
1461    a_defor23(ids,k,j) =0.0
1462    a_defor13(ids+1,k,j) =a_defor13(ids+1,k,j) +a_defor13(ids,k,j)
1463    a_defor13(ids,k,j) =0.0
1464    ENDDO
1465    ENDDO
1466
1467    END IF
1468    DO j =j_end, j_start, -1
1469    DO k =ktf, kts+1, -1
1470    DO i =i_end, i_start, -1
1471    a_Tmpv1 =a_defor23(i,k,j)
1472    a_defor23(i,k,j) =0.0
1473    a_defor23(i,k,j) =a_defor23(i,k,j) +a_Tmpv1
1474    a_tmp1(i,k,j) =a_tmp1(i,k,j) +a_Tmpv1
1475    ENDDO
1476    ENDDO
1477    ENDDO
1478
1479    ENDIF
1480
1481 !LPB[89]
1482
1483 !LPB[88]
1484
1485    IF( config_flags%mix_full_fields ) THEN
1486    DO j =j_start, j_end
1487    DO k =kts+1, ktf
1488    DO i =i_start, i_end
1489    Tmpv001 =v(i,k,j) -v(i,k-1,j)
1490    Tmpv002 =Tmpv001*0.5
1491    Tmpv003 =rdz(i,k,j) +rdz(i,k,j-1)
1492    Tmpv400(i,k,j) =Tmpv002
1493    Tmpv401(i,k,j) =Tmpv003
1494 ! Remarked by Ning Pan, 2010-08-31
1495 !   Tmpv004 =Tmpv400(i,k,j)*Tmpv401(i,k,j)
1496 !   tmp1(i,k,j) =Tmpv004
1497
1498    ENDDO
1499    ENDDO
1500    ENDDO
1501    ELSE
1502    DO j =j_start, j_end
1503    DO k =kts+1, ktf
1504    DO i =i_start, i_end
1505    Tmpv001 =v(i,k,j) -v_base(k) -v(i,k-1,j)
1506    Tmpv002 =Tmpv001 +v_base(k-1)
1507    Tmpv003 =Tmpv002*0.5
1508    Tmpv004 =rdz(i,k,j) +rdz(i,k,j-1)
1509    Tmpv402(i,k,j) =Tmpv003
1510    Tmpv403(i,k,j) =Tmpv004
1511 ! Remarked by Ning Pan, 2010-08-31
1512 !   Tmpv005 =Tmpv402(i,k,j)*Tmpv403(i,k,j)
1513 !   tmp1(i,k,j) =Tmpv005
1514
1515    ENDDO
1516    ENDDO
1517    ENDDO
1518    END IF
1519
1520    IF( config_flags%mix_full_fields ) THEN
1521
1522    DO j =j_end, j_start, -1
1523    DO k =ktf, kts+1, -1
1524    DO i =i_end, i_start, -1
1525    a_Tmpv4 =a_tmp1(i,k,j)
1526    a_tmp1(i,k,j) =0.0
1527    a_Tmpv2 =Tmpv401(i,k,j)*a_Tmpv4
1528    a_Tmpv3 =Tmpv400(i,k,j)*a_Tmpv4
1529    a_rdz(i,k,j) =a_rdz(i,k,j) +a_Tmpv3
1530    a_rdz(i,k,j-1) =a_rdz(i,k,j-1) +a_Tmpv3
1531    a_Tmpv1 =0.5*a_Tmpv2
1532    a_v(i,k,j) =a_v(i,k,j) +a_Tmpv1
1533    a_v(i,k-1,j) =a_v(i,k-1,j) -a_Tmpv1
1534    ENDDO
1535    ENDDO
1536    ENDDO
1537
1538    ELSE
1539
1540    DO j =j_end, j_start, -1
1541    DO k =ktf, kts+1, -1
1542    DO i =i_end, i_start, -1
1543    a_Tmpv5 =a_tmp1(i,k,j)
1544    a_tmp1(i,k,j) =0.0
1545    a_Tmpv3 =Tmpv403(i,k,j)*a_Tmpv5
1546    a_Tmpv4 =Tmpv402(i,k,j)*a_Tmpv5
1547    a_rdz(i,k,j) =a_rdz(i,k,j) +a_Tmpv4
1548    a_rdz(i,k,j-1) =a_rdz(i,k,j-1) +a_Tmpv4
1549    a_Tmpv2 =0.5*a_Tmpv3
1550    a_Tmpv1 =a_Tmpv2
1551    a_v(i,k,j) =a_v(i,k,j) +a_Tmpv1
1552    a_v(i,k-1,j) =a_v(i,k-1,j) -a_Tmpv1
1553    ENDDO
1554    ENDDO
1555    ENDDO
1556
1557    END IF
1558
1559 !LPB[87]
1560
1561 !LPB[86]
1562    DO j =j_end, j_start, -1
1563
1564 !  DO i =i_start, i_end
1565 !  defor23(i,kts,j) =0.0
1566
1567 !  defor23(i,ktf+1,j) =0.0
1568
1569 !  ENDDO
1570
1571    DO i =i_end, i_start, -1
1572    a_defor23(i,ktf+1,j) =0.0
1573    a_defor23(i,kts,j) =0.0
1574    ENDDO
1575
1576    ENDDO
1577
1578 !LPB[85]
1579    DO j =j_end, j_start, -1
1580
1581 ! Remarked by Ning Pan, 2010-08-31
1582 !   DO k =kts+1, ktf
1583 !   DO i =i_start, i_end
1584 !   Tmpv001 =hat(i,k,j) -hat(i,k,j-1)
1585 !   Tmpv002 =rdy*Tmpv001
1586 !   Tmpv003 =Tmpv002 -tmp1(i,k,j)
1587 !   Tmpv300(i,k) =Tmpv003
1588 !   Tmpv004 =mm(i,j)*Tmpv300(i,k)
1589 !   defor23(i,k,j) =Tmpv004
1590
1591 !   ENDDO
1592 !   ENDDO
1593
1594    DO k =ktf, kts+1, -1
1595    DO i =i_end, i_start, -1
1596    a_Tmpv4 =a_defor23(i,k,j)
1597    a_defor23(i,k,j) =0.0
1598 !   a_mm(i,j) =a_mm(i,j) +Tmpv300(i,k)*a_Tmpv4  ! Remarked by Ning Pan, 2010-08-31
1599    a_Tmpv3 =mm(i,j)*a_Tmpv4
1600    a_Tmpv2 =a_Tmpv3
1601    a_tmp1(i,k,j) =a_tmp1(i,k,j) -a_Tmpv3
1602    a_Tmpv1 =rdy*a_Tmpv2
1603    a_hat(i,k,j) =a_hat(i,k,j) +a_Tmpv1
1604    a_hat(i,k,j-1) =a_hat(i,k,j-1) -a_Tmpv1
1605    ENDDO
1606    ENDDO
1607
1608    ENDDO
1609
1610 !LPB[84]
1611
1612    DO j =j_end, j_start, -1
1613
1614    DO k =kts+1, ktf
1615    DO i =i_start, i_end
1616    Tmpv001 =hatavg(i,k,j) -hatavg(i,k-1,j)
1617    Tmpv300(i,k) =Tmpv001
1618    Tmpv002 =Tmpv300(i,k)*zy(i,k,j)
1619    Tmpv003 =Tmpv002*0.5
1620    Tmpv004 =rdz(i,k,j) +rdz(i,k,j-1)
1621    Tmpv301(i,k) =Tmpv003
1622    Tmpv302(i,k) =Tmpv004
1623 ! Remarked by Ning Pan, 2010-08-31
1624 !   Tmpv005 =Tmpv301(i,k)*Tmpv302(i,k)
1625 !   tmp1(i,k,j) =Tmpv005
1626
1627    ENDDO
1628    ENDDO
1629
1630    DO k =ktf, kts+1, -1
1631    DO i =i_end, i_start, -1
1632    a_Tmpv5 =a_tmp1(i,k,j)
1633    a_tmp1(i,k,j) =0.0
1634    a_Tmpv3 =Tmpv302(i,k)*a_Tmpv5
1635    a_Tmpv4 =Tmpv301(i,k)*a_Tmpv5
1636    a_rdz(i,k,j) =a_rdz(i,k,j) +a_Tmpv4
1637    a_rdz(i,k,j-1) =a_rdz(i,k,j-1) +a_Tmpv4
1638    a_Tmpv2 =0.5*a_Tmpv3
1639    a_Tmpv1 =zy(i,k,j)*a_Tmpv2
1640    a_zy(i,k,j) =a_zy(i,k,j) +Tmpv300(i,k)*a_Tmpv2
1641    a_hatavg(i,k,j) =a_hatavg(i,k,j) +a_Tmpv1
1642    a_hatavg(i,k-1,j) =a_hatavg(i,k-1,j) -a_Tmpv1
1643    ENDDO
1644    ENDDO
1645
1646    ENDDO
1647
1648 !BIG ERRORS, ADDED BY WALLS
1649 !       tmp1 =Keep_Lpb60_tmp1  ! Remarked by Ning Pan, 2010-08-31
1650
1651 !LPB[83]
1652    DO j =j_end, j_start, -1
1653
1654 !  DO k =kts, ktf
1655 !  DO i =i_start, i_end
1656 !  Tmpv001 =hat(i,k,j) +hat(i,k+1,j)
1657 !  Tmpv002 =Tmpv001 +hat(i,k,j-1)
1658 !  Tmpv003 =Tmpv002 +hat(i,k+1,j-1)
1659 !  Tmpv004 =0.25*Tmpv003
1660 !  hatavg(i,k,j) =Tmpv004
1661
1662 !  ENDDO
1663 !  ENDDO
1664
1665    DO k =ktf, kts, -1
1666    DO i =i_end, i_start, -1
1667    a_Tmpv4 =a_hatavg(i,k,j)
1668    a_hatavg(i,k,j) =0.0
1669    a_Tmpv3 =0.25*a_Tmpv4
1670    a_Tmpv2 =a_Tmpv3
1671    a_hat(i,k+1,j-1) =a_hat(i,k+1,j-1) +a_Tmpv3
1672    a_Tmpv1 =a_Tmpv2
1673    a_hat(i,k,j-1) =a_hat(i,k,j-1) +a_Tmpv2
1674    a_hat(i,k,j) =a_hat(i,k,j) +a_Tmpv1
1675    a_hat(i,k+1,j) =a_hat(i,k+1,j) +a_Tmpv1
1676    ENDDO
1677    ENDDO
1678
1679    ENDDO
1680
1681 !ADDED BY WALLS
1682 !FROM LPB[81]
1683    j =j_start-1
1684
1685 !LPB[82]
1686    DO k =kte, kts, -1
1687
1688 !  DO i =i_start, min(ite, ide-1)
1689 !  hat(i,k,j) =w(i,k,j)/msftx(i,j)
1690
1691 !  ENDDO
1692
1693    DO i =min(ite, ide-1), i_start, -1
1694    a_w(i,k,j) =a_w(i,k,j) +1.0/msftx(i,j)*a_hat(i,k,j)
1695    a_hat(i,k,j) =0.0
1696    ENDDO
1697
1698    ENDDO
1699
1700 !LPB[81]
1701 !  j =j_start-1
1702
1703 !ADDED BY WALLS
1704 !FROM LPB[79]
1705    i =i_start-1
1706
1707 !LPB[80]
1708    DO j =min(jte, jde-1), j_start, -1
1709
1710 !  DO k =kts, kte
1711 !  hat(i,k,j) =w(i,k,j)/msftx(i,j)
1712
1713 !  ENDDO
1714
1715    DO k =kte, kts, -1
1716    a_w(i,k,j) =a_w(i,k,j) +1.0/msftx(i,j)*a_hat(i,k,j)
1717    a_hat(i,k,j) =0.0
1718    ENDDO
1719
1720    ENDDO
1721
1722 !LPB[79]
1723 !  i =i_start-1
1724
1725 !LPB[78]
1726    DO j =j_end, j_start, -1
1727
1728 !  DO k =kts, kte
1729 !  DO i =i_start, i_end
1730 !  hat(i,k,j) =w(i,k,j)/msftx(i,j)
1731
1732 !  ENDDO
1733 !  ENDDO
1734
1735    DO k =kte, kts, -1
1736    DO i =i_end, i_start, -1
1737    a_w(i,k,j) =a_w(i,k,j) +1.0/msftx(i,j)*a_hat(i,k,j)
1738    a_hat(i,k,j) =0.0
1739    ENDDO
1740    ENDDO
1741
1742    ENDDO
1743
1744 !BIG ERRORS, REVISED BY WALLS
1745 !   hat =Keep_Lpb54_hat  ! Remarked by Ning Pan, 2010-08-31
1746
1747 !LPB[77]
1748 ! Remarked by Ning Pan, 2010-08-31
1749 !   DO j =jte, jts, -1
1750
1751 !!  DO i =its, ite
1752 !!  mm(i,j) =msfvx(i,j)*msfvy(i,j)
1753
1754 !!  ENDDO
1755
1756 !   DO i =ite, its, -1
1757 !   a_mm(i,j) =0.0
1758 !   ENDDO
1759
1760 !   ENDDO
1761
1762 !BIG ERRORS, REVISED BY WALLS
1763    mm =Keep_Lpb53_mm
1764
1765 !LPB[76]
1766
1767 !  IF( config_flags%periodic_x ) THEN
1768 !  i_end =min(ite, ide-1)
1769 !  END IF
1770
1771 !  IF( config_flags%periodic_x ) THEN
1772
1773 !  END IF
1774
1775 !LPB[75]
1776
1777 !LPB[74]
1778
1779 !  IF( config_flags%periodic_x ) THEN
1780 !  i_start =its
1781 !  END IF
1782
1783 !  IF( config_flags%periodic_x ) THEN
1784
1785 !  END IF
1786
1787 !LPB[73]
1788
1789 !LPB[72]
1790
1791 !  IF( config_flags%periodic_y ) THEN
1792 !  j_end =min(jte, jde)
1793 !  END IF
1794
1795 !  IF( config_flags%periodic_y ) THEN
1796
1797 !  END IF
1798
1799 !LPB[71]
1800
1801 !LPB[70]
1802
1803 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.             config_flags%nested) THEN
1804 !  j_start =max(jds+1, jts)
1805 !  END IF
1806
1807 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
1808 !            config_flags%nested) THEN
1809
1810 !  END IF
1811
1812 !LPB[69]
1813
1814 !LPB[68]
1815
1816 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.             config_flags%nested) THEN
1817 !  i_start =max(ids+1, its)
1818 !  END IF
1819
1820 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
1821 !            config_flags%nested) THEN
1822
1823 !  END IF
1824
1825 !LPB[67]
1826 !  i_start =its
1827 !  i_end =min(ite, ide-1)
1828 !  j_start =jts
1829 !  j_end =min(jte, jde-1)
1830
1831 !ADDED BY WALLS
1832 !FROM LPB[43]
1833
1834        i_start = its
1835        i_end   = MIN( ite, ide-1 )
1836        j_start = jts
1837        j_end   = MIN( jte, jde-1 )
1838
1839 !FROM LPB[44]
1840     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
1841          config_flags%nested) i_start = MAX( ids+1, its )
1842
1843 !FROM LPB[45]
1844
1845 !FROM LPB[46]
1846     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
1847          config_flags%nested) j_start = MAX( jds+1, jts )
1848
1849 !FROM LPB[47]
1850
1851 !FROM LPB[48]
1852     IF ( config_flags%periodic_x ) i_start = its
1853
1854 !FROM LPB[49]
1855
1856 !FROM LPB[50]
1857     IF ( config_flags%periodic_x ) i_end = MIN( ite, ide )
1858
1859 !FROM LPB[51]
1860
1861 !FROM LPB[52]
1862     IF ( config_flags%periodic_y ) j_end = MIN( jte, jde )
1863
1864 !LPB[66]
1865
1866 !  IF( config_flags%sfs_opt .GT. 0 ) THEN
1867 !  DO j =j_start, j_end
1868 !  DO k =kts+1, ktf
1869 !  DO i =i_start, i_end
1870 !  Tmpv001 =tmp1(i,k,j) -defor13(i,k,j)
1871 !  nba_rij(i,k,j,P_r13) =Tmpv001
1872
1873 !  Tmpv001 =defor13(i,k,j) +tmp1(i,k,j)
1874 !  defor13(i,k,j) =Tmpv001
1875
1876 !  ENDDO
1877 !  ENDDO
1878 !  ENDDO
1879 !  DO j =j_start, j_end
1880 !  DO i =i_start, i_end
1881 !  nba_rij(i,kts,j,P_r13) =0.0
1882
1883 !  nba_rij(i,ktf+1,j,P_r13) =0.0
1884
1885 !  ENDDO
1886 !  ENDDO
1887 !  ELSE
1888 !  DO j =j_start, j_end
1889 !  DO k =kts+1, ktf
1890 !  DO i =i_start, i_end
1891 !  Tmpv001 =defor13(i,k,j) +tmp1(i,k,j)
1892 !  defor13(i,k,j) =Tmpv001
1893
1894 !  ENDDO
1895 !  ENDDO
1896 !  ENDDO
1897 !  ENDIF
1898
1899    IF( config_flags%sfs_opt .GT. 0 ) THEN
1900
1901    DO j =j_end, j_start, -1
1902    DO i =i_end, i_start, -1
1903    a_nba_rij(i,ktf+1,j,P_r13) =0.0
1904    a_nba_rij(i,kts,j,P_r13) =0.0
1905    ENDDO
1906    ENDDO
1907    DO j =j_end, j_start, -1
1908    DO k =ktf, kts+1, -1
1909    DO i =i_end, i_start, -1
1910    a_Tmpv1 =a_defor13(i,k,j)
1911    a_defor13(i,k,j) =0.0
1912    a_defor13(i,k,j) =a_defor13(i,k,j) +a_Tmpv1
1913    a_tmp1(i,k,j) =a_tmp1(i,k,j) +a_Tmpv1
1914    a_Tmpv1 =a_nba_rij(i,k,j,P_r13)
1915    a_nba_rij(i,k,j,P_r13) =0.0
1916    a_tmp1(i,k,j) =a_tmp1(i,k,j) +a_Tmpv1
1917    a_defor13(i,k,j) =a_defor13(i,k,j) -a_Tmpv1
1918    ENDDO
1919    ENDDO
1920    ENDDO
1921
1922    ELSE
1923
1924    DO j =j_end, j_start, -1
1925    DO k =ktf, kts+1, -1
1926    DO i =i_end, i_start, -1
1927    a_Tmpv1 =a_defor13(i,k,j)
1928    a_defor13(i,k,j) =0.0
1929    a_defor13(i,k,j) =a_defor13(i,k,j) +a_Tmpv1
1930    a_tmp1(i,k,j) =a_tmp1(i,k,j) +a_Tmpv1
1931    ENDDO
1932    ENDDO
1933    ENDDO
1934
1935    ENDIF
1936
1937 !LPB[65]
1938
1939 !LPB[64]
1940
1941    IF( config_flags%mix_full_fields ) THEN
1942    DO j =j_start, j_end
1943    DO k =kts+1, ktf
1944    DO i =i_start, i_end
1945    Tmpv001 =u(i,k,j) -u(i,k-1,j)
1946    Tmpv002 =Tmpv001*0.5
1947    Tmpv003 =rdz(i,k,j) +rdz(i-1,k,j)
1948    Tmpv400(i,k,j) =Tmpv002
1949    Tmpv401(i,k,j) =Tmpv003
1950 ! Remarked by Ning Pan, 2010-08-31
1951 !   Tmpv004 =Tmpv400(i,k,j)*Tmpv401(i,k,j)
1952 !   tmp1(i,k,j) =Tmpv004
1953
1954    ENDDO
1955    ENDDO
1956    ENDDO
1957    ELSE
1958    DO j =j_start, j_end
1959    DO k =kts+1, ktf
1960    DO i =i_start, i_end
1961    Tmpv001 =u(i,k,j) -u_base(k) -u(i,k-1,j)
1962    Tmpv002 =Tmpv001 +u_base(k-1)
1963    Tmpv003 =Tmpv002*0.5
1964    Tmpv004 =rdz(i,k,j) +rdz(i-1,k,j)
1965    Tmpv402(i,k,j) =Tmpv003
1966    Tmpv403(i,k,j) =Tmpv004
1967 ! Remarked by Ning Pan, 2010-08-31
1968 !   Tmpv005 =Tmpv402(i,k,j)*Tmpv403(i,k,j)
1969 !   tmp1(i,k,j) =Tmpv005
1970
1971    ENDDO
1972    ENDDO
1973    ENDDO
1974    END IF
1975
1976    IF( config_flags%mix_full_fields ) THEN
1977
1978    DO j =j_end, j_start, -1
1979    DO k =ktf, kts+1, -1
1980    DO i =i_end, i_start, -1
1981    a_Tmpv4 =a_tmp1(i,k,j)
1982    a_tmp1(i,k,j) =0.0
1983    a_Tmpv2 =Tmpv401(i,k,j)*a_Tmpv4
1984    a_Tmpv3 =Tmpv400(i,k,j)*a_Tmpv4
1985    a_rdz(i,k,j) =a_rdz(i,k,j) +a_Tmpv3
1986    a_rdz(i-1,k,j) =a_rdz(i-1,k,j) +a_Tmpv3
1987    a_Tmpv1 =0.5*a_Tmpv2
1988    a_u(i,k,j) =a_u(i,k,j) +a_Tmpv1
1989    a_u(i,k-1,j) =a_u(i,k-1,j) -a_Tmpv1
1990    ENDDO
1991    ENDDO
1992    ENDDO
1993
1994    ELSE
1995
1996    DO j =j_end, j_start, -1
1997    DO k =ktf, kts+1, -1
1998    DO i =i_end, i_start, -1
1999    a_Tmpv5 =a_tmp1(i,k,j)
2000    a_tmp1(i,k,j) =0.0
2001    a_Tmpv3 =Tmpv403(i,k,j)*a_Tmpv5
2002    a_Tmpv4 =Tmpv402(i,k,j)*a_Tmpv5
2003    a_rdz(i,k,j) =a_rdz(i,k,j) +a_Tmpv4
2004    a_rdz(i-1,k,j) =a_rdz(i-1,k,j) +a_Tmpv4
2005    a_Tmpv2 =0.5*a_Tmpv3
2006    a_Tmpv1 =a_Tmpv2
2007    a_u(i,k,j) =a_u(i,k,j) +a_Tmpv1
2008    a_u(i,k-1,j) =a_u(i,k-1,j) -a_Tmpv1
2009    ENDDO
2010    ENDDO
2011    ENDDO
2012
2013    END IF
2014
2015 !LPB[63]
2016
2017 !LPB[62]
2018    DO j =j_end, j_start, -1
2019
2020 !  DO i =i_start, i_end
2021 !  defor13(i,kts,j) =0.0
2022
2023 !  defor13(i,ktf+1,j) =0.0
2024
2025 !  ENDDO
2026
2027    DO i =i_end, i_start, -1
2028    a_defor13(i,ktf+1,j) =0.0
2029    a_defor13(i,kts,j) =0.0
2030    ENDDO
2031
2032    ENDDO
2033
2034 !LPB[61]
2035    DO j =j_end, j_start, -1
2036
2037 ! Remarked by Ning Pan, 2010-08-31
2038 !   DO k =kts+1, ktf
2039 !   DO i =i_start, i_end
2040 !   Tmpv001 =hat(i,k,j) -hat(i-1,k,j)
2041 !   Tmpv002 =rdx*Tmpv001
2042 !   Tmpv003 =Tmpv002 -tmp1(i,k,j)
2043 !   Tmpv300(i,k) =Tmpv003
2044 !   Tmpv004 =mm(i,j)*Tmpv300(i,k)
2045 !   defor13(i,k,j) =Tmpv004
2046
2047 !   ENDDO
2048 !   ENDDO
2049
2050    DO k =ktf, kts+1, -1
2051    DO i =i_end, i_start, -1
2052    a_Tmpv4 =a_defor13(i,k,j)
2053    a_defor13(i,k,j) =0.0
2054 !   a_mm(i,j) =a_mm(i,j) +Tmpv300(i,k)*a_Tmpv4  ! Remarked by Ning Pan, 2010-08-31
2055    a_Tmpv3 =mm(i,j)*a_Tmpv4
2056    a_Tmpv2 =a_Tmpv3
2057    a_tmp1(i,k,j) =a_tmp1(i,k,j) -a_Tmpv3
2058    a_Tmpv1 =rdx*a_Tmpv2
2059    a_hat(i,k,j) =a_hat(i,k,j) +a_Tmpv1
2060    a_hat(i-1,k,j) =a_hat(i-1,k,j) -a_Tmpv1
2061    ENDDO
2062    ENDDO
2063
2064    ENDDO
2065
2066 !LPB[60]
2067    DO j =j_end, j_start, -1
2068
2069    DO k =kts+1, ktf
2070    DO i =i_start, i_end
2071 !BIG ERRORS, ADDED BY WALLS
2072 !BIG ERRORS, ADDED BY WALLS
2073 !  Tmpv001 =hatavg(i,k,j) -hatavg(i,k-1,j)
2074    Tmpv001 =Keep_Lpb60_hatavg(i,k,j)
2075
2076    Tmpv300(i,k) =Tmpv001
2077    Tmpv002 =Tmpv300(i,k)*zx(i,k,j)
2078    Tmpv003 =Tmpv002*0.5
2079    Tmpv004 =rdz(i,k,j) +rdz(i-1,k,j)
2080    Tmpv301(i,k) =Tmpv003
2081    Tmpv302(i,k) =Tmpv004
2082 ! Remarked by Ning Pan, 2010-08-31
2083 !   Tmpv005 =Tmpv301(i,k)*Tmpv302(i,k)
2084 !   tmp1(i,k,j) =Tmpv005
2085
2086    ENDDO
2087    ENDDO
2088
2089    DO k =ktf, kts+1, -1
2090    DO i =i_end, i_start, -1
2091    a_Tmpv5 =a_tmp1(i,k,j)
2092    a_tmp1(i,k,j) =0.0
2093    a_Tmpv3 =Tmpv302(i,k)*a_Tmpv5
2094    a_Tmpv4 =Tmpv301(i,k)*a_Tmpv5
2095    a_rdz(i,k,j) =a_rdz(i,k,j) +a_Tmpv4
2096    a_rdz(i-1,k,j) =a_rdz(i-1,k,j) +a_Tmpv4
2097    a_Tmpv2 =0.5*a_Tmpv3
2098    a_Tmpv1 =zx(i,k,j)*a_Tmpv2
2099    a_zx(i,k,j) =a_zx(i,k,j) +Tmpv300(i,k)*a_Tmpv2
2100    a_hatavg(i,k,j) =a_hatavg(i,k,j) +a_Tmpv1
2101    a_hatavg(i,k-1,j) =a_hatavg(i,k-1,j) -a_Tmpv1
2102    ENDDO
2103    ENDDO
2104
2105    ENDDO
2106
2107 !BIG ERRORS, ADDED BY WALLS
2108 !       tmp1 =Keep_Lpb40_tmp1  ! Remarked by Ning Pan, 2010-08-31
2109
2110 !LPB[59]
2111    DO j =j_end, j_start, -1
2112
2113 !  DO k =kts, ktf
2114 !  DO i =i_start, i_end
2115 !  Tmpv001 =hat(i,k,j) +hat(i,k+1,j)
2116 !  Tmpv002 =Tmpv001 +hat(i-1,k,j)
2117 !  Tmpv003 =Tmpv002 +hat(i-1,k+1,j)
2118 !  Tmpv004 =0.25*Tmpv003
2119 !  hatavg(i,k,j) =Tmpv004
2120
2121 !  ENDDO
2122 !  ENDDO
2123
2124    DO k =ktf, kts, -1
2125    DO i =i_end, i_start, -1
2126    a_Tmpv4 =a_hatavg(i,k,j)
2127    a_hatavg(i,k,j) =0.0
2128    a_Tmpv3 =0.25*a_Tmpv4
2129    a_Tmpv2 =a_Tmpv3
2130    a_hat(i-1,k+1,j) =a_hat(i-1,k+1,j) +a_Tmpv3
2131    a_Tmpv1 =a_Tmpv2
2132    a_hat(i-1,k,j) =a_hat(i-1,k,j) +a_Tmpv2
2133    a_hat(i,k,j) =a_hat(i,k,j) +a_Tmpv1
2134    a_hat(i,k+1,j) =a_hat(i,k+1,j) +a_Tmpv1
2135    ENDDO
2136    ENDDO
2137
2138    ENDDO
2139
2140 !ADDED BY WALLS
2141 !FROM LPB[57]
2142        j = j_start-1
2143
2144 !LPB[58]
2145    DO k =kte, kts, -1
2146
2147 !  DO i =i_start, min(ite, ide-1)
2148 !  hat(i,k,j) =w(i,k,j)/msfty(i,j)
2149
2150 !  ENDDO
2151
2152    DO i =min(ite, ide-1), i_start, -1
2153    a_w(i,k,j) =a_w(i,k,j) +1.0/msfty(i,j)*a_hat(i,k,j)
2154    a_hat(i,k,j) =0.0
2155    ENDDO
2156
2157    ENDDO
2158
2159 !LPB[57]
2160 !  j =j_start-1
2161
2162 !ADDED BY WALLS
2163 !FROM LPB[55]
2164        i = i_start-1
2165
2166 !LPB[56]
2167    DO j =min(jte, jde-1), j_start, -1
2168
2169 !  DO k =kts, kte
2170 !  hat(i,k,j) =w(i,k,j)/msfty(i,j)
2171
2172 !  ENDDO
2173
2174    DO k =kte, kts, -1
2175    a_w(i,k,j) =a_w(i,k,j) +1.0/msfty(i,j)*a_hat(i,k,j)
2176    a_hat(i,k,j) =0.0
2177    ENDDO
2178
2179    ENDDO
2180
2181 !LPB[55]
2182 !  i =i_start-1
2183
2184 !LPB[54]
2185    DO j =j_end, j_start, -1
2186
2187 !  DO k =kts, kte
2188 !  DO i =i_start, i_end
2189 !  hat(i,k,j) =w(i,k,j)/msfty(i,j)
2190
2191 !  ENDDO
2192 !  ENDDO
2193
2194    DO k =kte, kts, -1
2195    DO i =i_end, i_start, -1
2196    a_w(i,k,j) =a_w(i,k,j) +1.0/msfty(i,j)*a_hat(i,k,j)
2197    a_hat(i,k,j) =0.0
2198    ENDDO
2199    ENDDO
2200
2201    ENDDO
2202
2203 !BIG ERRORS, REVISED BY WALLS
2204 !   hat =Keep_Lpb37_hat  ! Remarked by Ning Pan, 2010-08-31
2205
2206 !LPB[53]
2207 ! Remarked by Ning Pan, 2010-08-31
2208 !   DO j =jte, jts, -1
2209
2210 !!  DO i =its, ite
2211 !!  mm(i,j) =msfux(i,j)*msfuy(i,j)
2212
2213 !!  ENDDO
2214
2215 !   DO i =ite, its, -1
2216 !   a_mm(i,j) =0.0
2217 !   ENDDO
2218
2219 !   ENDDO
2220
2221 !BIG ERRORS, REVISED BY WALLS
2222    mm =Keep_Lpb31_mm
2223
2224 !LPB[52]
2225
2226 !  IF( config_flags%periodic_y ) THEN
2227 !  j_end =min(jte, jde)
2228 !  END IF
2229
2230 !  IF( config_flags%periodic_y ) THEN
2231
2232 !  END IF
2233
2234 !LPB[51]
2235
2236 !LPB[50]
2237
2238 !  IF( config_flags%periodic_x ) THEN
2239 !  i_end =min(ite, ide)
2240 !  END IF
2241
2242 !  IF( config_flags%periodic_x ) THEN
2243
2244 !  END IF
2245
2246 !LPB[49]
2247
2248 !LPB[48]
2249
2250 !  IF( config_flags%periodic_x ) THEN
2251 !  i_start =its
2252 !  END IF
2253
2254 !  IF( config_flags%periodic_x ) THEN
2255
2256 !  END IF
2257
2258 !LPB[47]
2259
2260 !LPB[46]
2261
2262 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.             config_flags%nested) THEN
2263 !  j_start =max(jds+1, jts)
2264 !  END IF
2265
2266 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
2267 !            config_flags%nested) THEN
2268
2269 !  END IF
2270
2271 !LPB[45]
2272
2273 !LPB[44]
2274
2275 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.             config_flags%nested) THEN
2276 !  i_start =max(ids+1, its)
2277 !  END IF
2278
2279 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
2280 !            config_flags%nested) THEN
2281
2282 !  END IF
2283
2284 !LPB[43]
2285 !  i_start =its
2286 !  i_end =min(ite, ide-1)
2287 !  j_start =jts
2288 !  j_end =min(jte, jde-1)
2289
2290 !ADDED BY WALLS
2291 !FROM LPB[19]
2292        i_start = its
2293        i_end   = ite
2294        j_start = jts
2295        j_end   = jte
2296
2297 !FROM LPB[20]
2298     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
2299          config_flags%nested) i_start = MAX( ids+1, its )
2300
2301 !FROM LPB[21]
2302
2303 !FROM LPB[22]
2304     IF ( config_flags%open_xe .OR. config_flags%specified .OR.    &
2305          config_flags%nested) i_end   = MIN( ide-1, ite )
2306
2307 !FROM LPB[23]
2308
2309 !FROM LPB[24]
2310     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
2311          config_flags%nested) j_start = MAX( jds+1, jts )
2312
2313 !FROM LPB[25]
2314
2315 !FROM LPB[26]
2316     IF ( config_flags%open_ye .OR. config_flags%specified .OR.   &
2317          config_flags%nested) j_end   = MIN( jde-1, jte )
2318
2319 !FROM LPB[27]
2320
2321 !FROM LPB[28]
2322       IF ( config_flags%periodic_x ) i_start = its
2323
2324 !FROM LPB[29]
2325
2326 !FROM LPB[30]
2327       IF ( config_flags%periodic_x ) i_end = ite
2328
2329 !LPB[42]
2330
2331    IF( config_flags%sfs_opt .GT. 0 ) THEN
2332    DO j =j_start, j_end
2333    DO k =kts, ktf
2334    DO i =i_start, i_end
2335    Tmpv001 =hat(i,k,j) -hat(i-1,k,j)
2336    Tmpv002 =rdx*Tmpv001
2337    Tmpv003 =Tmpv002 -tmp1(i,k,j)
2338    Tmpv400(i,k,j) =Tmpv003
2339 ! Remarked by Ning Pan, 2010-08-31
2340 !   Tmpv004 =mm(i,j)*Tmpv400(i,k,j)
2341 !   Tmpv005 =defor12(i,k,j) -Tmpv004
2342 !   nba_rij(i,k,j,P_r12) =Tmpv005
2343
2344    Tmpv001 =hat(i,k,j) -hat(i-1,k,j)
2345    Tmpv002 =rdx*Tmpv001
2346    Tmpv003 =Tmpv002 -tmp1(i,k,j)
2347    Tmpv401(i,k,j) =Tmpv003
2348 ! Remarked by Ning Pan, 2010-08-31
2349 !   Tmpv004 =mm(i,j)*Tmpv401(i,k,j)
2350 !   Tmpv005 =defor12(i,k,j) +Tmpv004
2351 !   defor12(i,k,j) =Tmpv005
2352
2353    ENDDO
2354    ENDDO
2355    ENDDO
2356 ! Remarked by Ning Pan, 2010-08-31
2357 !   IF( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1 ) THEN
2358 !   DO j =jts, jte
2359 !   DO k =kts, kte
2360 !   defor12(ids,k,j) =defor12(ids+1,k,j)
2361
2362 !   nba_rij(ids,k,j,P_r12) =nba_rij(ids+1,k,j,P_r12)
2363
2364 !   ENDDO
2365 !   ENDDO
2366 !   END IF
2367 !   IF( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN
2368 !   DO k =kts, kte
2369 !   DO i =its, ite
2370 !   defor12(i,k,jds) =defor12(i,k,jds+1)
2371
2372 !   nba_rij(i,k,jds,P_r12) =nba_rij(i,k,jds+1,P_r12)
2373
2374 !   ENDDO
2375 !   ENDDO
2376 !   END IF
2377 !   IF( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN
2378 !   DO j =jts, jte
2379 !   DO k =kts, kte
2380 !   defor12(ide,k,j) =defor12(ide-1,k,j)
2381
2382 !   nba_rij(ide,k,j,P_r12) =nba_rij(ide-1,k,j,P_r12)
2383
2384 !   ENDDO
2385 !   ENDDO
2386 !   END IF
2387 !   IF( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN
2388 !   DO k =kts, kte
2389 !   DO i =its, ite
2390 !   defor12(i,k,jde) =defor12(i,k,jde-1)
2391
2392 !   nba_rij(i,k,jde,P_r12) =nba_rij(i,k,jde-1,P_r12)
2393
2394 !   ENDDO
2395 !   ENDDO
2396 !   END IF
2397 !   ELSE
2398 !   DO j =j_start, j_end
2399 !   DO k =kts, ktf
2400 !   DO i =i_start, i_end
2401 !   Tmpv001 =hat(i,k,j) -hat(i-1,k,j)
2402 !   Tmpv002 =rdx*Tmpv001
2403 !   Tmpv003 =Tmpv002 -tmp1(i,k,j)
2404 !   Tmpv402(i,k,j) =Tmpv003
2405 !   Tmpv004 =mm(i,j)*Tmpv402(i,k,j)
2406 !   Tmpv005 =defor12(i,k,j) +Tmpv004
2407 !   defor12(i,k,j) =Tmpv005
2408
2409 !   ENDDO
2410 !   ENDDO
2411 !   ENDDO
2412 !   IF( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1 ) THEN
2413 !   DO j =jts, jte
2414 !   DO k =kts, kte
2415 !   defor12(ids,k,j) =defor12(ids+1,k,j)
2416
2417 !   ENDDO
2418 !   ENDDO
2419 !   END IF
2420 !   IF( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN
2421 !   DO k =kts, kte
2422 !   DO i =its, ite
2423 !   defor12(i,k,jds) =defor12(i,k,jds+1)
2424
2425 !   ENDDO
2426 !   ENDDO
2427 !   END IF
2428 !   IF( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN
2429 !   DO j =jts, jte
2430 !   DO k =kts, kte
2431 !   defor12(ide,k,j) =defor12(ide-1,k,j)
2432
2433 !   ENDDO
2434 !   ENDDO
2435 !   END IF
2436 !   IF( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN
2437 !   DO k =kts, kte
2438 !   DO i =its, ite
2439 !   defor12(i,k,jde) =defor12(i,k,jde-1)
2440
2441 !   ENDDO
2442 !   ENDDO
2443 !   END IF
2444    ENDIF
2445
2446    IF( config_flags%sfs_opt .GT. 0 ) THEN
2447
2448    IF( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN
2449
2450    DO k =kte, kts, -1
2451    DO i =ite, its, -1
2452    a_nba_rij(i,k,jde-1,P_r12) =a_nba_rij(i,k,jde-1,P_r12) +a_nba_rij(i,k,jde,P_r12)
2453    a_nba_rij(i,k,jde,P_r12) =0.0
2454    a_defor12(i,k,jde-1) =a_defor12(i,k,jde-1) +a_defor12(i,k,jde)
2455    a_defor12(i,k,jde) =0.0
2456    ENDDO
2457    ENDDO
2458
2459    END IF
2460
2461    IF( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN
2462
2463    DO j =jte, jts, -1
2464    DO k =kte, kts, -1
2465    a_nba_rij(ide-1,k,j,P_r12) =a_nba_rij(ide-1,k,j,P_r12) +a_nba_rij(ide,k,j,P_r12)
2466    a_nba_rij(ide,k,j,P_r12) =0.0
2467    a_defor12(ide-1,k,j) =a_defor12(ide-1,k,j) +a_defor12(ide,k,j)
2468    a_defor12(ide,k,j) =0.0
2469    ENDDO
2470    ENDDO
2471
2472    END IF
2473
2474    IF( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN
2475
2476    DO k =kte, kts, -1
2477    DO i =ite, its, -1
2478    a_nba_rij(i,k,jds+1,P_r12) =a_nba_rij(i,k,jds+1,P_r12) +a_nba_rij(i,k,jds,P_r12)
2479    a_nba_rij(i,k,jds,P_r12) =0.0
2480    a_defor12(i,k,jds+1) =a_defor12(i,k,jds+1) +a_defor12(i,k,jds)
2481    a_defor12(i,k,jds) =0.0
2482    ENDDO
2483    ENDDO
2484
2485    END IF
2486
2487    IF( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1 ) THEN
2488
2489    DO j =jte, jts, -1
2490    DO k =kte, kts, -1
2491    a_nba_rij(ids+1,k,j,P_r12) =a_nba_rij(ids+1,k,j,P_r12) +a_nba_rij(ids,k,j,P_r12)
2492    a_nba_rij(ids,k,j,P_r12) =0.0
2493    a_defor12(ids+1,k,j) =a_defor12(ids+1,k,j) +a_defor12(ids,k,j)
2494    a_defor12(ids,k,j) =0.0
2495    ENDDO
2496    ENDDO
2497
2498    END IF
2499    DO j =j_end, j_start, -1
2500    DO k =ktf, kts, -1
2501    DO i =i_end, i_start, -1
2502    a_Tmpv5 =a_defor12(i,k,j)
2503    a_defor12(i,k,j) =0.0
2504    a_defor12(i,k,j) =a_defor12(i,k,j) +a_Tmpv5
2505    a_Tmpv4 =a_Tmpv5
2506 !   a_mm(i,j) =a_mm(i,j) +Tmpv401(i,k,j)*a_Tmpv4  ! Remarked by Ning Pan, 2010-08-31
2507    a_Tmpv3 =mm(i,j)*a_Tmpv4
2508    a_Tmpv2 =a_Tmpv3
2509    a_tmp1(i,k,j) =a_tmp1(i,k,j) -a_Tmpv3
2510    a_Tmpv1 =rdx*a_Tmpv2
2511    a_hat(i,k,j) =a_hat(i,k,j) +a_Tmpv1
2512    a_hat(i-1,k,j) =a_hat(i-1,k,j) -a_Tmpv1
2513    a_Tmpv5 =a_nba_rij(i,k,j,P_r12)
2514    a_nba_rij(i,k,j,P_r12) =0.0
2515    a_defor12(i,k,j) =a_defor12(i,k,j) +a_Tmpv5
2516    a_Tmpv4 =-a_Tmpv5
2517 !   a_mm(i,j) =a_mm(i,j) +Tmpv400(i,k,j)*a_Tmpv4  ! Remarked by Ning Pan, 2010-08-31
2518    a_Tmpv3 =mm(i,j)*a_Tmpv4
2519    a_Tmpv2 =a_Tmpv3
2520    a_tmp1(i,k,j) =a_tmp1(i,k,j) -a_Tmpv3
2521    a_Tmpv1 =rdx*a_Tmpv2
2522    a_hat(i,k,j) =a_hat(i,k,j) +a_Tmpv1
2523    a_hat(i-1,k,j) =a_hat(i-1,k,j) -a_Tmpv1
2524    ENDDO
2525    ENDDO
2526    ENDDO
2527
2528    ELSE
2529
2530    IF( .NOT. config_flags%periodic_y .AND. j_end .EQ. jde-1) THEN
2531
2532    DO k =kte, kts, -1
2533    DO i =ite, its, -1
2534    a_defor12(i,k,jde-1) =a_defor12(i,k,jde-1) +a_defor12(i,k,jde)
2535    a_defor12(i,k,jde) =0.0
2536    ENDDO
2537    ENDDO
2538
2539    END IF
2540
2541    IF( .NOT. config_flags%periodic_x .AND. i_end .EQ. ide-1) THEN
2542
2543    DO j =jte, jts, -1
2544    DO k =kte, kts, -1
2545    a_defor12(ide-1,k,j) =a_defor12(ide-1,k,j) +a_defor12(ide,k,j)
2546    a_defor12(ide,k,j) =0.0
2547    ENDDO
2548    ENDDO
2549
2550    END IF
2551
2552    IF( .NOT. config_flags%periodic_y .AND. j_start .EQ. jds+1) THEN
2553
2554    DO k =kte, kts, -1
2555    DO i =ite, its, -1
2556    a_defor12(i,k,jds+1) =a_defor12(i,k,jds+1) +a_defor12(i,k,jds)
2557    a_defor12(i,k,jds) =0.0
2558    ENDDO
2559    ENDDO
2560
2561    END IF
2562
2563    IF( .NOT. config_flags%periodic_x .AND. i_start .EQ. ids+1 ) THEN
2564
2565    DO j =jte, jts, -1
2566    DO k =kte, kts, -1
2567    a_defor12(ids+1,k,j) =a_defor12(ids+1,k,j) +a_defor12(ids,k,j)
2568    a_defor12(ids,k,j) =0.0
2569    ENDDO
2570    ENDDO
2571
2572    END IF
2573    DO j =j_end, j_start, -1
2574    DO k =ktf, kts, -1
2575    DO i =i_end, i_start, -1
2576    a_Tmpv5 =a_defor12(i,k,j)
2577    a_defor12(i,k,j) =0.0
2578    a_defor12(i,k,j) =a_defor12(i,k,j) +a_Tmpv5
2579    a_Tmpv4 =a_Tmpv5
2580 !   a_mm(i,j) =a_mm(i,j) +Tmpv402(i,k,j)*a_Tmpv4  ! Remarked by Ning Pan, 2010-08-31
2581    a_Tmpv3 =mm(i,j)*a_Tmpv4
2582    a_Tmpv2 =a_Tmpv3
2583    a_tmp1(i,k,j) =a_tmp1(i,k,j) -a_Tmpv3
2584    a_Tmpv1 =rdx*a_Tmpv2
2585    a_hat(i,k,j) =a_hat(i,k,j) +a_Tmpv1
2586    a_hat(i-1,k,j) =a_hat(i-1,k,j) -a_Tmpv1
2587    ENDDO
2588    ENDDO
2589    ENDDO
2590
2591    ENDIF
2592
2593 !LPB[41]
2594
2595 !LPB[40]
2596    DO j =j_end, j_start, -1
2597
2598 !   tmpzx =Keep_Lpb40_tmpzx(j)  ! Remarked by Ning Pan, 2010-08-31
2599
2600    DO k =kts, ktf
2601    DO i =i_start, i_end
2602    Tmpv001 =zx(i,k,j-1) +zx(i,k,j)
2603    Tmpv002 =Tmpv001 +zx(i,k+1,j-1)
2604    Tmpv003 =Tmpv002 +zx(i,k+1,j)
2605    Tmpv004 =0.25*Tmpv003
2606    tmpzx =Tmpv004
2607    Tmpv300(i,k) =tmpzx
2608
2609 !BIG ERRORS, ADDED BY WALLS
2610 !BIG ERRORS, ADDED BY WALLS
2611 !  Tmpv001 =hatavg(i,k+1,j) -hatavg(i,k,j)
2612    Tmpv001 =Keep_Lpb40_hatavg(i,k,j)
2613    Tmpv002 =Tmpv001*0.25
2614    Tmpv301(i,k) =Tmpv002
2615    Tmpv003 =Tmpv301(i,k)*tmpzx
2616    Tmpv004 =rdzw(i,k,j) +rdzw(i,k,j-1)
2617    Tmpv005 =Tmpv004 +rdzw(i-1,k,j-1)
2618    Tmpv006 =Tmpv005 +rdzw(i-1,k,j)
2619    Tmpv302(i,k) =Tmpv003
2620    Tmpv303(i,k) =Tmpv006
2621 ! Remarked by Ning Pan, 2010-08-31
2622 !   Tmpv007 =Tmpv302(i,k)*Tmpv303(i,k)
2623 !   tmp1(i,k,j) =Tmpv007
2624
2625    ENDDO
2626    ENDDO
2627
2628    DO k =ktf, kts, -1
2629    DO i =i_end, i_start, -1
2630    tmpzx =Tmpv300(i,k)
2631
2632    a_Tmpv7 =a_tmp1(i,k,j)
2633    a_tmp1(i,k,j) =0.0
2634    a_Tmpv3 =Tmpv303(i,k)*a_Tmpv7
2635    a_Tmpv6 =Tmpv302(i,k)*a_Tmpv7
2636    a_Tmpv5 =a_Tmpv6
2637    a_rdzw(i-1,k,j) =a_rdzw(i-1,k,j) +a_Tmpv6
2638    a_Tmpv4 =a_Tmpv5
2639    a_rdzw(i-1,k,j-1) =a_rdzw(i-1,k,j-1) +a_Tmpv5
2640    a_rdzw(i,k,j) =a_rdzw(i,k,j) +a_Tmpv4
2641    a_rdzw(i,k,j-1) =a_rdzw(i,k,j-1) +a_Tmpv4
2642    a_Tmpv2 =tmpzx*a_Tmpv3
2643    a_tmpzx =a_tmpzx +Tmpv301(i,k)*a_Tmpv3
2644    a_Tmpv1 =0.25*a_Tmpv2
2645    a_hatavg(i,k+1,j) =a_hatavg(i,k+1,j) +a_Tmpv1
2646    a_hatavg(i,k,j) =a_hatavg(i,k,j) -a_Tmpv1
2647
2648 !  tmpzx =Tmpv300(i,k)
2649
2650    a_Tmpv4 =a_tmpzx
2651    a_tmpzx =0.0
2652    a_Tmpv3 =0.25*a_Tmpv4
2653    a_Tmpv2 =a_Tmpv3
2654    a_zx(i,k+1,j) =a_zx(i,k+1,j) +a_Tmpv3
2655    a_Tmpv1 =a_Tmpv2
2656    a_zx(i,k+1,j-1) =a_zx(i,k+1,j-1) +a_Tmpv2
2657    a_zx(i,k,j-1) =a_zx(i,k,j-1) +a_Tmpv1
2658    a_zx(i,k,j) =a_zx(i,k,j) +a_Tmpv1
2659
2660    ENDDO
2661    ENDDO
2662
2663    ENDDO
2664
2665 !BIG ERRORS, ADDED BY WALLS
2666 !       tmp1 =Keep_Lpb35_tmp1  ! Remarked by Ning Pan, 2010-08-31
2667
2668 !LPB[39]
2669    DO j =j_end, j_start, -1
2670
2671 ! Remarked by Ning Pan, 2010-08-31
2672 !   DO i =i_start, i_end
2673 !   Tmpv001 =cf1*hat(i-1,1,j) +cf2*hat(i-1,2,j)
2674 !   Tmpv002 =Tmpv001 +cf3*hat(i-1,3,j)
2675 !   Tmpv003 =Tmpv002 +cf1*hat(i,1,j)
2676 !   Tmpv004 =Tmpv003 +cf2*hat(i,2,j)
2677 !   Tmpv005 =Tmpv004 +cf3*hat(i,3,j)
2678 !   Tmpv006 =0.5*Tmpv005
2679 !   hatavg(i,1,j) =Tmpv006
2680
2681 !   Tmpv001 =hat(i,ktes1,j) +hat(i-1,ktes1,j)
2682 !   Tmpv200(i) =Tmpv001
2683 !   Tmpv002 =cft1*Tmpv200(i)
2684 !   Tmpv003 =hat(i,ktes2,j) +hat(i-1,ktes2,j)
2685 !   Tmpv201(i) =Tmpv003
2686 !   Tmpv004 =cft2*Tmpv201(i)
2687 !   Tmpv005 =Tmpv002 +Tmpv004
2688 !   Tmpv006 =0.5*Tmpv005
2689 !   hatavg(i,kte,j) =Tmpv006
2690
2691 !   ENDDO
2692
2693    DO i =i_end, i_start, -1
2694    a_Tmpv6 =a_hatavg(i,kte,j)
2695    a_hatavg(i,kte,j) =0.0
2696    a_Tmpv5 =0.5*a_Tmpv6
2697    a_Tmpv2 =a_Tmpv5
2698    a_Tmpv4 =a_Tmpv5
2699 !   a_cft2 =a_cft2 +Tmpv201(i)*a_Tmpv4  ! Remarked by Ning Pan, 2010-08-31
2700    a_Tmpv3 =cft2*a_Tmpv4
2701    a_hat(i,ktes2,j) =a_hat(i,ktes2,j) +a_Tmpv3
2702    a_hat(i-1,ktes2,j) =a_hat(i-1,ktes2,j) +a_Tmpv3
2703 !   a_cft1 =a_cft1 +Tmpv200(i)*a_Tmpv2  ! Remarked by Ning Pan, 2010-08-31
2704    a_Tmpv1 =cft1*a_Tmpv2
2705    a_hat(i,ktes1,j) =a_hat(i,ktes1,j) +a_Tmpv1
2706    a_hat(i-1,ktes1,j) =a_hat(i-1,ktes1,j) +a_Tmpv1
2707    a_Tmpv6 =a_hatavg(i,1,j)
2708    a_hatavg(i,1,j) =0.0
2709    a_Tmpv5 =0.5*a_Tmpv6
2710    a_Tmpv4 =a_Tmpv5
2711    a_hat(i,3,j) =a_hat(i,3,j) +cf3*a_Tmpv5
2712    a_Tmpv3 =a_Tmpv4
2713    a_hat(i,2,j) =a_hat(i,2,j) +cf2*a_Tmpv4
2714    a_Tmpv2 =a_Tmpv3
2715    a_hat(i,1,j) =a_hat(i,1,j) +cf1*a_Tmpv3
2716    a_Tmpv1 =a_Tmpv2
2717    a_hat(i-1,3,j) =a_hat(i-1,3,j) +cf3*a_Tmpv2
2718    a_hat(i-1,1,j) =a_hat(i-1,1,j) +cf1*a_Tmpv1
2719    a_hat(i-1,2,j) =a_hat(i-1,2,j) +cf2*a_Tmpv1
2720    ENDDO
2721
2722    ENDDO
2723
2724 !LPB[38]
2725    DO j =j_end, j_start, -1
2726
2727 !  DO k =kts+1, ktf
2728 !  DO i =i_start, i_end
2729 !  Tmpv001 =hat(i-1,k,j) +hat(i,k,j)
2730 !  Tmpv002 =fnm(k)*Tmpv001
2731 !  Tmpv003 =hat(i-1,k-1,j) +hat(i,k-1,j)
2732 !  Tmpv004 =fnp(k)*Tmpv003
2733 !  Tmpv005 =Tmpv002 +Tmpv004
2734 !  Tmpv006 =0.5*Tmpv005
2735 !  hatavg(i,k,j) =Tmpv006
2736
2737 !  ENDDO
2738 !  ENDDO
2739
2740    DO k =ktf, kts+1, -1
2741    DO i =i_end, i_start, -1
2742    a_Tmpv6 =a_hatavg(i,k,j)
2743    a_hatavg(i,k,j) =0.0
2744    a_Tmpv5 =0.5*a_Tmpv6
2745    a_Tmpv2 =a_Tmpv5
2746    a_Tmpv4 =a_Tmpv5
2747    a_Tmpv3 =fnp(k)*a_Tmpv4
2748    a_hat(i-1,k-1,j) =a_hat(i-1,k-1,j) +a_Tmpv3
2749    a_hat(i,k-1,j) =a_hat(i,k-1,j) +a_Tmpv3
2750    a_Tmpv1 =fnm(k)*a_Tmpv2
2751    a_hat(i-1,k,j) =a_hat(i-1,k,j) +a_Tmpv1
2752    a_hat(i,k,j) =a_hat(i,k,j) +a_Tmpv1
2753    ENDDO
2754    ENDDO
2755
2756    ENDDO
2757
2758 !LPB[37]
2759    DO j =j_end, j_start, -1
2760
2761 !  DO k =kts, ktf
2762 !  DO i =i_start-1, i_end
2763 !  hat(i,k,j) =v(i,k,j)/msfvy(i,j)
2764
2765 !  ENDDO
2766 !  ENDDO
2767
2768    DO k =ktf, kts, -1
2769    DO i =i_end, i_start-1, -1
2770    a_v(i,k,j) =a_v(i,k,j) +1.0/msfvy(i,j)*a_hat(i,k,j)
2771    a_hat(i,k,j) =0.0
2772    ENDDO
2773    ENDDO
2774
2775    ENDDO
2776
2777 !BIG ERRORS, REVISED BY WALLS
2778 !   hat =Keep_Lpb32_hat  ! Remarked by Ning Pan, 2010-08-31
2779
2780 !LPB[36]
2781    DO j =j_end, j_start, -1
2782
2783 ! Remarked by Ning Pan, 2010-08-31
2784 !   DO k =kts, ktf
2785 !   DO i =i_start, i_end
2786 !   Tmpv001 =hat(i,k,j) -hat(i,k,j-1)
2787 !   Tmpv002 =rdy*Tmpv001
2788 !   Tmpv003 =Tmpv002 -tmp1(i,k,j)
2789 !   Tmpv300(i,k) =Tmpv003
2790 !   Tmpv004 =mm(i,j)*Tmpv300(i,k)
2791 !   defor12(i,k,j) =Tmpv004
2792
2793 !   ENDDO
2794 !   ENDDO
2795
2796    DO k =ktf, kts, -1
2797    DO i =i_end, i_start, -1
2798    a_Tmpv4 =a_defor12(i,k,j)
2799    a_defor12(i,k,j) =0.0
2800 !   a_mm(i,j) =a_mm(i,j) +Tmpv300(i,k)*a_Tmpv4   ! Remarked by Ning Pan, 2010-08-31
2801    a_Tmpv3 =mm(i,j)*a_Tmpv4
2802    a_Tmpv2 =a_Tmpv3
2803    a_tmp1(i,k,j) =a_tmp1(i,k,j) -a_Tmpv3
2804    a_Tmpv1 =rdy*a_Tmpv2
2805    a_hat(i,k,j) =a_hat(i,k,j) +a_Tmpv1
2806    a_hat(i,k,j-1) =a_hat(i,k,j-1) -a_Tmpv1
2807    ENDDO
2808    ENDDO
2809
2810    ENDDO
2811
2812 !LPB[35]
2813    DO j =j_end, j_start, -1
2814
2815 !   tmpzy =Keep_Lpb35_tmpzy(j)  ! Remarked by Ning Pan, 2010-08-31
2816
2817    DO k =kts, ktf
2818    DO i =i_start, i_end
2819    Tmpv001 =zy(i-1,k,j) +zy(i,k,j)
2820    Tmpv002 =Tmpv001 +zy(i-1,k+1,j)
2821    Tmpv003 =Tmpv002 +zy(i,k+1,j)
2822    Tmpv004 =0.25*Tmpv003
2823    tmpzy =Tmpv004
2824    Tmpv300(i,k) =tmpzy
2825
2826 !BIG ERRORS, ADDED BY WALLS
2827 !BIG ERRORS, ADDED BY WALLS
2828 !  Tmpv001 =hatavg(i,k+1,j) -hatavg(i,k,j)
2829    Tmpv001 =Keep_Lpb35_hatavg(i,k,j)
2830    Tmpv002 =Tmpv001*0.25
2831    Tmpv301(i,k) =Tmpv002
2832    Tmpv003 =Tmpv301(i,k)*tmpzy
2833    Tmpv004 =rdzw(i,k,j) +rdzw(i-1,k,j)
2834    Tmpv005 =Tmpv004 +rdzw(i-1,k,j-1)
2835    Tmpv006 =Tmpv005 +rdzw(i,k,j-1)
2836    Tmpv302(i,k) =Tmpv003
2837    Tmpv303(i,k) =Tmpv006
2838 ! Remarked by Ning Pan, 2010-08-31
2839 !   Tmpv007 =Tmpv302(i,k)*Tmpv303(i,k)
2840 !   tmp1(i,k,j) =Tmpv007
2841
2842    ENDDO
2843    ENDDO
2844
2845    DO k =ktf, kts, -1
2846    DO i =i_end, i_start, -1
2847    tmpzy =Tmpv300(i,k)
2848
2849    a_Tmpv7 =a_tmp1(i,k,j)
2850    a_tmp1(i,k,j) =0.0
2851    a_Tmpv3 =Tmpv303(i,k)*a_Tmpv7
2852    a_Tmpv6 =Tmpv302(i,k)*a_Tmpv7
2853    a_Tmpv5 =a_Tmpv6
2854    a_rdzw(i,k,j-1) =a_rdzw(i,k,j-1) +a_Tmpv6
2855    a_Tmpv4 =a_Tmpv5
2856    a_rdzw(i-1,k,j-1) =a_rdzw(i-1,k,j-1) +a_Tmpv5
2857    a_rdzw(i,k,j) =a_rdzw(i,k,j) +a_Tmpv4
2858    a_rdzw(i-1,k,j) =a_rdzw(i-1,k,j) +a_Tmpv4
2859    a_Tmpv2 =tmpzy*a_Tmpv3
2860    a_tmpzy =a_tmpzy +Tmpv301(i,k)*a_Tmpv3
2861    a_Tmpv1 =0.25*a_Tmpv2
2862    a_hatavg(i,k+1,j) =a_hatavg(i,k+1,j) +a_Tmpv1
2863    a_hatavg(i,k,j) =a_hatavg(i,k,j) -a_Tmpv1
2864
2865 !  tmpzy =Tmpv300(i,k)
2866
2867    a_Tmpv4 =a_tmpzy
2868    a_tmpzy =0.0
2869    a_Tmpv3 =0.25*a_Tmpv4
2870    a_Tmpv2 =a_Tmpv3
2871    a_zy(i,k+1,j) =a_zy(i,k+1,j) +a_Tmpv3
2872    a_Tmpv1 =a_Tmpv2
2873    a_zy(i-1,k+1,j) =a_zy(i-1,k+1,j) +a_Tmpv2
2874    a_zy(i-1,k,j) =a_zy(i-1,k,j) +a_Tmpv1
2875    a_zy(i,k,j) =a_zy(i,k,j) +a_Tmpv1
2876
2877    ENDDO
2878    ENDDO
2879
2880    ENDDO
2881
2882 !LPB[34]
2883    DO j =j_end, j_start, -1
2884
2885 ! Remarked by Ning Pan, 2010-08-31
2886 !   DO i =i_start, i_end
2887 !   Tmpv001 =cf1*hat(i,1,j-1) +cf2*hat(i,2,j-1)
2888 !   Tmpv002 =Tmpv001 +cf3*hat(i,3,j-1)
2889 !   Tmpv003 =Tmpv002 +cf1*hat(i,1,j)
2890 !   Tmpv004 =Tmpv003 +cf2*hat(i,2,j)
2891 !   Tmpv005 =Tmpv004 +cf3*hat(i,3,j)
2892 !   Tmpv006 =0.5*Tmpv005
2893 !   hatavg(i,1,j) =Tmpv006
2894
2895 !   Tmpv001 =hat(i,ktes1,j-1) +hat(i,ktes1,j)
2896 !   Tmpv200(i) =Tmpv001
2897 !   Tmpv002 =cft1*Tmpv200(i)
2898 !   Tmpv003 =hat(i,ktes2,j-1) +hat(i,ktes2,j)
2899 !   Tmpv201(i) =Tmpv003
2900 !   Tmpv004 =cft2*Tmpv201(i)
2901 !   Tmpv005 =Tmpv002 +Tmpv004
2902 !   Tmpv006 =0.5*Tmpv005
2903 !   hatavg(i,kte,j) =Tmpv006
2904
2905 !   ENDDO
2906
2907    DO i =i_end, i_start, -1
2908    a_Tmpv6 =a_hatavg(i,kte,j)
2909    a_hatavg(i,kte,j) =0.0
2910    a_Tmpv5 =0.5*a_Tmpv6
2911    a_Tmpv2 =a_Tmpv5
2912    a_Tmpv4 =a_Tmpv5
2913 !   a_cft2 =a_cft2 +Tmpv201(i)*a_Tmpv4  ! Remarked by Ning Pan, 2010-08-31
2914    a_Tmpv3 =cft2*a_Tmpv4
2915    a_hat(i,ktes2,j-1) =a_hat(i,ktes2,j-1) +a_Tmpv3
2916    a_hat(i,ktes2,j) =a_hat(i,ktes2,j) +a_Tmpv3
2917 !   a_cft1 =a_cft1 +Tmpv200(i)*a_Tmpv2  ! Remarked by Ning Pan, 2010-08-31
2918    a_Tmpv1 =cft1*a_Tmpv2
2919    a_hat(i,ktes1,j-1) =a_hat(i,ktes1,j-1) +a_Tmpv1
2920    a_hat(i,ktes1,j) =a_hat(i,ktes1,j) +a_Tmpv1
2921    a_Tmpv6 =a_hatavg(i,1,j)
2922    a_hatavg(i,1,j) =0.0
2923    a_Tmpv5 =0.5*a_Tmpv6
2924    a_Tmpv4 =a_Tmpv5
2925    a_hat(i,3,j) =a_hat(i,3,j) +cf3*a_Tmpv5
2926    a_Tmpv3 =a_Tmpv4
2927    a_hat(i,2,j) =a_hat(i,2,j) +cf2*a_Tmpv4
2928    a_Tmpv2 =a_Tmpv3
2929    a_hat(i,1,j) =a_hat(i,1,j) +cf1*a_Tmpv3
2930    a_Tmpv1 =a_Tmpv2
2931    a_hat(i,3,j-1) =a_hat(i,3,j-1) +cf3*a_Tmpv2
2932    a_hat(i,1,j-1) =a_hat(i,1,j-1) +cf1*a_Tmpv1
2933    a_hat(i,2,j-1) =a_hat(i,2,j-1) +cf2*a_Tmpv1
2934    ENDDO
2935
2936    ENDDO
2937
2938 !LPB[33]
2939    DO j =j_end, j_start, -1
2940
2941 !  DO k =kts+1, ktf
2942 !  DO i =i_start, i_end
2943 !  Tmpv001 =hat(i,k,j-1) +hat(i,k,j)
2944 !  Tmpv002 =fnm(k)*Tmpv001
2945 !  Tmpv003 =hat(i,k-1,j-1) +hat(i,k-1,j)
2946 !  Tmpv004 =fnp(k)*Tmpv003
2947 !  Tmpv005 =Tmpv002 +Tmpv004
2948 !  Tmpv006 =0.5*Tmpv005
2949 !  hatavg(i,k,j) =Tmpv006
2950
2951 !  ENDDO
2952 !  ENDDO
2953
2954    DO k =ktf, kts+1, -1
2955    DO i =i_end, i_start, -1
2956    a_Tmpv6 =a_hatavg(i,k,j)
2957    a_hatavg(i,k,j) =0.0
2958    a_Tmpv5 =0.5*a_Tmpv6
2959    a_Tmpv2 =a_Tmpv5
2960    a_Tmpv4 =a_Tmpv5
2961    a_Tmpv3 =fnp(k)*a_Tmpv4
2962    a_hat(i,k-1,j-1) =a_hat(i,k-1,j-1) +a_Tmpv3
2963    a_hat(i,k-1,j) =a_hat(i,k-1,j) +a_Tmpv3
2964    a_Tmpv1 =fnm(k)*a_Tmpv2
2965    a_hat(i,k,j-1) =a_hat(i,k,j-1) +a_Tmpv1
2966    a_hat(i,k,j) =a_hat(i,k,j) +a_Tmpv1
2967    ENDDO
2968    ENDDO
2969
2970    ENDDO
2971
2972 !LPB[32]
2973    DO j =j_end, j_start-1, -1
2974
2975 !  DO k =kts, ktf
2976 !  DO i =i_start, i_end
2977 !  hat(i,k,j) =u(i,k,j)/msfux(i,j)
2978
2979 !  ENDDO
2980 !  ENDDO
2981
2982    DO k =ktf, kts, -1
2983    DO i =i_end, i_start, -1
2984    a_u(i,k,j) =a_u(i,k,j) +1.0/msfux(i,j)*a_hat(i,k,j)
2985    a_hat(i,k,j) =0.0
2986    ENDDO
2987    ENDDO
2988
2989    ENDDO
2990
2991 !BIG ERRORS, REVISED BY WALLS
2992 !   hat =Keep_Lpb9_hat  ! Remarked by Ning Pan, 2010-08-31
2993
2994 !LPB[31]
2995 ! Remarked by Ning Pan, 2010-08-31
2996 !   DO j =j_end, j_start, -1
2997
2998 !!  DO i =i_start, i_end
2999 !!  mm(i,j) =0.25*(msfux(i,j-1)+msfux(i,j))*(msfvy(i-1,j)+msfvy(i,j))
3000
3001 !!  ENDDO
3002
3003 !   DO i =i_end, i_start, -1
3004 !   a_mm(i,j) =0.0
3005 !   ENDDO
3006
3007 !   ENDDO
3008
3009 !BIG ERRORS, REVISED BY WALLS
3010    mm =Keep_Lpb1_mm
3011
3012 !LPB[30]
3013
3014 !  IF( config_flags%periodic_x ) THEN
3015 !  i_end =ite
3016 !  END IF
3017
3018 !  IF( config_flags%periodic_x ) THEN
3019
3020 !  END IF
3021
3022 !LPB[29]
3023
3024 !LPB[28]
3025
3026 !  IF( config_flags%periodic_x ) THEN
3027 !  i_start =its
3028 !  END IF
3029
3030 !  IF( config_flags%periodic_x ) THEN
3031
3032 !  END IF
3033
3034 !LPB[27]
3035
3036 !LPB[26]
3037
3038 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.             config_flags%nested) THEN
3039 !  j_end =min(jde-1, jte)
3040 !  END IF
3041
3042 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
3043 !            config_flags%nested) THEN
3044
3045 !  END IF
3046
3047 !LPB[25]
3048
3049 !LPB[24]
3050
3051 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.             config_flags%nested) THEN
3052 !  j_start =max(jds+1, jts)
3053 !  END IF
3054
3055 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
3056 !            config_flags%nested) THEN
3057
3058 !  END IF
3059
3060 !LPB[23]
3061
3062 !LPB[22]
3063
3064 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.             config_flags%nested) THEN
3065 !  i_end =min(ide-1, ite)
3066 !  END IF
3067
3068 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.    &
3069 !            config_flags%nested) THEN
3070
3071 !  END IF
3072
3073 !LPB[21]
3074
3075 !LPB[20]
3076
3077 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.             config_flags%nested) THEN
3078 !  i_start =max(ids+1, its)
3079 !  END IF
3080
3081 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
3082 !            config_flags%nested) THEN
3083
3084 !  END IF
3085
3086 !LPB[19]
3087 !  i_start =its
3088 !  i_end =ite
3089 !  j_start =jts
3090 !  j_end =jte
3091
3092 !ADDED BY WALLS
3093 !FROM LPB[0]
3094 ! Remarked by Ning Pan, 2010-08-31
3095 !       ktes1   = kte-1
3096 !       ktes2   = kte-2
3097 !       cft2    = - 0.5 * dnw(ktes1) / dn(ktes1)
3098 !       cft1    = 1.0 - cft2
3099 !       ktf     = MIN( kte, kde-1 )
3100        i_start = its
3101        i_end   = MIN( ite, ide-1 )
3102        j_start = jts
3103        j_end   = MIN( jte, jde-1 )
3104
3105 !LPB[18]
3106    DO j =j_end, j_start, -1
3107
3108 !  DO k =kts, ktf
3109 !  DO i =i_start, i_end
3110 !  Tmpv001 =div(i,k,j) +tmp1(i,k,j)
3111 !  div(i,k,j) =Tmpv001
3112
3113 !  ENDDO
3114 !  ENDDO
3115
3116    DO k =ktf, kts, -1
3117    DO i =i_end, i_start, -1
3118    a_Tmpv1 =a_div(i,k,j)
3119    a_div(i,k,j) =0.0
3120    a_div(i,k,j) =a_div(i,k,j) +a_Tmpv1
3121    a_tmp1(i,k,j) =a_tmp1(i,k,j) +a_Tmpv1
3122    ENDDO
3123    ENDDO
3124
3125    ENDDO
3126
3127 !LPB[17]
3128    DO j =j_end, j_start, -1
3129
3130 !  DO k =kts, ktf
3131 !  DO i =i_start, i_end
3132 !  defor33(i,k,j) =2.0*tmp1(i,k,j)
3133
3134 !  ENDDO
3135 !  ENDDO
3136
3137    DO k =ktf, kts, -1
3138    DO i =i_end, i_start, -1
3139    a_tmp1(i,k,j) =a_tmp1(i,k,j) +2.0*a_defor33(i,k,j)
3140    a_defor33(i,k,j) =0.0
3141    ENDDO
3142    ENDDO
3143
3144    ENDDO
3145
3146 !LPB[16]
3147    DO j =j_end, j_start, -1
3148
3149    DO k =kts, ktf
3150    DO i =i_start, i_end
3151    Tmpv001 =w(i,k+1,j) -w(i,k,j)
3152    Tmpv300(i,k) =Tmpv001
3153 ! Remarked by Ning Pan, 2010-08-31
3154 !   Tmpv002 =Tmpv300(i,k)*rdzw(i,k,j)
3155 !   tmp1(i,k,j) =Tmpv002
3156
3157    ENDDO
3158    ENDDO
3159
3160    DO k =ktf, kts, -1
3161    DO i =i_end, i_start, -1
3162    a_Tmpv2 =a_tmp1(i,k,j)
3163    a_tmp1(i,k,j) =0.0
3164    a_Tmpv1 =rdzw(i,k,j)*a_Tmpv2
3165    a_rdzw(i,k,j) =a_rdzw(i,k,j) +Tmpv300(i,k)*a_Tmpv2
3166    a_w(i,k+1,j) =a_w(i,k+1,j) +a_Tmpv1
3167    a_w(i,k,j) =a_w(i,k,j) -a_Tmpv1
3168    ENDDO
3169    ENDDO
3170
3171    ENDDO
3172
3173 !LPB[15]
3174    DO j =j_end, j_start, -1
3175
3176 !  DO k =kts, ktf
3177 !  DO i =i_start, i_end
3178 !  Tmpv001 =div(i,k,j) +tmp1(i,k,j)
3179 !  div(i,k,j) =Tmpv001
3180
3181 !  ENDDO
3182 !  ENDDO
3183
3184    DO k =ktf, kts, -1
3185    DO i =i_end, i_start, -1
3186    a_Tmpv1 =a_div(i,k,j)
3187    a_div(i,k,j) =0.0
3188    a_div(i,k,j) =a_div(i,k,j) +a_Tmpv1
3189    a_tmp1(i,k,j) =a_tmp1(i,k,j) +a_Tmpv1
3190    ENDDO
3191    ENDDO
3192
3193    ENDDO
3194
3195 !LPB[14]
3196    DO j =j_end, j_start, -1
3197
3198 !  DO k =kts, ktf
3199 !  DO i =i_start, i_end
3200 !  defor22(i,k,j) =2.0*tmp1(i,k,j)
3201
3202 !  ENDDO
3203 !  ENDDO
3204
3205    DO k =ktf, kts, -1
3206    DO i =i_end, i_start, -1
3207    a_tmp1(i,k,j) =a_tmp1(i,k,j) +2.0*a_defor22(i,k,j)
3208    a_defor22(i,k,j) =0.0
3209    ENDDO
3210    ENDDO
3211
3212    ENDDO
3213
3214 !LPB[13]
3215    DO j =j_end, j_start, -1
3216
3217 ! Remarked by Ning Pan, 2010-08-31
3218 !   DO k=kts, min(kte,kde-1)
3219 !   DO i=its, min(ite,ide-1)
3220 !   tmp1(i,k,j) =Keep_Lpb13_tmp1(i,k,j)
3221 !   END DO
3222 !   END DO
3223
3224 !   DO k =kts, ktf
3225 !   DO i =i_start, i_end
3226 !   Tmpv001 =hat(i,k,j+1) -hat(i,k,j)
3227 !   Tmpv002 =rdy*Tmpv001
3228 !   Tmpv003 =Tmpv002 -tmp1(i,k,j)
3229 !   Tmpv300(i,k) =Tmpv003
3230 !   Tmpv004 =mm(i,j)*Tmpv300(i,k)
3231 !   tmp1(i,k,j) =Tmpv004
3232
3233 !   ENDDO
3234 !   ENDDO
3235
3236    DO k =ktf, kts, -1
3237    DO i =i_end, i_start, -1
3238    a_Tmpv4 =a_tmp1(i,k,j)
3239    a_tmp1(i,k,j) =0.0
3240 !   a_mm(i,j) =a_mm(i,j) +Tmpv300(i,k)*a_Tmpv4  ! Remarked by Ning Pan, 2010-08-31
3241    a_Tmpv3 =mm(i,j)*a_Tmpv4
3242    a_Tmpv2 =a_Tmpv3
3243    a_tmp1(i,k,j) =a_tmp1(i,k,j) -a_Tmpv3
3244    a_Tmpv1 =rdy*a_Tmpv2
3245    a_hat(i,k,j+1) =a_hat(i,k,j+1) +a_Tmpv1
3246    a_hat(i,k,j) =a_hat(i,k,j) -a_Tmpv1
3247    ENDDO
3248    ENDDO
3249
3250    ENDDO
3251
3252 !LPB[12]
3253    DO j =j_end, j_start, -1
3254
3255    DO k =kts, ktf
3256    DO i =i_start, i_end
3257
3258    Tmpv001 =zy(i,k,j) +zy(i,k,j+1)
3259    Tmpv002 =Tmpv001 +zy(i,k+1,j)
3260    Tmpv003 =Tmpv002 +zy(i,k+1,j+1)
3261    Tmpv004 =0.25*Tmpv003
3262    tmpzy =Tmpv004
3263    Tmpv300(i,k) =tmpzy
3264
3265 !BIG ERRORS, ADDED BY WALLS
3266 !BIG ERRORS, ADDED BY WALLS
3267 !  Tmpv001 =hatavg(i,k+1,j) -hatavg(i,k,j)
3268    Tmpv001 =Keep_Lpb12_hatavg(i,k,j)
3269
3270    Tmpv301(i,k) =Tmpv001
3271    Tmpv002 =Tmpv301(i,k)*tmpzy
3272    Tmpv302(i,k) =Tmpv002
3273 ! Remarked by Ning Pan, 2010-08-31
3274 !   Tmpv003 =Tmpv302(i,k)*rdzw(i,k,j)
3275 !   tmp1(i,k,j) =Tmpv003
3276
3277    ENDDO
3278    ENDDO
3279
3280    DO k =ktf, kts, -1
3281    DO i =i_end, i_start, -1
3282 !REVISED BY WALLS
3283    tmpzy =Tmpv300(i,k)
3284
3285    a_Tmpv3 =a_tmp1(i,k,j)
3286    a_tmp1(i,k,j) =0.0
3287    a_Tmpv2 =rdzw(i,k,j)*a_Tmpv3
3288    a_rdzw(i,k,j) =a_rdzw(i,k,j) +Tmpv302(i,k)*a_Tmpv3
3289    a_Tmpv1 =tmpzy*a_Tmpv2
3290    a_tmpzy =a_tmpzy +Tmpv301(i,k)*a_Tmpv2
3291    a_hatavg(i,k+1,j) =a_hatavg(i,k+1,j) +a_Tmpv1
3292    a_hatavg(i,k,j) =a_hatavg(i,k,j) -a_Tmpv1
3293
3294 !  tmpzy =Tmpv300(i,k)
3295
3296    a_Tmpv4 =a_tmpzy
3297    a_tmpzy =0.0
3298    a_Tmpv3 =0.25*a_Tmpv4
3299    a_Tmpv2 =a_Tmpv3
3300    a_zy(i,k+1,j+1) =a_zy(i,k+1,j+1) +a_Tmpv3
3301    a_Tmpv1 =a_Tmpv2
3302    a_zy(i,k+1,j) =a_zy(i,k+1,j) +a_Tmpv2
3303    a_zy(i,k,j) =a_zy(i,k,j) +a_Tmpv1
3304    a_zy(i,k,j+1) =a_zy(i,k,j+1) +a_Tmpv1
3305
3306    ENDDO
3307    ENDDO
3308
3309    ENDDO
3310
3311 !LPB[11]
3312    DO j =j_end, j_start, -1
3313
3314 ! Remarked by Ning Pan, 2010-08-31
3315 !   DO i =i_start, i_end
3316 !   Tmpv001 =cf1*hat(i,1,j) +cf2*hat(i,2,j)
3317 !   Tmpv002 =Tmpv001 +cf3*hat(i,3,j)
3318 !   Tmpv003 =Tmpv002 +cf1*hat(i,1,j+1)
3319 !   Tmpv004 =Tmpv003 +cf2*hat(i,2,j+1)
3320 !   Tmpv005 =Tmpv004 +cf3*hat(i,3,j+1)
3321 !   Tmpv006 =0.5*Tmpv005
3322 !   hatavg(i,1,j) =Tmpv006
3323
3324 !   Tmpv001 =hat(i,ktes1,j) +hat(i,ktes1,j+1)
3325 !   Tmpv200(i) =Tmpv001
3326 !   Tmpv002 =cft1*Tmpv200(i)
3327 !   Tmpv003 =hat(i,ktes2,j) +hat(i,ktes2,j+1)
3328 !   Tmpv201(i) =Tmpv003
3329 !   Tmpv004 =cft2*Tmpv201(i)
3330 !   Tmpv005 =Tmpv002 +Tmpv004
3331 !   Tmpv006 =0.5*Tmpv005
3332 !   hatavg(i,kte,j) =Tmpv006
3333
3334 !   ENDDO
3335
3336    DO i =i_end, i_start, -1
3337    a_Tmpv6 =a_hatavg(i,kte,j)
3338    a_hatavg(i,kte,j) =0.0
3339    a_Tmpv5 =0.5*a_Tmpv6
3340    a_Tmpv2 =a_Tmpv5
3341    a_Tmpv4 =a_Tmpv5
3342 !   a_cft2 =a_cft2 +Tmpv201(i)*a_Tmpv4  ! Remarked by Ning Pan, 2010-08-31
3343    a_Tmpv3 =cft2*a_Tmpv4
3344    a_hat(i,ktes2,j) =a_hat(i,ktes2,j) +a_Tmpv3
3345    a_hat(i,ktes2,j+1) =a_hat(i,ktes2,j+1) +a_Tmpv3
3346 !   a_cft1 =a_cft1 +Tmpv200(i)*a_Tmpv2  ! Remarked by Ning Pan, 2010-08-31
3347    a_Tmpv1 =cft1*a_Tmpv2
3348    a_hat(i,ktes1,j) =a_hat(i,ktes1,j) +a_Tmpv1
3349    a_hat(i,ktes1,j+1) =a_hat(i,ktes1,j+1) +a_Tmpv1
3350    a_Tmpv6 =a_hatavg(i,1,j)
3351    a_hatavg(i,1,j) =0.0
3352    a_Tmpv5 =0.5*a_Tmpv6
3353    a_Tmpv4 =a_Tmpv5
3354    a_hat(i,3,j+1) =a_hat(i,3,j+1) +cf3*a_Tmpv5
3355    a_Tmpv3 =a_Tmpv4
3356    a_hat(i,2,j+1) =a_hat(i,2,j+1) +cf2*a_Tmpv4
3357    a_Tmpv2 =a_Tmpv3
3358    a_hat(i,1,j+1) =a_hat(i,1,j+1) +cf1*a_Tmpv3
3359    a_Tmpv1 =a_Tmpv2
3360    a_hat(i,3,j) =a_hat(i,3,j) +cf3*a_Tmpv2
3361    a_hat(i,1,j) =a_hat(i,1,j) +cf1*a_Tmpv1
3362    a_hat(i,2,j) =a_hat(i,2,j) +cf2*a_Tmpv1
3363    ENDDO
3364
3365    ENDDO
3366
3367 !LPB[10]
3368    DO j =j_end, j_start, -1
3369
3370 !  DO k =kts+1, ktf
3371 !  DO i =i_start, i_end
3372 !  Tmpv001 =hat(i,k,j) +hat(i,k,j+1)
3373 !  Tmpv002 =fnm(k)*Tmpv001
3374 !  Tmpv003 =hat(i,k-1,j) +hat(i,k-1,j+1)
3375 !  Tmpv004 =fnp(k)*Tmpv003
3376 !  Tmpv005 =Tmpv002 +Tmpv004
3377 !  Tmpv006 =0.5*Tmpv005
3378 !  hatavg(i,k,j) =Tmpv006
3379
3380 !  ENDDO
3381 !  ENDDO
3382
3383    DO k =ktf, kts+1, -1
3384    DO i =i_end, i_start, -1
3385    a_Tmpv6 =a_hatavg(i,k,j)
3386    a_hatavg(i,k,j) =0.0
3387    a_Tmpv5 =0.5*a_Tmpv6
3388    a_Tmpv2 =a_Tmpv5
3389    a_Tmpv4 =a_Tmpv5
3390    a_Tmpv3 =fnp(k)*a_Tmpv4
3391    a_hat(i,k-1,j) =a_hat(i,k-1,j) +a_Tmpv3
3392    a_hat(i,k-1,j+1) =a_hat(i,k-1,j+1) +a_Tmpv3
3393    a_Tmpv1 =fnm(k)*a_Tmpv2
3394    a_hat(i,k,j) =a_hat(i,k,j) +a_Tmpv1
3395    a_hat(i,k,j+1) =a_hat(i,k,j+1) +a_Tmpv1
3396    ENDDO
3397    ENDDO
3398
3399    ENDDO
3400
3401 !LPB[9]
3402    DO j =j_end+1, j_start, -1
3403
3404 !  DO k =kts, ktf
3405 !  DO i =i_start, i_end
3406 !  IF((config_flags%polar) .AND. ((j == jds) .OR. (j == jde))) THEN
3407 !  hat(i,k,j) =0.
3408
3409 !  ELSE
3410 !  hat(i,k,j) =v(i,k,j)/msfvx(i,j)
3411
3412 !  ENDIF
3413 !  ENDDO
3414 !  ENDDO
3415
3416    DO k =ktf, kts, -1
3417    DO i =i_end, i_start, -1
3418
3419    IF((config_flags%polar) .AND. ((j == jds) .OR. (j == jde))) THEN
3420
3421    a_hat(i,k,j) =0.0
3422
3423    ELSE
3424
3425    a_v(i,k,j) =a_v(i,k,j) +1.0/msfvx(i,j)*a_hat(i,k,j)
3426    a_hat(i,k,j) =0.0
3427
3428    ENDIF
3429    ENDDO
3430    ENDDO
3431
3432    ENDDO
3433
3434 !BIG ERRORS, REVISED BY WALLS
3435 !   hat =Keep_Lpb2_hat  ! Remarked by Ning Pan, 2010-08-31
3436
3437 !LPB[8]
3438    DO j =j_end, j_start, -1
3439
3440 !  DO k =kts, ktf
3441 !  DO i =i_start, i_end
3442 !  div(i,k,j) =tmp1(i,k,j)
3443
3444 !  ENDDO
3445 !  ENDDO
3446
3447    DO k =ktf, kts, -1
3448    DO i =i_end, i_start, -1
3449    a_tmp1(i,k,j) =a_tmp1(i,k,j) +a_div(i,k,j)
3450    a_div(i,k,j) =0.0
3451    ENDDO
3452    ENDDO
3453
3454    ENDDO
3455
3456 !LPB[7]
3457    DO j =j_end, j_start, -1
3458
3459 !  DO k =kts, ktf
3460 !  DO i =i_start, i_end
3461 !  defor11(i,k,j) =2.0*tmp1(i,k,j)
3462
3463 !  ENDDO
3464 !  ENDDO
3465
3466    DO k =ktf, kts, -1
3467    DO i =i_end, i_start, -1
3468    a_tmp1(i,k,j) =a_tmp1(i,k,j) +2.0*a_defor11(i,k,j)
3469    a_defor11(i,k,j) =0.0
3470    ENDDO
3471    ENDDO
3472
3473    ENDDO
3474
3475 !LPB[6]
3476    DO j =j_end, j_start, -1
3477
3478 !REVISED BY WALLS
3479 !  DO k=kts, min(kte,kde-1)
3480 !  DO i=its, min(ite,ide-1)
3481 ! Remarked by Ning Pan, 2010-08-31
3482 !   DO k=kts, ktf
3483 !   DO i=i_start, i_end
3484 !   tmp1(i,k,j) =Keep_Lpb6_tmp1(i,k,j)
3485 !   END DO
3486 !   END DO
3487
3488 !   DO k =kts, ktf
3489 !   DO i =i_start, i_end
3490 !   Tmpv001 =hat(i+1,k,j) -hat(i,k,j)
3491 !   Tmpv002 =rdx*Tmpv001
3492 !   Tmpv003 =Tmpv002 -tmp1(i,k,j)
3493 !   Tmpv300(i,k) =Tmpv003
3494 !   Tmpv004 =mm(i,j)*Tmpv300(i,k)
3495 !   tmp1(i,k,j) =Tmpv004
3496
3497 !   ENDDO
3498 !   ENDDO
3499
3500    DO k =ktf, kts, -1
3501    DO i =i_end, i_start, -1
3502    a_Tmpv4 =a_tmp1(i,k,j)
3503    a_tmp1(i,k,j) =0.0
3504 !   a_mm(i,j) =a_mm(i,j) +Tmpv300(i,k)*a_Tmpv4  ! Remarked by Ning Pan, 2010-08-31
3505    a_Tmpv3 =mm(i,j)*a_Tmpv4
3506    a_Tmpv2 =a_Tmpv3
3507    a_tmp1(i,k,j) =a_tmp1(i,k,j) -a_Tmpv3
3508    a_Tmpv1 =rdx*a_Tmpv2
3509    a_hat(i+1,k,j) =a_hat(i+1,k,j) +a_Tmpv1
3510    a_hat(i,k,j) =a_hat(i,k,j) -a_Tmpv1
3511    ENDDO
3512    ENDDO
3513
3514    ENDDO
3515
3516 !LPB[5]
3517    DO j =j_end, j_start, -1
3518
3519    DO k =kts, ktf
3520    DO i =i_start, i_end
3521
3522    Tmpv001 =zx(i,k,j) +zx(i+1,k,j)
3523    Tmpv002 =Tmpv001 +zx(i,k+1,j)
3524    Tmpv003 =Tmpv002 +zx(i+1,k+1,j)
3525    Tmpv004 =0.25*Tmpv003
3526    tmpzx =Tmpv004
3527    Tmpv300(i,k) =tmpzx
3528
3529 !BIG ERRORS, ADDED BY WALLS
3530 !BIG ERRORS, ADDED BY WALLS
3531 !  Tmpv001 =hatavg(i,k+1,j) -hatavg(i,k,j)
3532    Tmpv001 =Keep_Lpb5_hatavg(i,k,j)
3533
3534    Tmpv301(i,k) =Tmpv001
3535    Tmpv002 =Tmpv301(i,k)*tmpzx
3536    Tmpv302(i,k) =Tmpv002
3537 ! Remarked by Ning Pan, 2010-08-31
3538 !   Tmpv003 =Tmpv302(i,k)*rdzw(i,k,j)
3539 !   tmp1(i,k,j) =Tmpv003
3540
3541    ENDDO
3542    ENDDO
3543
3544    DO k =ktf, kts, -1
3545    DO i =i_end, i_start, -1
3546    tmpzx =Tmpv300(i,k)
3547
3548    a_Tmpv3 =a_tmp1(i,k,j)
3549    a_tmp1(i,k,j) =0.0
3550    a_Tmpv2 =rdzw(i,k,j)*a_Tmpv3
3551    a_rdzw(i,k,j) =a_rdzw(i,k,j) +Tmpv302(i,k)*a_Tmpv3
3552    a_Tmpv1 =tmpzx*a_Tmpv2
3553    a_tmpzx =a_tmpzx +Tmpv301(i,k)*a_Tmpv2
3554    a_hatavg(i,k+1,j) =a_hatavg(i,k+1,j) +a_Tmpv1
3555    a_hatavg(i,k,j) =a_hatavg(i,k,j) -a_Tmpv1
3556
3557 !  tmpzx =Tmpv300(i,k)
3558
3559    a_Tmpv4 =a_tmpzx
3560    a_tmpzx =0.0
3561    a_Tmpv3 =0.25*a_Tmpv4
3562    a_Tmpv2 =a_Tmpv3
3563    a_zx(i+1,k+1,j) =a_zx(i+1,k+1,j) +a_Tmpv3
3564    a_Tmpv1 =a_Tmpv2
3565    a_zx(i,k+1,j) =a_zx(i,k+1,j) +a_Tmpv2
3566    a_zx(i,k,j) =a_zx(i,k,j) +a_Tmpv1
3567    a_zx(i+1,k,j) =a_zx(i+1,k,j) +a_Tmpv1
3568
3569    ENDDO
3570    ENDDO
3571
3572    ENDDO
3573
3574 !LPB[4]
3575    DO j =j_end, j_start, -1
3576
3577 ! Remarked by Ning Pan, 2010-08-31
3578 !   DO i =i_start, i_end
3579 !   Tmpv001 =cf1*hat(i,1,j) +cf2*hat(i,2,j)
3580 !   Tmpv002 =Tmpv001 +cf3*hat(i,3,j)
3581 !   Tmpv003 =Tmpv002 +cf1*hat(i+1,1,j)
3582 !   Tmpv004 =Tmpv003 +cf2*hat(i+1,2,j)
3583 !   Tmpv005 =Tmpv004 +cf3*hat(i+1,3,j)
3584 !   Tmpv006 =0.5*Tmpv005
3585 !   hatavg(i,1,j) =Tmpv006
3586
3587 !   Tmpv001 =hat(i,ktes1,j) +hat(i+1,ktes1,j)
3588 !   Tmpv200(i) =Tmpv001
3589 !   Tmpv002 =cft1*Tmpv200(i)
3590 !   Tmpv003 =hat(i,ktes2,j) +hat(i+1,ktes2,j)
3591 !   Tmpv201(i) =Tmpv003
3592 !   Tmpv004 =cft2*Tmpv201(i)
3593 !   Tmpv005 =Tmpv002 +Tmpv004
3594 !   Tmpv006 =0.5*Tmpv005
3595 !   hatavg(i,kte,j) =Tmpv006
3596
3597 !   ENDDO
3598
3599    DO i =i_end, i_start, -1
3600    a_Tmpv6 =a_hatavg(i,kte,j)
3601    a_hatavg(i,kte,j) =0.0
3602    a_Tmpv5 =0.5*a_Tmpv6
3603    a_Tmpv2 =a_Tmpv5
3604    a_Tmpv4 =a_Tmpv5
3605 !   a_cft2 =a_cft2 +Tmpv201(i)*a_Tmpv4  ! Remarked by Ning Pan, 2010-08-31
3606    a_Tmpv3 =cft2*a_Tmpv4
3607    a_hat(i,ktes2,j) =a_hat(i,ktes2,j) +a_Tmpv3
3608    a_hat(i+1,ktes2,j) =a_hat(i+1,ktes2,j) +a_Tmpv3
3609 !   a_cft1 =a_cft1 +Tmpv200(i)*a_Tmpv2  ! Remarked by Ning Pan, 2010-08-31
3610    a_Tmpv1 =cft1*a_Tmpv2
3611    a_hat(i,ktes1,j) =a_hat(i,ktes1,j) +a_Tmpv1
3612    a_hat(i+1,ktes1,j) =a_hat(i+1,ktes1,j) +a_Tmpv1
3613    a_Tmpv6 =a_hatavg(i,1,j)
3614    a_hatavg(i,1,j) =0.0
3615    a_Tmpv5 =0.5*a_Tmpv6
3616    a_Tmpv4 =a_Tmpv5
3617    a_hat(i+1,3,j) =a_hat(i+1,3,j) +cf3*a_Tmpv5
3618    a_Tmpv3 =a_Tmpv4
3619    a_hat(i+1,2,j) =a_hat(i+1,2,j) +cf2*a_Tmpv4
3620    a_Tmpv2 =a_Tmpv3
3621    a_hat(i+1,1,j) =a_hat(i+1,1,j) +cf1*a_Tmpv3
3622    a_Tmpv1 =a_Tmpv2
3623    a_hat(i,3,j) =a_hat(i,3,j) +cf3*a_Tmpv2
3624    a_hat(i,1,j) =a_hat(i,1,j) +cf1*a_Tmpv1
3625    a_hat(i,2,j) =a_hat(i,2,j) +cf2*a_Tmpv1
3626    ENDDO
3627
3628    ENDDO
3629
3630 !LPB[3]
3631    DO j =j_end, j_start, -1
3632
3633 !  DO k =kts+1, ktf
3634 !  DO i =i_start, i_end
3635 !  Tmpv001 =hat(i,k,j) +hat(i+1,k,j)
3636 !  Tmpv002 =fnm(k)*Tmpv001
3637 !  Tmpv003 =hat(i,k-1,j) +hat(i+1,k-1,j)
3638 !  Tmpv004 =fnp(k)*Tmpv003
3639 !  Tmpv005 =Tmpv002 +Tmpv004
3640 !  Tmpv006 =0.5*Tmpv005
3641 !  hatavg(i,k,j) =Tmpv006
3642
3643 !  ENDDO
3644 !  ENDDO
3645
3646    DO k =ktf, kts+1, -1
3647    DO i =i_end, i_start, -1
3648    a_Tmpv6 =a_hatavg(i,k,j)
3649    a_hatavg(i,k,j) =0.0
3650    a_Tmpv5 =0.5*a_Tmpv6
3651    a_Tmpv2 =a_Tmpv5
3652    a_Tmpv4 =a_Tmpv5
3653    a_Tmpv3 =fnp(k)*a_Tmpv4
3654    a_hat(i,k-1,j) =a_hat(i,k-1,j) +a_Tmpv3
3655    a_hat(i+1,k-1,j) =a_hat(i+1,k-1,j) +a_Tmpv3
3656    a_Tmpv1 =fnm(k)*a_Tmpv2
3657    a_hat(i,k,j) =a_hat(i,k,j) +a_Tmpv1
3658    a_hat(i+1,k,j) =a_hat(i+1,k,j) +a_Tmpv1
3659    ENDDO
3660    ENDDO
3661
3662    ENDDO
3663
3664 !LPB[2]
3665    DO j =j_end, j_start, -1
3666
3667 !  DO k =kts, ktf
3668 !  DO i =i_start, i_end+1
3669 !  hat(i,k,j) =u(i,k,j)/msfuy(i,j)
3670
3671 !  ENDDO
3672 !  ENDDO
3673
3674    DO k =ktf, kts, -1
3675    DO i =i_end+1, i_start, -1
3676    a_u(i,k,j) =a_u(i,k,j) +1.0/msfuy(i,j)*a_hat(i,k,j)
3677    a_hat(i,k,j) =0.0
3678    ENDDO
3679    ENDDO
3680
3681    ENDDO
3682
3683 !LPB[1]
3684 ! Remarked by Ning Pan, 2010-08-31
3685 !   DO j =j_end, j_start, -1
3686
3687 !!  DO i =i_start, i_end
3688 !!  mm(i,j) =msftx(i,j)*msfty(i,j)
3689
3690 !!  ENDDO
3691
3692 !   DO i =i_end, i_start, -1
3693 !   a_mm(i,j) =0.0
3694 !   ENDDO
3695
3696 !   ENDDO
3697
3698 !LPB[0]
3699 !  ktes1 =kte-1
3700 !  ktes2 =kte-2
3701 !  cft2 =-0.5*dnw(ktes1)/dn(ktes1)
3702
3703 !  cft1 =1.0 -cft2
3704
3705 !  ktf =min(kte, kde-1)
3706 !  i_start =its
3707 !  i_end =min(ite, ide-1)
3708 !  j_start =jts
3709 !  j_end =min(jte, jde-1)
3710
3711 ! Remarked by Ning Pan, 2010-08-31
3712 !   a_cft2 =a_cft2 -a_cft1
3713 !   a_cft1 =0.0
3714 !   a_cft2 =0.0
3715
3716    END SUBROUTINE a_cal_deform_and_div
3717
3718    SUBROUTINE a_calculate_km_kh(config_flags,dt,dampcoef,zdamp,damp_opt,xkmh,a_xkmh, &
3719    xkmv,a_xkmv,xkhh,a_xkhh,xkhv,a_xkhv,BN2,a_BN2,khdif,kvdif,div,a_div, &
3720    defor11,a_defor11,defor22,a_defor22,defor33,a_defor33,defor12,a_defor12, &
3721    defor13,a_defor13,defor23,a_defor23,tke,a_tke,p8w,a_p8w,t8w,a_t8w,theta, &
3722    a_theta,t,a_t,p,a_p,moist,a_moist,dn,dnw,dx,dy,rdz,a_rdz,rdzw,a_rdzw, &
3723    isotropic,n_moist,cf1,cf2,cf3,warm_rain,mix_upper_bound,msftx,msfty,zx,a_zx,zy,a_zy,ids,ide,jds,jde, &
3724    kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
3725
3726 !PART I: DECLARATION OF VARIABLES
3727
3728    IMPLICIT NONE
3729
3730    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
3731    TYPE(grid_config_rec_type) :: config_flags
3732    INTEGER :: n_moist,damp_opt,isotropic,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
3733    kme,its,ite,jts,jte,kts,kte
3734    LOGICAL :: warm_rain
3735    REAL :: dx,dy,zdamp,dt,dampcoef,cf1,cf2,cf3,khdif,kvdif
3736    REAL,DIMENSION(kms:kme) :: dnw,dn
3737    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist,a_moist
3738    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: xkmv,a_xkmv,xkmh,a_xkmh,xkhv,a_xkhv, &
3739    xkhh,a_xkhh,BN2,a_BN2
3740    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor11,a_defor11,defor22,a_defor22, &
3741    defor33,a_defor33,defor12,a_defor12,defor13,a_defor13,defor23,a_defor23,div, &
3742    a_div,rdz,a_rdz,rdzw,a_rdzw,p8w,a_p8w,t8w,a_t8w,theta,a_theta,t,a_t,p,a_p,zx,a_zx,zy,a_zy
3743    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tke,a_tke
3744    REAL :: mix_upper_bound
3745    REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty
3746    INTEGER :: i_start,i_end,j_start,j_end,ktf,i,j,k!,km_opt
3747
3748 !  REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb3_xkmh
3749 !  REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb3_xkhh
3750 !  REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb3_xkmv
3751 !  REAL,DIMENSION(1,ims:ime,kms:kme,jms:jme) :: Keep_Lpb3_xkhv
3752    INTEGER :: IX1,IX2,IX3
3753    REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv400
3754    REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv401
3755    REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv402
3756    REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv403
3757    REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv404
3758    REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv405
3759    REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv406
3760    REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv407
3761    REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv408
3762    REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv409
3763    REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv4010
3764
3765     REAL, DIMENSION( ims:ime, jms:jme )           &
3766     :: hpbl
3767
3768     REAL, DIMENSION( ims:ime, kms:kme, jms:jme )  &
3769     :: dlk
3770
3771     REAL, DIMENSION( ims:ime, kms:kme, jms:jme )  &
3772     :: xkmv_meso,xkmh_t
3773
3774 !PART II: CALCULATIONS OF B. S. TRAJECTORY
3775
3776 !LPB[0]
3777
3778        ktf     = MIN( kte, kde-1 )
3779        i_start = its
3780        i_end   = MIN( ite, ide-1 )
3781        j_start = jts
3782        j_end   = MIN( jte, jde-1 )
3783        CALL calculate_N2( config_flags, BN2, moist,             &
3784                           theta, t, p, p8w, t8w,                &
3785                           dnw, dn, rdz, rdzw,                   &
3786                           n_moist, cf1, cf2, cf3, warm_rain,    &
3787                           ids, ide, jds, jde, kds, kde,         &
3788                           ims, ime, jms, jme, kms, kme,         &
3789                           its, ite, jts, jte, kts, kte        )
3790
3791 !LPB[1]
3792 !   km_opt =config_flags%km_opt
3793 !   km_opt =3
3794
3795 !REVISED BY WALLS
3796     km_coef: SELECT CASE( config_flags%km_opt )
3797 !   km_coef: SELECT CASE( km_opt )
3798
3799          CASE (1)
3800                CALL isotropic_km( config_flags, xkmh, xkmv,                  &
3801                                   xkhh, xkhv, khdif, kvdif,                  &
3802                                   ids, ide, jds, jde, kds, kde,              &
3803                                   ims, ime, jms, jme, kms, kme,              &
3804                                   its, ite, jts, jte, kts, kte             )
3805          CASE (2)
3806                CALL tke_km(       config_flags, xkmh, xkmv,                  &
3807                                   xkhh, xkhv, BN2, tke, p8w, t8w, theta,     &
3808                                   rdz, rdzw, dx, dy, dt, isotropic,          &
3809                                   mix_upper_bound, msftx, msfty,             &
3810                                   hpbl,dlk,xkmv_meso,                        &
3811                                   defor11,defor22,defor12,zx,zy,             &
3812                                   ids, ide, jds, jde, kds, kde,              &
3813                                   ims, ime, jms, jme, kms, kme,              &
3814                                   its, ite, jts, jte, kts, kte             )
3815          CASE (3)
3816                CALL smag_km(      config_flags, xkmh, xkmv,                  &
3817                                   xkhh, xkhv, BN2, div,                      &
3818                                   defor11, defor22, defor33,                 &
3819                                   defor12, defor13, defor23,                 &
3820                                   rdzw, dx, dy, dt, isotropic,               &
3821                                   mix_upper_bound, msftx, msfty,             &
3822                                   ids, ide, jds, jde, kds, kde,              &
3823                                   ims, ime, jms, jme, kms, kme,              &
3824                                   its, ite, jts, jte, kts, kte             )
3825          CASE (4)
3826                CALL smag2d_km(    config_flags, xkmh, xkmv,                  &
3827                                   xkhh, xkhv, defor11, defor22, defor12,     &
3828                                   rdzw, dx, dy, msftx, msfty,                &
3829                                   zx, zy,                                    &
3830                                   ids, ide, jds, jde, kds, kde,              &
3831                                   ims, ime, jms, jme, kms, kme,              &
3832                                   its, ite, jts, jte, kts, kte             )
3833          CASE DEFAULT
3834                CALL wrf_error_fatal( 'Please choose diffusion coefficient scheme' )
3835
3836    END SELECT km_coef
3837
3838 !LPB[2]
3839
3840 !!LPB[3]
3841 !!  DO IX3=jms,jme
3842 !!  DO IX2=kms,kme
3843 !!  DO IX1=ims,ime
3844 !    !  Keep_Lpb3_xkmh(IX1,IX2,IX3) =xkmh(IX1,IX2,IX3)
3845 !!  END DO
3846 !!  END DO
3847 !!  END DO
3848 !!  DO IX3=jms,jme
3849 !!  DO IX2=kms,kme
3850 !!  DO IX1=ims,ime
3851 !    !  Keep_Lpb3_xkhh(IX1,IX2,IX3) =xkhh(IX1,IX2,IX3)
3852 !!  END DO
3853 !!  END DO
3854 !!  END DO
3855 !!  DO IX3=jms,jme
3856 !!  DO IX2=kms,kme
3857 !!  DO IX1=ims,ime
3858 !    !  Keep_Lpb3_xkmv(IX1,IX2,IX3) =xkmv(IX1,IX2,IX3)
3859 !!  END DO
3860 !!  END DO
3861 !!  END DO
3862 !!  DO IX3=jms,jme
3863 !!  DO IX2=kms,kme
3864 !!  DO IX1=ims,ime
3865 !    !  Keep_Lpb3_xkhv(IX1,IX2,IX3) =xkhv(IX1,IX2,IX3)
3866 !!  END DO
3867 !!  END DO
3868 !!  END DO
3869
3870 !    IF ( damp_opt .eq. 1 ) THEN
3871
3872 !         CALL cal_dampkm( config_flags, xkmh, xkhh, xkmv, xkhv,      &
3873 !                          dx, dy, dt, dampcoef, rdz, rdzw, zdamp,    &
3874 !                          msftx, msfty,                              &
3875 !                          ids, ide, jds, jde, kds, kde,              &
3876 !                          ims, ime, jms, jme, kms, kme,              &
3877 !                          its, ite, jts, jte, kts, kte             )
3878
3879 !   END IF
3880
3881 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
3882
3883 !LPB[3]
3884 !  DO IX3=jms,jme
3885 !  DO IX2=kms,kme
3886 !  DO IX1=ims,ime
3887 !  xkmh(IX1,IX2,IX3) =Keep_Lpb3_xkmh(IX1,IX2,IX3)
3888 !  END DO
3889 !  END DO
3890 !  END DO
3891 !  DO IX3=jms,jme
3892 !  DO IX2=kms,kme
3893 !  DO IX1=ims,ime
3894 !  xkhh(IX1,IX2,IX3) =Keep_Lpb3_xkhh(IX1,IX2,IX3)
3895 !  END DO
3896 !  END DO
3897 !  END DO
3898 !  DO IX3=jms,jme
3899 !  DO IX2=kms,kme
3900 !  DO IX1=ims,ime
3901 !  xkmv(IX1,IX2,IX3) =Keep_Lpb3_xkmv(IX1,IX2,IX3)
3902 !  END DO
3903 !  END DO
3904 !  END DO
3905 !  DO IX3=jms,jme
3906 !  DO IX2=kms,kme
3907 !  DO IX1=ims,ime
3908 !  xkhv(IX1,IX2,IX3) =Keep_Lpb3_xkhv(IX1,IX2,IX3)
3909 !  END DO
3910 !  END DO
3911 !  END DO
3912
3913 !  IF( damp_opt .eq. 1 ) THEN
3914 !  DO IX3=jms,jme
3915 !  DO IX2=kms,kme
3916 !  DO IX1=ims,ime
3917 !  Tmpv400(IX1,IX2,IX3) =xkmh(IX1,IX2,IX3)
3918 !  END DO
3919 !  END DO
3920 !  END DO
3921
3922 !  DO IX3=jms,jme
3923 !  DO IX2=kms,kme
3924 !  DO IX1=ims,ime
3925 !  Tmpv401(IX1,IX2,IX3) =xkhh(IX1,IX2,IX3)
3926 !  END DO
3927 !  END DO
3928 !  END DO
3929
3930 !  DO IX3=jms,jme
3931 !  DO IX2=kms,kme
3932 !  DO IX1=ims,ime
3933 !  Tmpv402(IX1,IX2,IX3) =xkmv(IX1,IX2,IX3)
3934 !  END DO
3935 !  END DO
3936 !  END DO
3937
3938 !  DO IX3=jms,jme
3939 !  DO IX2=kms,kme
3940 !  DO IX1=ims,ime
3941 !  Tmpv403(IX1,IX2,IX3) =xkhv(IX1,IX2,IX3)
3942 !  END DO
3943 !  END DO
3944 !  END DO
3945
3946 !  CALL cal_dampkm(config_flags,xkmh,xkhh,xkmv,xkhv,dx,dy,dt,dampcoef,rdz,rdzw,zdamp,  &
3947 !  msftx,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
3948
3949 !  END IF
3950
3951    IF( damp_opt .eq. 1 ) THEN
3952
3953 ! Remarked by Ning Pan, 2010-08-18
3954 !   DO IX3=jms,jme
3955 !   DO IX2=kms,kme
3956 !   DO IX1=ims,ime
3957 !   xkhv(IX1,IX2,IX3) =Tmpv403(IX1,IX2,IX3)
3958 !   END DO
3959 !   END DO
3960 !   END DO
3961
3962 ! Remarked by Ning Pan, 2010-08-18
3963 !   DO IX3=jms,jme
3964 !   DO IX2=kms,kme
3965 !   DO IX1=ims,ime
3966 !   xkmv(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
3967 !   END DO
3968 !   END DO
3969 !   END DO
3970
3971 ! Remarked by Ning Pan, 2010-08-18
3972 !   DO IX3=jms,jme
3973 !   DO IX2=kms,kme
3974 !   DO IX1=ims,ime
3975 !   xkhh(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
3976 !   END DO
3977 !   END DO
3978 !   END DO
3979
3980 ! Remarked by Ning Pan, 2010-08-18
3981 !   DO IX3=jms,jme
3982 !   DO IX2=kms,kme
3983 !   DO IX1=ims,ime
3984 !   xkmh(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
3985 !   END DO
3986 !   END DO
3987 !   END DO
3988
3989    CALL a_cal_dampkm(config_flags,xkmh,a_xkmh,xkhh,a_xkhh,xkmv,a_xkmv,xkhv,  &
3990    a_xkhv,dx,dy,dt,dampcoef,rdz,a_rdz,rdzw,a_rdzw,zdamp,msftx,msfty,ids,ide,jds,  &
3991    jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
3992
3993    END IF
3994
3995 !LPB[2]
3996
3997 ! Remarked by Ning Pan, 2010-08-18 : recalculation of LPB[1]
3998 !LPB[1]
3999
4000 !   SELECT CASE (config_flags%km_opt)
4001 !!  SELECT CASE (km_opt)
4002 !   CASE(1)
4003 !   CALL isotropic_km(config_flags,xkmh,xkmv,xkhh,xkhv,khdif,kvdif,ids,ide,jds,jde,  &
4004 !   kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
4005
4006 !   CASE(2)
4007 !   DO IX3=jms,jme
4008 !   DO IX2=kms,kme
4009 !   DO IX1=ims,ime
4010 !   Tmpv400(IX1,IX2,IX3) =xkmh(IX1,IX2,IX3)
4011 !   END DO
4012 !   END DO
4013 !   END DO
4014
4015 !   DO IX3=jms,jme
4016 !   DO IX2=kms,kme
4017 !   DO IX1=ims,ime
4018 !   Tmpv401(IX1,IX2,IX3) =xkmv(IX1,IX2,IX3)
4019 !   END DO
4020 !   END DO
4021 !   END DO
4022
4023 !   DO IX3=jms,jme
4024 !   DO IX2=kms,kme
4025 !   DO IX1=ims,ime
4026 !   Tmpv402(IX1,IX2,IX3) =xkhh(IX1,IX2,IX3)
4027 !   END DO
4028 !   END DO
4029 !   END DO
4030
4031 !   CALL tke_km(config_flags,xkmh,xkmv,xkhh,xkhv,BN2,tke,p8w,t8w,theta,rdz,rdzw,dx,dy,  &
4032 !   dt,isotropic,mix_upper_bound,msftx,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
4033 !   kme,its,ite,jts,jte,kts,kte)
4034
4035 !   CASE(3)
4036 !   DO IX3=jms,jme
4037 !   DO IX2=kms,kme
4038 !   DO IX1=ims,ime
4039 !   Tmpv403(IX1,IX2,IX3) =xkmh(IX1,IX2,IX3)
4040 !   END DO
4041 !   END DO
4042 !   END DO
4043
4044 !   DO IX3=jms,jme
4045 !   DO IX2=kms,kme
4046 !   DO IX1=ims,ime
4047 !   Tmpv404(IX1,IX2,IX3) =xkmv(IX1,IX2,IX3)
4048 !   END DO
4049 !   END DO
4050 !   END DO
4051
4052 !   DO IX3=jms,jme
4053 !   DO IX2=kms,kme
4054 !   DO IX1=ims,ime
4055 !   Tmpv405(IX1,IX2,IX3) =xkhh(IX1,IX2,IX3)
4056 !   END DO
4057 !   END DO
4058 !   END DO
4059
4060 !   DO IX3=jms,jme
4061 !   DO IX2=kms,kme
4062 !   DO IX1=ims,ime
4063 !   Tmpv406(IX1,IX2,IX3) =xkhv(IX1,IX2,IX3)
4064 !   END DO
4065 !   END DO
4066 !   END DO
4067
4068 !   CALL smag_km(config_flags,xkmh,xkmv,xkhh,xkhv,BN2,div,defor11,defor22,defor33,  &
4069 !   defor12,defor13,defor23,rdzw,dx,dy,dt,isotropic,mix_upper_bound,msftx,msfty,ids,ide,  &
4070 !   jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
4071
4072 !   CASE(4)
4073 !   DO IX3=jms,jme
4074 !   DO IX2=kms,kme
4075 !   DO IX1=ims,ime
4076 !   Tmpv407(IX1,IX2,IX3) =xkmh(IX1,IX2,IX3)
4077 !   END DO
4078 !   END DO
4079 !   END DO
4080
4081 !   DO IX3=jms,jme
4082 !   DO IX2=kms,kme
4083 !   DO IX1=ims,ime
4084 !   Tmpv408(IX1,IX2,IX3) =xkmv(IX1,IX2,IX3)
4085 !   END DO
4086 !   END DO
4087 !   END DO
4088
4089 !   DO IX3=jms,jme
4090 !   DO IX2=kms,kme
4091 !   DO IX1=ims,ime
4092 !   Tmpv409(IX1,IX2,IX3) =xkhh(IX1,IX2,IX3)
4093 !   END DO
4094 !   END DO
4095 !   END DO
4096
4097 !   DO IX3=jms,jme
4098 !   DO IX2=kms,kme
4099 !   DO IX1=ims,ime
4100 !   Tmpv4010(IX1,IX2,IX3) =xkhv(IX1,IX2,IX3)
4101 !   END DO
4102 !   END DO
4103 !   END DO
4104
4105 !   CALL smag2d_km(config_flags,xkmh,xkmv,xkhh,xkhv,defor11,defor22,defor12,rdzw,dx,  &
4106 !   dy,msftx,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
4107
4108 !   CASE DEFAULT
4109 !   CALL wrf_error_fatal('Please choose diffusion coefficient scheme')
4110
4111 !REVISED! BY WALLS
4112 !!  END SELECT km_coef
4113 !   END SELECT
4114
4115    SELECT CASE (config_flags%km_opt)
4116 !  SELECT CASE (km_opt)
4117
4118    CASE(1)
4119
4120    CALL a_isotropic_km(config_flags,xkmh,a_xkmh,xkmv,a_xkmv,xkhh,a_xkhh,xkhv,  &
4121    a_xkhv,khdif,kvdif,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
4122
4123    CASE(2)
4124
4125 ! Remarked by Ning Pan, 2010-08-18
4126 !   DO IX3=jms,jme
4127 !   DO IX2=kms,kme
4128 !   DO IX1=ims,ime
4129 !   xkhh(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
4130 !   END DO
4131 !   END DO
4132 !   END DO
4133
4134 ! Remarked by Ning Pan, 2010-08-18
4135 !   DO IX3=jms,jme
4136 !   DO IX2=kms,kme
4137 !   DO IX1=ims,ime
4138 !   xkmv(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
4139 !   END DO
4140 !   END DO
4141 !   END DO
4142
4143 ! Remarked by Ning Pan, 2010-08-18
4144 !   DO IX3=jms,jme
4145 !   DO IX2=kms,kme
4146 !   DO IX1=ims,ime
4147 !   xkmh(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
4148 !   END DO
4149 !   END DO
4150 !   END DO
4151
4152    CALL a_tke_km(config_flags,xkmh,a_xkmh,xkmv,a_xkmv,xkhh,a_xkhh,xkhv,  &
4153    a_xkhv,BN2,a_BN2,tke,a_tke,p8w,a_p8w,t8w,a_t8w,theta,a_theta,rdz,a_rdz,  &
4154    rdzw,a_rdzw,dx,dy,dt,isotropic,mix_upper_bound,msftx,msfty,ids,ide,jds,jde,kds,kde,  &
4155    ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
4156
4157    CASE(3)
4158
4159 ! Remarked by Ning Pan, 2010-08-18
4160 !   DO IX3=jms,jme
4161 !   DO IX2=kms,kme
4162 !   DO IX1=ims,ime
4163 !   xkhv(IX1,IX2,IX3) =Tmpv406(IX1,IX2,IX3)
4164 !   END DO
4165 !   END DO
4166 !   END DO
4167
4168 ! Remarked by Ning Pan, 2010-08-18
4169 !   DO IX3=jms,jme
4170 !   DO IX2=kms,kme
4171 !   DO IX1=ims,ime
4172 !   xkhh(IX1,IX2,IX3) =Tmpv405(IX1,IX2,IX3)
4173 !   END DO
4174 !   END DO
4175 !   END DO
4176
4177 ! Remarked by Ning Pan, 2010-08-18
4178 !   DO IX3=jms,jme
4179 !   DO IX2=kms,kme
4180 !   DO IX1=ims,ime
4181 !   xkmv(IX1,IX2,IX3) =Tmpv404(IX1,IX2,IX3)
4182 !   END DO
4183 !   END DO
4184 !   END DO
4185
4186 ! Remarked by Ning Pan, 2010-08-18
4187 !   DO IX3=jms,jme
4188 !   DO IX2=kms,kme
4189 !   DO IX1=ims,ime
4190 !   xkmh(IX1,IX2,IX3) =Tmpv403(IX1,IX2,IX3)
4191 !   END DO
4192 !   END DO
4193 !   END DO
4194
4195    CALL a_smag_km(config_flags,xkmh,a_xkmh,xkmv,a_xkmv,xkhh,a_xkhh,xkhv,  &
4196    a_xkhv,BN2,a_BN2,div,a_div,defor11,a_defor11,defor22,a_defor22,defor33,  &
4197    a_defor33,defor12,a_defor12,defor13,a_defor13,defor23,a_defor23,rdzw,  &
4198    a_rdzw,dx,dy,dt,isotropic,mix_upper_bound,msftx,msfty,ids,ide,jds,jde,kds,kde,ims,  &
4199    ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
4200
4201    CASE(4)
4202
4203 ! Remarked by Ning Pan, 2010-08-18
4204 !   DO IX3=jms,jme
4205 !   DO IX2=kms,kme
4206 !   DO IX1=ims,ime
4207 !   xkhv(IX1,IX2,IX3) =Tmpv4010(IX1,IX2,IX3)
4208 !   END DO
4209 !   END DO
4210 !   END DO
4211
4212 ! Remarked by Ning Pan, 2010-08-18
4213 !   DO IX3=jms,jme
4214 !   DO IX2=kms,kme
4215 !   DO IX1=ims,ime
4216 !   xkhh(IX1,IX2,IX3) =Tmpv409(IX1,IX2,IX3)
4217 !   END DO
4218 !   END DO
4219 !   END DO
4220
4221 ! Remarked by Ning Pan, 2010-08-18
4222 !   DO IX3=jms,jme
4223 !   DO IX2=kms,kme
4224 !   DO IX1=ims,ime
4225 !   xkmv(IX1,IX2,IX3) =Tmpv408(IX1,IX2,IX3)
4226 !   END DO
4227 !   END DO
4228 !   END DO
4229
4230 ! Remarked by Ning Pan, 2010-08-18
4231 !   DO IX3=jms,jme
4232 !   DO IX2=kms,kme
4233 !   DO IX1=ims,ime
4234 !   xkmh(IX1,IX2,IX3) =Tmpv407(IX1,IX2,IX3)
4235 !   END DO
4236 !   END DO
4237 !   END DO
4238
4239    CALL a_smag2d_km(config_flags,xkmh,a_xkmh,xkmv,a_xkmv,xkhh,a_xkhh,xkhv,  &
4240    a_xkhv,defor11,a_defor11,defor22,a_defor22,defor12,a_defor12,rdzw,a_rdzw,  &
4241    dx,dy,msftx,msfty,zx,a_zx,zy,a_zy,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
4242
4243    CASE DEFAULT
4244
4245 !REVISED BY WALLS
4246 !  CALL a_wrf_error_fatal('Please choose diffusion coefficient scheme')
4247    CALL wrf_error_fatal('Please choose diffusion coefficient scheme')
4248
4249 !REVISED BY WALLS
4250 !  END SELECT km_coef
4251    END SELECT
4252
4253 !LPB[0]
4254 ! Remarked by Ning Pan, 2010-08-18
4255 !   ktf =min(kte, kde-1)
4256 !   i_start =its
4257 !   i_end =min(ite, ide-1)
4258 !   j_start =jts
4259 !   j_end =min(jte, jde-1)
4260
4261 !DELETED BY WALLS
4262 !  CALL calculate_N2(config_flags,BN2,moist,theta,t,p,p8w,t8w,dnw,dn,rdz,rdzw,  &
4263 !  n_moist,cf1,cf2,cf3,warm_rain,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,  &
4264 !  ite,jts,jte,kts,kte)
4265
4266 !REVISED BY WALLS
4267 !  CALL a_calculate_N2(config_flags,BN2,a_BN2,moist,a_moist,theta,a_theta,t,  &
4268 !  a_t,p,a_p,p8w,a_p8w,t8w,a_t8w,dnw,dn,rdz,a_rdz,rdzw,a_rdzw,n_moist,cf1,  &
4269 !  cf2,cf3,,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
4270
4271    CALL a_calculate_N2(config_flags,BN2,a_BN2,moist,a_moist,theta,a_theta,t,  &
4272    a_t,p,a_p,p8w,a_p8w,t8w,a_t8w,dnw,dn,rdz,a_rdz,rdzw,a_rdzw,n_moist,cf1,  &
4273    cf2,cf3,warm_rain,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
4274
4275    END SUBROUTINE a_calculate_km_kh
4276
4277    SUBROUTINE a_cal_dampkm(config_flags,xkmh,a_xkmh,xkhh,a_xkhh,xkmv,a_xkmv, &
4278    xkhv,a_xkhv,dx,dy,dt,dampcoef,rdz,a_rdz,rdzw,a_rdzw,zdamp,msftx,msfty,ids,ide, &
4279    jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
4280
4281 !PART I: DECLARATION OF VARIABLES
4282
4283    IMPLICIT NONE
4284
4285    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
4286    TYPE(grid_config_rec_type) :: config_flags
4287    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
4288    REAL :: zdamp,dx,dy,dt,dampcoef
4289    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: xkmh,a_xkmh,xkhh,a_xkhh,xkmv,a_xkmv, &
4290    xkhv,a_xkhv
4291    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rdz,a_rdz,rdzw,a_rdzw
4292    REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty
4293    INTEGER :: i_start,i_end,j_start,j_end,ktf,ktfm1,i,j,k
4294    REAL :: kmmax,kmmvmax,a_kmmvmax,degrad90,dz,a_dz,tmp,a_tmp
4295    REAL :: ds
4296    REAL,DIMENSION(its:ite) :: deltaz,a_deltaz
4297    REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: dampk,a_dampk,dampkv,a_dampkv
4298
4299    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002
4300
4301 !REVISED BY WALLS
4302 !  REAL,DIMENSION(REVISEDBYWALLS:REVISEDBYWALLS) :: Tmpv200
4303 !  REAL,DIMENSION(REVISEDBYWALLS:REVISEDBYWALLS) :: Tmpv201
4304 !  REAL,DIMENSION(REVISEDBYWALLS:REVISEDBYWALLS) :: Tmpv202
4305 !  REAL,DIMENSION(REVISEDBYWALLS:REVISEDBYWALLS,kts:min(kte,kde-1)-1) :: Tmpv300
4306 !  REAL,DIMENSION(REVISEDBYWALLS:REVISEDBYWALLS,kts:min(kte,kde-1)-1) :: Tmpv301
4307 !  REAL,DIMENSION(REVISEDBYWALLS:REVISEDBYWALLS,kts:min(kte,kde-1)-1) :: Tmpv302
4308 !  REAL,DIMENSION(REVISEDBYWALLS:REVISEDBYWALLS,kts:min(kte,kde-1)-1) :: Tmpv303
4309
4310    REAL,DIMENSION(its:MIN(ite,ide-1)) :: Tmpv200
4311    REAL,DIMENSION(its:MIN(ite,ide-1)) :: Tmpv201
4312    REAL,DIMENSION(its:MIN(ite,ide-1)) :: Tmpv202
4313    REAL,DIMENSION(its:MIN(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv300
4314    REAL,DIMENSION(its:MIN(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv301
4315    REAL,DIMENSION(its:MIN(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv302
4316    REAL,DIMENSION(its:MIN(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv303
4317    REAL,DIMENSION(its:MIN(ite,ide-1),kts:min(kte,kde-1)-1) :: Tmpv304
4318
4319 !PART II: CALCULATIONS OF B. S. TRAJECTORY
4320
4321 !LPB[0]
4322
4323       ktf = min(kte,kde-1)
4324       ktfm1 = ktf-1
4325       i_start = its
4326       i_end   = MIN(ite,ide-1)
4327       j_start = jts
4328       j_end   = MIN(jte,jde-1)
4329
4330 !LPB[1]
4331    IF(config_flags%specified .OR. config_flags%nested)THEN
4332
4333         i_start = MAX(i_start,ids+config_flags%spec_bdy_width-1)
4334         i_end   = MIN(i_end,ide-config_flags%spec_bdy_width)
4335         j_start = MAX(j_start,jds+config_flags%spec_bdy_width-1)
4336         j_end   = MIN(j_end,jde-config_flags%spec_bdy_width)
4337
4338    ENDIF
4339
4340 !LPB[2]
4341
4342       kmmax=dx*dx/dt
4343       degrad90=DEGRAD*90.
4344
4345 !LPB[3]
4346       DO j = j_start, j_end
4347
4348          k=ktf
4349
4350          DO i = i_start, i_end
4351             ds = MIN(dx/msftx(i,j),dy/msfty(i,j))
4352             kmmax=ds*ds/dt
4353             dz = 1./rdzw(i,k,j)
4354             deltaz(i) = 0.5*dz
4355             kmmvmax=dz*dz/dt
4356             tmp=min(deltaz(i)/zdamp,1.)
4357             dampk(i,k,j)=cos(degrad90*tmp)*cos(degrad90*tmp)*kmmax*dampcoef
4358             dampkv(i,k,j)=cos(degrad90*tmp)*cos(degrad90*tmp)*kmmvmax*dampcoef
4359             dampkv(i,k,j)=min(dampkv(i,k,j),dampk(i,k,j))
4360          ENDDO
4361
4362          DO k = ktfm1,kts,-1
4363          DO i = i_start, i_end
4364             ds = MIN(dx/msftx(i,j),dy/msfty(i,j))
4365             kmmax=ds*ds/dt
4366             dz = 1./rdz(i,k,j)
4367             deltaz(i) = deltaz(i) + dz
4368             dz = 1./rdzw(i,k,j)
4369             kmmvmax=dz*dz/dt
4370             tmp=min(deltaz(i)/zdamp,1.)
4371             dampk(i,k,j)=cos(degrad90*tmp)*cos(degrad90*tmp)*kmmax*dampcoef
4372             dampkv(i,k,j)=cos(degrad90*tmp)*cos(degrad90*tmp)*kmmvmax*dampcoef
4373             dampkv(i,k,j)=min(dampkv(i,k,j),dampk(i,k,j))
4374          ENDDO
4375          ENDDO
4376
4377       ENDDO
4378
4379 !!LPB[4]
4380 !      DO j = j_start, j_end
4381
4382 !      DO k = kts,ktf
4383 !      DO i = i_start, i_end
4384 !         xkmh(i,k,j)=max(xkmh(i,k,j),dampk(i,k,j))
4385 !         xkhh(i,k,j)=max(xkhh(i,k,j),dampk(i,k,j))
4386 !         xkmv(i,k,j)=max(xkmv(i,k,j),dampkv(i,k,j))
4387 !         xkhv(i,k,j)=max(xkhv(i,k,j),dampkv(i,k,j))
4388 !      ENDDO
4389 !      ENDDO
4390
4391 !      ENDDO
4392
4393 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
4394
4395    a_kmmvmax =0.0
4396    a_dz =0.0
4397    a_tmp =0.0
4398
4399    Do K0_ADJ =its, ite
4400    a_deltaz(K0_ADJ) =0.0
4401    End Do
4402
4403    Do K2_ADJ =jts, jte
4404    Do K1_ADJ =kts, kte
4405    Do K0_ADJ =its, ite
4406    a_dampk(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
4407    End Do
4408    End Do
4409    End Do
4410
4411    Do K2_ADJ =jts, jte
4412    Do K1_ADJ =kts, kte
4413    Do K0_ADJ =its, ite
4414    a_dampkv(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
4415    End Do
4416    End Do
4417    End Do
4418
4419 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
4420
4421 !LPB[4]
4422    DO j =j_end, j_start, -1
4423
4424 !  DO k =kts, ktf
4425 !  DO i =i_start, i_end
4426 !  Tmpv001 =max(xkmh(i,k,j), dampk(i,k,j))
4427 !  xkmh(i,k,j) =Tmpv001
4428
4429 !  Tmpv001 =max(xkhh(i,k,j), dampk(i,k,j))
4430 !  xkhh(i,k,j) =Tmpv001
4431
4432 !  Tmpv001 =max(xkmv(i,k,j), dampkv(i,k,j))
4433 !  xkmv(i,k,j) =Tmpv001
4434
4435 !  Tmpv001 =max(xkhv(i,k,j), dampkv(i,k,j))
4436 !  xkhv(i,k,j) =Tmpv001
4437
4438 !  ENDDO
4439 !  ENDDO
4440
4441    DO k =ktf, kts, -1
4442    DO i =i_end, i_start, -1
4443    a_Tmpv1 =a_xkhv(i,k,j)
4444    a_xkhv(i,k,j) =0.0
4445    a_xkhv(i,k,j) =a_xkhv(i,k,j)  +(1.0 +sign(1.0, xkhv(i,k,j) -dampkv(i,k,j)))  &
4446    *0.5*1.0*a_Tmpv1
4447    a_dampkv(i,k,j) =a_dampkv(i,k,j)  +(1.0 -sign(1.0, xkhv(i,k,j) -dampkv(i,k,j))  &
4448    )*0.5*1.0*a_Tmpv1
4449    a_Tmpv1 =a_xkmv(i,k,j)
4450    a_xkmv(i,k,j) =0.0
4451    a_xkmv(i,k,j) =a_xkmv(i,k,j)  +(1.0 +sign(1.0, xkmv(i,k,j) -dampkv(i,k,j)))  &
4452    *0.5*1.0*a_Tmpv1
4453    a_dampkv(i,k,j) =a_dampkv(i,k,j)  +(1.0 -sign(1.0, xkmv(i,k,j) -dampkv(i,k,j))  &
4454    )*0.5*1.0*a_Tmpv1
4455    a_Tmpv1 =a_xkhh(i,k,j)
4456    a_xkhh(i,k,j) =0.0
4457    a_xkhh(i,k,j) =a_xkhh(i,k,j)  +(1.0 +sign(1.0, xkhh(i,k,j) -dampk(i,k,j)))  &
4458    *0.5*1.0*a_Tmpv1
4459    a_dampk(i,k,j) =a_dampk(i,k,j)  +(1.0 -sign(1.0, xkhh(i,k,j) -dampk(i,k,j)))  &
4460    *0.5*1.0*a_Tmpv1
4461    a_Tmpv1 =a_xkmh(i,k,j)
4462    a_xkmh(i,k,j) =0.0
4463    a_xkmh(i,k,j) =a_xkmh(i,k,j)  +(1.0 +sign(1.0, xkmh(i,k,j) -dampk(i,k,j)))  &
4464    *0.5*1.0*a_Tmpv1
4465    a_dampk(i,k,j) =a_dampk(i,k,j)  +(1.0 -sign(1.0, xkmh(i,k,j) -dampk(i,k,j)))  &
4466    *0.5*1.0*a_Tmpv1
4467    ENDDO
4468    ENDDO
4469
4470    ENDDO
4471
4472 !LPB[3]
4473    DO j =j_end, j_start, -1
4474
4475    k =ktf
4476    DO i =i_start, i_end
4477    ds =min(dx/msftx(i,j), dy/msfty(i,j))
4478    kmmax =ds*ds/dt
4479    dz =1./rdzw(i,k,j)
4480    Tmpv200(i) =dz
4481
4482    deltaz(i) =0.5*dz
4483
4484    kmmvmax =dz*dz/dt
4485    Tmpv201(i) =kmmvmax
4486
4487    tmp =min(deltaz(i)/zdamp, 1.)
4488    Tmpv202(i) =tmp
4489
4490    dampk(i,k,j) =cos(degrad90*tmp)*cos(degrad90*tmp)*kmmax*dampcoef
4491
4492    Tmpv001 =cos(degrad90*tmp)*cos(degrad90*tmp)*kmmvmax
4493    Tmpv002 =Tmpv001*dampcoef
4494    dampkv(i,k,j) =Tmpv002
4495
4496    Tmpv001 =min(dampkv(i,k,j), dampk(i,k,j))
4497    dampkv(i,k,j) =Tmpv001
4498
4499    ENDDO
4500
4501    DO k =ktfm1, kts, -1
4502    DO i =i_start, i_end
4503    ds =min(dx/msftx(i,j), dy/msfty(i,j))
4504    kmmax =ds*ds/dt
4505    dz =1./rdz(i,k,j)
4506    Tmpv300(i,k) =dz
4507
4508    Tmpv001 =deltaz(i) +dz
4509    deltaz(i) =Tmpv001
4510
4511    dz =1./rdzw(i,k,j)
4512    Tmpv301(i,k) =dz
4513
4514    kmmvmax =dz*dz/dt
4515    Tmpv302(i,k) =kmmvmax
4516
4517    tmp =min(deltaz(i)/zdamp, 1.)
4518    Tmpv303(i,k) =tmp
4519    Tmpv304(i,k) =deltaz(i)
4520
4521    dampk(i,k,j) =cos(degrad90*tmp)*cos(degrad90*tmp)*kmmax*dampcoef
4522
4523    Tmpv001 =cos(degrad90*tmp)*cos(degrad90*tmp)*kmmvmax
4524    Tmpv002 =Tmpv001*dampcoef
4525    dampkv(i,k,j) =Tmpv002
4526
4527    Tmpv001 =min(dampkv(i,k,j), dampk(i,k,j))
4528    dampkv(i,k,j) =Tmpv001
4529
4530    ENDDO
4531    ENDDO
4532
4533    DO k =kts, ktfm1, 1
4534    DO i =i_end, i_start, -1
4535 !ADDED BY WALLS
4536    ds =min(dx/msftx(i,j), dy/msfty(i,j))
4537    kmmax =ds*ds/dt
4538
4539    kmmvmax =Tmpv302(i,k)
4540    tmp =Tmpv303(i,k)
4541    deltaz(i)=Tmpv304(i,k)
4542    dz =Tmpv301(i,k)
4543
4544    a_Tmpv1 =a_dampkv(i,k,j)
4545    a_dampkv(i,k,j) =0.0
4546    a_dampkv(i,k,j) =a_dampkv(i,k,j)  +(1.0 -sign(1.0, dampkv(i,k,j) -dampk(i,k,j)  &
4547    ))*0.5*1.0*a_Tmpv1
4548    a_dampk(i,k,j) =a_dampk(i,k,j)  +(1.0 +sign(1.0, dampkv(i,k,j) -dampk(i,k,j)))  &
4549    *0.5*1.0*a_Tmpv1
4550    a_Tmpv2 =a_dampkv(i,k,j)
4551    a_dampkv(i,k,j) =0.0
4552    a_Tmpv1 =dampcoef*a_Tmpv2
4553    a_tmp =a_tmp -2.0*cos(degrad90*tmp)*degrad90*sin(degrad90*tmp)*kmmvmax*a_Tmpv1
4554    a_kmmvmax =a_kmmvmax +cos(degrad90*tmp)*cos(degrad90*tmp)*a_Tmpv1
4555    a_tmp =a_tmp -2.0*cos(degrad90*tmp)*degrad90*sin(degrad90*tmp)*kmmax*dampcoef*  &
4556    a_dampk(i,k,j)
4557    a_dampk(i,k,j) =0.0
4558
4559 !  tmp =Tmpv303(i,k)
4560
4561    a_deltaz(i) =a_deltaz(i) +(1.0/zdamp -(1.0/zdamp)*sign(1.0, deltaz(i)  &
4562    /zdamp -1.))*0.5*a_tmp
4563    a_tmp =0.0
4564
4565 !  kmmvmax =Tmpv302(i,k)
4566
4567    a_dz =a_dz +2.0*dz/dt*a_kmmvmax
4568    a_kmmvmax =0.0
4569
4570 !  dz =Tmpv301(i,k)
4571
4572    a_rdzw(i,k,j) =a_rdzw(i,k,j) -1./(rdzw(i,k,j)*rdzw(i,k,j))*a_dz
4573    a_dz =0.0
4574    a_Tmpv1 =a_deltaz(i)
4575    a_deltaz(i) =0.0
4576    a_deltaz(i) =a_deltaz(i) +a_Tmpv1
4577    a_dz =a_dz +a_Tmpv1
4578
4579    dz =Tmpv300(i,k)
4580
4581    a_rdz(i,k,j) =a_rdz(i,k,j) -1./(rdz(i,k,j)*rdz(i,k,j))*a_dz
4582    a_dz =0.0
4583    ENDDO
4584    ENDDO
4585
4586 !ADDED BY WALLS
4587    k =ktf
4588
4589    DO i =i_end, i_start, -1
4590 !ADDED BY WALLS
4591    ds =min(dx/msftx(i,j), dy/msfty(i,j))
4592    kmmax =ds*ds/dt
4593
4594    tmp =Tmpv202(i)
4595    kmmvmax =Tmpv201(i)
4596    dz =Tmpv200(i)
4597
4598 !ADDED BY WALLS
4599    deltaz(i) =0.5*dz
4600
4601    a_Tmpv1 =a_dampkv(i,k,j)
4602    a_dampkv(i,k,j) =0.0
4603    a_dampkv(i,k,j) =a_dampkv(i,k,j)  +(1.0 -sign(1.0, dampkv(i,k,j) -dampk(i,k,j)  &
4604    ))*0.5*1.0*a_Tmpv1
4605    a_dampk(i,k,j) =a_dampk(i,k,j)  +(1.0 +sign(1.0, dampkv(i,k,j) -dampk(i,k,j)))  &
4606    *0.5*1.0*a_Tmpv1
4607    a_Tmpv2 =a_dampkv(i,k,j)
4608    a_dampkv(i,k,j) =0.0
4609    a_Tmpv1 =dampcoef*a_Tmpv2
4610    a_tmp =a_tmp -2.0*cos(degrad90*tmp)*degrad90*sin(degrad90*tmp)*kmmvmax*a_Tmpv1
4611    a_kmmvmax =a_kmmvmax +cos(degrad90*tmp)*cos(degrad90*tmp)*a_Tmpv1
4612    a_tmp =a_tmp -2.0*cos(degrad90*tmp)*degrad90*sin(degrad90*tmp)*kmmax*dampcoef*  &
4613    a_dampk(i,k,j)
4614    a_dampk(i,k,j) =0.0
4615
4616    a_deltaz(i) =a_deltaz(i) +(1.0/zdamp -(1.0/zdamp)*sign(1.0, deltaz(i)  &
4617    /zdamp -1.))*0.5*a_tmp
4618    a_tmp =0.0
4619
4620    a_dz =a_dz +2.0*dz/dt*a_kmmvmax
4621    a_kmmvmax =0.0
4622    a_dz =a_dz +0.5*a_deltaz(i)
4623    a_deltaz(i) =0.0
4624
4625    a_rdzw(i,k,j) =a_rdzw(i,k,j) -1./(rdzw(i,k,j)*rdzw(i,k,j))*a_dz
4626    a_dz =0.0
4627    ENDDO
4628
4629    ENDDO
4630
4631 !LPB[2]
4632 !  kmmax =dx*dx/dt
4633 !  degrad90 =DEGRAD*90.
4634
4635 !LPB[1]
4636
4637 !  IF(config_flags%specified .OR. config_flags%nested) THEN
4638 !  i_start =max(i_start, ids +config_flags%spec_bdy_width -1)
4639 !  i_end =min(i_end, ide -config_flags%spec_bdy_width)
4640 !  j_start =max(j_start, jds +config_flags%spec_bdy_width -1)
4641 !  j_end =min(j_end, jde -config_flags%spec_bdy_width)
4642 !  ENDIF
4643
4644    IF(config_flags%specified .OR. config_flags%nested) THEN
4645
4646    ENDIF
4647
4648 !LPB[0]
4649 !  ktf =min(kte, kde-1)
4650 !  ktfm1 =ktf-1
4651 !  i_start =its
4652 !  i_end =min(ite, ide-1)
4653 !  j_start =jts
4654 !  j_end =min(jte, jde-1)
4655
4656    END SUBROUTINE a_cal_dampkm
4657
4658 !        Generated by TAPENADE     (INRIA, Tropics team)
4659 !  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
4660 !
4661 !  Differentiation of calculate_n2 in reverse (adjoint) mode:
4662 !   gradient     of useful results: p t t8w bn2 theta rdzw rdz
4663 !                moist p8w
4664 !   with respect to varying inputs: p t t8w bn2 theta rdzw rdz
4665 !                moist p8w
4666 !   RW status of diff variables: p:incr t:incr t8w:incr bn2:in-out
4667 !                theta:incr rdzw:incr rdz:incr moist:incr p8w:incr
4668 SUBROUTINE A_CALCULATE_N2(config_flags, bn2, bn2b, moist, moistb, theta&
4669 &  , thetab, t, tb, p, pb, p8w, p8wb, t8w, t8wb, dnw, dn, rdz, rdzb, rdzw&
4670 &  , rdzwb, n_moist, cf1, cf2, cf3, warm_rain, ids, ide, jds, jde, kds, &
4671 &  kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte)
4672   IMPLICIT NONE
4673 ! end of MARTA/WCS change
4674   TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
4675   INTEGER, INTENT(IN) :: n_moist, ids, ide, jds, jde, kds, kde, ims, ime&
4676 &  , jms, jme, kms, kme, its, ite, jts, jte, kts, kte
4677   LOGICAL, INTENT(IN) :: warm_rain
4678   REAL, INTENT(IN) :: cf1, cf2, cf3
4679   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: bn2
4680   REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: bn2b
4681   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rdz, rdzw, &
4682 &  theta, t, p, p8w, t8w
4683   REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rdzb, rdzwb, thetab, tb&
4684 &  , pb, p8wb, t8wb
4685   REAL, DIMENSION(kms:kme), INTENT(IN) :: dnw, dn
4686   REAL, DIMENSION(ims:ime, kms:kme, jms:jme, n_moist), INTENT(INOUT) :: &
4687 &  moist
4688   REAL, DIMENSION(ims:ime, kms:kme, jms:jme, n_moist) :: moistb
4689 ! Local variables.
4690   INTEGER :: i, j, k, ktf, ispe, ktes1, ktes2, i_start, i_end, j_start, &
4691 &  j_end
4692   REAL :: coefa, thetaep1, thetaem1, qc_cr, es, tc, qlpqi, qsw, qsi, &
4693 &  tmpdz, xlvqv, thetaesfc, thetasfc, qvtop, qvsfc, thetatop, thetaetop
4694   REAL :: coefab, thetaep1b, thetaem1b, esb, tcb, tmpdzb, xlvqvb, &
4695 &  thetaesfcb, thetasfcb, qvsfcb
4696   REAL, DIMENSION(its:ite, jts:jte) :: tmp1sfc, tmp1top
4697   REAL, DIMENSION(its:ite, jts:jte) :: tmp1sfcb
4698   REAL, DIMENSION(its:ite, kts:kte, jts:jte) :: tmp1, qvs, qctmp
4699   REAL, DIMENSION(its:ite, kts:kte, jts:jte) :: tmp1b, qvsb
4700   INTEGER :: branch
4701   REAL :: temp3
4702   REAL :: temp2
4703   REAL :: temp1
4704   REAL :: temp0
4705   REAL :: temp7b
4706   REAL :: temp21b
4707   REAL :: temp22
4708   REAL :: temp9b0
4709   REAL :: temp21
4710   REAL :: temp20
4711   REAL :: temp0b
4712   REAL :: temp19
4713   REAL :: temp18
4714   REAL :: temp17
4715   REAL :: temp16
4716   REAL :: temp15
4717   REAL :: temp20b
4718   REAL :: temp14
4719   REAL :: temp13
4720   REAL :: temp12
4721   REAL :: temp11
4722   REAL :: temp10
4723   REAL :: temp15b
4724   REAL :: temp9b
4725   REAL :: temp21b0
4726   REAL :: temp18b
4727   REAL :: tempb
4728   REAL :: temp14b0
4729   REAL :: temp0b0
4730   REAL :: temp2b
4731   REAL :: temp5b
4732   REAL :: temp14b
4733   REAL :: temp22b
4734   REAL :: temp22b4
4735   REAL :: temp22b3
4736   REAL :: temp22b2
4737   REAL :: temp22b1
4738   REAL :: temp22b0
4739   REAL :: temp1b
4740   REAL :: temp
4741   REAL :: temp9
4742   REAL :: temp10b4
4743   REAL :: temp8
4744   REAL :: temp10b3
4745   REAL :: temp7
4746   REAL :: temp10b
4747   REAL :: temp1b0
4748   REAL :: temp10b2
4749   REAL :: temp6
4750   REAL :: temp10b1
4751   REAL :: temp5
4752   REAL :: temp10b0
4753   REAL :: temp4
4754 ! End declarations.
4755 !-----------------------------------------------------------------------
4756 ! in Kg/Kg
4757   qc_cr = 0.00001
4758   IF (kte .GT. kde - 1) THEN
4759     ktf = kde - 1
4760   ELSE
4761     ktf = kte
4762   END IF
4763   i_start = its
4764   IF (ite .GT. ide - 1) THEN
4765     i_end = ide - 1
4766   ELSE
4767     i_end = ite
4768   END IF
4769   j_start = jts
4770   IF (jte .GT. jde - 1) THEN
4771     j_end = jde - 1
4772   ELSE
4773     j_end = jte
4774   END IF
4775   IF ((config_flags%open_xs .OR. config_flags%specified) .OR. &
4776 &      config_flags%nested) THEN
4777     IF (ids + 1 .LT. its) THEN
4778       i_start = its
4779     ELSE
4780       i_start = ids + 1
4781     END IF
4782   END IF
4783   IF ((config_flags%open_xe .OR. config_flags%specified) .OR. &
4784 &      config_flags%nested) THEN
4785     IF (ide - 2 .GT. ite) THEN
4786       i_end = ite
4787     ELSE
4788       i_end = ide - 2
4789     END IF
4790   END IF
4791   IF ((config_flags%open_ys .OR. config_flags%specified) .OR. &
4792 &      config_flags%nested) THEN
4793     IF (jds + 1 .LT. jts) THEN
4794       j_start = jts
4795     ELSE
4796       j_start = jds + 1
4797     END IF
4798   END IF
4799   IF ((config_flags%open_ye .OR. config_flags%specified) .OR. &
4800 &      config_flags%nested) THEN
4801     IF (jde - 2 .GT. jte) THEN
4802       j_end = jte
4803     ELSE
4804       j_end = jde - 2
4805     END IF
4806   END IF
4807   IF (config_flags%periodic_x) i_start = its
4808   IF (config_flags%periodic_x) THEN
4809     IF (ite .GT. ide - 1) THEN
4810       i_end = ide - 1
4811     ELSE
4812       i_end = ite
4813     END IF
4814   END IF
4815   IF (p_qc .GT. param_first_scalar) THEN
4816     DO j=j_start,j_end
4817       DO k=kts,ktf
4818         DO i=i_start,i_end
4819           qctmp(i, k, j) = moist(i, k, j, p_qc)
4820         END DO
4821       END DO
4822     END DO
4823   ELSE
4824     DO j=j_start,j_end
4825       DO k=kts,ktf
4826         DO i=i_start,i_end
4827           qctmp(i, k, j) = 0.0
4828         END DO
4829       END DO
4830     END DO
4831   END IF
4832   DO j=jts,jte
4833     DO k=kts,kte
4834       DO i=its,ite
4835         tmp1(i, k, j) = 0.0
4836       END DO
4837     END DO
4838   END DO
4839   DO j=jts,jte
4840     DO i=its,ite
4841       tmp1sfc(i, j) = 0.0
4842     END DO
4843   END DO
4844   DO ispe=param_first_scalar,n_moist
4845     IF ((ispe .EQ. p_qv .OR. ispe .EQ. p_qc) .OR. ispe .EQ. p_qi) THEN
4846       DO j=j_start,j_end
4847         DO k=kts,ktf
4848           DO i=i_start,i_end
4849             tmp1(i, k, j) = tmp1(i, k, j) + moist(i, k, j, ispe)
4850           END DO
4851         END DO
4852       END DO
4853       DO j=j_start,j_end
4854         DO i=i_start,i_end
4855           tmp1sfc(i, j) = tmp1sfc(i, j) + cf1*moist(i, 1, j, ispe) + cf2&
4856 &            *moist(i, 2, j, ispe) + cf3*moist(i, 3, j, ispe)
4857         END DO
4858       END DO
4859       CALL PUSHCONTROL1B(1)
4860     ELSE
4861       CALL PUSHCONTROL1B(0)
4862     END IF
4863   END DO
4864 ! Calculate saturation mixing ratio.
4865   DO j=j_start,j_end
4866     DO k=kts,ktf
4867       DO i=i_start,i_end
4868         tc = t(i, k, j) - svpt0
4869         CALL PUSHREAL8(es)
4870         es = 1000.0*svp1*EXP(svp2*tc/(t(i, k, j)-svp3))
4871         qvs(i, k, j) = ep_2*es/(p(i, k, j)-es)
4872       END DO
4873     END DO
4874   END DO
4875   DO j=j_start,j_end
4876     DO k=kts+1,ktf-1
4877       DO i=i_start,i_end
4878         IF (moist(i, k, j, p_qv) .GE. qvs(i, k, j) .OR. qctmp(i, k, j) &
4879 &            .GE. qc_cr) THEN
4880           xlvqv = xlv*moist(i, k, j, p_qv)
4881           CALL PUSHREAL8(coefa)
4882           coefa = (1.0+xlvqv/r_d/t(i, k, j))/(1.0+xlv*xlvqv/cp/r_v/t(i, &
4883 &            k, j)/t(i, k, j))/theta(i, k, j)
4884           CALL PUSHREAL8(thetaep1)
4885           thetaep1 = theta(i, k+1, j)*(1.0+xlv*qvs(i, k+1, j)/cp/t(i, k+&
4886 &            1, j))
4887           CALL PUSHREAL8(thetaem1)
4888           thetaem1 = theta(i, k-1, j)*(1.0+xlv*qvs(i, k-1, j)/cp/t(i, k-&
4889 &            1, j))
4890           CALL PUSHCONTROL1B(1)
4891         ELSE
4892           CALL PUSHCONTROL1B(0)
4893         END IF
4894       END DO
4895     END DO
4896   END DO
4897   k = kts
4898   DO j=j_start,j_end
4899     DO i=i_start,i_end
4900       tmpdz = 1.0/rdz(i, k+1, j) + 0.5/rdzw(i, k, j)
4901       thetasfc = t8w(i, kts, j)/(p8w(i, k, j)/p1000mb)**(r_d/cp)
4902       IF (moist(i, k, j, p_qv) .GE. qvs(i, k, j) .OR. qctmp(i, k, j) &
4903 &          .GE. qc_cr) THEN
4904         CALL PUSHREAL8(qvsfc)
4905         xlvqv = xlv*moist(i, k, j, p_qv)
4906         CALL PUSHREAL8(coefa)
4907         coefa = (1.0+xlvqv/r_d/t(i, k, j))/(1.0+xlv*xlvqv/cp/r_v/t(i, k&
4908 &          , j)/t(i, k, j))/theta(i, k, j)
4909         CALL PUSHREAL8(thetaep1)
4910         thetaep1 = theta(i, k+1, j)*(1.0+xlv*qvs(i, k+1, j)/cp/t(i, k+1&
4911 &          , j))
4912         CALL PUSHCONTROL1B(1)
4913       ELSE
4914         CALL PUSHREAL8(qvsfc)
4915         qvsfc = cf1*moist(i, 1, j, p_qv) + cf2*moist(i, 2, j, p_qv) + &
4916 &          cf3*moist(i, 3, j, p_qv)
4917 !        BN2(i,k,j) = g * ( ( theta(i,k+1,j) - thetasfc ) /  &
4918 !                     theta(i,k,j) / tmpdz +  &
4919 !                     1.61 * ( moist(i,k+1,j,P_QV) - qvsfc ) /  &
4920 !                     tmpdz -  &
4921 !                     ( tmp1(i,k+1,j) - tmp1sfc(i,j) ) / tmpdz  )
4922 !...... MARTA: change in computation of BN2 at the surface, WCS 040331
4923 ! controlare come calcola rdzw
4924 ! end of MARTA/WCS change
4925         CALL PUSHCONTROL1B(0)
4926       END IF
4927     END DO
4928   END DO
4929   DO j=j_end,j_start,-1
4930     DO i=i_end,i_start,-1
4931       bn2b(i, ktf-1, j) = bn2b(i, ktf-1, j) + bn2b(i, ktf, j)
4932       bn2b(i, ktf, j) = 0.0
4933     END DO
4934   END DO
4935   tmp1b = 0.0
4936   tmp1sfcb = 0.0
4937   qvsb = 0.0
4938   DO j=j_end,j_start,-1
4939     DO i=i_end,i_start,-1
4940       CALL POPCONTROL1B(branch)
4941       IF (branch .EQ. 0) THEN
4942         tmpdz = 1./rdzw(i, k, j)
4943         temp22 = theta(i, k, j)
4944         temp22b0 = g*bn2b(i, k, j)
4945         temp22b1 = temp22b0/(temp22*tmpdz)
4946         temp22b2 = -((theta(i, k+1, j)-theta(i, k, j))*temp22b1/(temp22*&
4947 &          tmpdz))
4948         temp22b3 = 1.61*temp22b0/tmpdz
4949         temp22b4 = -(temp22b0/tmpdz)
4950         thetab(i, k+1, j) = thetab(i, k+1, j) + temp22b1
4951         thetab(i, k, j) = thetab(i, k, j) + tmpdz*temp22b2 - temp22b1
4952         tmpdzb = temp22*temp22b2 - (moist(i, k+1, j, p_qv)-qvsfc)*&
4953 &          temp22b3/tmpdz - (tmp1(i, k+1, j)-tmp1sfc(i, j))*temp22b4/&
4954 &          tmpdz
4955         moistb(i, k+1, j, p_qv) = moistb(i, k+1, j, p_qv) + temp22b3
4956         qvsfcb = -temp22b3
4957         tmp1b(i, k+1, j) = tmp1b(i, k+1, j) + temp22b4
4958         tmp1sfcb(i, j) = tmp1sfcb(i, j) - temp22b4
4959         bn2b(i, k, j) = 0.0
4960         rdzwb(i, k, j) = rdzwb(i, k, j) - tmpdzb/rdzw(i, k, j)**2
4961         CALL POPREAL8(qvsfc)
4962         moistb(i, 1, j, p_qv) = moistb(i, 1, j, p_qv) + cf1*qvsfcb
4963         moistb(i, 2, j, p_qv) = moistb(i, 2, j, p_qv) + cf2*qvsfcb
4964         moistb(i, 3, j, p_qv) = moistb(i, 3, j, p_qv) + cf3*qvsfcb
4965         tmpdzb = 0.0
4966         thetasfcb = 0.0
4967       ELSE
4968         tmpdz = 1.0/rdz(i, k+1, j) + 0.5/rdzw(i, k, j)
4969         thetasfc = t8w(i, kts, j)/(p8w(i, k, j)/p1000mb)**(r_d/cp)
4970         qvsfc = cf1*qvs(i, 1, j) + cf2*qvs(i, 2, j) + cf3*qvs(i, 3, j)
4971         thetaesfc = thetasfc*(1.0+xlv*qvsfc/cp/t8w(i, kts, j))
4972         temp21 = coefa/tmpdz
4973         temp21b = g*bn2b(i, k, j)
4974         temp21b0 = (thetaep1-thetaesfc)*temp21b/tmpdz
4975         temp22b = -(temp21b/tmpdz)
4976         thetaep1b = temp21*temp21b
4977         thetaesfcb = -(temp21*temp21b)
4978         coefab = temp21b0
4979         tmpdzb = -((tmp1(i, k+1, j)-tmp1sfc(i, j))*temp22b/tmpdz) - &
4980 &          temp21*temp21b0
4981         tmp1b(i, k+1, j) = tmp1b(i, k+1, j) + temp22b
4982         tmp1sfcb(i, j) = tmp1sfcb(i, j) - temp22b
4983         bn2b(i, k, j) = 0.0
4984         temp20 = cp*t8w(i, kts, j)
4985         temp20b = xlv*thetasfc*thetaesfcb/temp20
4986         thetasfcb = (xlv*(qvsfc/temp20)+1.0)*thetaesfcb
4987         qvsfcb = temp20b
4988         t8wb(i, kts, j) = t8wb(i, kts, j) - qvsfc*cp*temp20b/temp20
4989         CALL POPREAL8(thetaep1)
4990         temp19 = cp*t(i, k+1, j)
4991         temp18 = qvs(i, k+1, j)/temp19
4992         temp18b = xlv*theta(i, k+1, j)*thetaep1b/temp19
4993         thetab(i, k+1, j) = thetab(i, k+1, j) + (xlv*temp18+1.0)*&
4994 &          thetaep1b
4995         qvsb(i, k+1, j) = qvsb(i, k+1, j) + temp18b
4996         tb(i, k+1, j) = tb(i, k+1, j) - temp18*cp*temp18b
4997         xlvqv = xlv*moist(i, k, j, p_qv)
4998         CALL POPREAL8(coefa)
4999         temp17 = cp*r_v*t(i, k, j)**2
5000         temp15 = xlvqv/temp17
5001         temp14 = (xlv*temp15+1.0)*theta(i, k, j)
5002         temp14b = coefab/temp14
5003         temp16 = r_d*t(i, k, j)
5004         temp14b0 = -((xlvqv/temp16+1.0)*temp14b/temp14)
5005         temp15b = xlv*theta(i, k, j)*temp14b0/temp17
5006         xlvqvb = temp15b + temp14b/temp16
5007         tb(i, k, j) = tb(i, k, j) - cp*r_v*temp15*2*t(i, k, j)*temp15b -&
5008 &          xlvqv*r_d*temp14b/temp16**2
5009         thetab(i, k, j) = thetab(i, k, j) + (xlv*temp15+1.0)*temp14b0
5010         moistb(i, k, j, p_qv) = moistb(i, k, j, p_qv) + xlv*xlvqvb
5011         CALL POPREAL8(qvsfc)
5012         qvsb(i, 1, j) = qvsb(i, 1, j) + cf1*qvsfcb
5013         qvsb(i, 2, j) = qvsb(i, 2, j) + cf2*qvsfcb
5014         qvsb(i, 3, j) = qvsb(i, 3, j) + cf3*qvsfcb
5015       END IF
5016       temp13 = r_d/cp
5017       temp12 = p8w(i, k, j)/p1000mb
5018       temp11 = temp12**temp13
5019       t8wb(i, kts, j) = t8wb(i, kts, j) + thetasfcb/temp11
5020       IF (.NOT.(temp12 .LE. 0.0 .AND. (temp13 .EQ. 0.0 .OR. temp13 .NE. &
5021 &          INT(temp13)))) p8wb(i, k, j) = p8wb(i, k, j) - temp13*temp12**&
5022 &          (temp13-1)*t8w(i, kts, j)*thetasfcb/(temp11**2*p1000mb)
5023       rdzb(i, k+1, j) = rdzb(i, k+1, j) - tmpdzb/rdz(i, k+1, j)**2
5024       rdzwb(i, k, j) = rdzwb(i, k, j) - 0.5*tmpdzb/rdzw(i, k, j)**2
5025     END DO
5026   END DO
5027   DO j=j_end,j_start,-1
5028     DO k=ktf-1,kts+1,-1
5029       DO i=i_end,i_start,-1
5030         CALL POPCONTROL1B(branch)
5031         IF (branch .EQ. 0) THEN
5032           tmpdz = 1.0/rdz(i, k, j) + 1.0/rdz(i, k+1, j)
5033           temp10 = theta(i, k, j)
5034           temp10b0 = g*bn2b(i, k, j)
5035           temp10b1 = temp10b0/(temp10*tmpdz)
5036           temp10b2 = -((theta(i, k+1, j)-theta(i, k-1, j))*temp10b1/(&
5037 &            temp10*tmpdz))
5038           temp10b3 = 1.61*temp10b0/tmpdz
5039           temp10b4 = -(temp10b0/tmpdz)
5040           thetab(i, k+1, j) = thetab(i, k+1, j) + temp10b1
5041           thetab(i, k-1, j) = thetab(i, k-1, j) - temp10b1
5042           thetab(i, k, j) = thetab(i, k, j) + tmpdz*temp10b2
5043           tmpdzb = temp10*temp10b2 - (moist(i, k+1, j, p_qv)-moist(i, k-&
5044 &            1, j, p_qv))*temp10b3/tmpdz - (tmp1(i, k+1, j)-tmp1(i, k-1, &
5045 &            j))*temp10b4/tmpdz
5046           moistb(i, k+1, j, p_qv) = moistb(i, k+1, j, p_qv) + temp10b3
5047           moistb(i, k-1, j, p_qv) = moistb(i, k-1, j, p_qv) - temp10b3
5048           tmp1b(i, k+1, j) = tmp1b(i, k+1, j) + temp10b4
5049           tmp1b(i, k-1, j) = tmp1b(i, k-1, j) - temp10b4
5050           bn2b(i, k, j) = 0.0
5051         ELSE
5052           tmpdz = 1.0/rdz(i, k, j) + 1.0/rdz(i, k+1, j)
5053           temp9 = coefa/tmpdz
5054           temp9b = g*bn2b(i, k, j)
5055           temp9b0 = (thetaep1-thetaem1)*temp9b/tmpdz
5056           temp10b = -(temp9b/tmpdz)
5057           thetaep1b = temp9*temp9b
5058           thetaem1b = -(temp9*temp9b)
5059           coefab = temp9b0
5060           tmpdzb = -((tmp1(i, k+1, j)-tmp1(i, k-1, j))*temp10b/tmpdz) - &
5061 &            temp9*temp9b0
5062           tmp1b(i, k+1, j) = tmp1b(i, k+1, j) + temp10b
5063           tmp1b(i, k-1, j) = tmp1b(i, k-1, j) - temp10b
5064           bn2b(i, k, j) = 0.0
5065           CALL POPREAL8(thetaem1)
5066           temp8 = cp*t(i, k-1, j)
5067           temp7 = qvs(i, k-1, j)/temp8
5068           temp7b = xlv*theta(i, k-1, j)*thetaem1b/temp8
5069           thetab(i, k-1, j) = thetab(i, k-1, j) + (xlv*temp7+1.0)*&
5070 &            thetaem1b
5071           qvsb(i, k-1, j) = qvsb(i, k-1, j) + temp7b
5072           tb(i, k-1, j) = tb(i, k-1, j) - temp7*cp*temp7b
5073           CALL POPREAL8(thetaep1)
5074           temp6 = cp*t(i, k+1, j)
5075           temp5 = qvs(i, k+1, j)/temp6
5076           temp5b = xlv*theta(i, k+1, j)*thetaep1b/temp6
5077           thetab(i, k+1, j) = thetab(i, k+1, j) + (xlv*temp5+1.0)*&
5078 &            thetaep1b
5079           qvsb(i, k+1, j) = qvsb(i, k+1, j) + temp5b
5080           tb(i, k+1, j) = tb(i, k+1, j) - temp5*cp*temp5b
5081           xlvqv = xlv*moist(i, k, j, p_qv)
5082           CALL POPREAL8(coefa)
5083           temp4 = cp*r_v*t(i, k, j)**2
5084           temp2 = xlvqv/temp4
5085           temp1 = (xlv*temp2+1.0)*theta(i, k, j)
5086           temp1b = coefab/temp1
5087           temp3 = r_d*t(i, k, j)
5088           temp1b0 = -((xlvqv/temp3+1.0)*temp1b/temp1)
5089           temp2b = xlv*theta(i, k, j)*temp1b0/temp4
5090           xlvqvb = temp2b + temp1b/temp3
5091           tb(i, k, j) = tb(i, k, j) - cp*r_v*temp2*2*t(i, k, j)*temp2b -&
5092 &            xlvqv*r_d*temp1b/temp3**2
5093           thetab(i, k, j) = thetab(i, k, j) + (xlv*temp2+1.0)*temp1b0
5094           moistb(i, k, j, p_qv) = moistb(i, k, j, p_qv) + xlv*xlvqvb
5095         END IF
5096         rdzb(i, k, j) = rdzb(i, k, j) - tmpdzb/rdz(i, k, j)**2
5097         rdzb(i, k+1, j) = rdzb(i, k+1, j) - tmpdzb/rdz(i, k+1, j)**2
5098       END DO
5099     END DO
5100   END DO
5101   DO j=j_end,j_start,-1
5102     DO k=ktf,kts,-1
5103       DO i=i_end,i_start,-1
5104         temp0 = p(i, k, j) - es
5105         temp0b = ep_2*qvsb(i, k, j)/temp0
5106         temp0b0 = -(es*temp0b/temp0)
5107         esb = temp0b - temp0b0
5108         pb(i, k, j) = pb(i, k, j) + temp0b0
5109         qvsb(i, k, j) = 0.0
5110         tc = t(i, k, j) - svpt0
5111         CALL POPREAL8(es)
5112         temp = t(i, k, j) - svp3
5113         tempb = svp2*EXP(svp2*(tc/temp))*svp1*1000.0*esb/temp
5114         tcb = tempb
5115         tb(i, k, j) = tb(i, k, j) + tcb - tc*tempb/temp
5116       END DO
5117     END DO
5118   END DO
5119   DO ispe=n_moist,param_first_scalar,-1
5120     CALL POPCONTROL1B(branch)
5121     IF (branch .NE. 0) THEN
5122       DO j=j_end,j_start,-1
5123         DO i=i_end,i_start,-1
5124           moistb(i, 1, j, ispe) = moistb(i, 1, j, ispe) + cf1*tmp1sfcb(i&
5125 &            , j)
5126           moistb(i, 2, j, ispe) = moistb(i, 2, j, ispe) + cf2*tmp1sfcb(i&
5127 &            , j)
5128           moistb(i, 3, j, ispe) = moistb(i, 3, j, ispe) + cf3*tmp1sfcb(i&
5129 &            , j)
5130         END DO
5131       END DO
5132       DO j=j_end,j_start,-1
5133         DO k=ktf,kts,-1
5134           DO i=i_end,i_start,-1
5135             moistb(i, k, j, ispe) = moistb(i, k, j, ispe) + tmp1b(i, k, &
5136 &              j)
5137           END DO
5138         END DO
5139       END DO
5140     END IF
5141   END DO
5142 END SUBROUTINE A_CALCULATE_N2
5143
5144    SUBROUTINE a_isotropic_km(config_flags,xkmh,a_xkmh,xkmv,a_xkmv,xkhh,a_xkhh, &
5145    xkhv,a_xkhv,khdif,kvdif,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite, &
5146    jts,jte,kts,kte)
5147
5148 !PART I: DECLARATION OF VARIABLES
5149
5150    IMPLICIT NONE
5151
5152    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
5153    TYPE(grid_config_rec_type) :: config_flags
5154    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
5155    REAL :: khdif,kvdif
5156    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: xkmh,a_xkmh,xkmv,a_xkmv,xkhh,a_xkhh, &
5157    xkhv,a_xkhv
5158    INTEGER :: i_start,i_end,j_start,j_end,ktf,i,j,k
5159    REAL :: khdif3,kvdif3
5160
5161 !PART II: CALCULATIONS OF B. S. TRAJECTORY
5162
5163 !ADDED BY WALLS
5164    ktf = kte
5165
5166    i_start = its
5167    i_end   = MIN(ite,ide-1)
5168    j_start = jts
5169    j_end   = MIN(jte,jde-1)
5170
5171 !  khdif3=khdif*3.
5172 !  kvdif3=kvdif*3.
5173    khdif3=khdif/prandtl
5174    kvdif3=kvdif/prandtl
5175
5176 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
5177
5178 !LPB[1]
5179    DO j =j_end, j_start, -1
5180
5181 !  DO k =kts, ktf
5182 !  DO i =i_start, i_end
5183 !  xkmh(i,k,j) =khdif
5184
5185 !  xkmv(i,k,j) =kvdif
5186
5187 !  xkhh(i,k,j) =khdif3
5188
5189 !  xkhv(i,k,j) =kvdif3
5190
5191 !  ENDDO
5192 !  ENDDO
5193
5194    DO k =ktf, kts, -1
5195    DO i =i_end, i_start, -1
5196    a_xkhv(i,k,j) =0.0
5197    a_xkhh(i,k,j) =0.0
5198    a_xkmv(i,k,j) =0.0
5199    a_xkmh(i,k,j) =0.0
5200    ENDDO
5201    ENDDO
5202
5203    ENDDO
5204
5205 !LPB[0]
5206 !  ktf =kte
5207 !  i_start =its
5208 !  i_end =min(ite, ide-1)
5209 !  j_start =jts
5210 !  j_end =min(jte, jde-1)
5211 !  khdif3 =khdif/prandtl
5212 !  kvdif3 =kvdif/prandtl
5213
5214    END SUBROUTINE a_isotropic_km
5215
5216    SUBROUTINE a_smag_km(config_flags,xkmh,a_xkmh,xkmv,a_xkmv,xkhh,a_xkhh,xkhv, &
5217    a_xkhv,BN2,a_BN2,div,a_div,defor11,a_defor11,defor22,a_defor22,defor33, &
5218    a_defor33,defor12,a_defor12,defor13,a_defor13,defor23,a_defor23,rdzw, &
5219    a_rdzw,dx,dy,dt,isotropic,mix_upper_bound,msftx,msfty,ids,ide,jds,jde,kds,kde,ims, &
5220    ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
5221
5222 !PART I: DECLARATION OF VARIABLES
5223
5224    IMPLICIT NONE
5225
5226    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
5227    TYPE(grid_config_rec_type) :: config_flags
5228    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
5229    INTEGER :: isotropic
5230    REAL :: dx,dy,dt,mix_upper_bound
5231    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: BN2,a_BN2,rdzw,a_rdzw
5232    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: xkmh,a_xkmh,xkmv,a_xkmv,xkhh,a_xkhh, &
5233    xkhv,a_xkhv
5234    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor11,a_defor11,defor22,a_defor22, &
5235    defor33,a_defor33,defor12,a_defor12,defor13,a_defor13,defor23,a_defor23,div,a_div
5236    REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty
5237    INTEGER :: i_start,i_end,j_start,j_end,ktf,i,j,k
5238    REAL :: deltas,a_deltas,tmp,a_tmp,pr,a_pr,mlen_h,a_mlen_h,mlen_v,a_mlen_v, &
5239    c_s,a_c_s
5240    REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: def2,a_def2
5241
5242    REAL,DIMENSION(max(jds+1,jts):min(jde-2,jte)) :: Keep_Lpb15_tmp
5243    REAL,DIMENSION(max(jds+1,jts):min(jde-2,jte)) :: Keep_Lpb16_tmp
5244 !  REAL,DIMENSION(1) :: Keep_Lpb18_tmp
5245    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004
5246    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv300
5247    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5248     :: Tmpv400
5249    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5250     :: Tmpv401
5251    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5252     :: Tmpv402
5253    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5254     :: Tmpv403
5255    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5256     :: Tmpv404
5257    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5258     :: Tmpv405
5259    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5260     :: Tmpv406
5261    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5262     :: Tmpv407
5263    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5264     :: Tmpv408
5265    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5266     :: Tmpv409
5267    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5268     :: Tmpv4010
5269    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5270     :: Tmpv4011
5271    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5272     :: Tmpv4012
5273    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5274     :: Tmpv4013
5275    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5276     :: Tmpv4014
5277    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5278     :: Tmpv4015
5279    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5280     :: Tmpv4016
5281    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5282     :: Tmpv4017
5283    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5284     :: Tmpv4018
5285    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5286     :: Tmpv4019
5287    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5288     :: Tmpv4020
5289    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5290     :: Tmpv4021
5291    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5292     :: Tmpv4022
5293    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5294     :: Tmpv4023
5295    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5296     :: Tmpv4024
5297    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5298     :: Tmpv4025
5299    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5300     :: Tmpv4026
5301    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5302     :: Tmpv4027
5303    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)) &
5304     :: Tmpv4028
5305
5306 !PART II: CALCULATIONS OF B. S. TRAJECTORY
5307
5308 !LPB[0]
5309       ktf = min(kte,kde-1)
5310       i_start = its
5311       i_end   = MIN(ite,ide-1)
5312       j_start = jts
5313       j_end   = MIN(jte,jde-1)
5314
5315 !LPB[1]
5316    IF ( config_flags%open_xs .or. config_flags%specified .or.   &
5317         config_flags%nested) i_start = MAX(ids+1,its)
5318
5319 !LPB[2]
5320
5321 !LPB[3]
5322    IF ( config_flags%open_xe .or. config_flags%specified .or.   &
5323         config_flags%nested) i_end   = MIN(ide-2,ite)
5324
5325 !LPB[4]
5326
5327 !LPB[5]
5328    IF ( config_flags%open_ys .or. config_flags%specified .or.   &
5329         config_flags%nested) j_start = MAX(jds+1,jts)
5330
5331 !LPB[6]
5332
5333 !LPB[7]
5334    IF ( config_flags%open_ye .or. config_flags%specified .or.   &
5335         config_flags%nested) j_end   = MIN(jde-2,jte)
5336
5337 !LPB[8]
5338
5339 !LPB[9]
5340       IF ( config_flags%periodic_x ) i_start = its
5341
5342 !LPB[10]
5343
5344 !LPB[11]
5345       IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
5346
5347 !LPB[12]
5348       pr = prandtl
5349       c_s = config_flags%c_s
5350
5351 !LPB[13]
5352       do j=j_start,j_end
5353
5354       do k=kts,ktf
5355       do i=i_start,i_end
5356          def2(i,k,j)=0.5*(defor11(i,k,j)*defor11(i,k,j) +   &
5357                           defor22(i,k,j)*defor22(i,k,j) +   &
5358                           defor33(i,k,j)*defor33(i,k,j))
5359       enddo
5360       enddo
5361
5362       enddo
5363
5364 !LPB[14]
5365       do j=j_start,j_end
5366
5367       do k=kts,ktf
5368       do i=i_start,i_end
5369          tmp=0.25*(defor12(i  ,k,j)+defor12(i  ,k,j+1)+   &
5370                    defor12(i+1,k,j)+defor12(i+1,k,j+1))
5371          def2(i,k,j)=def2(i,k,j)+tmp*tmp
5372       enddo
5373       enddo
5374
5375       enddo
5376
5377 !LPB[15]
5378       do j=j_start,j_end
5379
5380        Keep_Lpb15_tmp(j) =tmp
5381
5382       do k=kts,ktf
5383       do i=i_start,i_end
5384          tmp=0.25*(defor13(i  ,k+1,j)+defor13(i  ,k,j)+   &
5385                    defor13(i+1,k+1,j)+defor13(i+1,k,j))
5386          def2(i,k,j)=def2(i,k,j)+tmp*tmp
5387       enddo
5388       enddo
5389
5390       enddo
5391
5392 !LPB[16]
5393       do j=j_start,j_end
5394
5395        Keep_Lpb16_tmp(j) =tmp
5396
5397       do k=kts,ktf
5398       do i=i_start,i_end
5399          tmp=0.25*(defor23(i,k+1,j  )+defor23(i,k,j  )+   &
5400                    defor23(i,k+1,j+1)+defor23(i,k,j+1))
5401          def2(i,k,j)=def2(i,k,j)+tmp*tmp
5402       enddo
5403       enddo
5404
5405       enddo
5406
5407 !LPB[17]
5408
5409 !!LPB[18]
5410 !    !  Keep_Lpb18_tmp =tmp
5411
5412 !   IF (isotropic .EQ. 0) THEN
5413
5414 !         DO j = j_start, j_end
5415 !         DO k = kts, ktf
5416 !         DO i = i_start, i_end
5417 !            mlen_h=sqrt(dx/msftx(i,j) * dy/msfty(i,j))
5418 !            mlen_v= 1./rdzw(i,k,j)
5419 !            tmp=max(0.,def2(i,k,j)-BN2(i,k,j)/pr)
5420 !            tmp=tmp**0.5
5421 !            xkmh(i,k,j)=max(c_s*c_s*mlen_h*mlen_h*tmp, 1.0E-6*mlen_h*mlen_h )
5422 !            xkmh(i,k,j)=min(xkmh(i,k,j), mix_upper_bound * mlen_h * mlen_h / dt )
5423 !            xkmv(i,k,j)=max(c_s*c_s*mlen_v*mlen_v*tmp, 1.0E-6*mlen_v*mlen_v )
5424 !            xkmv(i,k,j)=min(xkmv(i,k,j), mix_upper_bound * mlen_v * mlen_v / dt )
5425 !            xkhh(i,k,j)=xkmh(i,k,j)/pr
5426 !            xkhh(i,k,j)=min(xkhh(i,k,j), mix_upper_bound * mlen_h * mlen_h / dt )
5427 !            xkhv(i,k,j)=xkmv(i,k,j)/pr
5428 !            xkhv(i,k,j)=min(xkhv(i,k,j), mix_upper_bound * mlen_v * mlen_v / dt )
5429 !         ENDDO
5430 !         ENDDO
5431 !         ENDDO
5432 !      ELSE
5433
5434 !         DO j = j_start, j_end
5435 !         DO k = kts, ktf
5436 !         DO i = i_start, i_end
5437 !            deltas=(dx/msftx(i,j) * dy/msfty(i,j)/rdzw(i,k,j))**0.33333333
5438 !            tmp=max(0.,def2(i,k,j)-BN2(i,k,j)/pr)
5439 !            tmp=tmp**0.5
5440 !            xkmh(i,k,j)=max(c_s*c_s*deltas*deltas*tmp, 1.0E-6*deltas*deltas )
5441 !            xkmh(i,k,j)=min(xkmh(i,k,j), mix_upper_bound * dx/msftx(i,j) * dy/msfty(i,j) / dt )
5442 !            xkmv(i,k,j)=xkmh(i,k,j)
5443 !            xkmv(i,k,j)=min(xkmv(i,k,j), mix_upper_bound / rdzw(i,k,j) / rdzw(i,k,j) / dt )
5444 !            xkhh(i,k,j)=xkmh(i,k,j)/pr
5445 !            xkhh(i,k,j)=min(xkhh(i,k,j), mix_upper_bound * dx/msftx(i,j) * dy/msfty(i,j) / dt )
5446 !            xkhv(i,k,j)=xkmv(i,k,j)/pr
5447 !            xkhv(i,k,j)=min(xkhv(i,k,j), mix_upper_bound / rdzw(i,k,j) / rdzw(i,k,j) / dt )
5448 !         ENDDO
5449 !         ENDDO
5450 !         ENDDO
5451
5452 !   ENDIF
5453
5454 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
5455
5456    a_deltas =0.0
5457    a_tmp =0.0
5458    a_pr =0.0
5459    a_mlen_h =0.0
5460    a_mlen_v =0.0
5461    a_c_s =0.0
5462
5463    Do K2_ADJ =jts, jte
5464    Do K1_ADJ =kts, kte
5465    Do K0_ADJ =its, ite
5466    a_def2(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
5467    End Do
5468    End Do
5469    End Do
5470
5471 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
5472
5473 !LPB[18]
5474 !  tmp =Keep_Lpb18_tmp
5475
5476    IF(isotropic .EQ. 0) THEN
5477    DO j =j_start, j_end
5478    DO k =kts, ktf
5479    DO i =i_start, i_end
5480    mlen_h =sqrt(dx/msftx(i,j)*dy/msfty(i,j))
5481    Tmpv400(i,k,j) =mlen_h
5482
5483    mlen_v =1./rdzw(i,k,j)
5484    Tmpv401(i,k,j) =mlen_v
5485
5486    Tmpv001 =BN2(i,k,j)/pr
5487    Tmpv002 =def2(i,k,j) -Tmpv001
5488    Tmpv402(i,k,j) =Tmpv002
5489    tmp =max(0., Tmpv402(i,k,j))
5490    Tmpv403(i,k,j) =tmp
5491
5492    tmp =tmp**0.5
5493    Tmpv404(i,k,j) =tmp
5494
5495    Tmpv001 =c_s*c_s*mlen_h
5496    Tmpv405(i,k,j) =Tmpv001
5497    Tmpv002 =Tmpv405(i,k,j)*mlen_h
5498    Tmpv406(i,k,j) =Tmpv002
5499    Tmpv003 =Tmpv406(i,k,j)*tmp
5500    Tmpv407(i,k,j) =Tmpv003
5501    Tmpv408(i,k,j) =Tmpv407(i,k,j)
5502    Tmpv004 =max(Tmpv408(i,k,j), 1.0E-6*mlen_h*mlen_h)
5503    Tmpv409(i,k,j) =xkmh(i,k,j)
5504    xkmh(i,k,j) =Tmpv004
5505
5506    Tmpv001 =min(xkmh(i,k,j), mix_upper_bound*mlen_h*mlen_h/dt)
5507    Tmpv4010(i,k,j) =xkmh(i,k,j)
5508    xkmh(i,k,j) =Tmpv001
5509
5510    Tmpv001 =c_s*c_s*mlen_v
5511    Tmpv4011(i,k,j) =Tmpv001
5512    Tmpv002 =Tmpv4011(i,k,j)*mlen_v
5513    Tmpv4012(i,k,j) =Tmpv002
5514    Tmpv003 =Tmpv4012(i,k,j)*tmp
5515    Tmpv4013(i,k,j) =Tmpv003
5516    Tmpv4014(i,k,j) =Tmpv4013(i,k,j)
5517    Tmpv004 =max(Tmpv4014(i,k,j), 1.0E-6*mlen_v*mlen_v)
5518    Tmpv4015(i,k,j) =xkmv(i,k,j)
5519    xkmv(i,k,j) =Tmpv004
5520
5521    Tmpv001 =min(xkmv(i,k,j), mix_upper_bound*mlen_v*mlen_v/dt)
5522    Tmpv4016(i,k,j) =xkmv(i,k,j)
5523    xkmv(i,k,j) =Tmpv001
5524
5525    Tmpv001 =xkmh(i,k,j)/pr
5526    xkhh(i,k,j) =Tmpv001
5527
5528    Tmpv001 =min(xkhh(i,k,j), mix_upper_bound*mlen_h*mlen_h/dt)
5529    xkhh(i,k,j) =Tmpv001
5530
5531    Tmpv001 =xkmv(i,k,j)/pr
5532    xkhv(i,k,j) =Tmpv001
5533
5534    Tmpv001 =min(xkhv(i,k,j), mix_upper_bound*mlen_v*mlen_v/dt)
5535    xkhv(i,k,j) =Tmpv001
5536
5537    ENDDO
5538    ENDDO
5539    ENDDO
5540
5541    ELSE
5542
5543    DO j =j_start, j_end
5544    DO k =kts, ktf
5545    DO i =i_start, i_end
5546    deltas =(dx/msftx(i,j)*dy/msfty(i,j)/rdzw(i,k,j))**0.33333333
5547    Tmpv4017(i,k,j) =deltas
5548
5549    Tmpv001 =BN2(i,k,j)/pr
5550    Tmpv002 =def2(i,k,j) -Tmpv001
5551    Tmpv4018(i,k,j) =Tmpv002
5552    tmp =max(0., Tmpv4018(i,k,j))
5553    Tmpv4019(i,k,j) =tmp
5554
5555    tmp =tmp**0.5
5556    Tmpv4020(i,k,j) =tmp
5557
5558    Tmpv001 =c_s*c_s*deltas
5559    Tmpv4021(i,k,j) =Tmpv001
5560    Tmpv002 =Tmpv4021(i,k,j)*deltas
5561    Tmpv4022(i,k,j) =Tmpv002
5562    Tmpv003 =Tmpv4022(i,k,j)*tmp
5563    Tmpv4023(i,k,j) =Tmpv003
5564    Tmpv4024(i,k,j) =Tmpv4023(i,k,j)
5565    Tmpv004 =max(Tmpv4024(i,k,j), 1.0E-6*deltas*deltas)
5566    Tmpv4025(i,k,j) =xkmh(i,k,j)
5567    xkmh(i,k,j) =Tmpv004
5568
5569    Tmpv4026(i,k,j) =xkmh(i,k,j)
5570    xkmh(i,k,j) =min(xkmh(i,k,j), mix_upper_bound*dx/msftx(i,j)*dy/msfty(i,j)/dt)
5571
5572    Tmpv4027(i,k,j) =xkmv(i,k,j)
5573    xkmv(i,k,j) =xkmh(i,k,j)
5574
5575    Tmpv4028(i,k,j) =xkmv(i,k,j)
5576    xkmv(i,k,j) =min(xkmv(i,k,j), mix_upper_bound/rdzw(i,k,j)/rdzw(i,k,j)/dt)
5577
5578    Tmpv001 =xkmh(i,k,j)/pr
5579    xkhh(i,k,j) =Tmpv001
5580
5581    xkhh(i,k,j) =min(xkhh(i,k,j), mix_upper_bound*dx/msftx(i,j)*dy/msfty(i,j)/dt)
5582
5583    Tmpv001 =xkmv(i,k,j)/pr
5584    xkhv(i,k,j) =Tmpv001
5585
5586    xkhv(i,k,j) =min(xkhv(i,k,j), mix_upper_bound/rdzw(i,k,j)/rdzw(i,k,j)/dt)
5587
5588    ENDDO
5589    ENDDO
5590    ENDDO
5591    ENDIF
5592
5593    IF(isotropic .EQ. 0) THEN
5594
5595    DO j =j_end, j_start, -1
5596    DO k =ktf, kts, -1
5597    DO i =i_end, i_start, -1
5598 !ADDED BY WALLS
5599    tmp =Tmpv404(i,k,j)
5600    mlen_v =Tmpv401(i,k,j)
5601    mlen_h =Tmpv400(i,k,j)
5602
5603    a_Tmpv1 =a_xkhv(i,k,j)
5604    a_xkhv(i,k,j) =0.0
5605    a_xkhv(i,k,j) =a_xkhv(i,k,j)  +(1.0 -sign(1.0, xkhv(i,k,j) -mix_upper_bound*  &
5606    mlen_v*mlen_v/dt))*0.5*1.0*a_Tmpv1
5607    a_mlen_v =a_mlen_v  +(1.0 +sign(1.0, xkhv(i,k,j) -mix_upper_bound*mlen_v*  &
5608    mlen_v/dt))*0.5*(mix_upper_bound*mlen_v +mix_upper_bound*mlen_v)/dt*a_Tmpv1
5609
5610    a_Tmpv1 =a_xkhv(i,k,j)
5611    a_xkhv(i,k,j) =0.0
5612    a_xkmv(i,k,j) =a_xkmv(i,k,j) +a_Tmpv1/pr
5613    a_pr =a_pr -xkmv(i,k,j)/(pr*pr)*a_Tmpv1
5614
5615    a_Tmpv1 =a_xkhh(i,k,j)
5616    a_xkhh(i,k,j) =0.0
5617    a_xkhh(i,k,j) =a_xkhh(i,k,j)  +(1.0 -sign(1.0, xkhh(i,k,j) -mix_upper_bound*  &
5618    mlen_h*mlen_h/dt))*0.5*1.0*a_Tmpv1
5619    a_mlen_h =a_mlen_h  +(1.0 +sign(1.0, xkhh(i,k,j) -mix_upper_bound*mlen_h*  &
5620    mlen_h/dt))*0.5*(mix_upper_bound*mlen_h +mix_upper_bound*mlen_h)/dt*a_Tmpv1
5621
5622    a_Tmpv1 =a_xkhh(i,k,j)
5623    a_xkhh(i,k,j) =0.0
5624    a_xkmh(i,k,j) =a_xkmh(i,k,j) +a_Tmpv1/pr
5625    a_pr =a_pr -xkmh(i,k,j)/(pr*pr)*a_Tmpv1
5626
5627    xkmv(i,k,j) =Tmpv4016(i,k,j)
5628
5629    a_Tmpv1 =a_xkmv(i,k,j)
5630    a_xkmv(i,k,j) =0.0
5631    a_xkmv(i,k,j) =a_xkmv(i,k,j)  +(1.0 -sign(1.0, xkmv(i,k,j) -mix_upper_bound*  &
5632    mlen_v*mlen_v/dt))*0.5*1.0*a_Tmpv1
5633    a_mlen_v =a_mlen_v  +(1.0 +sign(1.0, xkmv(i,k,j) -mix_upper_bound*mlen_v*  &
5634    mlen_v/dt))*0.5*(mix_upper_bound*mlen_v +mix_upper_bound*mlen_v)/dt*a_Tmpv1
5635
5636    xkmv(i,k,j) =Tmpv4015(i,k,j)
5637
5638    a_Tmpv4 =a_xkmv(i,k,j)
5639    a_xkmv(i,k,j) =0.0
5640    a_Tmpv3 =(1.0 +sign(1.0, Tmpv4014(i,k,j) -1.0E-6*mlen_v*mlen_v))*0.5*a_Tmpv4
5641    a_mlen_v =a_mlen_v  +(1.0 -sign(1.0, Tmpv4014(i,k,j) -1.0E-6*mlen_v*mlen_v))  &
5642    *0.5*(1.0E-6*mlen_v +1.0E-6*mlen_v)*a_Tmpv4
5643    a_Tmpv2 =tmp*a_Tmpv3
5644    a_tmp =a_tmp +Tmpv4012(i,k,j)*a_Tmpv3
5645    a_Tmpv1 =mlen_v*a_Tmpv2
5646    a_mlen_v =a_mlen_v +Tmpv4011(i,k,j)*a_Tmpv2
5647    a_c_s =a_c_s +2.0*c_s*mlen_v*a_Tmpv1
5648    a_mlen_v =a_mlen_v +c_s*c_s*a_Tmpv1
5649
5650    xkmh(i,k,j) =Tmpv4010(i,k,j)
5651
5652    a_Tmpv1 =a_xkmh(i,k,j)
5653    a_xkmh(i,k,j) =0.0
5654    a_xkmh(i,k,j) =a_xkmh(i,k,j)  +(1.0 -sign(1.0, xkmh(i,k,j) -mix_upper_bound*  &
5655    mlen_h*mlen_h/dt))*0.5*1.0*a_Tmpv1
5656    a_mlen_h =a_mlen_h  +(1.0 +sign(1.0, xkmh(i,k,j) -mix_upper_bound*mlen_h*  &
5657    mlen_h/dt))*0.5*(mix_upper_bound*mlen_h +mix_upper_bound*mlen_h)/dt*a_Tmpv1
5658
5659    xkmh(i,k,j) =Tmpv409(i,k,j)
5660
5661    a_Tmpv4 =a_xkmh(i,k,j)
5662    a_xkmh(i,k,j) =0.0
5663    a_Tmpv3 =(1.0 +sign(1.0, Tmpv408(i,k,j) -1.0E-6*mlen_h*mlen_h))*0.5*a_Tmpv4
5664    a_mlen_h =a_mlen_h  +(1.0 -sign(1.0, Tmpv408(i,k,j) -1.0E-6*mlen_h*mlen_h))  &
5665    *0.5*(1.0E-6*mlen_h +1.0E-6*mlen_h)*a_Tmpv4
5666    a_Tmpv2 =tmp*a_Tmpv3
5667    a_tmp =a_tmp +Tmpv406(i,k,j)*a_Tmpv3
5668    a_Tmpv1 =mlen_h*a_Tmpv2
5669    a_mlen_h =a_mlen_h +Tmpv405(i,k,j)*a_Tmpv2
5670    a_c_s =a_c_s +2.0*c_s*mlen_h*a_Tmpv1
5671    a_mlen_h =a_mlen_h +c_s*c_s*a_Tmpv1
5672
5673 !  tmp =Tmpv404(i,k,j)
5674    tmp =Tmpv403(i,k,j)
5675
5676    IF(tmp.NE.0.0) THEN
5677    a_tmp =0.5*1.0*tmp**(0.5 -1)*a_tmp
5678    ELSE
5679    a_tmp =0.0
5680    END IF
5681
5682 !  tmp =Tmpv403(i,k,j)
5683
5684 !REVISED BY WALLS
5685 !  (1.0 +(-1.0)*sign(1.0, 0. -Tmpv402(i,k,j)))*0.5* =a_tmp
5686    a_Tmpv2 =(1.0 +(-1.0)*sign(1.0, 0. -Tmpv402(i,k,j)))*0.5*a_tmp
5687    a_tmp =0.0
5688    a_def2(i,k,j) =a_def2(i,k,j) +a_Tmpv2
5689    a_Tmpv1 =-a_Tmpv2
5690    a_BN2(i,k,j) =a_BN2(i,k,j) +a_Tmpv1/pr
5691    a_pr =a_pr -BN2(i,k,j)/(pr*pr)*a_Tmpv1
5692
5693    a_rdzw(i,k,j) =a_rdzw(i,k,j) -1./(rdzw(i,k,j)*rdzw(i,k,j))*a_mlen_v
5694    a_mlen_v =0.0
5695
5696    a_mlen_h =0.0
5697    ENDDO
5698    ENDDO
5699    ENDDO
5700
5701    ELSE
5702
5703    DO j =j_end, j_start, -1
5704    DO k =ktf, kts, -1
5705    DO i =i_end, i_start, -1
5706    deltas =Tmpv4017(i,k,j)
5707    tmp =Tmpv4020(i,k,j)
5708
5709    a_Tmpv1 =a_xkhv(i,k,j)
5710    a_xkhv(i,k,j) =0.0
5711    a_xkhv(i,k,j) =a_xkhv(i,k,j)  +(1.0 -sign(1.0, xkhv(i,k,j) -mix_upper_bound/  &
5712    rdzw(i,k,j)/rdzw(i,k,j)/dt))*0.5*1.0*a_Tmpv1
5713    a_rdzw(i,k,j) =a_rdzw(i,k,j)  +(1.0 +sign(1.0, xkhv(i,k,j) -mix_upper_bound/  &
5714    rdzw(i,k,j)/rdzw(i,k,j)/dt))*0.5*(-mix_upper_bound/(rdzw(i,k,j)*rdzw(i,k,j))  &
5715    *rdzw(i,k,j) -mix_upper_bound/rdzw(i,k,j))/(rdzw(i,k,j)*rdzw(i,k,j))/dt*a_Tmpv1
5716    a_Tmpv1 =a_xkhv(i,k,j)
5717    a_xkhv(i,k,j) =0.0
5718    a_xkmv(i,k,j) =a_xkmv(i,k,j) +a_Tmpv1/pr
5719    a_pr =a_pr -xkmv(i,k,j)/(pr*pr)*a_Tmpv1
5720    a_xkhh(i,k,j) =(1.0 -(1.0)*sign(1.0, xkhh(i,k,j) -mix_upper_bound*dx/msftx(i,j)  &
5721    *dy/msfty(i,j)/dt))*0.5*a_xkhh(i,k,j)
5722    a_Tmpv1 =a_xkhh(i,k,j)
5723    a_xkhh(i,k,j) =0.0
5724    a_xkmh(i,k,j) =a_xkmh(i,k,j) +a_Tmpv1/pr
5725    a_pr =a_pr -xkmh(i,k,j)/(pr*pr)*a_Tmpv1
5726
5727    xkmv(i,k,j) =Tmpv4028(i,k,j)
5728
5729    a_Tmpv1 =a_xkmv(i,k,j)
5730    a_xkmv(i,k,j) =0.0
5731    a_xkmv(i,k,j) =a_xkmv(i,k,j)  +(1.0 -sign(1.0, xkmv(i,k,j) -mix_upper_bound/  &
5732    rdzw(i,k,j)/rdzw(i,k,j)/dt))*0.5*1.0*a_Tmpv1
5733    a_rdzw(i,k,j) =a_rdzw(i,k,j)  +(1.0 +sign(1.0, xkmv(i,k,j) -mix_upper_bound/  &
5734    rdzw(i,k,j)/rdzw(i,k,j)/dt))*0.5*(-mix_upper_bound/(rdzw(i,k,j)*rdzw(i,k,j))  &
5735    *rdzw(i,k,j) -mix_upper_bound/rdzw(i,k,j))/(rdzw(i,k,j)*rdzw(i,k,j))/dt*a_Tmpv1
5736
5737    xkmv(i,k,j) =Tmpv4027(i,k,j)
5738
5739    a_xkmh(i,k,j) =a_xkmh(i,k,j) +a_xkmv(i,k,j)
5740    a_xkmv(i,k,j) =0.0
5741
5742    xkmh(i,k,j) =Tmpv4026(i,k,j)
5743
5744    a_xkmh(i,k,j) =(1.0 -(1.0)*sign(1.0, xkmh(i,k,j) -mix_upper_bound*dx/msftx(i,j)  &
5745    *dy/msfty(i,j)/dt))*0.5*a_xkmh(i,k,j)
5746
5747    xkmh(i,k,j) =Tmpv4025(i,k,j)
5748
5749    a_Tmpv4 =a_xkmh(i,k,j)
5750    a_xkmh(i,k,j) =0.0
5751    a_Tmpv3 =(1.0 +sign(1.0, Tmpv4024(i,k,j) -1.0E-6*deltas*deltas))*0.5*a_Tmpv4
5752    a_deltas =a_deltas  +(1.0 -sign(1.0, Tmpv4024(i,k,j) -1.0E-6*deltas*deltas))  &
5753    *0.5*(1.0E-6*deltas +1.0E-6*deltas)*a_Tmpv4
5754    a_Tmpv2 =tmp*a_Tmpv3
5755    a_tmp =a_tmp +Tmpv4022(i,k,j)*a_Tmpv3
5756    a_Tmpv1 =deltas*a_Tmpv2
5757    a_deltas =a_deltas +Tmpv4021(i,k,j)*a_Tmpv2
5758    a_c_s =a_c_s +2.0*c_s*deltas*a_Tmpv1
5759    a_deltas =a_deltas +c_s*c_s*a_Tmpv1
5760
5761    tmp =Tmpv4019(i,k,j)
5762
5763    IF(tmp.NE.0.0) THEN
5764    a_tmp =0.5*1.0*tmp**(0.5 -1)*a_tmp
5765    ELSE
5766    a_tmp =0.0
5767    END IF
5768
5769 !REVISED BY WALLS
5770 !  (1.0 +(-1.0)*sign(1.0, 0. -Tmpv4018(i,k,j)))*0.5* =a_tmp
5771    a_Tmpv2 =(1.0 +(-1.0)*sign(1.0, 0. -Tmpv4018(i,k,j)))*0.5*a_tmp
5772    a_tmp =0.0
5773    a_def2(i,k,j) =a_def2(i,k,j) +a_Tmpv2
5774    a_Tmpv1 =-a_Tmpv2
5775    a_BN2(i,k,j) =a_BN2(i,k,j) +a_Tmpv1/pr
5776    a_pr =a_pr -BN2(i,k,j)/(pr*pr)*a_Tmpv1
5777
5778    a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx/msftx(i,j)*dy/msfty(i,j)/(rdzw(i,k,j)  &
5779    *rdzw(i,k,j))*0.33333333*(dx/msftx(i,j)*dy/msfty(i,j)/rdzw(i,k,j))**(0.33333333 -1)*a_deltas
5780    a_deltas =0.0
5781
5782    ENDDO
5783    ENDDO
5784    ENDDO
5785
5786    ENDIF
5787
5788 !LPB[17]
5789
5790 !LPB[16]
5791    DO j =j_end, j_start, -1
5792
5793    tmp =Keep_Lpb16_tmp(j)
5794
5795    DO k =kts, ktf
5796    DO i =i_start, i_end
5797    Tmpv001 =defor23(i,k+1,j) +defor23(i,k,j)
5798    Tmpv002 =Tmpv001 +defor23(i,k+1,j+1)
5799    Tmpv003 =Tmpv002 +defor23(i,k,j+1)
5800    Tmpv004 =0.25*Tmpv003
5801    Tmpv300(i,k) =tmp
5802    tmp =Tmpv004
5803
5804    Tmpv001 =def2(i,k,j) +tmp*tmp
5805    def2(i,k,j) =Tmpv001
5806
5807    ENDDO
5808    ENDDO
5809
5810    DO k =ktf, kts, -1
5811    DO i =i_end, i_start, -1
5812    a_Tmpv1 =a_def2(i,k,j)
5813    a_def2(i,k,j) =0.0
5814    a_def2(i,k,j) =a_def2(i,k,j) +a_Tmpv1
5815    a_tmp =a_tmp +2.0*tmp*a_Tmpv1
5816
5817    tmp =Tmpv300(i,k)
5818
5819    a_Tmpv4 =a_tmp
5820    a_tmp =0.0
5821    a_Tmpv3 =0.25*a_Tmpv4
5822    a_Tmpv2 =a_Tmpv3
5823    a_defor23(i,k,j+1) =a_defor23(i,k,j+1) +a_Tmpv3
5824    a_Tmpv1 =a_Tmpv2
5825    a_defor23(i,k+1,j+1) =a_defor23(i,k+1,j+1) +a_Tmpv2
5826    a_defor23(i,k+1,j) =a_defor23(i,k+1,j) +a_Tmpv1
5827    a_defor23(i,k,j) =a_defor23(i,k,j) +a_Tmpv1
5828    ENDDO
5829    ENDDO
5830
5831    ENDDO
5832
5833 !LPB[15]
5834    DO j =j_end, j_start, -1
5835
5836    tmp =Keep_Lpb15_tmp(j)
5837
5838    DO k =kts, ktf
5839    DO i =i_start, i_end
5840    Tmpv001 =defor13(i,k+1,j) +defor13(i,k,j)
5841    Tmpv002 =Tmpv001 +defor13(i+1,k+1,j)
5842    Tmpv003 =Tmpv002 +defor13(i+1,k,j)
5843    Tmpv004 =0.25*Tmpv003
5844    Tmpv300(i,k) =tmp
5845    tmp =Tmpv004
5846
5847    Tmpv001 =def2(i,k,j) +tmp*tmp
5848    def2(i,k,j) =Tmpv001
5849
5850    ENDDO
5851    ENDDO
5852
5853    DO k =ktf, kts, -1
5854    DO i =i_end, i_start, -1
5855    a_Tmpv1 =a_def2(i,k,j)
5856    a_def2(i,k,j) =0.0
5857    a_def2(i,k,j) =a_def2(i,k,j) +a_Tmpv1
5858    a_tmp =a_tmp +2.0*tmp*a_Tmpv1
5859
5860    tmp =Tmpv300(i,k)
5861
5862    a_Tmpv4 =a_tmp
5863    a_tmp =0.0
5864    a_Tmpv3 =0.25*a_Tmpv4
5865    a_Tmpv2 =a_Tmpv3
5866    a_defor13(i+1,k,j) =a_defor13(i+1,k,j) +a_Tmpv3
5867    a_Tmpv1 =a_Tmpv2
5868    a_defor13(i+1,k+1,j) =a_defor13(i+1,k+1,j) +a_Tmpv2
5869    a_defor13(i,k+1,j) =a_defor13(i,k+1,j) +a_Tmpv1
5870    a_defor13(i,k,j) =a_defor13(i,k,j) +a_Tmpv1
5871    ENDDO
5872    ENDDO
5873
5874    ENDDO
5875
5876 !LPB[14]
5877    DO j =j_end, j_start, -1
5878
5879    DO k =kts, ktf
5880    DO i =i_start, i_end
5881    Tmpv001 =defor12(i,k,j) +defor12(i,k,j+1)
5882    Tmpv002 =Tmpv001 +defor12(i+1,k,j)
5883    Tmpv003 =Tmpv002 +defor12(i+1,k,j+1)
5884    Tmpv004 =0.25*Tmpv003
5885    Tmpv300(i,k) =tmp
5886    tmp =Tmpv004
5887
5888    Tmpv001 =def2(i,k,j) +tmp*tmp
5889    def2(i,k,j) =Tmpv001
5890
5891    ENDDO
5892    ENDDO
5893
5894    DO k =ktf, kts, -1
5895    DO i =i_end, i_start, -1
5896    a_Tmpv1 =a_def2(i,k,j)
5897    a_def2(i,k,j) =0.0
5898    a_def2(i,k,j) =a_def2(i,k,j) +a_Tmpv1
5899    a_tmp =a_tmp +2.0*tmp*a_Tmpv1
5900
5901    tmp =Tmpv300(i,k)
5902
5903    a_Tmpv4 =a_tmp
5904    a_tmp =0.0
5905    a_Tmpv3 =0.25*a_Tmpv4
5906    a_Tmpv2 =a_Tmpv3
5907    a_defor12(i+1,k,j+1) =a_defor12(i+1,k,j+1) +a_Tmpv3
5908    a_Tmpv1 =a_Tmpv2
5909    a_defor12(i+1,k,j) =a_defor12(i+1,k,j) +a_Tmpv2
5910    a_defor12(i,k,j) =a_defor12(i,k,j) +a_Tmpv1
5911    a_defor12(i,k,j+1) =a_defor12(i,k,j+1) +a_Tmpv1
5912    ENDDO
5913    ENDDO
5914
5915    ENDDO
5916
5917 !LPB[13]
5918    DO j =j_end, j_start, -1
5919
5920 !  DO k =kts, ktf
5921 !  DO i =i_start, i_end
5922 !  Tmpv001 =defor11(i,k,j)*defor11(i,k,j) +defor22(i,k,j)*defor22(i,k,j)
5923 !  Tmpv002 =Tmpv001 +defor33(i,k,j)*defor33(i,k,j)
5924 !  Tmpv003 =0.5*Tmpv002
5925 !  def2(i,k,j) =Tmpv003
5926
5927 !  ENDDO
5928 !  ENDDO
5929
5930    DO k =ktf, kts, -1
5931    DO i =i_end, i_start, -1
5932    a_Tmpv3 =a_def2(i,k,j)
5933    a_def2(i,k,j) =0.0
5934    a_Tmpv2 =0.5*a_Tmpv3
5935    a_Tmpv1 =a_Tmpv2
5936    a_defor33(i,k,j) =a_defor33(i,k,j) +2.0*defor33(i,k,j)*a_Tmpv2
5937    a_defor11(i,k,j) =a_defor11(i,k,j) +2.0*defor11(i,k,j)*a_Tmpv1
5938    a_defor22(i,k,j) =a_defor22(i,k,j) +2.0*defor22(i,k,j)*a_Tmpv1
5939    ENDDO
5940    ENDDO
5941
5942    ENDDO
5943
5944 !LPB[12]
5945 !  pr =prandtl
5946
5947 !  c_s =config_flags%c_s
5948
5949 !REVISED BY WALLS
5950 !  a_config_flags%c_s =a_config_flags%c_s +a_c_s
5951    a_c_s =0.0
5952    a_pr =0.0
5953
5954 !LPB[11]
5955
5956 !  IF( config_flags%periodic_x ) THEN
5957 !  i_end =min(ite, ide-1)
5958 !  END IF
5959
5960 !  IF( config_flags%periodic_x ) THEN
5961
5962 !  END IF
5963
5964 !LPB[10]
5965
5966 !LPB[9]
5967
5968 !  IF( config_flags%periodic_x ) THEN
5969 !  i_start =its
5970 !  END IF
5971
5972 !  IF( config_flags%periodic_x ) THEN
5973
5974 !  END IF
5975
5976 !LPB[8]
5977
5978 !LPB[7]
5979
5980 !  IF( config_flags%open_ye .or. config_flags%specified .or.            config_flags%nested) THEN
5981 !  j_end =min(jde-2, jte)
5982 !  END IF
5983
5984 !  IF( config_flags%open_ye .or. config_flags%specified .or.   &
5985 !           config_flags%nested) THEN
5986
5987 !  END IF
5988
5989 !LPB[6]
5990
5991 !LPB[5]
5992
5993 !  IF( config_flags%open_ys .or. config_flags%specified .or.            config_flags%nested) THEN
5994 !  j_start =max(jds+1, jts)
5995 !  END IF
5996
5997 !  IF( config_flags%open_ys .or. config_flags%specified .or.   &
5998 !           config_flags%nested) THEN
5999
6000 !  END IF
6001
6002 !LPB[4]
6003
6004 !LPB[3]
6005
6006 !  IF( config_flags%open_xe .or. config_flags%specified .or.            config_flags%nested) THEN
6007 !  i_end =min(ide-2, ite)
6008 !  END IF
6009
6010 !  IF( config_flags%open_xe .or. config_flags%specified .or.   &
6011 !           config_flags%nested) THEN
6012
6013 !  END IF
6014
6015 !LPB[2]
6016
6017 !LPB[1]
6018
6019 !  IF( config_flags%open_xs .or. config_flags%specified .or.            config_flags%nested) THEN
6020 !  i_start =max(ids+1, its)
6021 !  END IF
6022
6023 !  IF( config_flags%open_xs .or. config_flags%specified .or.   &
6024 !           config_flags%nested) THEN
6025
6026 !  END IF
6027
6028 !LPB[0]
6029 !  ktf =min(kte, kde-1)
6030 !  i_start =its
6031 !  i_end =min(ite, ide-1)
6032 !  j_start =jts
6033 !  j_end =min(jte, jde-1)
6034
6035    END SUBROUTINE a_smag_km
6036
6037 !        Generated by TAPENADE     (INRIA, Tropics team)
6038 !  Tapenade 3.10 (r5363) -  9 Sep 2014 09:54
6039 !
6040 !  Differentiation of smag2d_km in reverse (adjoint) mode:
6041 !   gradient     of useful results: defor11 defor12 zx zy xkmh
6042 !                defor22 xkmv rdzw xkhh xkhv
6043 !   with respect to varying inputs: defor11 defor12 zx zy xkmh
6044 !                defor22 xkmv rdzw xkhh xkhv
6045 !   RW status of diff variables: defor11:incr defor12:incr zx:incr
6046 !                zy:incr xkmh:in-out defor22:incr xkmv:in-out rdzw:incr
6047 !                xkhh:in-out xkhv:in-out
6048 SUBROUTINE A_SMAG2D_KM(config_flags, xkmh, xkmhb, xkmv, xkmvb, xkhh, &
6049 &  xkhhb, xkhv, xkhvb, defor11, defor11b, defor22, defor22b, defor12, &
6050 &  defor12b, rdzw, rdzwb, dx, dy, msftx, msfty, zx, zxb, zy, zyb, ids, &
6051 &  ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, &
6052 &  jte, kts, kte)
6053   IMPLICIT NONE
6054   TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
6055   INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
6056 &  jme, kms, kme, its, ite, jts, jte, kts, kte
6057   REAL, INTENT(IN) :: dx, dy
6058   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rdzw, zx, zy
6059   REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rdzwb, zxb, zyb
6060   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: xkmh, &
6061 &  xkmv, xkhh, xkhv
6062   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: xkmhb
6063   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: defor11, &
6064 &  defor22, defor12
6065   REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: defor11b, defor22b, &
6066 &  defor12b
6067   REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN) :: msftx, msfty
6068 ! LOCAL VARS
6069   INTEGER :: i_start, i_end, j_start, j_end, ktf, i, j, k
6070   REAL :: deltas, tmp, pr, mlen_h, c_s
6071   REAL :: tmpb
6072   REAL :: dxm, dym, tmpzx, tmpzy, alpha, def_limit
6073   REAL :: tmpzxb, tmpzyb, alphab
6074   REAL, DIMENSION(its:ite, kts:kte, jts:jte) :: def2
6075   REAL, DIMENSION(its:ite, kts:kte, jts:jte) :: def2b
6076   INTEGER :: branch
6077   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: xkhhb
6078   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: xkhvb
6079   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: xkmvb
6080   REAL :: abs1b
6081   REAL :: tempb6
6082   REAL :: tempb5
6083   REAL :: tempb4
6084   REAL :: tempb3
6085   REAL :: abs4b
6086   REAL :: tempb2
6087   REAL :: tempb1
6088   REAL :: tempb0
6089   REAL :: abs7b
6090   REAL :: x1
6091   REAL :: abs0b
6092   REAL :: abs3b
6093   REAL :: tempb
6094   REAL :: abs6b
6095   REAL :: x1b
6096   REAL :: abs7
6097   REAL :: abs6
6098   REAL :: abs5
6099   REAL :: abs4
6100   REAL :: abs3
6101   REAL :: abs2
6102   REAL :: abs1
6103   REAL :: abs0
6104   REAL :: abs2b
6105   REAL :: abs5b
6106   IF (kte .GT. kde - 1) THEN
6107     ktf = kde - 1
6108   ELSE
6109     ktf = kte
6110   END IF
6111   i_start = its
6112   IF (ite .GT. ide - 1) THEN
6113     i_end = ide - 1
6114   ELSE
6115     i_end = ite
6116   END IF
6117   j_start = jts
6118   IF (jte .GT. jde - 1) THEN
6119     j_end = jde - 1
6120   ELSE
6121     j_end = jte
6122   END IF
6123   IF ((config_flags%open_xs .OR. config_flags%specified) .OR. &
6124 &      config_flags%nested) THEN
6125     IF (ids + 1 .LT. its) THEN
6126       i_start = its
6127     ELSE
6128       i_start = ids + 1
6129     END IF
6130   END IF
6131   IF ((config_flags%open_xe .OR. config_flags%specified) .OR. &
6132 &      config_flags%nested) THEN
6133     IF (ide - 2 .GT. ite) THEN
6134       i_end = ite
6135     ELSE
6136       i_end = ide - 2
6137     END IF
6138   END IF
6139   IF ((config_flags%open_ys .OR. config_flags%specified) .OR. &
6140 &      config_flags%nested) THEN
6141     IF (jds + 1 .LT. jts) THEN
6142       j_start = jts
6143     ELSE
6144       j_start = jds + 1
6145     END IF
6146   END IF
6147   IF ((config_flags%open_ye .OR. config_flags%specified) .OR. &
6148 &      config_flags%nested) THEN
6149     IF (jde - 2 .GT. jte) THEN
6150       j_end = jte
6151     ELSE
6152       j_end = jde - 2
6153     END IF
6154   END IF
6155   IF (config_flags%periodic_x) i_start = its
6156   IF (config_flags%periodic_x) THEN
6157     IF (ite .GT. ide - 1) THEN
6158       i_end = ide - 1
6159     ELSE
6160       i_end = ite
6161     END IF
6162   END IF
6163   pr = prandtl
6164   c_s = config_flags%c_s
6165   DO j=j_start,j_end
6166     DO k=kts,ktf
6167       DO i=i_start,i_end
6168         def2(i, k, j) = 0.25*((defor11(i, k, j)-defor22(i, k, j))*(&
6169 &          defor11(i, k, j)-defor22(i, k, j)))
6170         CALL PUSHREAL8(tmp)
6171         tmp = 0.25*(defor12(i, k, j)+defor12(i, k, j+1)+defor12(i+1, k, &
6172 &          j)+defor12(i+1, k, j+1))
6173         def2(i, k, j) = def2(i, k, j) + tmp*tmp
6174       END DO
6175     END DO
6176   END DO
6177 !
6178   DO j=j_start,j_end
6179     DO k=kts,ktf
6180       DO i=i_start,i_end
6181         CALL PUSHREAL8(mlen_h)
6182         mlen_h = SQRT(dx/msftx(i, j)*dy/msfty(i, j))
6183         CALL PUSHREAL8(tmp)
6184         tmp = SQRT(def2(i, k, j))
6185 !        xkmh(i,k,j)=max(c_s*c_s*mlen_h*mlen_h*tmp, 1.0E-6*mlen_h*mlen_h )
6186         xkmh(i, k, j) = c_s*c_s*mlen_h*mlen_h*tmp
6187         IF (xkmh(i, k, j) .GT. 10.*mlen_h) THEN
6188           xkmh(i, k, j) = 10.*mlen_h
6189           CALL PUSHCONTROL1B(0)
6190         ELSE
6191           CALL PUSHCONTROL1B(1)
6192           xkmh(i, k, j) = xkmh(i, k, j)
6193         END IF
6194         xkhh(i, k, j) = xkmh(i, k, j)/pr
6195         IF (config_flags%diff_opt .EQ. 2) THEN
6196 ! jd: reduce diffusion coefficient by slope factor (modified by JB August 2014)
6197           dxm = dx/msftx(i, j)
6198           dym = dy/msfty(i, j)
6199           IF (zx(i, k, j) .GE. 0.0_8) THEN
6200             CALL PUSHREAL8(abs0)
6201             abs0 = zx(i, k, j)
6202             CALL PUSHCONTROL1B(1)
6203           ELSE
6204             CALL PUSHREAL8(abs0)
6205             abs0 = -zx(i, k, j)
6206             CALL PUSHCONTROL1B(0)
6207           END IF
6208           IF (zx(i+1, k, j) .GE. 0.0_8) THEN
6209             CALL PUSHREAL8(abs2)
6210             abs2 = zx(i+1, k, j)
6211             CALL PUSHCONTROL1B(1)
6212           ELSE
6213             CALL PUSHREAL8(abs2)
6214             abs2 = -zx(i+1, k, j)
6215             CALL PUSHCONTROL1B(0)
6216           END IF
6217           IF (zx(i, k+1, j) .GE. 0.0_8) THEN
6218             CALL PUSHREAL8(abs4)
6219             abs4 = zx(i, k+1, j)
6220             CALL PUSHCONTROL1B(1)
6221           ELSE
6222             CALL PUSHREAL8(abs4)
6223             abs4 = -zx(i, k+1, j)
6224             CALL PUSHCONTROL1B(0)
6225           END IF
6226           IF (zx(i+1, k+1, j) .GE. 0.0_8) THEN
6227             CALL PUSHREAL8(abs6)
6228             abs6 = zx(i+1, k+1, j)
6229             CALL PUSHCONTROL1B(0)
6230           ELSE
6231             CALL PUSHREAL8(abs6)
6232             abs6 = -zx(i+1, k+1, j)
6233             CALL PUSHCONTROL1B(1)
6234           END IF
6235           tmpzx = 0.25*(abs0+abs2+abs4+abs6)*rdzw(i, k, j)*dxm
6236           IF (zy(i, k, j) .GE. 0.0_8) THEN
6237             CALL PUSHREAL8(abs1)
6238             abs1 = zy(i, k, j)
6239             CALL PUSHCONTROL1B(1)
6240           ELSE
6241             CALL PUSHREAL8(abs1)
6242             abs1 = -zy(i, k, j)
6243             CALL PUSHCONTROL1B(0)
6244           END IF
6245           IF (zy(i, k, j+1) .GE. 0.0_8) THEN
6246             CALL PUSHREAL8(abs3)
6247             abs3 = zy(i, k, j+1)
6248             CALL PUSHCONTROL1B(1)
6249           ELSE
6250             CALL PUSHREAL8(abs3)
6251             abs3 = -zy(i, k, j+1)
6252             CALL PUSHCONTROL1B(0)
6253           END IF
6254           IF (zy(i, k+1, j) .GE. 0.0_8) THEN
6255             CALL PUSHREAL8(abs5)
6256             abs5 = zy(i, k+1, j)
6257             CALL PUSHCONTROL1B(1)
6258           ELSE
6259             CALL PUSHREAL8(abs5)
6260             abs5 = -zy(i, k+1, j)
6261             CALL PUSHCONTROL1B(0)
6262           END IF
6263           IF (zy(i, k+1, j+1) .GE. 0.0_8) THEN
6264             CALL PUSHREAL8(abs7)
6265             abs7 = zy(i, k+1, j+1)
6266             CALL PUSHCONTROL1B(0)
6267           ELSE
6268             CALL PUSHREAL8(abs7)
6269             abs7 = -zy(i, k+1, j+1)
6270             CALL PUSHCONTROL1B(1)
6271           END IF
6272           tmpzy = 0.25*(abs1+abs3+abs5+abs7)*rdzw(i, k, j)*dym
6273           x1 = SQRT(tmpzx*tmpzx + tmpzy*tmpzy)
6274           IF (x1 .LT. 1.0) THEN
6275             CALL PUSHREAL8(alpha)
6276             alpha = 1.0
6277             CALL PUSHCONTROL1B(0)
6278           ELSE
6279             CALL PUSHREAL8(alpha)
6280             alpha = x1
6281             CALL PUSHCONTROL1B(1)
6282           END IF
6283           IF (10.0/mlen_h .LT. 1.e-3) THEN
6284             def_limit = 1.e-3
6285           ELSE
6286             def_limit = 10.0/mlen_h
6287           END IF
6288           IF (tmp .GT. def_limit) THEN
6289             CALL PUSHCONTROL1B(0)
6290           ELSE
6291             CALL PUSHCONTROL1B(1)
6292           END IF
6293           CALL PUSHCONTROL1B(1)
6294         ELSE
6295           CALL PUSHCONTROL1B(0)
6296         END IF
6297       END DO
6298     END DO
6299   END DO
6300   def2b = 0.0_8
6301   DO j=j_end,j_start,-1
6302     DO k=ktf,kts,-1
6303       DO i=i_end,i_start,-1
6304         CALL POPCONTROL1B(branch)
6305         IF (branch .NE. 0) THEN
6306           xkmhb(i, k, j) = xkmhb(i, k, j) + xkhhb(i, k, j)/pr
6307           xkhhb(i, k, j) = 0.0_8
6308           CALL POPCONTROL1B(branch)
6309           IF (branch .EQ. 0) THEN
6310             tempb6 = xkmhb(i, k, j)/alpha**2
6311             alphab = -(xkmh(i, k, j)*2*tempb6/alpha)
6312             xkmhb(i, k, j) = tempb6
6313           ELSE
6314             alphab = -(xkmh(i, k, j)*xkmhb(i, k, j)/alpha**2)
6315             xkmhb(i, k, j) = xkmhb(i, k, j)/alpha
6316           END IF
6317           CALL POPCONTROL1B(branch)
6318           IF (branch .EQ. 0) THEN
6319             CALL POPREAL8(alpha)
6320             x1b = 0.0_8
6321           ELSE
6322             CALL POPREAL8(alpha)
6323             x1b = alphab
6324           END IF
6325           dxm = dx/msftx(i, j)
6326           dym = dy/msfty(i, j)
6327           tmpzx = 0.25*(abs0+abs2+abs4+abs6)*rdzw(i, k, j)*dxm
6328           tmpzy = 0.25*(abs1+abs3+abs5+abs7)*rdzw(i, k, j)*dym
6329           IF (tmpzx**2 + tmpzy**2 .EQ. 0.0_8) THEN
6330             tempb3 = 0.0_8
6331           ELSE
6332             tempb3 = x1b/(2.0*SQRT(tmpzx**2+tmpzy**2))
6333           END IF
6334           tmpzxb = 2*tmpzx*tempb3
6335           tmpzyb = 2*tmpzy*tempb3
6336           tempb4 = dym*0.25*tmpzyb
6337           tempb5 = rdzw(i, k, j)*tempb4
6338           abs1b = tempb5
6339           abs3b = tempb5
6340           abs5b = tempb5
6341           abs7b = tempb5
6342           rdzwb(i, k, j) = rdzwb(i, k, j) + (abs1+abs3+abs5+abs7)*tempb4
6343           CALL POPCONTROL1B(branch)
6344           IF (branch .EQ. 0) THEN
6345             CALL POPREAL8(abs7)
6346             zyb(i, k+1, j+1) = zyb(i, k+1, j+1) + abs7b
6347           ELSE
6348             CALL POPREAL8(abs7)
6349             zyb(i, k+1, j+1) = zyb(i, k+1, j+1) - abs7b
6350           END IF
6351           CALL POPCONTROL1B(branch)
6352           IF (branch .EQ. 0) THEN
6353             CALL POPREAL8(abs5)
6354             zyb(i, k+1, j) = zyb(i, k+1, j) - abs5b
6355           ELSE
6356             CALL POPREAL8(abs5)
6357             zyb(i, k+1, j) = zyb(i, k+1, j) + abs5b
6358           END IF
6359           CALL POPCONTROL1B(branch)
6360           IF (branch .EQ. 0) THEN
6361             CALL POPREAL8(abs3)
6362             zyb(i, k, j+1) = zyb(i, k, j+1) - abs3b
6363           ELSE
6364             CALL POPREAL8(abs3)
6365             zyb(i, k, j+1) = zyb(i, k, j+1) + abs3b
6366           END IF
6367           CALL POPCONTROL1B(branch)
6368           IF (branch .EQ. 0) THEN
6369             CALL POPREAL8(abs1)
6370             zyb(i, k, j) = zyb(i, k, j) - abs1b
6371           ELSE
6372             CALL POPREAL8(abs1)
6373             zyb(i, k, j) = zyb(i, k, j) + abs1b
6374           END IF
6375           tempb1 = dxm*0.25*tmpzxb
6376           tempb2 = rdzw(i, k, j)*tempb1
6377           abs0b = tempb2
6378           abs2b = tempb2
6379           abs4b = tempb2
6380           abs6b = tempb2
6381           rdzwb(i, k, j) = rdzwb(i, k, j) + (abs0+abs2+abs4+abs6)*tempb1
6382           CALL POPCONTROL1B(branch)
6383           IF (branch .EQ. 0) THEN
6384             CALL POPREAL8(abs6)
6385             zxb(i+1, k+1, j) = zxb(i+1, k+1, j) + abs6b
6386           ELSE
6387             CALL POPREAL8(abs6)
6388             zxb(i+1, k+1, j) = zxb(i+1, k+1, j) - abs6b
6389           END IF
6390           CALL POPCONTROL1B(branch)
6391           IF (branch .EQ. 0) THEN
6392             CALL POPREAL8(abs4)
6393             zxb(i, k+1, j) = zxb(i, k+1, j) - abs4b
6394           ELSE
6395             CALL POPREAL8(abs4)
6396             zxb(i, k+1, j) = zxb(i, k+1, j) + abs4b
6397           END IF
6398           CALL POPCONTROL1B(branch)
6399           IF (branch .EQ. 0) THEN
6400             CALL POPREAL8(abs2)
6401             zxb(i+1, k, j) = zxb(i+1, k, j) - abs2b
6402           ELSE
6403             CALL POPREAL8(abs2)
6404             zxb(i+1, k, j) = zxb(i+1, k, j) + abs2b
6405           END IF
6406           CALL POPCONTROL1B(branch)
6407           IF (branch .EQ. 0) THEN
6408             CALL POPREAL8(abs0)
6409             zxb(i, k, j) = zxb(i, k, j) - abs0b
6410           ELSE
6411             CALL POPREAL8(abs0)
6412             zxb(i, k, j) = zxb(i, k, j) + abs0b
6413           END IF
6414         END IF
6415         xkhvb(i, k, j) = 0.0_8
6416         xkmhb(i, k, j) = xkmhb(i, k, j) + xkhhb(i, k, j)/pr
6417         xkhhb(i, k, j) = 0.0_8
6418         xkmvb(i, k, j) = 0.0_8
6419         CALL POPCONTROL1B(branch)
6420         IF (branch .EQ. 0) xkmhb(i, k, j) = 0.0_8
6421         tmpb = mlen_h**2*c_s**2*xkmhb(i, k, j)
6422         xkmhb(i, k, j) = 0.0_8
6423         CALL POPREAL8(tmp)
6424         IF (.NOT.def2(i, k, j) .EQ. 0.0_8) def2b(i, k, j) = def2b(i, k, &
6425 &            j) + tmpb/(2.0*SQRT(def2(i, k, j)))
6426         CALL POPREAL8(mlen_h)
6427       END DO
6428     END DO
6429   END DO
6430   DO j=j_end,j_start,-1
6431     DO k=ktf,kts,-1
6432       DO i=i_end,i_start,-1
6433         tmpb = 2*tmp*def2b(i, k, j)
6434         CALL POPREAL8(tmp)
6435         tempb = 0.25*tmpb
6436         defor12b(i, k, j) = defor12b(i, k, j) + tempb
6437         defor12b(i, k, j+1) = defor12b(i, k, j+1) + tempb
6438         defor12b(i+1, k, j) = defor12b(i+1, k, j) + tempb
6439         defor12b(i+1, k, j+1) = defor12b(i+1, k, j+1) + tempb
6440         tempb0 = 0.25*2*(defor11(i, k, j)-defor22(i, k, j))*def2b(i, k, &
6441 &          j)
6442         defor11b(i, k, j) = defor11b(i, k, j) + tempb0
6443         defor22b(i, k, j) = defor22b(i, k, j) - tempb0
6444         def2b(i, k, j) = 0.0_8
6445       END DO
6446     END DO
6447   END DO
6448 END SUBROUTINE A_SMAG2D_KM
6449
6450    SUBROUTINE a_phy_bc(config_flags,div,a_div,defor11,a_defor11,defor22, &
6451    a_defor22,defor33,a_defor33,defor12,a_defor12,defor13,a_defor13,defor23, &
6452    a_defor23,xkmh,a_xkmh,xkmv,a_xkmv,xkhh,a_xkhh,xkhv,a_xkhv,tke,a_tke, &
6453    RUBLTEN,a_RUBLTEN,RVBLTEN,a_RVBLTEN,RUCUTEN,a_RUCUTEN,RVCUTEN,a_RVCUTEN,RUSHTEN,a_RUSHTEN,RVSHTEN,a_RVSHTEN, &
6454    ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms, &
6455    kme,ips,ipe,jps,jpe,kps,kpe,its,ite,jts,jte,kts,kte)
6456
6457    IMPLICIT NONE
6458
6459    TYPE(grid_config_rec_type) :: config_flags
6460    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,ips,ipe,jps,jpe,kps,kpe, &
6461    its,ite,jts,jte,kts,kte
6462    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: RUBLTEN,a_RUBLTEN,RVBLTEN,a_RVBLTEN, &
6463    RUCUTEN,a_RUCUTEN,RVCUTEN,a_RVCUTEN,RUSHTEN,a_RUSHTEN,RVSHTEN,a_RVSHTEN, &
6464    defor11,a_defor11,defor22,a_defor22,defor33,a_defor33,defor12,a_defor12, &
6465    defor13,a_defor13,defor23,a_defor23,xkmh,a_xkmh,xkmv,a_xkmv,xkhh,a_xkhh, &
6466    xkhv,a_xkhv,tke,a_tke,div,a_div
6467
6468
6469    IF(config_flags%diff_opt .eq. 2) THEN
6470
6471    CALL a_set_physical_bc3d( a_defor23 , 'f', config_flags,           &
6472                                 ids, ide, jds, jde, kds, kde,             &
6473                                 ims, ime, jms, jme, kms, kme,             &
6474                                 ips, ipe, jps, jpe, kps, kpe,             &
6475                                 its, ite, jts, jte, kts, kte              )
6476
6477    CALL a_set_physical_bc3d( a_defor13 , 'e', config_flags,           &
6478                                 ids, ide, jds, jde, kds, kde,             &
6479                                 ims, ime, jms, jme, kms, kme,             &
6480                                 ips, ipe, jps, jpe, kps, kpe,             &
6481                                 its, ite, jts, jte, kts, kte              )
6482
6483    CALL a_set_physical_bc3d( a_defor12 , 'd', config_flags,           &
6484                                 ids, ide, jds, jde, kds, kde,             &
6485                                 ims, ime, jms, jme, kms, kme,             &
6486                                 ips, ipe, jps, jpe, kps, kpe,             &
6487                                 its, ite, jts, jte, kts, kte              )
6488
6489    CALL a_set_physical_bc3d( a_defor33 , 't', config_flags,           &
6490                                 ids, ide, jds, jde, kds, kde,             &
6491                                 ims, ime, jms, jme, kms, kme,             &
6492                                 ips, ipe, jps, jpe, kps, kpe,             &
6493                                 its, ite, jts, jte, kts, kte              )
6494
6495    CALL a_set_physical_bc3d( a_defor22 , 't', config_flags,           &
6496                                 ids, ide, jds, jde, kds, kde,             &
6497                                 ims, ime, jms, jme, kms, kme,             &
6498                                 ips, ipe, jps, jpe, kps, kpe,             &
6499                                 its, ite, jts, jte, kts, kte              )
6500
6501    CALL a_set_physical_bc3d( a_defor11 , 't', config_flags,           &
6502                                 ids, ide, jds, jde, kds, kde,             &
6503                                 ims, ime, jms, jme, kms, kme,             &
6504                                 ips, ipe, jps, jpe, kps, kpe,             &
6505                                 its, ite, jts, jte, kts, kte              )
6506
6507    CALL a_set_physical_bc3d( a_div     , 't', config_flags,           &
6508                                 ids, ide, jds, jde, kds, kde,             &
6509                                 ims, ime, jms, jme, kms, kme,             &
6510                                 ips, ipe, jps, jpe, kps, kpe,             &
6511                                 its, ite, jts, jte, kts, kte              )
6512
6513    CALL a_set_physical_bc3d( a_xkhv    , 't', config_flags,           &
6514                                 ids, ide, jds, jde, kds, kde,             &
6515                                 ims, ime, jms, jme, kms, kme,             &
6516                                 ips, ipe, jps, jpe, kps, kpe,             &
6517                                 its, ite, jts, jte, kts, kte              )
6518
6519    CALL a_set_physical_bc3d( a_xkmv    , 't', config_flags,           &
6520                                 ids, ide, jds, jde, kds, kde,             &
6521                                 ims, ime, jms, jme, kms, kme,             &
6522                                 ips, ipe, jps, jpe, kps, kpe,             &
6523                                 its, ite, jts, jte, kts, kte              )
6524
6525    ENDIF
6526
6527    CALL a_set_physical_bc3d( a_xkhh    , 't', config_flags,           &
6528                                 ids, ide, jds, jde, kds, kde,             &
6529                                 ims, ime, jms, jme, kms, kme,             &
6530                                 ips, ipe, jps, jpe, kps, kpe,             &
6531                                 its, ite, jts, jte, kts, kte              )
6532
6533    CALL a_set_physical_bc3d( a_xkmh    , 't', config_flags,           &
6534                                 ids, ide, jds, jde, kds, kde,             &
6535                                 ims, ime, jms, jme, kms, kme,             &
6536                                 ips, ipe, jps, jpe, kps, kpe,             &
6537                                 its, ite, jts, jte, kts, kte              )
6538
6539    IF(config_flags%shcu_physics .GT. 0) THEN
6540
6541         CALL a_set_physical_bc3d( a_RVSHTEN , 't', config_flags,              &
6542                                 ids, ide, jds, jde, kds, kde,             &
6543                                 ims, ime, jms, jme, kms, kme,             &
6544                                 ips, ipe, jps, jpe, kps, kpe,             &
6545                                 its, ite, jts, jte, kts, kte              )
6546
6547         CALL a_set_physical_bc3d( a_RUSHTEN , 't', config_flags,              &
6548                                 ids, ide, jds, jde, kds, kde,             &
6549                                 ims, ime, jms, jme, kms, kme,             &
6550                                 ips, ipe, jps, jpe, kps, kpe,             &
6551                                 its, ite, jts, jte, kts, kte              )
6552
6553    ENDIF
6554
6555    IF(config_flags%cu_physics .GT. 0) THEN
6556
6557         CALL a_set_physical_bc3d( a_RVCUTEN , 't', config_flags,      &
6558                                 ids, ide, jds, jde, kds, kde,             &
6559                                 ims, ime, jms, jme, kms, kme,             &
6560                                 ips, ipe, jps, jpe, kps, kpe,             &
6561                                 its, ite, jts, jte, kts, kte              )
6562
6563         CALL a_set_physical_bc3d( a_RUCUTEN , 't', config_flags,      &
6564                                 ids, ide, jds, jde, kds, kde,             &
6565                                 ims, ime, jms, jme, kms, kme,             &
6566                                 ips, ipe, jps, jpe, kps, kpe,             &
6567                                 its, ite, jts, jte, kts, kte              )
6568
6569    ENDIF
6570
6571    IF(config_flags%bl_pbl_physics .GT. 0) THEN
6572
6573         CALL a_set_physical_bc3d( a_RVBLTEN , 't', config_flags,      &
6574                                 ids, ide, jds, jde, kds, kde,             &
6575                                 ims, ime, jms, jme, kms, kme,             &
6576                                 ips, ipe, jps, jpe, kps, kpe,             &
6577                                 its, ite, jts, jte, kts, kte              )
6578
6579         CALL a_set_physical_bc3d( a_RUBLTEN , 't', config_flags,      &
6580                                 ids, ide, jds, jde, kds, kde,             &
6581                                 ims, ime, jms, jme, kms, kme,             &
6582                                 ips, ipe, jps, jpe, kps, kpe,             &
6583                                 its, ite, jts, jte, kts, kte              )
6584
6585    ENDIF
6586
6587    END SUBROUTINE a_phy_bc
6588
6589    SUBROUTINE a_tke_km(config_flags,xkmh,a_xkmh,xkmv,a_xkmv,xkhh,a_xkhh,xkhv, &
6590    a_xkhv,bn2,a_bn2,tke,a_tke,p8w,a_p8w,t8w,a_t8w,theta,a_theta,rdz,a_rdz, &
6591    rdzw,a_rdzw,dx,dy,dt,isotropic,mix_upper_bound,msftx,msfty,ids,ide,jds,jde,kds,kde, &
6592    ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
6593
6594 !PART I: DECLARATION OF VARIABLES
6595
6596    IMPLICIT NONE
6597
6598    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
6599    TYPE(grid_config_rec_type) :: config_flags
6600    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
6601    INTEGER :: isotropic
6602    REAL :: dx,dy,dt
6603    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tke,a_tke,p8w,a_p8w,t8w,a_t8w,theta, &
6604    a_theta,rdz,a_rdz,rdzw,a_rdzw,bn2,a_bn2
6605    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: xkmh,a_xkmh,xkmv,a_xkmv,xkhh,a_xkhh, &
6606    xkhv,a_xkhv
6607    REAL :: mix_upper_bound
6608    REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty
6609    REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: l_scale,a_l_scale
6610    REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: dthrdn,a_dthrdn
6611    REAL :: deltas,a_deltas,tmp,a_tmp,mlen_s,a_mlen_s,mlen_h,a_mlen_h,mlen_v, &
6612    a_mlen_v,tmpdz,a_tmpdz,thetasfc,a_thetasfc,thetatop,a_thetatop,minkx, &
6613    a_minkx,pr_inv,a_pr_inv,pr_inv_h,a_pr_inv_h,pr_inv_v,a_pr_inv_v,c_k,a_c_k
6614    INTEGER :: i_start,i_end,j_start,j_end,ktf,i,j,k
6615    REAL,PARAMETER :: tke_seed_value =1.e-06
6616    REAL :: tke_seed
6617    REAL,PARAMETER :: epsilon =1.e-10
6618
6619 ! Remarked by Ning Pan, 2010-08-13
6620 !   REAL,DIMENSION(max(jds+1,jts):min(jde-2,jte)) :: Keep_Lpb16_tmpdz
6621 !   REAL,DIMENSION(max(jds+1,jts):min(jde-2,jte)) :: Keep_Lpb18_tmpdz
6622    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004
6623    REAL,ALLOCATABLE,DIMENSION(:) :: Tmpv200
6624    REAL,ALLOCATABLE,DIMENSION(:) :: Tmpv201
6625    REAL,ALLOCATABLE,DIMENSION(:,:) :: Tmpv300
6626    REAL,ALLOCATABLE,DIMENSION(:,:) :: Tmpv301
6627    REAL,ALLOCATABLE,DIMENSION(:,:,:) ::  &
6628      Tmpv400, &
6629      Tmpv401, Tmpv402, Tmpv403, Tmpv404, Tmpv405, Tmpv406, Tmpv407, Tmpv408, Tmpv409, Tmpv4010, &
6630      Tmpv4011, Tmpv4012, Tmpv4013, Tmpv4014, Tmpv4015, Tmpv4016, Tmpv4017, Tmpv4018, Tmpv4019, Tmpv4020, &
6631      Tmpv4021, Tmpv4022, Tmpv4023, Tmpv4024, Tmpv4025, Tmpv4026, Tmpv4027, Tmpv4028, Tmpv4029, Tmpv4030, &
6632      Tmpv4031
6633    REAL :: g_Sqrt
6634
6635    ALLOCATE (Tmpv200(its:min(ite,ide-1)))
6636    ALLOCATE (Tmpv201(its:min(ite,ide-1)))
6637    ALLOCATE (Tmpv300(its:min(ite,ide-1),kts+1:min(kte,kde-1)-1))
6638    ALLOCATE (Tmpv301(its:min(ite,ide-1),kts+1:min(kte,kde-1)-1))
6639    ALLOCATE (Tmpv400(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6640    ALLOCATE (Tmpv401(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6641    ALLOCATE (Tmpv402(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6642    ALLOCATE (Tmpv403(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6643    ALLOCATE (Tmpv404(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6644    ALLOCATE (Tmpv405(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6645    ALLOCATE (Tmpv406(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6646    ALLOCATE (Tmpv407(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6647    ALLOCATE (Tmpv408(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6648    ALLOCATE (Tmpv409(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6649    ALLOCATE (Tmpv4010(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6650    ALLOCATE (Tmpv4011(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6651    ALLOCATE (Tmpv4012(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6652    ALLOCATE (Tmpv4013(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6653    ALLOCATE (Tmpv4014(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6654    ALLOCATE (Tmpv4015(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6655    ALLOCATE (Tmpv4016(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6656    ALLOCATE (Tmpv4017(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6657    ALLOCATE (Tmpv4018(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6658    ALLOCATE (Tmpv4019(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6659    ALLOCATE (Tmpv4020(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6660    ALLOCATE (Tmpv4021(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6661    ALLOCATE (Tmpv4022(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6662    ALLOCATE (Tmpv4023(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6663    ALLOCATE (Tmpv4024(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6664    ALLOCATE (Tmpv4025(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6665    ALLOCATE (Tmpv4026(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6666    ALLOCATE (Tmpv4027(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6667    ALLOCATE (Tmpv4028(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6668    ALLOCATE (Tmpv4029(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6669    ALLOCATE (Tmpv4030(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6670    ALLOCATE (Tmpv4031(its:min(ite,ide-1),kts:min(kte,kde-1),max(jds+1,jts):min(jde-2,jte)))
6671 !PART II: CALCULATIONS OF B. S. TRAJECTORY
6672
6673 !LPB[0]
6674        ktf     = MIN( kte, kde-1 )
6675        i_start = its
6676        i_end   = MIN( ite, ide-1 )
6677        j_start = jts
6678        j_end   = MIN( jte, jde-1 )
6679
6680 !LPB[1]
6681     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
6682          config_flags%nested) i_start = MAX( ids+1, its )
6683
6684 !LPB[2]
6685
6686 !LPB[3]
6687     IF ( config_flags%open_xe .OR. config_flags%specified .OR.   &
6688          config_flags%nested) i_end   = MIN( ide-2, ite )
6689
6690 !LPB[4]
6691
6692 !LPB[5]
6693     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
6694          config_flags%nested) j_start = MAX( jds+1, jts )
6695
6696 !LPB[6]
6697
6698 !LPB[7]
6699     IF ( config_flags%open_ye .OR. config_flags%specified .OR.   &
6700          config_flags%nested) j_end   = MIN( jde-2, jte)
6701
6702 !LPB[8]
6703
6704 !LPB[9]
6705       IF ( config_flags%periodic_x ) i_start = its
6706
6707 !LPB[10]
6708
6709 !LPB[11]
6710       IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
6711
6712 !LPB[12]
6713        c_k = config_flags%c_k
6714        tke_seed = 0.
6715
6716 !LPB[13]
6717        IF (config_flags%isfflx .eq. 0) THEN
6718          IF ((config_flags%diff_opt .eq. 2) .and. (config_flags%bl_pbl_physics .eq. 0)) THEN
6719            IF( (config_flags%tke_drag_coefficient .lt. epsilon) .and.  &
6720                (config_flags%tke_heat_flux .lt. epsilon)  )  THEN
6721              tke_seed = tke_seed_value
6722            ENDIF
6723          ELSE
6724            !tke_drag_coefficient and tke_heat_flux are irrelevant here
6725            tke_seed = tke_seed_value
6726          ENDIF
6727        ENDIF
6728
6729 !LPB[14]
6730        DO j = j_start, j_end
6731
6732        DO k = kts+1, ktf-1
6733        DO i = i_start, i_end
6734          tmpdz         = 1.0/rdz(i,k+1,j) + 1.0/rdz(i,k,j)
6735          dthrdn(i,k,j) = ( theta(i,k+1,j) - theta(i,k-1,j) ) / tmpdz
6736        END DO
6737        END DO
6738
6739        END DO
6740
6741 !LPB[15]
6742        k = kts
6743
6744 !LPB[16]
6745        DO j = j_start, j_end
6746
6747 !       Keep_Lpb16_tmpdz(j) =tmpdz  ! Remarked by Ning Pan, 2010-08-13
6748
6749        DO i = i_start, i_end
6750          tmpdz         = 1.0/rdzw(i,k+1,j) + 1.0/rdzw(i,k,j)
6751          thetasfc      = T8w(i,kts,j) / ( p8w(i,k,j) / p1000mb )**( R_d / Cp )
6752          dthrdn(i,k,j) = ( theta(i,k+1,j) - thetasfc ) / tmpdz
6753        END DO
6754
6755        END DO
6756
6757 !LPB[17]
6758        k = ktf
6759
6760 !LPB[18]
6761        DO j = j_start, j_end
6762
6763 !       Keep_Lpb18_tmpdz(j) =tmpdz  ! Remarked by Ning Pan, 2010-08-13
6764
6765        DO i = i_start, i_end
6766          tmpdz         = 1.0 / rdz(i,k,j) + 0.5 / rdzw(i,k,j)
6767          thetatop      = T8w(i,kde,j) / ( p8w(i,kde,j) / p1000mb )**( R_d / Cp )
6768          dthrdn(i,k,j) = ( thetatop - theta(i,k-1,j) ) / tmpdz
6769        END DO
6770
6771        END DO
6772
6773 !LPB[19]
6774
6775 !!LPB[20]
6776 !    IF ( isotropic .EQ. 0 ) THEN
6777
6778 !         DO j = j_start, j_end
6779 !         DO k = kts, ktf
6780 !         DO i = i_start, i_end
6781 !           mlen_h = SQRT( dx/msftx(i,j) * dy/msfty(i,j) )
6782 !           tmp    = SQRT( MAX( tke(i,k,j), tke_seed ) )
6783 !           deltas = 1.0 / rdzw(i,k,j)
6784 !           mlen_v = deltas
6785 !        IF ( dthrdn(i,k,j) .GT. 0.) THEN
6786
6787 !             mlen_s = 0.76 * tmp / ( ABS( g / theta(i,k,j) * dthrdn(i,k,j) ) )**0.5
6788 !             mlen_v = MIN( mlen_v, mlen_s )
6789 !           END IF
6790 !           xkmh(i,k,j)  = MAX( c_k * tmp * mlen_h, 1.0E-6 * mlen_h * mlen_h )
6791 !           xkmh(i,k,j)  = MIN( xkmh(i,k,j), mix_upper_bound * mlen_h *mlen_h / dt )
6792 !           xkmv(i,k,j)  = MAX( c_k * tmp * mlen_v, 1.0E-6 * deltas * deltas )
6793 !           xkmv(i,k,j)  = MIN( xkmv(i,k,j), mix_upper_bound * deltas *deltas / dt )
6794 !           pr_inv_h     = 1./prandtl
6795 !           pr_inv_v     = 1.0 + 2.0 * mlen_v / deltas
6796 !           xkhh(i,k,j)  = xkmh(i,k,j) * pr_inv_h
6797 !           xkhv(i,k,j)  = xkmv(i,k,j) * pr_inv_v
6798 !         END DO
6799 !         END DO
6800 !         END DO
6801 !       ELSE
6802 !         CALL calc_l_scale( config_flags, tke, BN2, l_scale,        &
6803 !                            i_start, i_end, ktf, j_start, j_end,    &
6804 !                            dx, dy, rdzw, msftx, msfty,             &
6805 !                            ids, ide, jds, jde, kds, kde,           &
6806 !                            ims, ime, jms, jme, kms, kme,           &
6807 !                            its, ite, jts, jte, kts, kte          )
6808
6809 !         DO j = j_start, j_end
6810 !         DO k = kts, ktf
6811 !         DO i = i_start, i_end
6812 !           tmp          = SQRT( MAX( tke(i,k,j), tke_seed ) )
6813 !           deltas       = ( dx/msftx(i,j) * dy/msfty(i,j) / rdzw(i,k,j) )**0.33333333
6814 !           xkmh(i,k,j)  = c_k * tmp * l_scale(i,k,j)
6815 !           xkmh(i,k,j)  = MIN( mix_upper_bound * dx/msftx(i,j) * dy/msfty(i,j) &
6816 !    / dt,  xkmh(i,k,j) )
6817 !           xkmv(i,k,j)  = c_k * tmp * l_scale(i,k,j)
6818 !           xkmv(i,k,j)  = MIN( mix_upper_bound / rdzw(i,k,j) / rdzw(i,k,j) / dt ,  xkmv(i,k,j) )
6819 !           pr_inv       = 1.0 + 2.0 * l_scale(i,k,j) / deltas
6820 !           xkhh(i,k,j)  = MIN( mix_upper_bound * dx/msftx(i,j) * dy/msfty(i,j) &
6821 !    / dt, xkmh(i,k,j) * pr_inv )
6822 !           xkhv(i,k,j)  = MIN( mix_upper_bound / rdzw(i,k,j) / rdzw(i,k,j) &
6823 !    / dt, xkmv(i,k,j) * pr_inv )
6824 !         END DO
6825 !         END DO
6826 !         END DO
6827
6828 !   END IF
6829
6830 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
6831
6832    Do K2_ADJ =jts, jte
6833    Do K1_ADJ =kts, kte
6834    Do K0_ADJ =its, ite
6835    a_l_scale(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
6836    End Do
6837    End Do
6838    End Do
6839
6840    Do K2_ADJ =jts, jte
6841    Do K1_ADJ =kts, kte
6842    Do K0_ADJ =its, ite
6843    a_dthrdn(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
6844    End Do
6845    End Do
6846    End Do
6847
6848    a_deltas =0.0
6849    a_tmp =0.0
6850    a_mlen_s =0.0
6851    a_mlen_h =0.0
6852    a_mlen_v =0.0
6853    a_tmpdz =0.0
6854    a_thetasfc =0.0
6855    a_thetatop =0.0
6856    a_minkx =0.0
6857    a_pr_inv =0.0
6858    a_pr_inv_h =0.0
6859    a_pr_inv_v =0.0
6860    a_c_k =0.0
6861
6862 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
6863
6864 !LPB[20]
6865
6866 !ADDED BY WALLS
6867 !isotropic =1
6868
6869    IF( isotropic .EQ. 0 ) THEN
6870    DO j =j_start, j_end
6871    DO k =kts, ktf
6872    DO i =i_start, i_end
6873    mlen_h =sqrt(dx/msftx(i,j)*dy/msfty(i,j))
6874    Tmpv400(i,k,j) =mlen_h
6875
6876    tmp =sqrt(max(tke(i,k,j), tke_seed))
6877    Tmpv401(i,k,j) =tmp
6878
6879    deltas =1.0/rdzw(i,k,j)
6880    Tmpv402(i,k,j) =deltas
6881
6882    mlen_v =deltas
6883 !   Tmpv403(i,k,j) =mlen_v  ! Remarked by Ning Pan, 2010-08-13
6884
6885    IF( dthrdn(i,k,j) .GT. 0.) THEN
6886    Tmpv001 =g/theta(i,k,j)*dthrdn(i,k,j)
6887    Tmpv404(i,k,j) =Tmpv001
6888    Tmpv002 =abs(Tmpv404(i,k,j))
6889    Tmpv405(i,k,j) =Tmpv002
6890    Tmpv003 =Tmpv405(i,k,j)**0.5
6891    Tmpv406(i,k,j) =Tmpv003
6892    Tmpv004 =0.76*tmp/Tmpv406(i,k,j)
6893    mlen_s =Tmpv004
6894
6895 !REVISED AND ADDED BY WALLS
6896    Tmpv4020(i,k,j) =mlen_s
6897    Tmpv407(i,k,j) =mlen_v
6898
6899    Tmpv001 =min(mlen_v, mlen_s)
6900    mlen_v =Tmpv001
6901
6902    END IF
6903
6904    Tmpv001 =c_k*tmp
6905    Tmpv408(i,k,j) =Tmpv001
6906    Tmpv002 =Tmpv408(i,k,j)*mlen_h
6907    Tmpv409(i,k,j) =Tmpv002
6908    Tmpv4010(i,k,j) =Tmpv409(i,k,j)
6909    Tmpv003 =max(Tmpv4010(i,k,j), 1.0E-6*mlen_h*mlen_h)
6910    xkmh(i,k,j) =Tmpv003
6911    Tmpv4011(i,k,j) =xkmh(i,k,j)
6912
6913    Tmpv001 =min(xkmh(i,k,j), mix_upper_bound*mlen_h*mlen_h/dt)
6914    xkmh(i,k,j) =Tmpv001
6915    Tmpv4012(i,k,j) =xkmh(i,k,j)
6916
6917    Tmpv403(i,k,j) =mlen_v  ! Added by Ning Pan, 2010-08-13
6918    Tmpv001 =c_k*tmp
6919    Tmpv4013(i,k,j) =Tmpv001
6920    Tmpv002 =Tmpv4013(i,k,j)*mlen_v
6921    Tmpv4014(i,k,j) =Tmpv002
6922    Tmpv4015(i,k,j) =Tmpv4014(i,k,j)
6923    Tmpv003 =max(Tmpv4015(i,k,j), 1.0E-6*deltas*deltas)
6924    xkmv(i,k,j) =Tmpv003
6925    Tmpv4016(i,k,j) =xkmv(i,k,j)
6926
6927    Tmpv001 =min(xkmv(i,k,j), mix_upper_bound*deltas*deltas/dt)
6928    xkmv(i,k,j) =Tmpv001
6929    Tmpv4017(i,k,j) =xkmv(i,k,j)
6930
6931    pr_inv_h =1./prandtl
6932    Tmpv4018(i,k,j) =pr_inv_h
6933
6934    Tmpv001 =2.0*mlen_v/deltas
6935    Tmpv002 =1.0 +Tmpv001
6936    pr_inv_v =Tmpv002
6937    Tmpv4019(i,k,j) =pr_inv_v
6938
6939    Tmpv001 =xkmh(i,k,j)*pr_inv_h
6940    xkhh(i,k,j) =Tmpv001
6941
6942    Tmpv001 =xkmv(i,k,j)*pr_inv_v
6943    xkhv(i,k,j) =Tmpv001
6944
6945    ENDDO
6946    ENDDO
6947    ENDDO
6948
6949    ELSE
6950
6951    CALL calc_l_scale(config_flags,tke,BN2,l_scale,i_start,i_end,ktf,j_start,j_end,dx,  &
6952    dy,rdzw,msftx,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
6953    DO j =j_start, j_end
6954    DO k =kts, ktf
6955    DO i =i_start, i_end
6956    tmp =sqrt(max(tke(i,k,j), tke_seed))
6957    Tmpv4020(i,k,j) =tmp
6958
6959    deltas =(dx/msftx(i,j)*dy/msfty(i,j)/rdzw(i,k,j))**0.33333333
6960    Tmpv4021(i,k,j) =deltas
6961
6962    Tmpv001 =c_k*tmp
6963    Tmpv4022(i,k,j) =Tmpv001
6964    Tmpv002 =Tmpv4022(i,k,j)*l_scale(i,k,j)
6965 !   Tmpv4023(i,k,j) =xkmh(i,k,j)  ! Remarked by Ning Pan, 2010-08-13
6966    xkmh(i,k,j) =Tmpv002
6967
6968    Tmpv4024(i,k,j) =xkmh(i,k,j)
6969    xkmh(i,k,j) =min(mix_upper_bound*dx/msftx(i,j)*dy/msfty(i,j)/dt, xkmh(i,k,j))
6970
6971    Tmpv001 =c_k*tmp
6972    Tmpv4025(i,k,j) =Tmpv001
6973    Tmpv002 =Tmpv4025(i,k,j)*l_scale(i,k,j)
6974 !   Tmpv4026(i,k,j) =xkmv(i,k,j)  ! Remarked by Ning Pan, 2010-08-13
6975    xkmv(i,k,j) =Tmpv002
6976
6977    Tmpv4027(i,k,j) =xkmv(i,k,j)
6978    xkmv(i,k,j) =min(mix_upper_bound/rdzw(i,k,j)/rdzw(i,k,j)/dt, xkmv(i,k,j))
6979
6980    Tmpv001 =2.0*l_scale(i,k,j)/deltas
6981    Tmpv002 =1.0 +Tmpv001
6982    pr_inv =Tmpv002
6983    Tmpv4028(i,k,j) =pr_inv
6984
6985    Tmpv001 =xkmh(i,k,j)*pr_inv
6986    Tmpv4029(i,k,j) =Tmpv001
6987    xkhh(i,k,j) =min(mix_upper_bound*dx/msftx(i,j)*dy/msfty(i,j)/dt, Tmpv4029(i,k,j))
6988
6989    Tmpv001 =xkmv(i,k,j)*pr_inv
6990    Tmpv4030(i,k,j) =Tmpv001
6991    xkhv(i,k,j) =min(mix_upper_bound/rdzw(i,k,j)/rdzw(i,k,j)/dt, Tmpv4030(i,k,j))
6992
6993    ENDDO
6994    ENDDO
6995    ENDDO
6996    END IF
6997
6998    IF( isotropic .EQ. 0 ) THEN
6999
7000    DO j =j_end, j_start, -1
7001    DO k =ktf, kts, -1
7002    DO i =i_end, i_start, -1
7003 !ADDED BY WALLS
7004    mlen_h =Tmpv400(i,k,j)
7005    tmp =Tmpv401(i,k,j)
7006    deltas =Tmpv402(i,k,j)
7007    mlen_v =Tmpv403(i,k,j)
7008
7009    pr_inv_v =Tmpv4019(i,k,j)
7010    pr_inv_h =Tmpv4018(i,k,j)
7011    xkmv(i,k,j) =Tmpv4017(i,k,j)
7012    xkmh(i,k,j) =Tmpv4012(i,k,j)
7013
7014    a_Tmpv1 =a_xkhv(i,k,j)
7015    a_xkhv(i,k,j) =0.0
7016    a_xkmv(i,k,j) =a_xkmv(i,k,j) +pr_inv_v*a_Tmpv1
7017    a_pr_inv_v =a_pr_inv_v +xkmv(i,k,j)*a_Tmpv1
7018
7019    a_Tmpv1 =a_xkhh(i,k,j)
7020    a_xkhh(i,k,j) =0.0
7021    a_xkmh(i,k,j) =a_xkmh(i,k,j) +pr_inv_h*a_Tmpv1
7022    a_pr_inv_h =a_pr_inv_h +xkmh(i,k,j)*a_Tmpv1
7023
7024    a_Tmpv2 =a_pr_inv_v
7025    a_pr_inv_v =0.0
7026    a_Tmpv1 =a_Tmpv2
7027    a_mlen_v =a_mlen_v +2.0/deltas*a_Tmpv1
7028    a_deltas =a_deltas -2.0*mlen_v/(deltas*deltas)*a_Tmpv1
7029
7030    a_pr_inv_h =0.0
7031
7032    xkmv(i,k,j) =Tmpv4016(i,k,j)
7033
7034    a_Tmpv1 =a_xkmv(i,k,j)
7035    a_xkmv(i,k,j) =0.0
7036    a_xkmv(i,k,j) =a_xkmv(i,k,j)  +(1.0 -sign(1.0, xkmv(i,k,j) -mix_upper_bound*  &
7037    deltas*deltas/dt))*0.5*1.0*a_Tmpv1
7038    a_deltas =a_deltas  +(1.0 +sign(1.0, xkmv(i,k,j) -mix_upper_bound*deltas*  &
7039    deltas/dt))*0.5*(mix_upper_bound*deltas +mix_upper_bound*deltas)/dt*a_Tmpv1
7040
7041    a_Tmpv3 =a_xkmv(i,k,j)
7042    a_xkmv(i,k,j) =0.0
7043    a_Tmpv2 =(1.0 +sign(1.0, Tmpv4015(i,k,j) -1.0E-6*deltas*deltas))*0.5*a_Tmpv3
7044    a_deltas =a_deltas  +(1.0 -sign(1.0, Tmpv4015(i,k,j) -1.0E-6*deltas*deltas))  &
7045    *0.5*(1.0E-6*deltas +1.0E-6*deltas)*a_Tmpv3
7046    a_Tmpv1 =mlen_v*a_Tmpv2
7047    a_mlen_v =a_mlen_v +Tmpv4013(i,k,j)*a_Tmpv2
7048    a_c_k =a_c_k +tmp*a_Tmpv1
7049    a_tmp =a_tmp +c_k*a_Tmpv1
7050
7051    xkmh(i,k,j) =Tmpv4011(i,k,j)
7052
7053    a_Tmpv1 =a_xkmh(i,k,j)
7054    a_xkmh(i,k,j) =0.0
7055    a_xkmh(i,k,j) =a_xkmh(i,k,j)  +(1.0 -sign(1.0, xkmh(i,k,j) -mix_upper_bound*  &
7056    mlen_h*mlen_h/dt))*0.5*1.0*a_Tmpv1
7057    a_mlen_h =a_mlen_h  +(1.0 +sign(1.0, xkmh(i,k,j) -mix_upper_bound*mlen_h*  &
7058    mlen_h/dt))*0.5*(mix_upper_bound*mlen_h +mix_upper_bound*mlen_h)/dt*a_Tmpv1
7059
7060    a_Tmpv3 =a_xkmh(i,k,j)
7061    a_xkmh(i,k,j) =0.0
7062    a_Tmpv2 =(1.0 +sign(1.0, Tmpv4010(i,k,j) -1.0E-6*mlen_h*mlen_h))*0.5*a_Tmpv3
7063    a_mlen_h =a_mlen_h  +(1.0 -sign(1.0, Tmpv4010(i,k,j) -1.0E-6*mlen_h*mlen_h))  &
7064    *0.5*(1.0E-6*mlen_h +1.0E-6*mlen_h)*a_Tmpv3
7065    a_Tmpv1 =mlen_h*a_Tmpv2
7066    a_mlen_h =a_mlen_h +Tmpv408(i,k,j)*a_Tmpv2
7067    a_c_k =a_c_k +tmp*a_Tmpv1
7068    a_tmp =a_tmp +c_k*a_Tmpv1
7069
7070    IF( dthrdn(i,k,j) .GT. 0.) THEN
7071
7072 !REVISED AND ADDED BY WALLS
7073    mlen_s =Tmpv4020(i,k,j)
7074    mlen_v =Tmpv407(i,k,j)
7075
7076 !MOVE FROM BELOW
7077    a_Tmpv1 =a_mlen_v
7078    a_mlen_v =0.0
7079    a_mlen_v =a_mlen_v  +(1.0 -sign(1.0, mlen_v -mlen_s))*0.5*1.0*a_Tmpv1
7080    a_mlen_s =a_mlen_s  +(1.0 +sign(1.0, mlen_v -mlen_s))*0.5*1.0*a_Tmpv1
7081
7082    a_Tmpv4 =a_mlen_s
7083    a_mlen_s =0.0
7084    a_tmp =a_tmp +0.76/Tmpv406(i,k,j)*a_Tmpv4
7085    a_Tmpv3 =-0.76*tmp/(Tmpv406(i,k,j)*Tmpv406(i,k,j))*a_Tmpv4
7086    a_Tmpv2 =0.5*Tmpv405(i,k,j)**(0.5 -1)*a_Tmpv3
7087    a_Tmpv1 =sign(1.0, Tmpv404(i,k,j))*a_Tmpv2
7088    a_theta(i,k,j) =a_theta(i,k,j) -g/(theta(i,k,j)*theta(i,k,j))*dthrdn(i,k,j)*a_Tmpv1
7089    a_dthrdn(i,k,j) =a_dthrdn(i,k,j) +g/theta(i,k,j)*a_Tmpv1
7090
7091 !MOVE LINES TO ABOVE
7092 !  a_Tmpv1 =a_mlen_v
7093 !  a_mlen_v =0.0
7094 !  a_mlen_v =a_mlen_v  +(1.0 -sign(1.0, mlen_v -mlen_s))*0.5*1.0*a_Tmpv1
7095 !  a_mlen_s =a_mlen_s  +(1.0 +sign(1.0, mlen_v -mlen_s))*0.5*1.0*a_Tmpv1
7096
7097    END IF
7098
7099 !  mlen_v =Tmpv403(i,k,j)
7100
7101    a_deltas =a_deltas +a_mlen_v
7102    a_mlen_v =0.0
7103
7104 !  deltas =Tmpv402(i,k,j)
7105
7106    a_rdzw(i,k,j) =a_rdzw(i,k,j) -1.0/(rdzw(i,k,j)*rdzw(i,k,j))*a_deltas
7107    a_deltas =0.0
7108
7109 !  tmp =Tmpv401(i,k,j)
7110
7111    a_tke(i,k,j) =a_tke(i,k,j) +g_Sqrt((1.0 +(1.0)*sign(1.0, tke(i,k,j)  &
7112     -tke_seed))*0.5, max(tke(i,k,j), tke_seed))*a_tmp
7113    a_tmp =0.0
7114
7115 !  mlen_h =Tmpv400(i,k,j)
7116
7117    a_mlen_h =0.0
7118    ENDDO
7119    ENDDO
7120    ENDDO
7121
7122    ELSE
7123
7124    DO j =j_end, j_start, -1
7125    DO k =ktf, kts, -1
7126    DO i =i_end, i_start, -1
7127    tmp =Tmpv4020(i,k,j)
7128    deltas =Tmpv4021(i,k,j)
7129    pr_inv =Tmpv4028(i,k,j)
7130
7131 !DELETED BY WALLS
7132 !  (1.0 -(-1.0)*sign(1.0, mix_upper_bound/rdzw(i,k,j)/rdzw(i,k,j)/dt -Tmpv4030(i,k,j)  &
7133 !  ))*0.5* =a_xkhv(i,k,j)
7134
7135    a_Tmpv2 =a_xkhv(i,k,j)
7136    a_xkhv(i,k,j) =0.0
7137    a_rdzw(i,k,j) =a_rdzw(i,k,j)  +(1.0 -sign(1.0, mix_upper_bound/rdzw(i,k,j)  &
7138    /rdzw(i,k,j)/dt -Tmpv4030(i,k,j)))*0.5*(-mix_upper_bound/(rdzw(i,k,j)*rdzw(i,k,j))  &
7139    *rdzw(i,k,j) -mix_upper_bound/rdzw(i,k,j))/(rdzw(i,k,j)*rdzw(i,k,j))/dt*a_Tmpv2
7140    a_Tmpv1 =(1.0 +sign(1.0, mix_upper_bound/rdzw(i,k,j)/rdzw(i,k,j)/dt -Tmpv4030(i,  &
7141    k,j)))*0.5*a_Tmpv2
7142    a_xkmv(i,k,j) =a_xkmv(i,k,j) +pr_inv*a_Tmpv1
7143    a_pr_inv =a_pr_inv +xkmv(i,k,j)*a_Tmpv1
7144 !REVISED BY WALLS
7145 !  (1.0 -(-1.0)*sign(1.0, mix_upper_bound*dx/msftx(i,j)*dy/msfty(i,j)/dt -Tmpv4029(i,  &
7146 !  k,j)))*0.5* =a_xkhh(i,k,j)
7147    a_Tmpv1 =(1.0 -(-1.0)*sign(1.0, mix_upper_bound*dx/msftx(i,j)*dy/msfty(i,j)/dt -Tmpv4029(i,  &
7148    k,j)))*0.5*a_xkhh(i,k,j)
7149    a_xkhh(i,k,j) =0.0
7150    a_xkmh(i,k,j) =a_xkmh(i,k,j) +pr_inv*a_Tmpv1
7151    a_pr_inv =a_pr_inv +xkmh(i,k,j)*a_Tmpv1
7152
7153    a_Tmpv2 =a_pr_inv
7154    a_pr_inv =0.0
7155    a_Tmpv1 =a_Tmpv2
7156    a_l_scale(i,k,j) =a_l_scale(i,k,j) +2.0/deltas*a_Tmpv1
7157    a_deltas =a_deltas -2.0*l_scale(i,k,j)/(deltas*deltas)*a_Tmpv1
7158
7159    xkmv(i,k,j) =Tmpv4027(i,k,j)
7160
7161    a_Tmpv1 =a_xkmv(i,k,j)
7162    a_xkmv(i,k,j) =0.0
7163    a_rdzw(i,k,j) =a_rdzw(i,k,j)  +(1.0 -sign(1.0, mix_upper_bound/rdzw(i,k,j)  &
7164    /rdzw(i,k,j)/dt -xkmv(i,k,j)))*0.5*(-mix_upper_bound/(rdzw(i,k,j)*rdzw(i,k,j))  &
7165    *rdzw(i,k,j) -mix_upper_bound/rdzw(i,k,j))/(rdzw(i,k,j)*rdzw(i,k,j))/dt*a_Tmpv1
7166    a_xkmv(i,k,j) =a_xkmv(i,k,j)  +(1.0 +sign(1.0, mix_upper_bound/rdzw(i,k,j)  &
7167    /rdzw(i,k,j)/dt -xkmv(i,k,j)))*0.5*1.0*a_Tmpv1
7168
7169 !   xkmv(i,k,j) =Tmpv4026(i,k,j)  ! Remarked by Ning Pan, 2010-08-13
7170
7171    a_Tmpv2 =a_xkmv(i,k,j)
7172    a_xkmv(i,k,j) =0.0
7173    a_Tmpv1 =l_scale(i,k,j)*a_Tmpv2
7174    a_l_scale(i,k,j) =a_l_scale(i,k,j) +Tmpv4025(i,k,j)*a_Tmpv2
7175    a_c_k =a_c_k +tmp*a_Tmpv1
7176    a_tmp =a_tmp +c_k*a_Tmpv1
7177
7178    xkmh(i,k,j) =Tmpv4024(i,k,j)
7179
7180    a_xkmh(i,k,j) =(1.0 -(-1.0)*sign(1.0, mix_upper_bound*dx/msftx(i,j)  &
7181    *dy/msfty(i,j)/dt -xkmh(i,k,j)))*0.5*a_xkmh(i,k,j)
7182
7183 !   xkmh(i,k,j) =Tmpv4023(i,k,j)  ! Remarked by Ning Pan, 2010-08-13
7184
7185    a_Tmpv2 =a_xkmh(i,k,j)
7186    a_xkmh(i,k,j) =0.0
7187    a_Tmpv1 =l_scale(i,k,j)*a_Tmpv2
7188    a_l_scale(i,k,j) =a_l_scale(i,k,j) +Tmpv4022(i,k,j)*a_Tmpv2
7189    a_c_k =a_c_k +tmp*a_Tmpv1
7190    a_tmp =a_tmp +c_k*a_Tmpv1
7191
7192    a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx/msftx(i,j)*dy/msfty(i,j)/(rdzw(i,k,j)  &
7193    *rdzw(i,k,j))*0.33333333*(dx/msftx(i,j)*dy/msfty(i,j)/rdzw(i,k,j))**(0.33333333 -1)*a_deltas
7194    a_deltas =0.0
7195
7196    a_tke(i,k,j) =a_tke(i,k,j) +g_Sqrt((1.0 +(1.0)*sign(1.0, tke(i,k,j)  &
7197     -tke_seed))*0.5, max(tke(i,k,j), tke_seed))*a_tmp
7198    a_tmp =0.0
7199
7200    ENDDO
7201    ENDDO
7202    ENDDO
7203
7204    CALL a_calc_l_scale(config_flags,tke,a_tke,BN2,a_BN2,l_scale,a_l_scale,  &
7205    i_start,i_end,ktf,j_start,j_end,dx,dy,rdzw,a_rdzw,msftx,msfty,ids,ide,jds,jde,kds,  &
7206    kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
7207
7208    END IF
7209
7210 !LPB[19]
7211
7212 !ADDED BY WALLS
7213 !FROM LPB[17]
7214    k = ktf
7215
7216 !LPB[18]
7217    DO j =j_end, j_start, -1
7218
7219 !   tmpdz =Keep_Lpb18_tmpdz(j)  ! Remarked by Ning Pan, 2010-08-13
7220
7221    DO i =i_start, i_end
7222    tmpdz =1.0/rdz(i,k,j)+0.5/rdzw(i,k,j)
7223    Tmpv200(i) =tmpdz
7224
7225    Tmpv001 =T8w(i,kde,j)/(p8w(i,kde,j)/p1000mb)**(R_d/Cp)
7226    thetatop =Tmpv001
7227
7228    Tmpv001 =thetatop -theta(i,k-1,j)
7229    Tmpv201(i) =Tmpv001
7230 ! Remarked by Ning Pan, 2010-08-13
7231 !   Tmpv002 =Tmpv201(i)/tmpdz
7232 !   dthrdn(i,k,j) =Tmpv002
7233
7234    ENDDO
7235
7236    DO i =i_end, i_start, -1
7237    tmpdz =Tmpv200(i)
7238
7239    a_Tmpv2 =a_dthrdn(i,k,j)
7240    a_dthrdn(i,k,j) =0.0
7241    a_Tmpv1 =a_Tmpv2/tmpdz
7242    a_tmpdz =a_tmpdz -Tmpv201(i)/(tmpdz*tmpdz)*a_Tmpv2
7243    a_thetatop =a_thetatop +a_Tmpv1
7244    a_theta(i,k-1,j) =a_theta(i,k-1,j) -a_Tmpv1
7245    a_Tmpv1 =a_thetatop
7246    a_thetatop =0.0
7247    a_T8w(i,kde,j) =a_T8w(i,kde,j) +a_Tmpv1/(p8w(i,kde,j)/p1000mb)**(R_d/Cp)
7248    a_p8w(i,kde,j) =a_p8w(i,kde,j) -(R_d/Cp)*1.0/p1000mb*(p8w(i,kde,j)/p1000mb)  &
7249    **((R_d/Cp) -1)*T8w(i,kde,j)/((p8w(i,kde,j)/p1000mb)**(R_d/Cp)*(p8w(i,kde,j)/p1000mb)  &
7250    **(R_d/Cp))*a_Tmpv1
7251
7252    a_Tmpv1 =a_tmpdz
7253    a_tmpdz =0.0
7254    a_rdz(i,k,j) =a_rdz(i,k,j) -1.0/(rdz(i,k,j)*rdz(i,k,j))*a_Tmpv1
7255    a_rdzw(i,k,j) =a_rdzw(i,k,j) -0.5/(rdzw(i,k,j)*rdzw(i,k,j))*a_Tmpv1
7256
7257    ENDDO
7258
7259    ENDDO
7260
7261 !LPB[17]
7262 !  k =ktf
7263
7264 !ADDED BY WALLS
7265 !FROM LPB[15]
7266    k = kts
7267
7268 !LPB[16]
7269    DO j =j_end, j_start, -1
7270
7271 !   tmpdz =Keep_Lpb16_tmpdz(j)  ! Remarked by Ning Pan, 2010-08-13
7272
7273    DO i =i_start, i_end
7274    tmpdz =1.0/rdzw(i,k+1,j) + 1.0/rdzw(i,k,j)
7275    Tmpv200(i) =tmpdz
7276
7277    Tmpv001 =T8w(i,kts,j)/(p8w(i,k,j)/p1000mb)**(R_d/Cp)
7278    thetasfc =Tmpv001
7279
7280    Tmpv001 =theta(i,k+1,j) -thetasfc
7281    Tmpv201(i) =Tmpv001
7282 ! Remarked by Ning Pan, 2010-08-13
7283 !   Tmpv002 =Tmpv201(i)/tmpdz
7284 !   dthrdn(i,k,j) =Tmpv002
7285
7286    ENDDO
7287
7288    DO i =i_end, i_start, -1
7289    tmpdz =Tmpv200(i)
7290
7291    a_Tmpv2 =a_dthrdn(i,k,j)
7292    a_dthrdn(i,k,j) =0.0
7293    a_Tmpv1 =a_Tmpv2/tmpdz
7294    a_tmpdz =a_tmpdz -Tmpv201(i)/(tmpdz*tmpdz)*a_Tmpv2
7295    a_theta(i,k+1,j) =a_theta(i,k+1,j) +a_Tmpv1
7296    a_thetasfc =a_thetasfc -a_Tmpv1
7297    a_Tmpv1 =a_thetasfc
7298    a_thetasfc =0.0
7299    a_T8w(i,kts,j) =a_T8w(i,kts,j) +a_Tmpv1/(p8w(i,k,j)/p1000mb)**(R_d/Cp)
7300    a_p8w(i,k,j) =a_p8w(i,k,j) -(R_d/Cp)*1.0/p1000mb*(p8w(i,k,j)/p1000mb)  &
7301    **((R_d/Cp) -1)*T8w(i,kts,j)/((p8w(i,k,j)/p1000mb)**(R_d/Cp)*(p8w(i,k,j)/p1000mb)  &
7302    **(R_d/Cp))*a_Tmpv1
7303
7304 !BIG ERRORS, ADDED BY WALLS
7305 !BIG ERRORS, ADDED BY WALLS
7306 !BIG ERRORS, ADDED BY WALLS
7307 Tmpv001 =(rdzw(i,k+1,j)+rdzw(i,k,j))
7308
7309    a_Tmpv2 =a_tmpdz
7310    a_tmpdz =0.0
7311    a_Tmpv1 =-(1.0)*a_Tmpv2/(Tmpv001*Tmpv001)
7312    !hcl a_rdzw(i,k+1,j) =a_rdzw(i,k+1,j) +a_Tmpv1
7313    !hcl a_rdzw(i,k,j) =a_rdzw(i,k,j) +a_Tmpv1
7314    a_rdzw(i,k+1,j) =a_rdzw(i,k+1,j) - a_tmpv2/(rdzw(i,k+1,j)*rdzw(i,k+1,j))
7315    a_rdzw(i,k,j) =a_rdzw(i,k,j) - a_tmpv2/(rdzw(i,k,j)*rdzw(i,k,j))
7316
7317    ENDDO
7318
7319    ENDDO
7320
7321 !LPB[15]
7322 !  k =kts
7323
7324 !LPB[14]
7325    DO j =j_end, j_start, -1
7326
7327    DO k =kts+1, ktf-1
7328    DO i =i_start, i_end
7329    tmpdz = 1.0/rdz(i,k+1,j) + 1.0/rdz(i,k,j)
7330    Tmpv300(i,k) =tmpdz
7331
7332    Tmpv001 =theta(i,k+1,j) -theta(i,k-1,j)
7333    Tmpv301(i,k) =Tmpv001
7334 ! Remarked by Ning Pan, 2010-08-13
7335 !   Tmpv002 =Tmpv301(i,k)/tmpdz
7336 !   dthrdn(i,k,j) =Tmpv002
7337
7338    ENDDO
7339    ENDDO
7340
7341    DO k =ktf-1, kts+1, -1
7342    DO i =i_end, i_start, -1
7343    tmpdz =Tmpv300(i,k)
7344
7345    a_Tmpv2 =a_dthrdn(i,k,j)
7346    a_dthrdn(i,k,j) =0.0
7347    a_Tmpv1 =a_Tmpv2/tmpdz
7348    a_tmpdz =a_tmpdz -Tmpv301(i,k)/(tmpdz*tmpdz)*a_Tmpv2
7349    a_theta(i,k+1,j) =a_theta(i,k+1,j) +a_Tmpv1
7350    a_theta(i,k-1,j) =a_theta(i,k-1,j) -a_Tmpv1
7351
7352 !BIG ERRORS, ADDED BY WALLS
7353 !BIG ERRORS, ADDED BY WALLS
7354 !BIG ERRORS, ADDED BY WALLS
7355 Tmpv001 =(rdz(i,k+1,j)+rdz(i,k,j))
7356
7357    a_Tmpv2 =a_tmpdz
7358    a_tmpdz =0.0
7359    a_Tmpv1 =-(1.0)*a_Tmpv2/(Tmpv001*Tmpv001)
7360    !hcl a_rdz(i,k+1,j) =a_rdz(i,k+1,j) +a_Tmpv1
7361    !hcl a_rdz(i,k,j) =a_rdz(i,k,j) +a_Tmpv1
7362    a_rdz(i,k+1,j) =a_rdz(i,k+1,j) - a_tmpv2/(rdz(i,k+1,j)*rdz(i,k+1,j))
7363    a_rdz(i,k,j) =a_rdz(i,k,j) - a_tmpv2/(rdz(i,k,j)*rdz(i,k,j))
7364
7365    ENDDO
7366    ENDDO
7367
7368    ENDDO
7369
7370 !LPB[13]
7371
7372 !  IF( (config_flags%tke_drag_coefficient .gt. epsilon) .or.            (config_flags%tke_heat_flux .gt. epsilon)  ) THEN
7373 !  tke_seed =0.
7374 !  END IF
7375
7376 !  IF( (config_flags%tke_drag_coefficient .gt. epsilon) .or.    &
7377 !           (config_flags%tke_heat_flux .gt. epsilon)  ) THEN
7378
7379 !  END IF
7380
7381 !LPB[12]
7382 !  c_k =config_flags%c_k
7383
7384 !  tke_seed =tke_seed_value
7385
7386 !REVISED BY WALLS
7387 !  a_config_flags%c_k =a_config_flags%c_k +a_c_k
7388    a_c_k =0.0
7389
7390 !LPB[11]
7391
7392 !  IF( config_flags%periodic_x ) THEN
7393 !  i_end =min(ite, ide-1)
7394 !  END IF
7395
7396 !  IF( config_flags%periodic_x ) THEN
7397
7398 !  END IF
7399
7400 !LPB[10]
7401
7402 !LPB[9]
7403
7404 !  IF( config_flags%periodic_x ) THEN
7405 !  i_start =its
7406 !  END IF
7407
7408 !  IF( config_flags%periodic_x ) THEN
7409
7410 !  END IF
7411
7412 !LPB[8]
7413
7414 !LPB[7]
7415
7416 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.             config_flags%nested) THEN
7417 !  j_end =min(jde-2, jte)
7418 !  END IF
7419
7420 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
7421 !            config_flags%nested) THEN
7422
7423 !  END IF
7424
7425 !LPB[6]
7426
7427 !LPB[5]
7428
7429 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.             config_flags%nested) THEN
7430 !  j_start =max(jds+1, jts)
7431 !  END IF
7432
7433 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
7434 !            config_flags%nested) THEN
7435
7436 !  END IF
7437
7438 !LPB[4]
7439
7440 !LPB[3]
7441
7442 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.             config_flags%nested) THEN
7443 !  i_end =min(ide-2, ite)
7444 !  END IF
7445
7446 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
7447 !            config_flags%nested) THEN
7448
7449 !  END IF
7450
7451 !LPB[2]
7452
7453 !LPB[1]
7454
7455 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.             config_flags%nested) THEN
7456 !  i_start =max(ids+1, its)
7457 !  END IF
7458
7459 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
7460 !            config_flags%nested) THEN
7461
7462 !  END IF
7463
7464 !LPB[0]
7465 !  ktf =min(kte, kde-1)
7466 !  i_start =its
7467 !  i_end =min(ite, ide-1)
7468 !  j_start =jts
7469 !  j_end =min(jte, jde-1)
7470
7471    DEALLOCATE ( Tmpv200, Tmpv201, Tmpv300, Tmpv301, &
7472      Tmpv400, &
7473      Tmpv401, Tmpv402, Tmpv403, Tmpv404, Tmpv405, Tmpv406, Tmpv407, Tmpv408, Tmpv409, Tmpv4010, &
7474      Tmpv4011, Tmpv4012, Tmpv4013, Tmpv4014, Tmpv4015, Tmpv4016, Tmpv4017, Tmpv4018, Tmpv4019, Tmpv4020, &
7475      Tmpv4021, Tmpv4022, Tmpv4023, Tmpv4024, Tmpv4025, Tmpv4026, Tmpv4027, Tmpv4028, Tmpv4029, Tmpv4030, &
7476      Tmpv4031 )
7477
7478    END SUBROUTINE a_tke_km
7479
7480    SUBROUTINE a_tke_rhs(tendency,a_tendency,BN2,a_BN2,config_flags,defor11, &
7481    a_defor11,defor22,a_defor22,defor33,a_defor33,defor12,a_defor12,defor13, &
7482    a_defor13,defor23,a_defor23,u,a_u,v,a_v,w,a_w,div,a_div,tke,a_tke,mu, &
7483    a_mu,c1,c2,theta,a_theta,p,a_p,p8w,a_p8w,t8w,a_t8w,z,a_z,fnm,fnp,cf1,cf2,cf3, &
7484    msftx,msfty,xkmh,a_xkmh,xkmv,a_xkmv,xkhv,a_xkhv,rdx,rdy,dx,dy,dt,zx,a_zx,zy, &
7485    a_zy,rdz,a_rdz,rdzw,a_rdzw,dn,dnw,isotropic,hfx,a_hfx,qfx,a_qfx,qv,a_qv, &
7486    ust,a_ust,rho,a_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts, &
7487    jte,kts,kte)
7488
7489 !PART I: DECLARATION OF VARIABLES
7490
7491    IMPLICIT NONE
7492
7493    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
7494    TYPE(grid_config_rec_type) :: config_flags
7495    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
7496    INTEGER :: isotropic
7497    REAL :: cf1,cf2,cf3,dt,rdx,rdy,dx,dy
7498    REAL,DIMENSION(kms:kme) :: fnm,fnp,dnw,dn
7499    REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty
7500    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
7501    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor11,a_defor11,defor22,a_defor22, &
7502    defor33,a_defor33,defor12,a_defor12,defor13,a_defor13,defor23,a_defor23,div, &
7503    a_div,BN2,a_BN2,tke,a_tke,xkmh,a_xkmh,xkmv,a_xkmv,xkhv,a_xkhv,zx,a_zx, &
7504    zy,a_zy,u,a_u,v,a_v,w,a_w,theta,a_theta,p,a_p,p8w,a_p8w,t8w,a_t8w,z, &
7505    a_z,rdz,a_rdz,rdzw,a_rdzw
7506    REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
7507    real, dimension(kms:kme) :: c1, c2
7508    REAL,DIMENSION(ims:ime,jms:jme) :: hfx,a_hfx,ust,a_ust,qfx,a_qfx
7509    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: qv,a_qv,rho,a_rho
7510    INTEGER :: i,j,k,ktf,i_start,i_end,j_start,j_end
7511
7512    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb0_tendency
7513    INTEGER :: IX1,IX2,IX3
7514
7515    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003
7516    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv300
7517    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv301
7518    REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv400
7519    REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv401
7520    REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv402
7521
7522     REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) &
7523     :: tke_buoy_tend, tke_shear_tend
7524
7525     REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) &
7526     :: l_scale
7527
7528     REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) &
7529     :: nlflux, dlk
7530
7531     REAL, DIMENSION( ims:ime, kms:kme, jms:jme ) &
7532     :: xkmh_t
7533
7534     REAL, DIMENSION( ims:ime, jms:jme ) &
7535     :: hpbl
7536
7537 !PART II: CALCULATIONS OF B. S. TRAJECTORY
7538
7539 !LPB[0]
7540 ! Remarked by Ning Pan, 2010-08-13
7541 !   DO IX3=jms,jme
7542 !   DO IX2=kms,kme
7543 !   DO IX1=ims,ime
7544 !       Keep_Lpb0_tendency(IX1,IX2,IX3) =tendency(IX1,IX2,IX3)
7545 !   END DO
7546 !   END DO
7547 !   END DO
7548
7549        CALL tke_shear(    tendency, config_flags,                  &
7550                           defor11, defor22, defor33,               &
7551                           defor12, defor13, defor23,               &
7552                           u, v, w, tke, ust, mu,                   &
7553                           c1, c2, fnm, fnp,                        &
7554                           cf1, cf2, cf3, msftx, msfty,             &
7555                           xkmh, xkmv,                              &
7556                           rdx, rdy, zx, zy, rdz, rdzw, dnw, dn,    &
7557                           ids, ide, jds, jde, kds, kde,            &
7558                           ims, ime, jms, jme, kms, kme,            &
7559                           its, ite, jts, jte, kts, kte           )
7560        CALL tke_buoyancy( tendency, config_flags, mu,              &
7561                           c1, c2,                                  &
7562                           tke, xkhv, BN2, theta, dt,               &
7563                           hfx, qfx, qv,  rho,                      &
7564                           nlflux,                                  &
7565                           ids, ide, jds, jde, kds, kde,            &
7566                           ims, ime, jms, jme, kms, kme,            &
7567                           its, ite, jts, jte, kts, kte           )
7568        CALL tke_dissip(   tendency, config_flags, mu, c1, c2,      &
7569                           tke, bn2, theta, p8w, t8w, z,            &
7570                           dx, dy,rdz, rdzw, isotropic,             &
7571                           msftx, msfty,                            &
7572                           hpbl, dlk,  l_scale,                      &
7573                           ids, ide, jds, jde, kds, kde,            &
7574                           ims, ime, jms, jme, kms, kme,            &
7575                           its, ite, jts, jte, kts, kte           )
7576        ktf     = MIN( kte, kde-1 )
7577        i_start = its
7578        i_end   = MIN( ite, ide-1 )
7579        j_start = jts
7580        j_end   = MIN( jte, jde-1 )
7581
7582 !LPB[1]
7583     IF ( config_flags%open_xs .or. config_flags%specified .or.   &
7584          config_flags%nested) i_start = MAX(ids+1,its)
7585
7586 !LPB[2]
7587
7588 !LPB[3]
7589     IF ( config_flags%open_xe .or. config_flags%specified .or.   &
7590          config_flags%nested) i_end   = MIN(ide-2,ite)
7591
7592 !LPB[4]
7593
7594 !LPB[5]
7595     IF ( config_flags%open_ys .or. config_flags%specified .or.   &
7596          config_flags%nested) j_start = MAX(jds+1,jts)
7597
7598 !LPB[6]
7599
7600 !LPB[7]
7601     IF ( config_flags%open_ye .or. config_flags%specified .or.   &
7602          config_flags%nested) j_end   = MIN(jde-2,jte)
7603
7604 !LPB[8]
7605
7606 !LPB[9]
7607       IF ( config_flags%periodic_x ) i_start = its
7608
7609 !LPB[10]
7610
7611 !LPB[11]
7612       IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
7613
7614 !!LPB[12]
7615 !       DO j = j_start, j_end
7616
7617 !       DO k = kts, ktf
7618 !       DO i = i_start, i_end
7619 !         tendency(i,k,j) = max( tendency(i,k,j), -mu(i,j) * max( 0.0 , tke(i,k,j) ) / dt )
7620 !       END DO
7621 !       END DO
7622
7623 !       END DO
7624
7625 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
7626
7627 !LPB[12]
7628    DO j =j_end, j_start, -1
7629
7630 ! Remarks removed by Ning Pan, 2010-08-13
7631    DO k =kts, ktf
7632    DO i =i_start, i_end
7633    Tmpv001 =-mu(i,j)*max(0.0, tke(i,k,j))
7634    Tmpv002 =Tmpv001/dt
7635    Tmpv300(i,k) =Tmpv002
7636    Tmpv301(i,k) =Tmpv300(i,k)
7637 !  Tmpv003 =max(tendency(i,k,j), Tmpv301(i,k))
7638 !  tendency(i,k,j) =Tmpv003
7639
7640 ! Remarks removed by Ning Pan, 2010-08-13
7641    ENDDO
7642    ENDDO
7643
7644    DO k =ktf, kts, -1
7645    DO i =i_end, i_start, -1
7646    a_Tmpv3 =a_tendency(i,k,j)
7647    a_tendency(i,k,j) =0.0
7648    a_tendency(i,k,j) =a_tendency(i,k,j)  +(1.0 +sign(1.0, tendency(i,k,j)  &
7649     -Tmpv301(i,k)))*0.5*1.0*a_Tmpv3
7650    a_Tmpv2 =(1.0 -sign(1.0, tendency(i,k,j) -Tmpv301(i,k)))*0.5*a_Tmpv3
7651    a_Tmpv1 =a_Tmpv2/dt
7652    a_mu(i,j) =a_mu(i,j) -max(0.0, tke(i,k,j))*a_Tmpv1
7653    a_tke(i,k,j) =a_tke(i,k,j) -mu(i,j)*(1.0 +(-1.0)*sign(1.0, 0.0 -tke(i,k,j)))  &
7654    *0.5*a_Tmpv1
7655    ENDDO
7656    ENDDO
7657
7658    ENDDO
7659
7660 !LPB[11]
7661
7662 !  IF( config_flags%periodic_x ) THEN
7663 !  i_end =min(ite, ide-1)
7664 !  END IF
7665
7666 !  IF( config_flags%periodic_x ) THEN
7667
7668 !  END IF
7669
7670 !LPB[10]
7671
7672 !LPB[9]
7673
7674 !  IF( config_flags%periodic_x ) THEN
7675 !  i_start =its
7676 !  END IF
7677
7678 !  IF( config_flags%periodic_x ) THEN
7679
7680 !  END IF
7681
7682 !LPB[8]
7683
7684 !LPB[7]
7685
7686 !  IF( config_flags%open_ye .or. config_flags%specified .or.             config_flags%nested) THEN
7687 !  j_end =min(jde-2, jte)
7688 !  END IF
7689
7690 !  IF( config_flags%open_ye .or. config_flags%specified .or.   &
7691 !            config_flags%nested) THEN
7692
7693 !  END IF
7694
7695 !LPB[6]
7696
7697 !LPB[5]
7698
7699 !  IF( config_flags%open_ys .or. config_flags%specified .or.             config_flags%nested) THEN
7700 !  j_start =max(jds+1, jts)
7701 !  END IF
7702
7703 !  IF( config_flags%open_ys .or. config_flags%specified .or.   &
7704 !            config_flags%nested) THEN
7705
7706 !  END IF
7707
7708 !LPB[4]
7709
7710 !LPB[3]
7711
7712 !  IF( config_flags%open_xe .or. config_flags%specified .or.             config_flags%nested) THEN
7713 !  i_end =min(ide-2, ite)
7714 !  END IF
7715
7716 !  IF( config_flags%open_xe .or. config_flags%specified .or.   &
7717 !            config_flags%nested) THEN
7718
7719 !  END IF
7720
7721 !LPB[2]
7722
7723 !LPB[1]
7724
7725 !  IF( config_flags%open_xs .or. config_flags%specified .or.             config_flags%nested) THEN
7726 !  i_start =max(ids+1, its)
7727 !  END IF
7728
7729 !  IF( config_flags%open_xs .or. config_flags%specified .or.   &
7730 !            config_flags%nested) THEN
7731
7732 !  END IF
7733
7734 !LPB[0]
7735 ! Remarked by Ning Pan, 2010-08-13
7736 !   DO IX3=jms,jme
7737 !   DO IX2=kms,kme
7738 !   DO IX1=ims,ime
7739 !   tendency(IX1,IX2,IX3) =Keep_Lpb0_tendency(IX1,IX2,IX3)
7740 !   END DO
7741 !   END DO
7742 !   END DO
7743
7744 !   DO IX3=jms,jme
7745 !   DO IX2=kms,kme
7746 !   DO IX1=ims,ime
7747 !   Tmpv400(IX1,IX2,IX3) =tendency(IX1,IX2,IX3)
7748 !   END DO
7749 !   END DO
7750 !   END DO
7751
7752 !   CALL tke_shear(tendency,config_flags,defor11,defor22,defor33,defor12,defor13,  &
7753 !   defor23,u,v,w,tke,ust,mu,fnm,fnp,cf1,cf2,cf3,msftx,msfty,xkmh,xkmv,rdx,rdy,zx,zy,rdz,  &
7754 !   rdzw,dnw,dn,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
7755
7756 !   DO IX3=jms,jme
7757 !   DO IX2=kms,kme
7758 !   DO IX1=ims,ime
7759 !   Tmpv401(IX1,IX2,IX3) =tendency(IX1,IX2,IX3)
7760 !   END DO
7761 !   END DO
7762 !   END DO
7763
7764 !   CALL tke_buoyancy(tendency,config_flags,mu,tke,xkhv,BN2,theta,dt,hfx,qfx,qv,rho,  &
7765 !   ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
7766
7767 !   DO IX3=jms,jme
7768 !   DO IX2=kms,kme
7769 !   DO IX1=ims,ime
7770 !   Tmpv402(IX1,IX2,IX3) =tendency(IX1,IX2,IX3)
7771 !   END DO
7772 !   END DO
7773 !   END DO
7774
7775 !   CALL tke_dissip(tendency,config_flags,mu,tke,bn2,theta,p8w,t8w,z,dx,dy,rdz,rdzw,  &
7776 !   isotropic,msftx,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,  &
7777 !   jte,kts,kte)
7778
7779 !   ktf =min(kte, kde-1)
7780 !   i_start =its
7781 !   i_end =min(ite, ide-1)
7782 !   j_start =jts
7783 !   j_end =min(jte, jde-1)
7784
7785 !   DO IX3=jms,jme
7786 !   DO IX2=kms,kme
7787 !   DO IX1=ims,ime
7788 !   tendency(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
7789 !   END DO
7790 !   END DO
7791 !   END DO
7792
7793    CALL a_tke_dissip(tendency,a_tendency,config_flags,mu,a_mu,tke,a_tke,bn2,  &
7794    a_bn2,theta,a_theta,p8w,a_p8w,t8w,a_t8w,z,a_z,dx,dy,rdz,a_rdz,rdzw,  &
7795    a_rdzw,isotropic,msftx,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,  &
7796    ite,jts,jte,kts,kte)
7797
7798 ! Remarked by Ning Pan, 2010-08-13
7799 !   DO IX3=jms,jme
7800 !   DO IX2=kms,kme
7801 !   DO IX1=ims,ime
7802 !   tendency(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
7803 !   END DO
7804 !   END DO
7805 !   END DO
7806
7807    CALL a_tke_buoyancy(tendency,a_tendency,config_flags,mu,a_mu,tke,a_tke,  &
7808    xkhv,a_xkhv,BN2,a_BN2,theta,a_theta,dt,hfx,a_hfx,qfx,a_qfx,qv,a_qv,rho,  &
7809    a_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
7810
7811 ! Remarked by Ning Pan, 2010-08-13
7812 !   DO IX3=jms,jme
7813 !   DO IX2=kms,kme
7814 !   DO IX1=ims,ime
7815 !   tendency(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
7816 !   END DO
7817 !   END DO
7818 !   END DO
7819
7820    CALL a_tke_shear(tendency,a_tendency,config_flags,defor11,a_defor11,defor22,  &
7821    a_defor22,defor33,a_defor33,defor12,a_defor12,defor13,a_defor13,defor23,  &
7822    a_defor23,u,a_u,v,a_v,w,a_w,tke,a_tke,ust,a_ust,mu,a_mu,fnm,fnp,cf1,  &
7823    cf2,cf3,msftx,msfty,xkmh,a_xkmh,xkmv,a_xkmv,rdx,rdy,zx,a_zx,zy,a_zy,rdz,  &
7824    a_rdz,rdzw,a_rdzw,dnw,dn,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,  &
7825    jts,jte,kts,kte)
7826
7827    END SUBROUTINE a_tke_rhs
7828
7829    SUBROUTINE a_calc_l_scale(config_flags,tke,a_tke,BN2,a_BN2,l_scale,a_l_scale, &
7830    i_start,i_end,ktf,j_start,j_end,dx,dy,rdzw,a_rdzw,msftx,msfty,ids,ide,jds,jde,kds, &
7831    kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
7832
7833 !PART I: DECLARATION OF VARIABLES
7834
7835    IMPLICIT NONE
7836
7837    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
7838    TYPE(grid_config_rec_type) :: config_flags
7839    INTEGER :: i_start,i_end,ktf,j_start,j_end,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme, &
7840    kms,kme,its,ite,jts,jte,kts,kte
7841    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: BN2,a_BN2,tke,a_tke,rdzw,a_rdzw
7842    REAL :: dx,dy
7843    REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: l_scale,a_l_scale
7844    REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty
7845    INTEGER :: i,j,k
7846    REAL :: deltas,a_deltas,tmp,a_tmp
7847
7848    REAL :: a_Tmpv1,Tmpv001
7849    REAL,DIMENSION(i_start:i_end,kts:ktf) :: Tmpv300
7850    REAL,DIMENSION(i_start:i_end,kts:ktf) :: Tmpv301,Tmpv302,Tmpv303  ! Added by Ning Pan, 2010-08-12
7851
7852    REAL :: g_Sqrt
7853
7854 !PART II: CALCULATIONS OF B. S. TRAJECTORY
7855
7856 !!LPB[0]
7857 !       DO j = j_start, j_end
7858
7859 !
7860 !       DO k = kts, ktf
7861 !       DO i = i_start, i_end
7862 !         deltas         = ( dx/msftx(i,j) * dy/msfty(i,j) / rdzw(i,k,j) )**0.33333333
7863 !         l_scale(i,k,j) = deltas
7864 !      IF ( BN2(i,k,j) .gt. 1.0e-6 ) THEN
7865
7866 !           tmp            = SQRT( MAX( tke(i,k,j), 1.0e-6 ) )
7867 !           l_scale(i,k,j) = 0.76 * tmp / SQRT( BN2(i,k,j) )
7868 !           l_scale(i,k,j) = MIN( l_scale(i,k,j), deltas)
7869 !           l_scale(i,k,j) = MAX( l_scale(i,k,j), 0.001 * deltas )
7870 !         END IF
7871 !       END DO
7872 !       END DO
7873
7874 !       END DO
7875
7876 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
7877
7878    a_deltas =0.0
7879    a_tmp =0.0
7880
7881 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
7882
7883 !LPB[0]
7884    DO j =j_end, j_start, -1
7885
7886    DO k =kts, ktf
7887    DO i =i_start, i_end
7888    deltas =(dx/msftx(i,j)*dy/msfty(i,j)/rdzw(i,k,j))**0.33333333
7889    Tmpv301(i,k) = deltas  ! Added by Ning Pan, 2010-08-13
7890
7891    l_scale(i,k,j) =deltas
7892
7893    IF( BN2(i,k,j) .gt. 1.0e-6 ) THEN
7894 ! Revised by Ning Pan, 2010-08-12
7895 !   Tmpv300(i,k) =tmp
7896 !   tmp =sqrt(max(tke(i,k,j), 1.0e-6))
7897    tmp =sqrt(max(tke(i,k,j), 1.0e-6))
7898    Tmpv300(i,k) =tmp
7899
7900    Tmpv001 =0.76*tmp/sqrt(BN2(i,k,j))
7901    l_scale(i,k,j) =Tmpv001
7902
7903    Tmpv302(i,k) = l_scale(i,k,j)  ! Added by Ning Pan, 2010-08-12
7904    Tmpv001 =min(l_scale(i,k,j), deltas)
7905    l_scale(i,k,j) =Tmpv001
7906
7907 ! Remarked by Ning Pan, 2010-08-13
7908 !   Tmpv001 =max(l_scale(i,k,j), 0.001*deltas)
7909 !   l_scale(i,k,j) =Tmpv001
7910
7911    END IF
7912    ENDDO
7913    ENDDO
7914
7915    DO k =ktf, kts, -1
7916    DO i =i_end, i_start, -1
7917
7918    IF( BN2(i,k,j) .gt. 1.0e-6 ) THEN
7919
7920    deltas = Tmpv301(i,k)  ! Added by Ning Pan, 2010-08-13
7921    a_Tmpv1 =a_l_scale(i,k,j)
7922    a_l_scale(i,k,j) =0.0
7923    a_l_scale(i,k,j) =a_l_scale(i,k,j)  +(1.0 +sign(1.0, l_scale(i,k,j)  &
7924     -0.001*deltas))*0.5*1.0*a_Tmpv1
7925    a_deltas =a_deltas  +(1.0 -sign(1.0, l_scale(i,k,j) -0.001*deltas))*0.5*0.001*a_Tmpv1
7926    l_scale(i,k,j) = Tmpv302(i,k)  ! Added by Ning Pan, 2010-08-12
7927    a_Tmpv1 =a_l_scale(i,k,j)
7928    a_l_scale(i,k,j) =0.0
7929    a_l_scale(i,k,j) =a_l_scale(i,k,j)  +(1.0 -sign(1.0, l_scale(i,k,j) -deltas))  &
7930    *0.5*1.0*a_Tmpv1
7931    a_deltas =a_deltas  +(1.0 +sign(1.0, l_scale(i,k,j) -deltas))*0.5*1.0*a_Tmpv1
7932    tmp =Tmpv300(i,k)  ! Added by Ning Pan, 2010-08-12
7933    a_Tmpv1 =a_l_scale(i,k,j)
7934    a_l_scale(i,k,j) =0.0
7935    a_tmp =a_tmp +0.76/sqrt(BN2(i,k,j))*a_Tmpv1
7936    a_BN2(i,k,j) =a_BN2(i,k,j) -g_Sqrt(1.0, BN2(i,k,j))*0.76*tmp/(sqrt(BN2(i,k,  &
7937    j))*sqrt(BN2(i,k,j)))*a_Tmpv1
7938
7939 !   tmp =Tmpv300(i,k)  ! Remarked by Ning Pan, 2010-08-12
7940
7941    a_tke(i,k,j) =a_tke(i,k,j) +g_Sqrt((1.0 +(1.0)*sign(1.0, tke(i,k,j)  &
7942     -1.0e-6))*0.5, max(tke(i,k,j), 1.0e-6))*a_tmp
7943    a_tmp =0.0
7944
7945    END IF
7946    a_deltas =a_deltas +a_l_scale(i,k,j)
7947    a_l_scale(i,k,j) =0.0
7948    a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx/msftx(i,j)*dy/msfty(i,j)/(rdzw(i,k,j)  &
7949    *rdzw(i,k,j))*0.33333333*(dx/msftx(i,j)*dy/msfty(i,j)/rdzw(i,k,j))**(0.33333333 -1)*a_deltas
7950    a_deltas =0.0
7951    ENDDO
7952    ENDDO
7953
7954    ENDDO
7955
7956    END SUBROUTINE a_calc_l_scale
7957
7958    SUBROUTINE a_tke_buoyancy(tendency,a_tendency,config_flags,mu,a_mu,tke,a_tke, &
7959    xkhv,a_xkhv,BN2,a_BN2,theta,a_theta,dt,hfx,a_hfx,qfx,a_qfx,qv,a_qv,rho, &
7960    a_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
7961
7962 !PART I: DECLARATION OF VARIABLES
7963
7964    IMPLICIT NONE
7965
7966    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
7967    TYPE(grid_config_rec_type) :: config_flags
7968    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
7969    REAL :: dt
7970    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
7971    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: xkhv,a_xkhv,tke,a_tke,BN2,a_BN2, &
7972    theta,a_theta
7973    REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
7974    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: qv,a_qv,rho,a_rho
7975    REAL,DIMENSION(ims:ime,jms:jme) :: hfx,a_hfx,qfx,a_qfx
7976    INTEGER :: i,j,k,ktf
7977    INTEGER :: i_start,i_end,j_start,j_end
7978    REAL :: heat_flux,a_heat_flux,heat_flux0,a_heat_flux0
7979    REAL :: cpm,a_cpm
7980
7981    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
7982    a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006
7983    REAL,DIMENSION(its:min(ite,ide-1),min0(kts+1,max(jds+1,jts)):max0(min(kte,kde-1) &
7984    ,min(jde-2,jte))) :: Tmpv300
7985    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv301
7986    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv302
7987    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv303
7988    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv304
7989    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv305
7990
7991 !PART II: CALCULATIONS OF B. S. TRAJECTORY
7992
7993 !LPB[0]
7994        ktf     = MIN( kte, kde-1 )
7995        i_start = its
7996        i_end   = MIN( ite, ide-1 )
7997        j_start = jts
7998        j_end   = MIN( jte, jde-1 )
7999
8000 !LPB[1]
8001     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
8002          config_flags%nested ) i_start = MAX( ids+1, its )
8003
8004 !LPB[2]
8005
8006 !LPB[3]
8007     IF ( config_flags%open_xe .OR. config_flags%specified .OR.   &
8008          config_flags%nested ) i_end   = MIN( ide-2, ite )
8009
8010 !LPB[4]
8011
8012 !LPB[5]
8013     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
8014          config_flags%nested ) j_start = MAX( jds+1, jts )
8015
8016 !LPB[6]
8017
8018 !LPB[7]
8019     IF ( config_flags%open_ye .OR. config_flags%specified .OR.   &
8020          config_flags%nested ) j_end   = MIN( jde-2, jte )
8021
8022 !LPB[8]
8023
8024 !LPB[9]
8025       IF ( config_flags%periodic_x ) i_start = its
8026
8027 !LPB[10]
8028
8029 !LPB[11]
8030       IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
8031
8032 !LPB[12]
8033        DO j = j_start, j_end
8034
8035        DO k = kts+1, ktf
8036        DO i = i_start, i_end
8037          tendency(i,k,j) = tendency(i,k,j) - mu(i,j) * xkhv(i,k,j) * BN2(i,k,j)
8038        END DO
8039        END DO
8040
8041        END DO
8042
8043 !LPB[13]
8044
8045 !!LPB[14]
8046 !  hflux: SELECT CASE( config_flags%isfflx )
8047
8048 !     CASE (0,2)
8049 !      heat_flux0 = config_flags%tke_heat_flux
8050 !      K=KTS
8051
8052 !      DO j = j_start, j_end
8053 !      DO i = i_start, i_end
8054 !         heat_flux = heat_flux0
8055 !         tendency(i,k,j)= tendency(i,k,j) -   &
8056 !                      mu(i,j)*((xkhv(i,k,j)*BN2(i,k,j))- (g/theta(i,k,j))*heat_flux)/2.
8057 !      ENDDO
8058 !      ENDDO
8059 !     CASE (1)
8060 !      K=KTS
8061
8062 !      DO j = j_start, j_end
8063 !      DO i = i_start, i_end
8064 !         cpm = cp * (1. + 0.8*qv(i,k,j))
8065 !         heat_flux = (hfx(i,j)/cpm)/rho(i,k,j)
8066 !         tendency(i,k,j)= tendency(i,k,j) -   &
8067 !                      mu(i,j)*((xkhv(i,k,j)*BN2(i,k,j))- (g/theta(i,k,j))*heat_flux)/2.
8068 !      ENDDO
8069 !      ENDDO
8070 !     CASE DEFAULT
8071 !       CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' )
8072
8073 !   END SELECT hflux
8074
8075 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
8076
8077    a_heat_flux =0.0
8078 !   a_heat_flux0 =0.0  ! Remarked by Ning Pan, 2010-08-12
8079    a_cpm =0.0
8080
8081 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
8082
8083 !LPB[14]
8084
8085    SELECT CASE (config_flags%isfflx)
8086    CASE(0,2)
8087    heat_flux0 =config_flags%tke_heat_flux
8088
8089    K =KTS
8090    DO j =j_start, j_end
8091    DO i =i_start, i_end
8092 ! Revised by Ning Pan, 2010-08-12
8093 !   Tmpv300(i,j) =heat_flux
8094 !   heat_flux =heat_flux0
8095    heat_flux =heat_flux0
8096    Tmpv300(i,j) =heat_flux
8097
8098    Tmpv001 =xkhv(i,k,j)*BN2(i,k,j)
8099    Tmpv002 =(g/theta(i,k,j))*heat_flux
8100    Tmpv003 =Tmpv001 -Tmpv002
8101    Tmpv301(i,j) =Tmpv003
8102 ! Remarked by Ning Pan, 2010-08-12
8103 !   Tmpv004 =mu(i,j)*Tmpv301(i,j)
8104 !   Tmpv005 =Tmpv004/2.
8105 !   Tmpv006 =tendency(i,k,j) -Tmpv005
8106 !   tendency(i,k,j) =Tmpv006
8107
8108    ENDDO
8109    ENDDO
8110    CASE(1)
8111    K =KTS
8112    DO j =j_start, j_end
8113    DO i =i_start, i_end
8114 ! Revised by Ning Pan, 2010-08-12
8115 !   Tmpv302(i,j) =cpm
8116 !   cpm =cp*(1. +0.8*qv(i,k,j))
8117    cpm =cp*(1. +0.8*qv(i,k,j))
8118    Tmpv302(i,j) =cpm
8119
8120    Tmpv001 =hfx(i,j)/cpm
8121    Tmpv303(i,j) =Tmpv001
8122    Tmpv002 =Tmpv303(i,j)/rho(i,k,j)
8123 ! Revised by Ning Pan, 2010-08-12
8124 !   Tmpv304(i,j) =heat_flux
8125 !   heat_flux =Tmpv002
8126    heat_flux =Tmpv002
8127    Tmpv304(i,j) =heat_flux
8128
8129    Tmpv001 =xkhv(i,k,j)*BN2(i,k,j)
8130    Tmpv002 =(g/theta(i,k,j))*heat_flux
8131    Tmpv003 =Tmpv001 -Tmpv002
8132    Tmpv305(i,j) =Tmpv003
8133    Tmpv004 =mu(i,j)*Tmpv305(i,j)
8134    Tmpv005 =Tmpv004/2.
8135    Tmpv006 =tendency(i,k,j) -Tmpv005
8136    tendency(i,k,j) =Tmpv006
8137
8138    ENDDO
8139    ENDDO
8140    CASE DEFAULT
8141    CALL wrf_error_fatal('isfflx value invalid for diff_opt=2')
8142
8143 ! Revised by Ning Pan, 2010-08-12
8144 !   END SELECT hflux
8145    END SELECT
8146
8147    SELECT CASE (config_flags%isfflx)
8148
8149    CASE(0,2)
8150
8151    DO j =j_end, j_start, -1
8152    DO i =i_end, i_start, -1
8153    heat_flux =Tmpv300(i,j)  ! Added by Ning Pan, 2010-08-12
8154    a_Tmpv6 =a_tendency(i,k,j)
8155    a_tendency(i,k,j) =0.0
8156    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv6
8157    a_Tmpv5 =-a_Tmpv6
8158    a_Tmpv4 =a_Tmpv5/2.
8159    a_mu(i,j) =a_mu(i,j) +Tmpv301(i,j)*a_Tmpv4
8160    a_Tmpv3 =mu(i,j)*a_Tmpv4
8161    a_Tmpv1 =a_Tmpv3
8162    a_Tmpv2 =-a_Tmpv3
8163    a_theta(i,k,j) =a_theta(i,k,j) -g/(theta(i,k,j)*theta(i,k,j))*heat_flux*a_Tmpv2
8164    a_heat_flux =a_heat_flux +(g/theta(i,k,j))*a_Tmpv2
8165    a_xkhv(i,k,j) =a_xkhv(i,k,j) +BN2(i,k,j)*a_Tmpv1
8166    a_BN2(i,k,j) =a_BN2(i,k,j) +xkhv(i,k,j)*a_Tmpv1
8167
8168 !   heat_flux =Tmpv300(i,j)  ! Remarked by Ning Pan, 2010-08-12
8169
8170 !   a_heat_flux0 =a_heat_flux0 +a_heat_flux  ! Remarked by Ning Pan, 2010-08-12
8171    a_heat_flux =0.0
8172    ENDDO
8173    ENDDO
8174 ! Remarked by Ning Pan, 2010-08-12
8175 !   a_config_flags%tke_heat_flux =a_config_flags%tke_heat_flux +a_heat_flux0
8176 !   a_heat_flux0 =0.0
8177
8178    CASE(1)
8179
8180    DO j =j_end, j_start, -1
8181    DO i =i_end, i_start, -1
8182 ! Added by Ning Pan, 2010-08-12
8183    cpm =Tmpv302(i,j)
8184    heat_flux =Tmpv304(i,j)
8185
8186    a_Tmpv6 =a_tendency(i,k,j)
8187    a_tendency(i,k,j) =0.0
8188    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv6
8189    a_Tmpv5 =-a_Tmpv6
8190    a_Tmpv4 =a_Tmpv5/2.
8191    a_mu(i,j) =a_mu(i,j) +Tmpv305(i,j)*a_Tmpv4
8192    a_Tmpv3 =mu(i,j)*a_Tmpv4
8193    a_Tmpv1 =a_Tmpv3
8194    a_Tmpv2 =-a_Tmpv3
8195    a_theta(i,k,j) =a_theta(i,k,j) -g/(theta(i,k,j)*theta(i,k,j))*heat_flux*a_Tmpv2
8196    a_heat_flux =a_heat_flux +(g/theta(i,k,j))*a_Tmpv2
8197    a_xkhv(i,k,j) =a_xkhv(i,k,j) +BN2(i,k,j)*a_Tmpv1
8198    a_BN2(i,k,j) =a_BN2(i,k,j) +xkhv(i,k,j)*a_Tmpv1
8199
8200 !   heat_flux =Tmpv304(i,j)  ! Remarked by Ning Pan, 2010-08-12
8201
8202    a_Tmpv2 =a_heat_flux
8203    a_heat_flux =0.0
8204    a_Tmpv1 =a_Tmpv2/rho(i,k,j)
8205    a_rho(i,k,j) =a_rho(i,k,j) -Tmpv303(i,j)/(rho(i,k,j)*rho(i,k,j))*a_Tmpv2
8206    a_hfx(i,j) =a_hfx(i,j) +a_Tmpv1/cpm
8207    a_cpm =a_cpm -hfx(i,j)/(cpm*cpm)*a_Tmpv1
8208
8209 !   cpm =Tmpv302(i,j)  ! Remarked by Ning Pan, 2010-08-12
8210
8211    a_qv(i,k,j) =a_qv(i,k,j) +cp*0.8*a_cpm
8212    a_cpm =0.0
8213    ENDDO
8214    ENDDO
8215
8216    CASE DEFAULT
8217
8218 ! Revised by Ning Pan, 2010-08-12
8219 !   CALL a_wrf_error_fatal('isfflx value invalid for diff_opt=2')
8220    CALL wrf_error_fatal('isfflx value invalid for diff_opt=2')
8221
8222 ! Revised by Ning Pan, 2010-08-12
8223 !   END SELECT hflux
8224    END SELECT
8225
8226 !LPB[13]
8227
8228 !LPB[12]
8229    DO j =j_end, j_start, -1
8230
8231    DO k =kts+1, ktf
8232    DO i =i_start, i_end
8233    Tmpv001 =mu(i,j)*xkhv(i,k,j)
8234    Tmpv300(i,k) =Tmpv001
8235 ! Remarked by Ning Pan, 2010-08-12
8236 !   Tmpv002 =Tmpv300(i,k)*BN2(i,k,j)
8237 !   Tmpv003 =tendency(i,k,j) -Tmpv002
8238 !   tendency(i,k,j) =Tmpv003
8239
8240    ENDDO
8241    ENDDO
8242
8243    DO k =ktf, kts+1, -1
8244    DO i =i_end, i_start, -1
8245    a_Tmpv3 =a_tendency(i,k,j)
8246    a_tendency(i,k,j) =0.0
8247    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv3
8248    a_Tmpv2 =-a_Tmpv3
8249    a_Tmpv1 =BN2(i,k,j)*a_Tmpv2
8250    a_BN2(i,k,j) =a_BN2(i,k,j) +Tmpv300(i,k)*a_Tmpv2
8251    a_mu(i,j) =a_mu(i,j) +xkhv(i,k,j)*a_Tmpv1
8252    a_xkhv(i,k,j) =a_xkhv(i,k,j) +mu(i,j)*a_Tmpv1
8253    ENDDO
8254    ENDDO
8255
8256    ENDDO
8257
8258 !LPB[11]
8259
8260 !  IF( config_flags%periodic_x ) THEN
8261 !  i_end =min(ite, ide-1)
8262 !  END IF
8263
8264 !  IF( config_flags%periodic_x ) THEN
8265
8266 !  END IF
8267
8268 !LPB[10]
8269
8270 !LPB[9]
8271
8272 !  IF( config_flags%periodic_x ) THEN
8273 !  i_start =its
8274 !  END IF
8275
8276 !  IF( config_flags%periodic_x ) THEN
8277
8278 !  END IF
8279
8280 !LPB[8]
8281
8282 !LPB[7]
8283
8284 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.             config_flags%nested ) THEN
8285 !  j_end =min(jde-2, jte)
8286 !  END IF
8287
8288 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
8289 !            config_flags%nested ) THEN
8290
8291 !  END IF
8292
8293 !LPB[6]
8294
8295 !LPB[5]
8296
8297 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.             config_flags%nested ) THEN
8298 !  j_start =max(jds+1, jts)
8299 !  END IF
8300
8301 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
8302 !            config_flags%nested ) THEN
8303
8304 !  END IF
8305
8306 !LPB[4]
8307
8308 !LPB[3]
8309
8310 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.             config_flags%nested ) THEN
8311 !  i_end =min(ide-2, ite)
8312 !  END IF
8313
8314 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
8315 !            config_flags%nested ) THEN
8316
8317 !  END IF
8318
8319 !LPB[2]
8320
8321 !LPB[1]
8322
8323 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.             config_flags%nested ) THEN
8324 !  i_start =max(ids+1, its)
8325 !  END IF
8326
8327 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
8328 !            config_flags%nested ) THEN
8329
8330 !  END IF
8331
8332 !LPB[0]
8333 !  ktf =min(kte, kde-1)
8334 !  i_start =its
8335 !  i_end =min(ite, ide-1)
8336 !  j_start =jts
8337 !  j_end =min(jte, jde-1)
8338
8339    END SUBROUTINE a_tke_buoyancy
8340
8341    SUBROUTINE a_tke_dissip(tendency,a_tendency,config_flags,mu,a_mu,tke,a_tke, &
8342    bn2,a_bn2,theta,a_theta,p8w,a_p8w,t8w,a_t8w,z,a_z,dx,dy,rdz,a_rdz,rdzw, &
8343    a_rdzw,isotropic,msftx,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its, &
8344    ite,jts,jte,kts,kte)
8345
8346 !PART I: DECLARATION OF VARIABLES
8347
8348    IMPLICIT NONE
8349
8350    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
8351    TYPE(grid_config_rec_type) :: config_flags
8352    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
8353    INTEGER :: isotropic
8354    REAL :: dx,dy
8355    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
8356    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tke,a_tke,bn2,a_bn2,theta,a_theta, &
8357    p8w,a_p8w,t8w,a_t8w,z,a_z,rdz,a_rdz,rdzw,a_rdzw
8358    REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
8359    REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty
8360    REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: dthrdn,a_dthrdn
8361    REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: l_scale,a_l_scale
8362    REAL,DIMENSION(its:ite) :: sumtke,a_sumtke,sumtkez,a_sumtkez
8363    INTEGER :: i,j,k,ktf,i_start,i_end,j_start,j_end
8364    REAL :: disp_len,a_disp_len,deltas,a_deltas,coefc,a_coefc,tmpdz,a_tmpdz, &
8365    len_s,a_len_s,thetasfc,a_thetasfc,thetatop,a_thetatop,len_0,a_len_0,tketmp, &
8366    a_tketmp,tmp,a_tmp,ce1,a_ce1,ce2,a_ce2,c_k,a_c_k
8367
8368    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004
8369    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv300
8370    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv301
8371    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv302
8372    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv303
8373    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv304
8374    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv305
8375    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv306
8376
8377 !PART II: CALCULATIONS OF B. S. TRAJECTORY
8378
8379 !LPB[0]
8380        c_k = config_flags%c_k
8381        ce1 = ( c_k / 0.10 ) * 0.19
8382        ce2 = max( 0.0 , 0.93 - ce1 )
8383        ktf     = MIN( kte, kde-1 )
8384        i_start = its
8385        i_end   = MIN(ite,ide-1)
8386        j_start = jts
8387        j_end   = MIN(jte,jde-1)
8388
8389 !LPB[1]
8390     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
8391          config_flags%nested) i_start = MAX( ids+1, its )
8392
8393 !LPB[2]
8394
8395 !LPB[3]
8396     IF ( config_flags%open_xe .OR. config_flags%specified .OR.   &
8397          config_flags%nested) i_end   = MIN( ide-2, ite )
8398
8399 !LPB[4]
8400
8401 !LPB[5]
8402     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
8403          config_flags%nested) j_start = MAX( jds+1, jts )
8404
8405 !LPB[6]
8406
8407 !LPB[7]
8408     IF ( config_flags%open_ye .OR. config_flags%specified .OR.   &
8409          config_flags%nested) j_end   = MIN( jde-2, jte )
8410
8411 !LPB[8]
8412
8413 !LPB[9]
8414       IF ( config_flags%periodic_x ) i_start = its
8415
8416 !LPB[10]
8417
8418 !LPB[11]
8419       IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
8420
8421 !LPB[12]
8422          CALL calc_l_scale( config_flags, tke, BN2, l_scale,        &
8423                             i_start, i_end, ktf, j_start, j_end,    &
8424                             dx, dy, rdzw, msftx, msfty,             &
8425                             ids, ide, jds, jde, kds, kde,           &
8426                             ims, ime, jms, jme, kms, kme,           &
8427                             its, ite, jts, jte, kts, kte          )
8428
8429 !!LPB[13]
8430 !         DO j = j_start, j_end
8431
8432 !         DO k = kts, ktf
8433 !         DO i = i_start, i_end
8434 !           deltas  = ( dx/msftx(i,j) * dy/msfty(i,j) / rdzw(i,k,j) )**0.33333333
8435 !           tketmp  = MAX( tke(i,k,j), 1.0e-6 )
8436 !        IF ( k .eq. kts .or. k .eq. ktf ) then
8437
8438 !             coefc = 3.9
8439 !           ELSE
8440 !             coefc = ce1 + ce2 * l_scale(i,k,j) / deltas
8441 !           END IF
8442 !           tendency(i,k,j) = tendency(i,k,j) -   &
8443 !                             mu(i,j) * coefc * tketmp**1.5 / l_scale(i,k,j)
8444 !         END DO
8445 !         END DO
8446
8447 !         END DO
8448
8449 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
8450
8451 ! Remarked by Ning Pan, 2010-08-12
8452 !   Do K2_ADJ =jts, jte
8453 !   Do K1_ADJ =kts, kte
8454 !   Do K0_ADJ =its, ite
8455 !   a_dthrdn(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
8456 !   End Do
8457 !   End Do
8458 !   End Do
8459
8460    Do K2_ADJ =jts, jte
8461    Do K1_ADJ =kts, kte
8462    Do K0_ADJ =its, ite
8463    a_l_scale(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
8464    End Do
8465    End Do
8466    End Do
8467
8468 ! Remarked by Ning Pan, 2010-08-12
8469 !   Do K0_ADJ =its, ite
8470 !   a_sumtke(K0_ADJ) =0.0
8471 !   End Do
8472
8473 !   Do K0_ADJ =its, ite
8474 !   a_sumtkez(K0_ADJ) =0.0
8475 !   End Do
8476
8477 !   a_disp_len =0.0
8478    a_deltas =0.0
8479    a_coefc =0.0
8480 ! Remarked by Ning Pan, 2010-08-12
8481 !   a_tmpdz =0.0
8482 !   a_len_s =0.0
8483 !   a_thetasfc =0.0
8484 !   a_thetatop =0.0
8485 !   a_len_0 =0.0
8486    a_tketmp =0.0
8487 ! Remarked by Ning Pan, 2010-08-12
8488 !   a_tmp =0.0
8489 !   a_ce1 =0.0
8490 !   a_ce2 =0.0
8491 !   a_c_k =0.0
8492
8493 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
8494
8495 !LPB[13]
8496    DO j =j_end, j_start, -1
8497
8498 ! Revised by Ning Pan, 2010-08-12
8499 !   DO k =kts, ktf
8500 !   DO i =i_start, i_end
8501    DO k =ktf, kts, -1
8502    DO i =i_end, i_start, -1
8503 !   Tmpv300(i,k) =deltas
8504    deltas =(dx/msftx(i,j)*dy/msfty(i,j)/rdzw(i,k,j))**0.33333333
8505
8506 !   Tmpv301(i,k) =tketmp
8507    tketmp =max(tke(i,k,j), 1.0e-6)
8508
8509    IF( k .eq. kts .or. k .eq. ktf ) THEN
8510 !   Tmpv302(i,k) =coefc
8511    coefc =3.9
8512
8513    ELSE
8514    Tmpv001 =ce2*l_scale(i,k,j)
8515    Tmpv303(i,k) =Tmpv001
8516    Tmpv002 =Tmpv303(i,k)/deltas
8517    Tmpv003 =ce1 +Tmpv002
8518 !   Tmpv304(i,k) =coefc
8519    coefc =Tmpv003
8520
8521    END IF
8522    Tmpv001 =mu(i,j)*coefc
8523    Tmpv305(i,k) =Tmpv001
8524    Tmpv002 =Tmpv305(i,k)*tketmp**1.5
8525    Tmpv306(i,k) =Tmpv002
8526 ! Remarked by Ning Pan, 2010-08-12
8527 !   Tmpv003 =Tmpv306(i,k)/l_scale(i,k,j)
8528 !   Tmpv004 =tendency(i,k,j) -Tmpv003
8529 !   tendency(i,k,j) =Tmpv004
8530
8531 ! Remarked by Ning Pan, 2010-08-12
8532 !   ENDDO
8533 !   ENDDO
8534
8535 ! Remarked by Ning Pan, 2010-08-12
8536 !   DO k =ktf, kts, -1
8537 !   DO i =i_end, i_start, -1
8538    a_Tmpv4 =a_tendency(i,k,j)
8539    a_tendency(i,k,j) =0.0
8540    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv4
8541    a_Tmpv3 =-a_Tmpv4
8542    a_Tmpv2 =a_Tmpv3/l_scale(i,k,j)
8543    a_l_scale(i,k,j) =a_l_scale(i,k,j) -Tmpv306(i,k)/(l_scale(i,k,j)  &
8544    *l_scale(i,k,j))*a_Tmpv3
8545    a_Tmpv1 =tketmp**1.5*a_Tmpv2
8546    a_tketmp =a_tketmp +1.5*1.0*tketmp**(1.5 -1)*Tmpv305(i,k)*a_Tmpv2
8547    a_mu(i,j) =a_mu(i,j) +coefc*a_Tmpv1
8548    a_coefc =a_coefc +mu(i,j)*a_Tmpv1
8549
8550    IF( k .eq. kts .or. k .eq. ktf ) THEN
8551
8552 !   coefc =Tmpv302(i,k)
8553
8554    a_coefc =0.0
8555
8556    ELSE
8557
8558 !   coefc =Tmpv304(i,k)
8559
8560    a_Tmpv3 =a_coefc
8561    a_coefc =0.0
8562 !   a_ce1 =a_ce1 +a_Tmpv3  ! Remarked by Ning Pan, 2010-08-12
8563    a_Tmpv2 =a_Tmpv3
8564    a_Tmpv1 =a_Tmpv2/deltas
8565    a_deltas =a_deltas -Tmpv303(i,k)/(deltas*deltas)*a_Tmpv2
8566 !   a_ce2 =a_ce2 +l_scale(i,k,j)*a_Tmpv1  ! Remarked by Ning Pan, 2010-08-12
8567    a_l_scale(i,k,j) =a_l_scale(i,k,j) +ce2*a_Tmpv1
8568
8569    END IF
8570
8571 !   tketmp =Tmpv301(i,k)
8572
8573    a_tke(i,k,j) =a_tke(i,k,j) +(1.0 +(1.0)*sign(1.0, tke(i,k,j) -1.0e-6))*0.5*a_tketmp
8574    a_tketmp =0.0
8575
8576 !   deltas =Tmpv300(i,k)
8577
8578    a_rdzw(i,k,j) =a_rdzw(i,k,j) -dx/msftx(i,j)*dy/msfty(i,j)/(rdzw(i,k,j)  &
8579    *rdzw(i,k,j))*0.33333333*(dx/msftx(i,j)*dy/msfty(i,j)/rdzw(i,k,j))**(0.33333333 -1)*a_deltas
8580    a_deltas =0.0
8581    ENDDO
8582    ENDDO
8583
8584    ENDDO
8585
8586 !LPB[12]
8587 !  CALL calc_l_scale(config_flags,tke,BN2,l_scale,i_start,i_end,ktf,j_start,j_end,dx,  &
8588 !  dy,rdzw,msftx,msfty,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
8589
8590    CALL a_calc_l_scale(config_flags,tke,a_tke,BN2,a_BN2,l_scale,a_l_scale,  &
8591    i_start,i_end,ktf,j_start,j_end,dx,dy,rdzw,a_rdzw,msftx,msfty,ids,ide,jds,jde,kds,  &
8592    kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
8593
8594 !LPB[11]
8595
8596 !  IF( config_flags%periodic_x ) THEN
8597 !  i_end =min(ite, ide-1)
8598 !  END IF
8599
8600 !  IF( config_flags%periodic_x ) THEN
8601
8602 !  END IF
8603
8604 !LPB[10]
8605
8606 !LPB[9]
8607
8608 !  IF( config_flags%periodic_x ) THEN
8609 !  i_start =its
8610 !  END IF
8611
8612 !  IF( config_flags%periodic_x ) THEN
8613
8614 !  END IF
8615
8616 !LPB[8]
8617
8618 !LPB[7]
8619
8620 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.             config_flags%nested) THEN
8621 !  j_end =min(jde-2, jte)
8622 !  END IF
8623
8624 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
8625 !            config_flags%nested) THEN
8626
8627 !  END IF
8628
8629 !LPB[6]
8630
8631 !LPB[5]
8632
8633 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.             config_flags%nested) THEN
8634 !  j_start =max(jds+1, jts)
8635 !  END IF
8636
8637 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
8638 !            config_flags%nested) THEN
8639
8640 !  END IF
8641
8642 !LPB[4]
8643
8644 !LPB[3]
8645
8646 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.             config_flags%nested) THEN
8647 !  i_end =min(ide-2, ite)
8648 !  END IF
8649
8650 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
8651 !            config_flags%nested) THEN
8652
8653 !  END IF
8654
8655 !LPB[2]
8656
8657 !LPB[1]
8658
8659 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.             config_flags%nested) THEN
8660 !  i_start =max(ids+1, its)
8661 !  END IF
8662
8663 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
8664 !            config_flags%nested) THEN
8665
8666 !  END IF
8667
8668 !LPB[0]
8669 !  c_k =config_flags%c_k
8670
8671 !  ce1 =(c_k/0.10)*0.19
8672
8673 !  ce2 =max(0.0, 0.93 -ce1)
8674
8675 !  ktf =min(kte, kde-1)
8676 !  i_start =its
8677 !  i_end =min(ite, ide-1)
8678 !  j_start =jts
8679 !  j_end =min(jte, jde-1)
8680
8681 ! Remarked by Ning Pan, 2010-08-12
8682 !   a_ce1 =a_ce1 +(-1.0 +(--1.0)*sign(1.0, 0.0 -0.93 -ce1))*0.5*a_ce2
8683 !   a_ce2 =0.0
8684 !   a_c_k =a_c_k +1.0/0.10*0.19*a_ce1
8685 !   a_ce1 =0.0
8686 !   a_config_flags%c_k =a_config_flags%c_k +a_c_k
8687 !   a_c_k =0.0
8688
8689    END SUBROUTINE a_tke_dissip
8690
8691    SUBROUTINE a_tke_shear(tendency,a_tendency,config_flags,defor11,a_defor11, &
8692    defor22,a_defor22,defor33,a_defor33,defor12,a_defor12,defor13,a_defor13, &
8693    defor23,a_defor23,u,a_u,v,a_v,w,a_w,tke,a_tke,ust,a_ust,mu,a_mu,fnm, &
8694    fnp,cf1,cf2,cf3,msftx,msfty,xkmh,a_xkmh,xkmv,a_xkmv,rdx,rdy,zx,a_zx,zy,a_zy, &
8695    rdz,a_rdz,rdzw,a_rdzw,dn,dnw,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its, &
8696    ite,jts,jte,kts,kte)
8697
8698 !PART I: DECLARATION OF VARIABLES
8699
8700    IMPLICIT NONE
8701
8702    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
8703    TYPE(grid_config_rec_type) :: config_flags
8704    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
8705    REAL :: cf1,cf2,cf3,rdx,rdy
8706    REAL,DIMENSION(kms:kme) :: fnm,fnp,dn,dnw
8707    REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty
8708    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
8709    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor11,a_defor11,defor22,a_defor22, &
8710    defor33,a_defor33,defor12,a_defor12,defor13,a_defor13,defor23,a_defor23,tke, &
8711    a_tke,xkmh,a_xkmh,xkmv,a_xkmv,zx,a_zx,zy,a_zy,u,a_u,v,a_v,w,a_w,rdz, &
8712    a_rdz,rdzw,a_rdzw
8713    REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
8714    REAL,DIMENSION(ims:ime,jms:jme) :: ust,a_ust
8715    INTEGER :: i,j,k,ktf,ktes1,ktes2,i_start,i_end,j_start,j_end,is_ext,ie_ext,js_ext,je_ext
8716    REAL :: mtau,a_mtau
8717    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: avg,a_avg,titau,a_titau,tmp2,a_tmp2
8718    REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: titau12,a_titau12,tmp1,a_tmp1,zxavg, &
8719    a_zxavg,zyavg,a_zyavg
8720    REAL :: absU,a_absU,cd0,a_cd0,Cd,a_Cd
8721
8722 !  REAL,DIMENSION(1) :: Keep_Lpb29_absU
8723 !  REAL,DIMENSION(1) :: Keep_Lpb29_Cd
8724    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
8725    a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,a_Tmpv8,Tmpv008,a_Tmpv9,Tmpv009
8726    REAL,DIMENSION(its:min(ite,ide-1),min0(kts,max(jds+1,jts)):max0(min(kte,kde-1) &
8727    ,min(jde-2,jte))) :: Tmpv300
8728    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv301
8729    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv302
8730    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv303
8731    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv304
8732    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv305
8733    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv306
8734    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv307
8735    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv308
8736    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv309
8737    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv3010
8738    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv3011
8739    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv3012
8740    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv3013
8741    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv3014
8742    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv3015
8743    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv3016
8744    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv3017
8745    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv3018
8746    REAL,DIMENSION(its:min(ite,ide-1),max(jds+1,jts):min(jde-2,jte)) :: Tmpv3019
8747
8748    REAL :: g_Sqrt
8749
8750 !PART II: CALCULATIONS OF B. S. TRAJECTORY
8751
8752 !LPB[0]
8753        ktf    = MIN( kte, kde-1 )
8754        ktes1  = kte-1
8755        ktes2  = kte-2
8756        i_start = its
8757        i_end   = MIN( ite, ide-1 )
8758        j_start = jts
8759        j_end   = MIN( jte, jde-1 )
8760
8761 !LPB[1]
8762     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
8763          config_flags%nested ) i_start = MAX( ids+1, its )
8764
8765 !LPB[2]
8766
8767 !LPB[3]
8768     IF ( config_flags%open_xe .OR. config_flags%specified .OR.   &
8769          config_flags%nested ) i_end   = MIN( ide-2, ite )
8770
8771 !LPB[4]
8772
8773 !LPB[5]
8774     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
8775          config_flags%nested ) j_start = MAX( jds+1, jts )
8776
8777 !LPB[6]
8778
8779 !LPB[7]
8780     IF ( config_flags%open_ye .OR. config_flags%specified .OR.   &
8781          config_flags%nested ) j_end   = MIN( jde-2, jte )
8782
8783 !LPB[8]
8784
8785 !LPB[9]
8786       IF ( config_flags%periodic_x ) i_start = its
8787
8788 !LPB[10]
8789
8790 !LPB[11]
8791       IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
8792
8793 ! Remarked by Ning Pan, 2010-08-12 : LPB[12]-[28]
8794 !LPB[12]
8795 !       DO j = j_start, j_end
8796
8797 !       DO k = kts, ktf
8798 !       DO i = i_start, i_end
8799 !         zxavg(i,k,j) = 0.25 * ( zx(i,k  ,j) + zx(i+1,k  ,j) +   &
8800 !                                 zx(i,k+1,j) + zx(i+1,k+1,j)  )
8801 !         zyavg(i,k,j) = 0.25 * ( zy(i,k  ,j) + zy(i,k  ,j+1) +   &
8802 !                                 zy(i,k+1,j) + zy(i,k+1,j+1)  )
8803 !       END DO
8804 !       END DO
8805
8806 !       END DO
8807
8808 !LPB[13]
8809 !       DO j = j_start, j_end
8810
8811 !       DO k = kts, ktf
8812 !       DO i = i_start, i_end
8813 !         tendency(i,k,j) = tendency(i,k,j) + 0.5 *    &
8814 !                           mu(i,j) * xkmh(i,k,j) * ( ( defor11(i,k,j) )**2 )
8815 !       END DO
8816 !       END DO
8817
8818 !       END DO
8819
8820 !LPB[14]
8821 !       DO j = j_start, j_end
8822
8823 !       DO k = kts, ktf
8824 !       DO i = i_start, i_end
8825 !         tendency(i,k,j) = tendency(i,k,j) + 0.5 *    &
8826 !                           mu(i,j) * xkmh(i,k,j) * ( ( defor22(i,k,j) )**2 )
8827 !       END DO
8828 !       END DO
8829
8830 !       END DO
8831
8832 !LPB[15]
8833 !       DO j = j_start, j_end
8834
8835 !       DO k = kts, ktf
8836 !       DO i = i_start, i_end
8837 !         tendency(i,k,j) = tendency(i,k,j) + 0.5 *    &
8838 !                           mu(i,j) * xkmv(i,k,j) * ( ( defor33(i,k,j) )**2 )
8839 !       END DO
8840 !       END DO
8841
8842 !       END DO
8843
8844 !LPB[16]
8845 !       DO j = j_start, j_end
8846
8847 !       DO k = kts, ktf
8848 !       DO i = i_start, i_end
8849 !         avg(i,k,j) = 0.25 *    &
8850 !                      ( ( defor12(i  ,k,j)**2 ) + ( defor12(i  ,k,j+1)**2 ) +    &
8851 !                        ( defor12(i+1,k,j)**2 ) + ( defor12(i+1,k,j+1)**2 ) )
8852 !       END DO
8853 !       END DO
8854
8855 !       END DO
8856
8857 !LPB[17]
8858 !       DO j = j_start, j_end
8859
8860 !       DO k = kts, ktf
8861 !       DO i = i_start, i_end
8862 !         tendency(i,k,j) = tendency(i,k,j) + mu(i,j) * xkmh(i,k,j) * avg(i,k,j)
8863 !       END DO
8864 !       END DO
8865
8866 !       END DO
8867
8868 !LPB[18]
8869 !       DO j = j_start, j_end
8870
8871 !       DO k = kts+1, ktf
8872 !       DO i = i_start, i_end+1
8873 !         tmp2(i,k,j) = defor13(i,k,j)
8874 !       END DO
8875 !       END DO
8876
8877 !       END DO
8878
8879 !LPB[19]
8880 !       DO j = j_start, j_end
8881
8882 !       DO i = i_start, i_end+1
8883 !         tmp2(i,kts  ,j) = 0.0
8884 !         tmp2(i,ktf+1,j) = 0.0
8885 !       END DO
8886
8887 !       END DO
8888
8889 !LPB[20]
8890 !       DO j = j_start, j_end
8891
8892 !       DO k = kts, ktf
8893 !       DO i = i_start, i_end
8894 !         avg(i,k,j) = 0.25 *    &
8895 !                      ( ( tmp2(i  ,k+1,j)**2 ) + ( tmp2(i  ,k,j)**2 ) +    &
8896 !                        ( tmp2(i+1,k+1,j)**2 ) + ( tmp2(i+1,k,j)**2 ) )
8897 !       END DO
8898 !       END DO
8899
8900 !       END DO
8901
8902 !LPB[21]
8903 !       DO j = j_start, j_end
8904
8905 !       DO k = kts, ktf
8906 !       DO i = i_start, i_end
8907 !         tendency(i,k,j) = tendency(i,k,j) + mu(i,j) * xkmv(i,k,j) * avg(i,k,j)
8908 !       END DO
8909 !       END DO
8910
8911 !       END DO
8912
8913 !LPB[22]
8914 !       K=KTS
8915
8916 !LPB[23]
8917 !  uflux: SELECT CASE( config_flags%isfflx )
8918
8919 !     CASE (0)
8920 !       cd0 = config_flags%tke_drag_coefficient
8921
8922 !       DO j = j_start, j_end
8923 !       DO i = i_start, i_end
8924 !         absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2)
8925 !         Cd = cd0
8926 !         tendency(i,k,j) = tendency(i,k,j) +         &
8927 !              mu(i,j)*( (u(i,k,j)+u(i+1,k,j))*0.5*   &
8928 !                        Cd*absU*(defor13(i,kts+1,j)+defor13(i+1,kts+1,j))*0.5 )
8929 !       END DO
8930 !       END DO
8931 !     CASE (1,2)
8932
8933 !       DO j = j_start, j_end
8934 !       DO i = i_start, i_end
8935 !         absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2)+epsilon
8936 !         Cd = (ust(i,j)**2)/(absU**2)
8937 !         tendency(i,k,j) = tendency(i,k,j) +         &
8938 !              mu(i,j)*( (u(i,k,j)+u(i+1,k,j))*0.5*   &
8939 !                        Cd*absU*(defor13(i,kts+1,j)+defor13(i+1,kts+1,j))*0.5 )
8940 !       END DO
8941 !       END DO
8942 !     CASE DEFAULT
8943 !       CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' )
8944
8945 !   END SELECT uflux
8946
8947 !LPB[24]
8948 !       DO j = j_start, j_end+1
8949
8950 !       DO k = kts+1, ktf
8951 !       DO i = i_start, i_end
8952 !         tmp2(i,k,j) = defor23(i,k,j)
8953 !       END DO
8954 !       END DO
8955
8956 !       END DO
8957
8958 !LPB[25]
8959 !       DO j = j_start, j_end+1
8960
8961 !       DO i = i_start, i_end
8962 !         tmp2(i,kts,  j) = 0.0
8963 !         tmp2(i,ktf+1,j) = 0.0
8964 !       END DO
8965
8966 !       END DO
8967
8968 !LPB[26]
8969 !       DO j = j_start, j_end
8970
8971 !       DO k = kts, ktf
8972 !       DO i = i_start, i_end
8973 !         avg(i,k,j) = 0.25 *    &
8974 !                      ( ( tmp2(i,k+1,j  )**2 ) + ( tmp2(i,k,j  )**2) +    &
8975 !                        ( tmp2(i,k+1,j+1)**2 ) + ( tmp2(i,k,j+1)**2) )
8976 !       END DO
8977 !       END DO
8978
8979 !       END DO
8980
8981 !LPB[27]
8982 !       DO j = j_start, j_end
8983
8984 !       DO k = kts, ktf
8985 !       DO i = i_start, i_end
8986 !         tendency(i,k,j) = tendency(i,k,j) + mu(i,j) * xkmv(i,k,j) * avg(i,k,j)
8987 !       END DO
8988 !       END DO
8989
8990 !       END DO
8991
8992 !LPB[28]
8993 !       K=KTS
8994
8995 !!LPB[29]
8996 !    !  Keep_Lpb29_absU(1) =absU
8997 !    !  Keep_Lpb29_Cd(1) =Cd
8998
8999 !  vflux: SELECT CASE( config_flags%isfflx )
9000
9001 !     CASE (0)
9002 !       cd0 = config_flags%tke_drag_coefficient
9003
9004 !       DO j = j_start, j_end
9005 !       DO i = i_start, i_end
9006 !         absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2)
9007 !         Cd = cd0
9008 !         tendency(i,k,j) = tendency(i,k,j) +         &
9009 !              mu(i,j)*( (v(i,k,j)+v(i,k,j+1))*0.5*   &
9010 !                        Cd*absU*(defor23(i,kts+1,j)+defor23(i,kts+1,j+1))*0.5 )
9011 !       END DO
9012 !       END DO
9013 !     CASE (1,2)
9014
9015 !       DO j = j_start, j_end
9016 !       DO i = i_start, i_end
9017 !         absU=0.5*sqrt((u(i,k,j)+u(i+1,k,j))**2+(v(i,k,j)+v(i,k,j+1))**2)+epsilon
9018 !         Cd = (ust(i,j)**2)/(absU**2)
9019 !         tendency(i,k,j) = tendency(i,k,j) +         &
9020 !              mu(i,j)*( (v(i,k,j)+v(i,k,j+1))*0.5*   &
9021 !                        Cd*absU*(defor23(i,kts+1,j)+defor23(i,kts+1,j+1))*0.5 )
9022 !       END DO
9023 !       END DO
9024 !     CASE DEFAULT
9025 !       CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' )
9026
9027 !   END SELECT vflux
9028
9029 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
9030
9031    a_mtau =0.0
9032
9033    Do K2_ADJ =jts-1, jte+1
9034    Do K1_ADJ =kts, kte
9035    Do K0_ADJ =its-1, ite+1
9036    a_avg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
9037    End Do
9038    End Do
9039    End Do
9040
9041    Do K2_ADJ =jts-1, jte+1
9042    Do K1_ADJ =kts, kte
9043    Do K0_ADJ =its-1, ite+1
9044    a_titau(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
9045    End Do
9046    End Do
9047    End Do
9048
9049    Do K2_ADJ =jts-1, jte+1
9050    Do K1_ADJ =kts, kte
9051    Do K0_ADJ =its-1, ite+1
9052    a_tmp2(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
9053    End Do
9054    End Do
9055    End Do
9056
9057    Do K2_ADJ =jts, jte
9058    Do K1_ADJ =kts, kte
9059    Do K0_ADJ =its, ite
9060    a_titau12(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
9061    End Do
9062    End Do
9063    End Do
9064
9065    Do K2_ADJ =jts, jte
9066    Do K1_ADJ =kts, kte
9067    Do K0_ADJ =its, ite
9068    a_tmp1(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
9069    End Do
9070    End Do
9071    End Do
9072
9073    Do K2_ADJ =jts, jte
9074    Do K1_ADJ =kts, kte
9075    Do K0_ADJ =its, ite
9076    a_zxavg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
9077    End Do
9078    End Do
9079    End Do
9080
9081    Do K2_ADJ =jts, jte
9082    Do K1_ADJ =kts, kte
9083    Do K0_ADJ =its, ite
9084    a_zyavg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
9085    End Do
9086    End Do
9087    End Do
9088
9089    a_absU =0.0
9090 !   a_cd0 =0.0   ! Remarked by Ning Pan, 2010-08-12
9091    a_Cd =0.0
9092
9093 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
9094
9095    K=KTS  ! Added by Ning Pan, 2010-08-12
9096 !LPB[29]
9097 !  absU =Keep_Lpb29_absU(1)
9098 !  Cd =Keep_Lpb29_Cd(1)
9099
9100    SELECT CASE (config_flags%isfflx)
9101    CASE(0)
9102    cd0 =config_flags%tke_drag_coefficient
9103
9104    DO j =j_start, j_end
9105    DO i =i_start, i_end
9106    Tmpv001 =u(i,k,j) +u(i+1,k,j)
9107    Tmpv300(i,j) =Tmpv001
9108    Tmpv002 =Tmpv300(i,j)**2
9109    Tmpv003 =v(i,k,j) +v(i,k,j+1)
9110    Tmpv301(i,j) =Tmpv003
9111    Tmpv004 =Tmpv301(i,j)**2
9112    Tmpv005 =Tmpv002 +Tmpv004
9113    Tmpv302(i,j) =Tmpv005
9114    Tmpv006 =sqrt(Tmpv302(i,j))
9115    Tmpv007 =0.5*Tmpv006
9116 ! Revised by Ning Pan, 2010-08-12
9117 !   Tmpv303(i,j) =absU
9118 !   absU =Tmpv007
9119    absU =Tmpv007
9120    Tmpv303(i,j) =absU
9121
9122 ! Revised by Ning Pan, 2010-08-12
9123 !   Tmpv304(i,j) =Cd
9124 !   Cd =cd0
9125    Cd =cd0
9126    Tmpv304(i,j) =Cd
9127
9128    Tmpv001 =v(i,k,j) +v(i,k,j+1)
9129    Tmpv002 =Tmpv001*0.5
9130    Tmpv305(i,j) =Tmpv002
9131    Tmpv003 =Tmpv305(i,j)*Cd
9132    Tmpv306(i,j) =Tmpv003
9133    Tmpv004 =Tmpv306(i,j)*absU
9134    Tmpv005 =defor23(i,kts+1,j) +defor23(i,kts+1,j+1)
9135    Tmpv307(i,j) =Tmpv004
9136    Tmpv308(i,j) =Tmpv005
9137    Tmpv006 =Tmpv307(i,j)*Tmpv308(i,j)
9138    Tmpv007 =Tmpv006*0.5
9139    Tmpv309(i,j) =Tmpv007
9140 ! Remarked by Ning Pan, 2010-08-12
9141 !   Tmpv008 =mu(i,j)*Tmpv309(i,j)
9142 !   Tmpv009 =tendency(i,k,j) +Tmpv008
9143 !   tendency(i,k,j) =Tmpv009
9144
9145    ENDDO
9146    ENDDO
9147    CASE(1,2)
9148    DO j =j_start, j_end
9149    DO i =i_start, i_end
9150    Tmpv001 =u(i,k,j) +u(i+1,k,j)
9151    Tmpv3010(i,j) =Tmpv001
9152    Tmpv002 =Tmpv3010(i,j)**2
9153    Tmpv003 =v(i,k,j) +v(i,k,j+1)
9154    Tmpv3011(i,j) =Tmpv003
9155    Tmpv004 =Tmpv3011(i,j)**2
9156    Tmpv005 =Tmpv002 +Tmpv004
9157    Tmpv3012(i,j) =Tmpv005
9158    Tmpv006 =sqrt(Tmpv3012(i,j))
9159    Tmpv007 =0.5*Tmpv006
9160    Tmpv008 =Tmpv007 +epsilon
9161 ! Revised by Ning Pan, 2010-08-12
9162 !   Tmpv3013(i,j) =absU
9163 !   absU =Tmpv008
9164    absU =Tmpv008
9165    Tmpv3013(i,j) =absU
9166
9167    Tmpv001 =(ust(i,j)**2)/(absU**2)
9168 ! Revised by Ning Pan, 2010-08-12
9169 !   Tmpv3014(i,j) =Cd
9170 !   Cd =Tmpv001
9171    Cd =Tmpv001
9172    Tmpv3014(i,j) =Cd
9173
9174    Tmpv001 =v(i,k,j) +v(i,k,j+1)
9175    Tmpv002 =Tmpv001*0.5
9176    Tmpv3015(i,j) =Tmpv002
9177    Tmpv003 =Tmpv3015(i,j)*Cd
9178    Tmpv3016(i,j) =Tmpv003
9179    Tmpv004 =Tmpv3016(i,j)*absU
9180    Tmpv005 =defor23(i,kts+1,j) +defor23(i,kts+1,j+1)
9181    Tmpv3017(i,j) =Tmpv004
9182    Tmpv3018(i,j) =Tmpv005
9183    Tmpv006 =Tmpv3017(i,j)*Tmpv3018(i,j)
9184    Tmpv007 =Tmpv006*0.5
9185    Tmpv3019(i,j) =Tmpv007
9186 ! Remarked by Ning Pan, 2010-08-12
9187 !   Tmpv008 =mu(i,j)*Tmpv3019(i,j)
9188 !   Tmpv009 =tendency(i,k,j) +Tmpv008
9189 !   tendency(i,k,j) =Tmpv009
9190
9191    ENDDO
9192    ENDDO
9193    CASE DEFAULT
9194    CALL wrf_error_fatal('isfflx value invalid for diff_opt=2')
9195
9196 ! Revised by Ning Pan, 2010-08-12
9197 !   END SELECT vflux
9198    END SELECT
9199
9200    SELECT CASE (config_flags%isfflx)
9201
9202    CASE(0)
9203
9204    DO j =j_end, j_start, -1
9205    DO i =i_end, i_start, -1
9206 ! Added by Ning Pan, 2010-08-12
9207    absU =Tmpv303(i,j)
9208    Cd =Tmpv304(i,j)
9209
9210    a_Tmpv9 =a_tendency(i,k,j)
9211    a_tendency(i,k,j) =0.0
9212    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv9
9213    a_Tmpv8 =a_Tmpv9
9214    a_mu(i,j) =a_mu(i,j) +Tmpv309(i,j)*a_Tmpv8
9215    a_Tmpv7 =mu(i,j)*a_Tmpv8
9216    a_Tmpv6 =0.5*a_Tmpv7
9217    a_Tmpv4 =Tmpv308(i,j)*a_Tmpv6
9218    a_Tmpv5 =Tmpv307(i,j)*a_Tmpv6
9219    a_defor23(i,kts+1,j) =a_defor23(i,kts+1,j) +a_Tmpv5
9220    a_defor23(i,kts+1,j+1) =a_defor23(i,kts+1,j+1) +a_Tmpv5
9221    a_Tmpv3 =absU*a_Tmpv4
9222    a_absU =a_absU +Tmpv306(i,j)*a_Tmpv4
9223    a_Tmpv2 =Cd*a_Tmpv3
9224    a_Cd =a_Cd +Tmpv305(i,j)*a_Tmpv3
9225    a_Tmpv1 =0.5*a_Tmpv2
9226    a_v(i,k,j) =a_v(i,k,j) +a_Tmpv1
9227    a_v(i,k,j+1) =a_v(i,k,j+1) +a_Tmpv1
9228
9229 !   Cd =Tmpv304(i,j)  ! Remarked by Ning Pan, 2010-08-12
9230
9231 !   a_cd0 =a_cd0 +a_Cd  ! ! Remarked by Ning Pan, 2010-08-12
9232    a_Cd =0.0
9233
9234 !   absU =Tmpv303(i,j)  ! Remarked by Ning Pan, 2010-08-12
9235
9236    a_Tmpv7 =a_absU
9237    a_absU =0.0
9238    a_Tmpv6 =0.5*a_Tmpv7
9239    a_Tmpv5 =g_Sqrt(1.0, Tmpv302(i,j))*a_Tmpv6
9240    a_Tmpv2 =a_Tmpv5
9241    a_Tmpv4 =a_Tmpv5
9242    a_Tmpv3 =2.0*Tmpv301(i,j)*a_Tmpv4
9243    a_v(i,k,j) =a_v(i,k,j) +a_Tmpv3
9244    a_v(i,k,j+1) =a_v(i,k,j+1) +a_Tmpv3
9245    a_Tmpv1 =2.0*Tmpv300(i,j)*a_Tmpv2
9246    a_u(i,k,j) =a_u(i,k,j) +a_Tmpv1
9247    a_u(i+1,k,j) =a_u(i+1,k,j) +a_Tmpv1
9248    ENDDO
9249    ENDDO
9250 ! Remarked by Ning Pan, 2010-08-12
9251 !   a_config_flags%tke_drag_coefficient =a_config_flags%tke_drag_coefficient +a_cd0
9252 !   a_cd0 =0.0
9253
9254    CASE(1,2)
9255
9256    DO j =j_end, j_start, -1
9257    DO i =i_end, i_start, -1
9258 ! Added by Ning Pan, 2010-08-12
9259    absU =Tmpv3013(i,j)
9260    Cd =Tmpv3014(i,j)
9261
9262    a_Tmpv9 =a_tendency(i,k,j)
9263    a_tendency(i,k,j) =0.0
9264    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv9
9265    a_Tmpv8 =a_Tmpv9
9266    a_mu(i,j) =a_mu(i,j) +Tmpv3019(i,j)*a_Tmpv8
9267    a_Tmpv7 =mu(i,j)*a_Tmpv8
9268    a_Tmpv6 =0.5*a_Tmpv7
9269    a_Tmpv4 =Tmpv3018(i,j)*a_Tmpv6
9270    a_Tmpv5 =Tmpv3017(i,j)*a_Tmpv6
9271    a_defor23(i,kts+1,j) =a_defor23(i,kts+1,j) +a_Tmpv5
9272    a_defor23(i,kts+1,j+1) =a_defor23(i,kts+1,j+1) +a_Tmpv5
9273    a_Tmpv3 =absU*a_Tmpv4
9274    a_absU =a_absU +Tmpv3016(i,j)*a_Tmpv4
9275    a_Tmpv2 =Cd*a_Tmpv3
9276    a_Cd =a_Cd +Tmpv3015(i,j)*a_Tmpv3
9277    a_Tmpv1 =0.5*a_Tmpv2
9278    a_v(i,k,j) =a_v(i,k,j) +a_Tmpv1
9279    a_v(i,k,j+1) =a_v(i,k,j+1) +a_Tmpv1
9280
9281 !   Cd =Tmpv3014(i,j)  ! Remarked by Ning Pan, 2010-08-12
9282
9283    a_Tmpv1 =a_Cd
9284    a_Cd =0.0
9285    a_ust(i,j) =a_ust(i,j) +2.0*ust(i,j)/(absU**2)*a_Tmpv1
9286    a_absU =a_absU -2.0*absU*(ust(i,j)**2)/((absU**2)*(absU**2))*a_Tmpv1
9287
9288 !   absU =Tmpv3013(i,j)  ! Remarked by Ning Pan, 2010-08-12
9289
9290    a_Tmpv8 =a_absU
9291    a_absU =0.0
9292    a_Tmpv7 =a_Tmpv8
9293    a_Tmpv6 =0.5*a_Tmpv7
9294    a_Tmpv5 =g_Sqrt(1.0, Tmpv3012(i,j))*a_Tmpv6
9295    a_Tmpv2 =a_Tmpv5
9296    a_Tmpv4 =a_Tmpv5
9297    a_Tmpv3 =2.0*Tmpv3011(i,j)*a_Tmpv4
9298    a_v(i,k,j) =a_v(i,k,j) +a_Tmpv3
9299    a_v(i,k,j+1) =a_v(i,k,j+1) +a_Tmpv3
9300    a_Tmpv1 =2.0*Tmpv3010(i,j)*a_Tmpv2
9301    a_u(i,k,j) =a_u(i,k,j) +a_Tmpv1
9302    a_u(i+1,k,j) =a_u(i+1,k,j) +a_Tmpv1
9303    ENDDO
9304    ENDDO
9305
9306    CASE DEFAULT
9307
9308 ! Revised by Ning Pan, 2010-08-12
9309 !   CALL a_wrf_error_fatal('isfflx value invalid for diff_opt=2')
9310    CALL wrf_error_fatal('isfflx value invalid for diff_opt=2')
9311
9312 ! Revised by Ning Pan, 2010-08-12
9313 !   END SELECT vflux
9314    END SELECT
9315
9316 !LPB[28]
9317 !  K =KTS
9318
9319 ! Added by Ning Pan, 2010-08-12: LPB[24]-[26]
9320 !LPB[24]
9321        DO j = j_start, j_end+1
9322
9323        DO k = kts+1, ktf
9324        DO i = i_start, i_end
9325          tmp2(i,k,j) = defor23(i,k,j)
9326        END DO
9327        END DO
9328
9329        END DO
9330
9331 !LPB[25]
9332        DO j = j_start, j_end+1
9333
9334        DO i = i_start, i_end
9335          tmp2(i,kts,  j) = 0.0
9336          tmp2(i,ktf+1,j) = 0.0
9337        END DO
9338
9339        END DO
9340
9341 !LPB[26]
9342        DO j = j_start, j_end
9343
9344        DO k = kts, ktf
9345        DO i = i_start, i_end
9346          avg(i,k,j) = 0.25 *    &
9347                       ( ( tmp2(i,k+1,j  )**2 ) + ( tmp2(i,k,j  )**2) +    &
9348                         ( tmp2(i,k+1,j+1)**2 ) + ( tmp2(i,k,j+1)**2) )
9349        END DO
9350        END DO
9351
9352        END DO
9353
9354 !LPB[27]
9355    DO j =j_end, j_start, -1
9356
9357    DO k =kts, ktf
9358    DO i =i_start, i_end
9359    Tmpv001 =mu(i,j)*xkmv(i,k,j)
9360    Tmpv300(i,k) =Tmpv001
9361 ! Remarked by Ning Pan, 2010-08-12
9362 !   Tmpv002 =Tmpv300(i,k)*avg(i,k,j)
9363 !   Tmpv003 =tendency(i,k,j) +Tmpv002
9364 !   tendency(i,k,j) =Tmpv003
9365
9366    ENDDO
9367    ENDDO
9368
9369    DO k =ktf, kts, -1
9370    DO i =i_end, i_start, -1
9371    a_Tmpv3 =a_tendency(i,k,j)
9372    a_tendency(i,k,j) =0.0
9373    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv3
9374    a_Tmpv2 =a_Tmpv3
9375    a_Tmpv1 =avg(i,k,j)*a_Tmpv2
9376    a_avg(i,k,j) =a_avg(i,k,j) +Tmpv300(i,k)*a_Tmpv2
9377    a_mu(i,j) =a_mu(i,j) +xkmv(i,k,j)*a_Tmpv1
9378    a_xkmv(i,k,j) =a_xkmv(i,k,j) +mu(i,j)*a_Tmpv1
9379    ENDDO
9380    ENDDO
9381
9382    ENDDO
9383
9384 !LPB[26]
9385    DO j =j_end, j_start, -1
9386
9387 !  DO k =kts, ktf
9388 !  DO i =i_start, i_end
9389 !  Tmpv001 =(tmp2(i,k+1,j)**2) +(tmp2(i,k,j)**2)
9390 !  Tmpv002 =Tmpv001 +(tmp2(i,k+1,j+1)**2)
9391 !  Tmpv003 =Tmpv002 +(tmp2(i,k,j+1)**2)
9392 !  Tmpv004 =0.25*Tmpv003
9393 !  avg(i,k,j) =Tmpv004
9394
9395 !  ENDDO
9396 !  ENDDO
9397
9398    DO k =ktf, kts, -1
9399    DO i =i_end, i_start, -1
9400    a_Tmpv4 =a_avg(i,k,j)
9401    a_avg(i,k,j) =0.0
9402    a_Tmpv3 =0.25*a_Tmpv4
9403    a_Tmpv2 =a_Tmpv3
9404    a_tmp2(i,k,j+1) =a_tmp2(i,k,j+1) +2.0*tmp2(i,k,j+1)*a_Tmpv3
9405    a_Tmpv1 =a_Tmpv2
9406    a_tmp2(i,k+1,j+1) =a_tmp2(i,k+1,j+1) +2.0*tmp2(i,k+1,j+1)*a_Tmpv2
9407    a_tmp2(i,k+1,j) =a_tmp2(i,k+1,j) +2.0*tmp2(i,k+1,j)*a_Tmpv1
9408    a_tmp2(i,k,j) =a_tmp2(i,k,j) +2.0*tmp2(i,k,j)*a_Tmpv1
9409    ENDDO
9410    ENDDO
9411
9412    ENDDO
9413
9414 !LPB[25]
9415    DO j =j_end+1, j_start, -1
9416
9417 !  DO i =i_start, i_end
9418 !  tmp2(i,kts,j) =0.0
9419
9420 !  tmp2(i,ktf+1,j) =0.0
9421
9422 !  ENDDO
9423
9424    DO i =i_end, i_start, -1
9425    a_tmp2(i,ktf+1,j) =0.0
9426    a_tmp2(i,kts,j) =0.0
9427    ENDDO
9428
9429    ENDDO
9430
9431 !LPB[24]
9432    DO j =j_end+1, j_start, -1
9433
9434 !  DO k =kts+1, ktf
9435 !  DO i =i_start, i_end
9436 !  tmp2(i,k,j) =defor23(i,k,j)
9437
9438 !  ENDDO
9439 !  ENDDO
9440
9441    DO k =ktf, kts+1, -1
9442    DO i =i_end, i_start, -1
9443    a_defor23(i,k,j) =a_defor23(i,k,j) +a_tmp2(i,k,j)
9444    a_tmp2(i,k,j) =0.0
9445    ENDDO
9446    ENDDO
9447
9448    ENDDO
9449
9450    K=KTS  ! Added by Ning Pan, 2010-08-12
9451 !LPB[23]
9452
9453    SELECT CASE (config_flags%isfflx)
9454    CASE(0)
9455    cd0 =config_flags%tke_drag_coefficient
9456
9457    DO j =j_start, j_end
9458    DO i =i_start, i_end
9459    Tmpv001 =u(i,k,j) +u(i+1,k,j)
9460    Tmpv300(i,j) =Tmpv001
9461    Tmpv002 =Tmpv300(i,j)**2
9462    Tmpv003 =v(i,k,j) +v(i,k,j+1)
9463    Tmpv301(i,j) =Tmpv003
9464    Tmpv004 =Tmpv301(i,j)**2
9465    Tmpv005 =Tmpv002 +Tmpv004
9466    Tmpv302(i,j) =Tmpv005
9467    Tmpv006 =sqrt(Tmpv302(i,j))
9468    Tmpv007 =0.5*Tmpv006
9469 ! Revised by Ning Pan, 2010-08-12
9470 !   Tmpv303(i,j) =absU
9471 !   absU =Tmpv007
9472    absU =Tmpv007
9473    Tmpv303(i,j) =absU
9474
9475 ! Revised by Ning Pan, 2010-08-12
9476 !   Tmpv304(i,j) =Cd
9477 !   Cd =cd0
9478    Cd =cd0
9479    Tmpv304(i,j) =Cd
9480
9481    Tmpv001 =u(i,k,j) +u(i+1,k,j)
9482    Tmpv002 =Tmpv001*0.5
9483    Tmpv305(i,j) =Tmpv002
9484    Tmpv003 =Tmpv305(i,j)*Cd
9485    Tmpv306(i,j) =Tmpv003
9486    Tmpv004 =Tmpv306(i,j)*absU
9487    Tmpv005 =defor13(i,kts+1,j) +defor13(i+1,kts+1,j)
9488    Tmpv307(i,j) =Tmpv004
9489    Tmpv308(i,j) =Tmpv005
9490    Tmpv006 =Tmpv307(i,j)*Tmpv308(i,j)
9491    Tmpv007 =Tmpv006*0.5
9492    Tmpv309(i,j) =Tmpv007
9493 ! Remarked by Ning Pan, 2010-08-12
9494 !   Tmpv008 =mu(i,j)*Tmpv309(i,j)
9495 !   Tmpv009 =tendency(i,k,j) +Tmpv008
9496 !   tendency(i,k,j) =Tmpv009
9497
9498    ENDDO
9499    ENDDO
9500    CASE(1,2)
9501    DO j =j_start, j_end
9502    DO i =i_start, i_end
9503    Tmpv001 =u(i,k,j) +u(i+1,k,j)
9504    Tmpv3010(i,j) =Tmpv001
9505    Tmpv002 =Tmpv3010(i,j)**2
9506    Tmpv003 =v(i,k,j) +v(i,k,j+1)
9507    Tmpv3011(i,j) =Tmpv003
9508    Tmpv004 =Tmpv3011(i,j)**2
9509    Tmpv005 =Tmpv002 +Tmpv004
9510    Tmpv3012(i,j) =Tmpv005
9511    Tmpv006 =sqrt(Tmpv3012(i,j))
9512    Tmpv007 =0.5*Tmpv006
9513    Tmpv008 =Tmpv007 +epsilon
9514 ! Revised by Ning Pan, 2010-08-12
9515 !   Tmpv3013(i,j) =absU
9516 !   absU =Tmpv008
9517    absU =Tmpv008
9518    Tmpv3013(i,j) =absU
9519
9520    Tmpv001 =(ust(i,j)**2)/(absU**2)
9521 ! Revised by Ning Pan, 2010-08-12
9522 !   Tmpv3014(i,j) =Cd
9523 !   Cd =Tmpv001
9524    Cd =Tmpv001
9525    Tmpv3014(i,j) =Cd
9526
9527    Tmpv001 =u(i,k,j) +u(i+1,k,j)
9528    Tmpv002 =Tmpv001*0.5
9529    Tmpv3015(i,j) =Tmpv002
9530    Tmpv003 =Tmpv3015(i,j)*Cd
9531    Tmpv3016(i,j) =Tmpv003
9532    Tmpv004 =Tmpv3016(i,j)*absU
9533    Tmpv005 =defor13(i,kts+1,j) +defor13(i+1,kts+1,j)
9534    Tmpv3017(i,j) =Tmpv004
9535    Tmpv3018(i,j) =Tmpv005
9536    Tmpv006 =Tmpv3017(i,j)*Tmpv3018(i,j)
9537    Tmpv007 =Tmpv006*0.5
9538    Tmpv3019(i,j) =Tmpv007
9539 ! Remarked by Ning Pan, 2010-08-12
9540 !   Tmpv008 =mu(i,j)*Tmpv3019(i,j)
9541 !   Tmpv009 =tendency(i,k,j) +Tmpv008
9542 !   tendency(i,k,j) =Tmpv009
9543
9544    ENDDO
9545    ENDDO
9546    CASE DEFAULT
9547    CALL wrf_error_fatal('isfflx value invalid for diff_opt=2')
9548
9549 ! Revised by Ning Pan, 2010-08-12
9550 !   END SELECT uflux
9551    END SELECT
9552
9553    SELECT CASE (config_flags%isfflx)
9554
9555    CASE(0)
9556
9557    DO j =j_end, j_start, -1
9558    DO i =i_end, i_start, -1
9559 ! Added by Ning Pan, 2010-08-12
9560    absU =Tmpv303(i,j)
9561    Cd =Tmpv304(i,j)
9562
9563    a_Tmpv9 =a_tendency(i,k,j)
9564    a_tendency(i,k,j) =0.0
9565    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv9
9566    a_Tmpv8 =a_Tmpv9
9567    a_mu(i,j) =a_mu(i,j) +Tmpv309(i,j)*a_Tmpv8
9568    a_Tmpv7 =mu(i,j)*a_Tmpv8
9569    a_Tmpv6 =0.5*a_Tmpv7
9570    a_Tmpv4 =Tmpv308(i,j)*a_Tmpv6
9571    a_Tmpv5 =Tmpv307(i,j)*a_Tmpv6
9572    a_defor13(i,kts+1,j) =a_defor13(i,kts+1,j) +a_Tmpv5
9573    a_defor13(i+1,kts+1,j) =a_defor13(i+1,kts+1,j) +a_Tmpv5
9574    a_Tmpv3 =absU*a_Tmpv4
9575    a_absU =a_absU +Tmpv306(i,j)*a_Tmpv4
9576    a_Tmpv2 =Cd*a_Tmpv3
9577    a_Cd =a_Cd +Tmpv305(i,j)*a_Tmpv3
9578    a_Tmpv1 =0.5*a_Tmpv2
9579    a_u(i,k,j) =a_u(i,k,j) +a_Tmpv1
9580    a_u(i+1,k,j) =a_u(i+1,k,j) +a_Tmpv1
9581
9582 !   Cd =Tmpv304(i,j)  ! Remarked by Ning Pan, 2010-08-12
9583
9584 !   a_cd0 =a_cd0 +a_Cd  ! Remarked by Ning Pan, 2010-08-12
9585    a_Cd =0.0
9586
9587 !   absU =Tmpv303(i,j)  ! Remarked by Ning Pan, 2010-08-12
9588
9589    a_Tmpv7 =a_absU
9590    a_absU =0.0
9591    a_Tmpv6 =0.5*a_Tmpv7
9592    a_Tmpv5 =g_Sqrt(1.0, Tmpv302(i,j))*a_Tmpv6
9593    a_Tmpv2 =a_Tmpv5
9594    a_Tmpv4 =a_Tmpv5
9595    a_Tmpv3 =2.0*Tmpv301(i,j)*a_Tmpv4
9596    a_v(i,k,j) =a_v(i,k,j) +a_Tmpv3
9597    a_v(i,k,j+1) =a_v(i,k,j+1) +a_Tmpv3
9598    a_Tmpv1 =2.0*Tmpv300(i,j)*a_Tmpv2
9599    a_u(i,k,j) =a_u(i,k,j) +a_Tmpv1
9600    a_u(i+1,k,j) =a_u(i+1,k,j) +a_Tmpv1
9601    ENDDO
9602    ENDDO
9603 ! Remarked by Ning Pan, 2010-08-12
9604 !   a_config_flags%tke_drag_coefficient =a_config_flags%tke_drag_coefficient +a_cd0
9605 !   a_cd0 =0.0
9606
9607    CASE(1,2)
9608
9609    DO j =j_end, j_start, -1
9610    DO i =i_end, i_start, -1
9611 ! Added by Ning Pan, 2010-08-12
9612    absU =Tmpv3013(i,j)
9613    Cd =Tmpv3014(i,j)
9614
9615    a_Tmpv9 =a_tendency(i,k,j)
9616    a_tendency(i,k,j) =0.0
9617    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv9
9618    a_Tmpv8 =a_Tmpv9
9619    a_mu(i,j) =a_mu(i,j) +Tmpv3019(i,j)*a_Tmpv8
9620    a_Tmpv7 =mu(i,j)*a_Tmpv8
9621    a_Tmpv6 =0.5*a_Tmpv7
9622    a_Tmpv4 =Tmpv3018(i,j)*a_Tmpv6
9623    a_Tmpv5 =Tmpv3017(i,j)*a_Tmpv6
9624    a_defor13(i,kts+1,j) =a_defor13(i,kts+1,j) +a_Tmpv5
9625    a_defor13(i+1,kts+1,j) =a_defor13(i+1,kts+1,j) +a_Tmpv5
9626    a_Tmpv3 =absU*a_Tmpv4
9627    a_absU =a_absU +Tmpv3016(i,j)*a_Tmpv4
9628    a_Tmpv2 =Cd*a_Tmpv3
9629    a_Cd =a_Cd +Tmpv3015(i,j)*a_Tmpv3
9630    a_Tmpv1 =0.5*a_Tmpv2
9631    a_u(i,k,j) =a_u(i,k,j) +a_Tmpv1
9632    a_u(i+1,k,j) =a_u(i+1,k,j) +a_Tmpv1
9633
9634 !   Cd =Tmpv3014(i,j)  ! Remarked by Ning Pan, 2010-08-12
9635
9636    a_Tmpv1 =a_Cd
9637    a_Cd =0.0
9638    a_ust(i,j) =a_ust(i,j) +2.0*ust(i,j)/(absU**2)*a_Tmpv1
9639    a_absU =a_absU -2.0*absU*(ust(i,j)**2)/((absU**2)*(absU**2))*a_Tmpv1
9640
9641 !   absU =Tmpv3013(i,j)  ! Remarked by Ning Pan, 2010-08-12
9642
9643    a_Tmpv8 =a_absU
9644    a_absU =0.0
9645    a_Tmpv7 =a_Tmpv8
9646    a_Tmpv6 =0.5*a_Tmpv7
9647    a_Tmpv5 =g_Sqrt(1.0, Tmpv3012(i,j))*a_Tmpv6
9648    a_Tmpv2 =a_Tmpv5
9649    a_Tmpv4 =a_Tmpv5
9650    a_Tmpv3 =2.0*Tmpv3011(i,j)*a_Tmpv4
9651    a_v(i,k,j) =a_v(i,k,j) +a_Tmpv3
9652    a_v(i,k,j+1) =a_v(i,k,j+1) +a_Tmpv3
9653    a_Tmpv1 =2.0*Tmpv3010(i,j)*a_Tmpv2
9654    a_u(i,k,j) =a_u(i,k,j) +a_Tmpv1
9655    a_u(i+1,k,j) =a_u(i+1,k,j) +a_Tmpv1
9656    ENDDO
9657    ENDDO
9658
9659    CASE DEFAULT
9660
9661 ! Revised by Ning Pan, 2010-08-12
9662 !   CALL a_wrf_error_fatal('isfflx value invalid for diff_opt=2')
9663    CALL wrf_error_fatal('isfflx value invalid for diff_opt=2')
9664
9665 ! Revised by Ning Pan, 2010-08-12
9666 !   END SELECT uflux
9667    END SELECT
9668
9669 !LPB[22]
9670 !  K =KTS
9671
9672 ! Added by Ning Pan, 2010-08-12 : LPB[18]-[20]
9673 !LPB[18]
9674        DO j = j_start, j_end
9675
9676        DO k = kts+1, ktf
9677        DO i = i_start, i_end+1
9678          tmp2(i,k,j) = defor13(i,k,j)
9679        END DO
9680        END DO
9681
9682        END DO
9683
9684 !LPB[19]
9685        DO j = j_start, j_end
9686
9687        DO i = i_start, i_end+1
9688          tmp2(i,kts  ,j) = 0.0
9689          tmp2(i,ktf+1,j) = 0.0
9690        END DO
9691
9692        END DO
9693
9694 !LPB[20]
9695        DO j = j_start, j_end
9696
9697        DO k = kts, ktf
9698        DO i = i_start, i_end
9699          avg(i,k,j) = 0.25 *    &
9700                       ( ( tmp2(i  ,k+1,j)**2 ) + ( tmp2(i  ,k,j)**2 ) +    &
9701                         ( tmp2(i+1,k+1,j)**2 ) + ( tmp2(i+1,k,j)**2 ) )
9702        END DO
9703        END DO
9704
9705        END DO
9706
9707 !LPB[21]
9708    DO j =j_end, j_start, -1
9709
9710    DO k =kts, ktf
9711    DO i =i_start, i_end
9712    Tmpv001 =mu(i,j)*xkmv(i,k,j)
9713    Tmpv300(i,k) =Tmpv001
9714 ! Remarked by Ning Pan, 2010-08-12
9715    Tmpv002 =Tmpv300(i,k)*avg(i,k,j)
9716    Tmpv003 =tendency(i,k,j) +Tmpv002
9717    tendency(i,k,j) =Tmpv003
9718
9719    ENDDO
9720    ENDDO
9721
9722    DO k =ktf, kts, -1
9723    DO i =i_end, i_start, -1
9724    a_Tmpv3 =a_tendency(i,k,j)
9725    a_tendency(i,k,j) =0.0
9726    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv3
9727    a_Tmpv2 =a_Tmpv3
9728    a_Tmpv1 =avg(i,k,j)*a_Tmpv2
9729    a_avg(i,k,j) =a_avg(i,k,j) +Tmpv300(i,k)*a_Tmpv2
9730    a_mu(i,j) =a_mu(i,j) +xkmv(i,k,j)*a_Tmpv1
9731    a_xkmv(i,k,j) =a_xkmv(i,k,j) +mu(i,j)*a_Tmpv1
9732    ENDDO
9733    ENDDO
9734
9735    ENDDO
9736
9737 !LPB[20]
9738    DO j =j_end, j_start, -1
9739
9740 !  DO k =kts, ktf
9741 !  DO i =i_start, i_end
9742 !  Tmpv001 =(tmp2(i,k+1,j)**2) +(tmp2(i,k,j)**2)
9743 !  Tmpv002 =Tmpv001 +(tmp2(i+1,k+1,j)**2)
9744 !  Tmpv003 =Tmpv002 +(tmp2(i+1,k,j)**2)
9745 !  Tmpv004 =0.25*Tmpv003
9746 !  avg(i,k,j) =Tmpv004
9747
9748 !  ENDDO
9749 !  ENDDO
9750
9751    DO k =ktf, kts, -1
9752    DO i =i_end, i_start, -1
9753    a_Tmpv4 =a_avg(i,k,j)
9754    a_avg(i,k,j) =0.0
9755    a_Tmpv3 =0.25*a_Tmpv4
9756    a_Tmpv2 =a_Tmpv3
9757    a_tmp2(i+1,k,j) =a_tmp2(i+1,k,j) +2.0*tmp2(i+1,k,j)*a_Tmpv3
9758    a_Tmpv1 =a_Tmpv2
9759    a_tmp2(i+1,k+1,j) =a_tmp2(i+1,k+1,j) +2.0*tmp2(i+1,k+1,j)*a_Tmpv2
9760    a_tmp2(i,k+1,j) =a_tmp2(i,k+1,j) +2.0*tmp2(i,k+1,j)*a_Tmpv1
9761    a_tmp2(i,k,j) =a_tmp2(i,k,j) +2.0*tmp2(i,k,j)*a_Tmpv1
9762    ENDDO
9763    ENDDO
9764
9765    ENDDO
9766
9767 !LPB[19]
9768    DO j =j_end, j_start, -1
9769
9770 !  DO i =i_start, i_end+1
9771 !  tmp2(i,kts,j) =0.0
9772
9773 !  tmp2(i,ktf+1,j) =0.0
9774
9775 !  ENDDO
9776
9777    DO i =i_end+1, i_start, -1
9778    a_tmp2(i,ktf+1,j) =0.0
9779    a_tmp2(i,kts,j) =0.0
9780    ENDDO
9781
9782    ENDDO
9783
9784 !LPB[18]
9785    DO j =j_end, j_start, -1
9786
9787 !  DO k =kts+1, ktf
9788 !  DO i =i_start, i_end+1
9789 !  tmp2(i,k,j) =defor13(i,k,j)
9790
9791 !  ENDDO
9792 !  ENDDO
9793
9794    DO k =ktf, kts+1, -1
9795    DO i =i_end+1, i_start, -1
9796    a_defor13(i,k,j) =a_defor13(i,k,j) +a_tmp2(i,k,j)
9797    a_tmp2(i,k,j) =0.0
9798    ENDDO
9799    ENDDO
9800
9801    ENDDO
9802
9803 ! Added by Ning Pan, 2010-08-12 : LPB[16]
9804 !LPB[16]
9805        DO j = j_start, j_end
9806
9807        DO k = kts, ktf
9808        DO i = i_start, i_end
9809          avg(i,k,j) = 0.25 *    &
9810                       ( ( defor12(i  ,k,j)**2 ) + ( defor12(i  ,k,j+1)**2 ) +    &
9811                         ( defor12(i+1,k,j)**2 ) + ( defor12(i+1,k,j+1)**2 ) )
9812        END DO
9813        END DO
9814
9815        END DO
9816
9817 !LPB[17]
9818    DO j =j_end, j_start, -1
9819
9820    DO k =kts, ktf
9821    DO i =i_start, i_end
9822    Tmpv001 =mu(i,j)*xkmh(i,k,j)
9823    Tmpv300(i,k) =Tmpv001
9824 ! Remarked by Ning Pan, 2010-08-12
9825 !   Tmpv002 =Tmpv300(i,k)*avg(i,k,j)
9826 !   Tmpv003 =tendency(i,k,j) +Tmpv002
9827 !   tendency(i,k,j) =Tmpv003
9828
9829    ENDDO
9830    ENDDO
9831
9832    DO k =ktf, kts, -1
9833    DO i =i_end, i_start, -1
9834    a_Tmpv3 =a_tendency(i,k,j)
9835    a_tendency(i,k,j) =0.0
9836    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv3
9837    a_Tmpv2 =a_Tmpv3
9838    a_Tmpv1 =avg(i,k,j)*a_Tmpv2
9839    a_avg(i,k,j) =a_avg(i,k,j) +Tmpv300(i,k)*a_Tmpv2
9840    a_mu(i,j) =a_mu(i,j) +xkmh(i,k,j)*a_Tmpv1
9841    a_xkmh(i,k,j) =a_xkmh(i,k,j) +mu(i,j)*a_Tmpv1
9842    ENDDO
9843    ENDDO
9844
9845    ENDDO
9846
9847 !LPB[16]
9848    DO j =j_end, j_start, -1
9849
9850 !  DO k =kts, ktf
9851 !  DO i =i_start, i_end
9852 !  Tmpv001 =(defor12(i,k,j)**2) +(defor12(i,k,j+1)**2)
9853 !  Tmpv002 =Tmpv001 +(defor12(i+1,k,j)**2)
9854 !  Tmpv003 =Tmpv002 +(defor12(i+1,k,j+1)**2)
9855 !  Tmpv004 =0.25*Tmpv003
9856 !  avg(i,k,j) =Tmpv004
9857
9858 !  ENDDO
9859 !  ENDDO
9860
9861    DO k =ktf, kts, -1
9862    DO i =i_end, i_start, -1
9863    a_Tmpv4 =a_avg(i,k,j)
9864    a_avg(i,k,j) =0.0
9865    a_Tmpv3 =0.25*a_Tmpv4
9866    a_Tmpv2 =a_Tmpv3
9867    a_defor12(i+1,k,j+1) =a_defor12(i+1,k,j+1) +2.0*defor12(i+1,k,j+1)*a_Tmpv3
9868    a_Tmpv1 =a_Tmpv2
9869    a_defor12(i+1,k,j) =a_defor12(i+1,k,j) +2.0*defor12(i+1,k,j)*a_Tmpv2
9870    a_defor12(i,k,j) =a_defor12(i,k,j) +2.0*defor12(i,k,j)*a_Tmpv1
9871    a_defor12(i,k,j+1) =a_defor12(i,k,j+1) +2.0*defor12(i,k,j+1)*a_Tmpv1
9872    ENDDO
9873    ENDDO
9874
9875    ENDDO
9876
9877 !LPB[15]
9878    DO j =j_end, j_start, -1
9879
9880    DO k =kts, ktf
9881    DO i =i_start, i_end
9882    Tmpv001 =0.5*mu(i,j)*xkmv(i,k,j)
9883    Tmpv300(i,k) =Tmpv001
9884 ! Remarked by Ning Pan, 2010-08-12
9885 !   Tmpv002 =Tmpv300(i,k)*((defor33(i,k,j))**2)
9886 !   Tmpv003 =tendency(i,k,j) +Tmpv002
9887 !   tendency(i,k,j) =Tmpv003
9888
9889    ENDDO
9890    ENDDO
9891
9892    DO k =ktf, kts, -1
9893    DO i =i_end, i_start, -1
9894    a_Tmpv3 =a_tendency(i,k,j)
9895    a_tendency(i,k,j) =0.0
9896    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv3
9897    a_Tmpv2 =a_Tmpv3
9898    a_Tmpv1 =((defor33(i,k,j))**2)*a_Tmpv2
9899    a_defor33(i,k,j) =a_defor33(i,k,j) +2.0*(defor33(i,k,j))*Tmpv300(i,k)*a_Tmpv2
9900    a_mu(i,j) =a_mu(i,j) +0.5*xkmv(i,k,j)*a_Tmpv1
9901    a_xkmv(i,k,j) =a_xkmv(i,k,j) +0.5*mu(i,j)*a_Tmpv1
9902    ENDDO
9903    ENDDO
9904
9905    ENDDO
9906
9907 !LPB[14]
9908    DO j =j_end, j_start, -1
9909
9910    DO k =kts, ktf
9911    DO i =i_start, i_end
9912    Tmpv001 =0.5*mu(i,j)*xkmh(i,k,j)
9913    Tmpv300(i,k) =Tmpv001
9914 ! Remarked by Ning Pan, 2010-08-12
9915 !   Tmpv002 =Tmpv300(i,k)*((defor22(i,k,j))**2)
9916 !   Tmpv003 =tendency(i,k,j) +Tmpv002
9917 !   tendency(i,k,j) =Tmpv003
9918
9919    ENDDO
9920    ENDDO
9921
9922    DO k =ktf, kts, -1
9923    DO i =i_end, i_start, -1
9924    a_Tmpv3 =a_tendency(i,k,j)
9925    a_tendency(i,k,j) =0.0
9926    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv3
9927    a_Tmpv2 =a_Tmpv3
9928    a_Tmpv1 =((defor22(i,k,j))**2)*a_Tmpv2
9929    a_defor22(i,k,j) =a_defor22(i,k,j) +2.0*(defor22(i,k,j))*Tmpv300(i,k)*a_Tmpv2
9930    a_mu(i,j) =a_mu(i,j) +0.5*xkmh(i,k,j)*a_Tmpv1
9931    a_xkmh(i,k,j) =a_xkmh(i,k,j) +0.5*mu(i,j)*a_Tmpv1
9932    ENDDO
9933    ENDDO
9934
9935    ENDDO
9936
9937 !LPB[13]
9938    DO j =j_end, j_start, -1
9939
9940    DO k =kts, ktf
9941    DO i =i_start, i_end
9942    Tmpv001 =0.5*mu(i,j)*xkmh(i,k,j)
9943    Tmpv300(i,k) =Tmpv001
9944 ! Remarked by Ning Pan, 2010-08-12
9945 !   Tmpv002 =Tmpv300(i,k)*((defor11(i,k,j))**2)
9946 !   Tmpv003 =tendency(i,k,j) +Tmpv002
9947 !   tendency(i,k,j) =Tmpv003
9948
9949    ENDDO
9950    ENDDO
9951
9952    DO k =ktf, kts, -1
9953    DO i =i_end, i_start, -1
9954    a_Tmpv3 =a_tendency(i,k,j)
9955    a_tendency(i,k,j) =0.0
9956    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv3
9957    a_Tmpv2 =a_Tmpv3
9958    a_Tmpv1 =((defor11(i,k,j))**2)*a_Tmpv2
9959    a_defor11(i,k,j) =a_defor11(i,k,j) +2.0*(defor11(i,k,j))*Tmpv300(i,k)*a_Tmpv2
9960    a_mu(i,j) =a_mu(i,j) +0.5*xkmh(i,k,j)*a_Tmpv1
9961    a_xkmh(i,k,j) =a_xkmh(i,k,j) +0.5*mu(i,j)*a_Tmpv1
9962    ENDDO
9963    ENDDO
9964
9965    ENDDO
9966
9967 !LPB[12]
9968    DO j =j_end, j_start, -1
9969
9970 !  DO k =kts, ktf
9971 !  DO i =i_start, i_end
9972 !  Tmpv001 =zx(i,k,j) +zx(i+1,k,j)
9973 !  Tmpv002 =Tmpv001 +zx(i,k+1,j)
9974 !  Tmpv003 =Tmpv002 +zx(i+1,k+1,j)
9975 !  Tmpv004 =0.25*Tmpv003
9976 !  zxavg(i,k,j) =Tmpv004
9977
9978 !  Tmpv001 =zy(i,k,j) +zy(i,k,j+1)
9979 !  Tmpv002 =Tmpv001 +zy(i,k+1,j)
9980 !  Tmpv003 =Tmpv002 +zy(i,k+1,j+1)
9981 !  Tmpv004 =0.25*Tmpv003
9982 !  zyavg(i,k,j) =Tmpv004
9983
9984 !  ENDDO
9985 !  ENDDO
9986
9987    DO k =ktf, kts, -1
9988    DO i =i_end, i_start, -1
9989    a_Tmpv4 =a_zyavg(i,k,j)
9990    a_zyavg(i,k,j) =0.0
9991    a_Tmpv3 =0.25*a_Tmpv4
9992    a_Tmpv2 =a_Tmpv3
9993    a_zy(i,k+1,j+1) =a_zy(i,k+1,j+1) +a_Tmpv3
9994    a_Tmpv1 =a_Tmpv2
9995    a_zy(i,k+1,j) =a_zy(i,k+1,j) +a_Tmpv2
9996    a_zy(i,k,j) =a_zy(i,k,j) +a_Tmpv1
9997    a_zy(i,k,j+1) =a_zy(i,k,j+1) +a_Tmpv1
9998    a_Tmpv4 =a_zxavg(i,k,j)
9999    a_zxavg(i,k,j) =0.0
10000    a_Tmpv3 =0.25*a_Tmpv4
10001    a_Tmpv2 =a_Tmpv3
10002    a_zx(i+1,k+1,j) =a_zx(i+1,k+1,j) +a_Tmpv3
10003    a_Tmpv1 =a_Tmpv2
10004    a_zx(i,k+1,j) =a_zx(i,k+1,j) +a_Tmpv2
10005    a_zx(i,k,j) =a_zx(i,k,j) +a_Tmpv1
10006    a_zx(i+1,k,j) =a_zx(i+1,k,j) +a_Tmpv1
10007    ENDDO
10008    ENDDO
10009
10010    ENDDO
10011
10012 !LPB[11]
10013
10014 !  IF( config_flags%periodic_x ) THEN
10015 !  i_end =min(ite, ide-1)
10016 !  END IF
10017
10018 !  IF( config_flags%periodic_x ) THEN
10019
10020 !  END IF
10021
10022 !LPB[10]
10023
10024 !LPB[9]
10025
10026 !  IF( config_flags%periodic_x ) THEN
10027 !  i_start =its
10028 !  END IF
10029
10030 !  IF( config_flags%periodic_x ) THEN
10031
10032 !  END IF
10033
10034 !LPB[8]
10035
10036 !LPB[7]
10037
10038 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.             config_flags%nested ) THEN
10039 !  j_end =min(jde-2, jte)
10040 !  END IF
10041
10042 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
10043 !            config_flags%nested ) THEN
10044
10045 !  END IF
10046
10047 !LPB[6]
10048
10049 !LPB[5]
10050
10051 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.             config_flags%nested ) THEN
10052 !  j_start =max(jds+1, jts)
10053 !  END IF
10054
10055 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
10056 !            config_flags%nested ) THEN
10057
10058 !  END IF
10059
10060 !LPB[4]
10061
10062 !LPB[3]
10063
10064 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.             config_flags%nested ) THEN
10065 !  i_end =min(ide-2, ite)
10066 !  END IF
10067
10068 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
10069 !            config_flags%nested ) THEN
10070
10071 !  END IF
10072
10073 !LPB[2]
10074
10075 !LPB[1]
10076
10077 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.             config_flags%nested ) THEN
10078 !  i_start =max(ids+1, its)
10079 !  END IF
10080
10081 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
10082 !            config_flags%nested ) THEN
10083
10084 !  END IF
10085
10086 !LPB[0]
10087 !  ktf =min(kte, kde-1)
10088 !  ktes1 =kte-1
10089 !  ktes2 =kte-2
10090 !  i_start =its
10091 !  i_end =min(ite, ide-1)
10092 !  j_start =jts
10093 !  j_end =min(jte, jde-1)
10094
10095    END SUBROUTINE a_tke_shear
10096
10097 !        Generated by TAPENADE     (INRIA, Tropics team)
10098 !  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
10099 !
10100 !  Differentiation of compute_diff_metrics in reverse (adjoint) mode:
10101 !   gradient     of useful results: zx zy z rdzw rdz ph
10102 !   with respect to varying inputs: zx zy z rdzw rdz ph
10103 !   RW status of diff variables: zx:in-out zy:in-out z:in-out rdzw:in-out
10104 !                rdz:in-out ph:incr
10105 SUBROUTINE A_COMPUTE_DIFF_METRICS(config_flags, ph, phb0, phb, z, zb, &
10106 &  rdz, rdzb, rdzw, rdzwb, zx, zxb, zy, zyb, rdx, rdy, ids, ide, jds, jde&
10107 &  , kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, kts, kte&
10108 &)
10109   IMPLICIT NONE
10110   TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
10111   INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
10112 &  jme, kms, kme, its, ite, jts, jte, kts, kte
10113   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: ph, phb
10114   REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: phb0
10115   REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rdz, rdzw, zx, zy, z
10116   REAL, DIMENSION(ims:ime, kms:kme, jms:jme) :: rdzb, rdzwb, zxb, zyb, &
10117 &  zb
10118   REAL, INTENT(IN) :: rdx, rdy
10119 ! Local variables.
10120   REAL, DIMENSION(its - 1:ite, kts:kte, jts - 1:jte) :: z_at_w
10121   REAL, DIMENSION(its-1:ite, kts:kte, jts-1:jte) :: z_at_wb
10122   INTEGER :: i, j, k, i_start, i_end, j_start, j_end, ktf
10123   INTEGER :: ad_from
10124   INTEGER :: ad_to
10125   INTEGER :: ad_from0
10126   INTEGER :: ad_to0
10127   INTEGER :: ad_from1
10128   INTEGER :: ad_to1
10129   INTEGER :: ad_from2
10130   INTEGER :: ad_to2
10131   INTEGER :: ad_from3
10132   INTEGER :: ad_to3
10133   INTEGER :: ad_from4
10134   INTEGER :: ad_from5
10135   INTEGER :: branch
10136   REAL :: temp1
10137   REAL :: temp0
10138   INTEGER :: min1
10139   REAL :: temp0b
10140   REAL :: temp2b5
10141   REAL :: temp2b4
10142   REAL :: temp2b3
10143   REAL :: temp2b2
10144   REAL :: temp2b1
10145   REAL :: temp2b0
10146   REAL :: tempb
10147   REAL :: temp2b
10148   REAL :: temp1b
10149   INTEGER :: max4
10150   REAL :: temp
10151   INTEGER :: max3
10152   INTEGER :: max2
10153   INTEGER :: max1
10154   IF (kte .GT. kde - 1) THEN
10155     ktf = kde - 1
10156   ELSE
10157     ktf = kte
10158   END IF
10159 ! Bug fix, WCS, 22 april 2002.
10160 ! We need rdzw in halo for average to u and v points.
10161   j_start = jts - 1
10162   j_end = jte
10163   ad_from3 = j_start
10164 ! Begin with dz computations.
10165   DO j=ad_from3,j_end
10166     IF (jte .GT. jde - 1) THEN
10167       min1 = jde - 1
10168     ELSE
10169       min1 = jte
10170     END IF
10171     IF (j_start .GE. jts .AND. j_end .LE. min1) THEN
10172       i_start = its - 1
10173       i_end = ite
10174     ELSE
10175       i_start = its
10176       IF (ite .GT. ide - 1) THEN
10177         i_end = ide - 1
10178       ELSE
10179         i_end = ite
10180       END IF
10181     END IF
10182 ! Compute z at w points for rdz and rdzw computations.  We'll switch z
10183 ! to z at p points before returning
10184     DO k=1,kte
10185       ad_from = i_start
10186 ! Bug fix, WCS, 22 april 2002
10187       DO i=ad_from,i_end
10188         z_at_w(i, k, j) = (ph(i, k, j)+phb(i, k, j))/g
10189       END DO
10190       CALL PUSHINTEGER4(i - 1)
10191       CALL PUSHINTEGER4(ad_from)
10192     END DO
10193     DO k=1,ktf
10194       ad_from0 = i_start
10195       i = i_end + 1
10196       CALL PUSHINTEGER4(i - 1)
10197       CALL PUSHINTEGER4(ad_from0)
10198     END DO
10199     DO k=2,ktf
10200       ad_from1 = i_start
10201       i = i_end + 1
10202       CALL PUSHINTEGER4(i - 1)
10203       CALL PUSHINTEGER4(ad_from1)
10204     END DO
10205     ad_from2 = i_start
10206 ! Bug fix, WCS, 22 april 2002; added the following code
10207     i = i_end + 1
10208     CALL PUSHINTEGER4(i - 1)
10209     CALL PUSHINTEGER4(ad_from2)
10210   END DO
10211   CALL PUSHINTEGER4(j - 1)
10212   CALL PUSHINTEGER4(ad_from3)
10213 ! End bug fix.
10214 ! Now compute zx and zy; we'll assume that the halo for ph and phb is
10215 ! properly filled.
10216   i_start = its
10217   IF (ite .GT. ide - 1) THEN
10218     i_end = ide - 1
10219   ELSE
10220     i_end = ite
10221   END IF
10222   j_start = jts
10223   IF (jte .GT. jde - 1) THEN
10224     j_end = jde - 1
10225   ELSE
10226     j_end = jte
10227   END IF
10228   DO j=j_start,j_end
10229     DO k=1,kte
10230       IF (ids + 1 .LT. its) THEN
10231         max1 = its
10232       ELSE
10233         max1 = ids + 1
10234       END IF
10235       ad_from4 = max1
10236       i = i_end + 1
10237       CALL PUSHINTEGER4(ad_from4)
10238     END DO
10239   END DO
10240   DO j=j_start,j_end
10241     DO k=1,kte
10242       IF (ids + 1 .LT. its) THEN
10243         max2 = its
10244       ELSE
10245         max2 = ids + 1
10246       END IF
10247       ad_from5 = max2
10248       i = i_end + 1
10249       CALL PUSHINTEGER4(ad_from5)
10250     END DO
10251   END DO
10252   IF (jds + 1 .LT. jts) THEN
10253     max3 = jts
10254   ELSE
10255     max3 = jds + 1
10256   END IF
10257   DO j=max3,j_end
10258     DO k=1,kte
10259       i = i_end + 1
10260     END DO
10261   END DO
10262   IF (jds + 1 .LT. jts) THEN
10263     max4 = jts
10264   ELSE
10265     max4 = jds + 1
10266   END IF
10267   DO j=max4,j_end
10268     DO k=1,kte
10269       i = i_end + 1
10270     END DO
10271   END DO
10272 ! Some b.c. on zx and zy.
10273   IF (.NOT.config_flags%periodic_x) THEN
10274     IF (ite .EQ. ide) THEN
10275       CALL PUSHCONTROL1B(0)
10276     ELSE
10277       CALL PUSHCONTROL1B(1)
10278     END IF
10279     IF (its .EQ. ids) THEN
10280       CALL PUSHCONTROL2B(0)
10281     ELSE
10282       CALL PUSHCONTROL2B(1)
10283     END IF
10284   ELSE
10285     IF (ite .EQ. ide) THEN
10286       CALL PUSHCONTROL1B(0)
10287     ELSE
10288       CALL PUSHCONTROL1B(1)
10289     END IF
10290     IF (its .EQ. ids) THEN
10291       CALL PUSHCONTROL2B(2)
10292     ELSE
10293       CALL PUSHCONTROL2B(3)
10294     END IF
10295   END IF
10296   IF (.NOT.config_flags%periodic_y) THEN
10297     IF (jte .EQ. jde) THEN
10298       CALL PUSHCONTROL1B(0)
10299     ELSE
10300       CALL PUSHCONTROL1B(1)
10301     END IF
10302     IF (jts .EQ. jds) THEN
10303       CALL PUSHCONTROL2B(3)
10304     ELSE
10305       CALL PUSHCONTROL2B(2)
10306     END IF
10307   ELSE
10308     IF (jte .EQ. jde) THEN
10309       CALL PUSHCONTROL1B(0)
10310     ELSE
10311       CALL PUSHCONTROL1B(1)
10312     END IF
10313     IF (jts .EQ. jds) THEN
10314       CALL PUSHCONTROL2B(1)
10315     ELSE
10316       CALL PUSHCONTROL2B(0)
10317     END IF
10318   END IF
10319 ! Calculate z at p points.
10320   DO j=j_start,j_end
10321     DO k=1,ktf
10322       CALL PUSHINTEGER4(i)
10323     END DO
10324   END DO
10325   DO j=j_end,j_start,-1
10326     DO k=ktf,1,-1
10327       DO i=i_end,i_start,-1
10328         temp2b5 = 0.5*zb(i, k, j)/g
10329         phb0(i, k, j) = phb0(i, k, j) + temp2b5
10330         phb0(i, k+1, j) = phb0(i, k+1, j) + temp2b5
10331         zb(i, k, j) = 0.0
10332       END DO
10333       CALL POPINTEGER4(i)
10334     END DO
10335   END DO
10336   CALL POPCONTROL2B(branch)
10337   IF (branch .LT. 2) THEN
10338     IF (branch .NE. 0) THEN
10339      DO k=ktf,1,-1
10340         DO i =i_end, i_start, -1
10341           temp2b4 = rdy*zyb(i, k, jds)/g
10342           phb0(i, k, jds) = phb0(i, k, jds) + temp2b4
10343           phb0(i, k, jds-1) = phb0(i, k, jds-1) - temp2b4
10344         END DO
10345       END DO
10346       DO k=ktf,1,-1
10347         DO i =i_end, i_start, -1
10348           zyb(i, k, jds) = 0.0
10349         END DO
10350       END DO
10351     END IF
10352     CALL POPCONTROL1B(branch)
10353     IF (branch .EQ. 0) THEN
10354      DO k=ktf,1,-1
10355         DO i =i_end, i_start, -1
10356           temp2b3 = rdy*zyb(i, k, jde)/g
10357           phb0(i, k, jde) = phb0(i, k, jde) + temp2b3
10358           phb0(i, k, jde-1) = phb0(i, k, jde-1) - temp2b3
10359         END DO
10360       END DO
10361      DO k=ktf,1,-1
10362         DO i =i_end, i_start, -1
10363           zyb(i, k, jde) = 0.0
10364         END DO
10365       END DO
10366     END IF
10367   ELSE
10368     IF (branch .NE. 2) THEN
10369       DO k=ktf,1,-1
10370         DO i=i_end,i_start,-1
10371           zyb(i, k, jds) = 0.0
10372         END DO
10373       END DO
10374     END IF
10375     CALL POPCONTROL1B(branch)
10376     IF (branch .EQ. 0) THEN
10377       DO k=ktf,1,-1
10378         DO i=i_end,i_start,-1
10379           zyb(i, k, jde) = 0.0
10380         END DO
10381       END DO
10382     END IF
10383   END IF
10384   CALL POPCONTROL2B(branch)
10385   IF (branch .LT. 2) THEN
10386     IF (branch .EQ. 0) THEN
10387       DO j=j_end,j_start,-1
10388         DO k=ktf,1,-1
10389           zxb(ids, k, j) = 0.0
10390         END DO
10391       END DO
10392     END IF
10393     CALL POPCONTROL1B(branch)
10394     IF (branch .EQ. 0) THEN
10395       DO j=j_end,j_start,-1
10396         DO k=ktf,1,-1
10397           zxb(ide, k, j) = 0.0
10398         END DO
10399       END DO
10400     END IF
10401   ELSE
10402     IF (branch .EQ. 2) THEN
10403       DO j=j_end,j_start,-1
10404         DO k=ktf,1,-1
10405           temp2b2 = rdx*zxb(ids, k, j)/g
10406           phb0(ids, k, j) = phb0(ids, k, j) + temp2b2
10407           phb0(ids-1, k, j) = phb0(ids-1, k, j) - temp2b2
10408         END DO
10409       END DO
10410       DO j=j_end,j_start,-1
10411         DO k=ktf,1,-1
10412           zxb(ids, k, j) = 0.0
10413         END DO
10414       END DO
10415     END IF
10416     CALL POPCONTROL1B(branch)
10417     IF (branch .EQ. 0) THEN
10418       DO j=j_end,j_start,-1
10419         DO k=ktf,1,-1
10420           temp2b1 = rdx*zxb(ide, k, j)/g
10421           phb0(ide, k, j) = phb0(ide, k, j) + temp2b1
10422           phb0(ide-1, k, j) = phb0(ide-1, k, j) - temp2b1
10423         END DO
10424       END DO
10425       DO j=j_end,j_start,-1
10426         DO k=ktf,1,-1
10427           zxb(ide, k, j) = 0.0
10428         END DO
10429       END DO
10430     END IF
10431   END IF
10432   DO j=j_end,max4,-1
10433     DO k=kte,1,-1
10434       DO i=i_end,i_start,-1
10435         temp2b0 = rdy*zyb(i, k, j)/g
10436         phb0(i, k, j) = phb0(i, k, j) + temp2b0
10437         phb0(i, k, j-1) = phb0(i, k, j-1) - temp2b0
10438       END DO
10439     END DO
10440   END DO
10441   DO j=j_end,max3,-1
10442     DO k=kte,1,-1
10443       DO i=i_end,i_start,-1
10444         zyb(i, k, j) = 0.0
10445       END DO
10446     END DO
10447   END DO
10448   DO j=j_end,j_start,-1
10449     DO k=kte,1,-1
10450       CALL POPINTEGER4(ad_from5)
10451       DO i=i_end,ad_from5,-1
10452         temp2b = rdx*zxb(i, k, j)/g
10453         phb0(i, k, j) = phb0(i, k, j) + temp2b
10454         phb0(i-1, k, j) = phb0(i-1, k, j) - temp2b
10455       END DO
10456     END DO
10457   END DO
10458   DO j=j_end,j_start,-1
10459     DO k=kte,1,-1
10460       CALL POPINTEGER4(ad_from4)
10461       DO i=i_end,ad_from4,-1
10462         zxb(i, k, j) = 0.0
10463       END DO
10464     END DO
10465   END DO
10466   z_at_wb = 0.0
10467   CALL POPINTEGER4(ad_from3)
10468   CALL POPINTEGER4(ad_to3)
10469   DO j=ad_to3,ad_from3,-1
10470     CALL POPINTEGER4(ad_from2)
10471     CALL POPINTEGER4(ad_to2)
10472     DO i=ad_to2,ad_from2,-1
10473       temp1 = z_at_w(i, 2, j) - z_at_w(i, 1, j)
10474       temp1b = -(2.*rdzb(i, 1, j)/temp1**2)
10475       z_at_wb(i, 2, j) = z_at_wb(i, 2, j) + temp1b
10476       z_at_wb(i, 1, j) = z_at_wb(i, 1, j) - temp1b
10477       rdzb(i, 1, j) = 0.0
10478     END DO
10479     DO k=ktf,2,-1
10480       CALL POPINTEGER4(ad_from1)
10481       CALL POPINTEGER4(ad_to1)
10482       DO i=ad_to1,ad_from1,-1
10483         temp0 = z_at_w(i, k+1, j) - z_at_w(i, k-1, j)
10484         temp0b = -(2.0*rdzb(i, k, j)/temp0**2)
10485         z_at_wb(i, k+1, j) = z_at_wb(i, k+1, j) + temp0b
10486         z_at_wb(i, k-1, j) = z_at_wb(i, k-1, j) - temp0b
10487         rdzb(i, k, j) = 0.0
10488       END DO
10489     END DO
10490     DO k=ktf,1,-1
10491       CALL POPINTEGER4(ad_from0)
10492       CALL POPINTEGER4(ad_to0)
10493       DO i=ad_to0,ad_from0,-1
10494         temp = z_at_w(i, k+1, j) - z_at_w(i, k, j)
10495         tempb = -(rdzwb(i, k, j)/temp**2)
10496         z_at_wb(i, k+1, j) = z_at_wb(i, k+1, j) + tempb
10497         z_at_wb(i, k, j) = z_at_wb(i, k, j) - tempb
10498         rdzwb(i, k, j) = 0.0
10499       END DO
10500     END DO
10501     DO k=kte,1,-1
10502       CALL POPINTEGER4(ad_from)
10503       CALL POPINTEGER4(ad_to)
10504       DO i=ad_to,ad_from,-1
10505         phb0(i, k, j) = phb0(i, k, j) + z_at_wb(i, k, j)/g
10506         z_at_wb(i, k, j) = 0.0
10507       END DO
10508     END DO
10509   END DO
10510 END SUBROUTINE A_COMPUTE_DIFF_METRICS
10511
10512    SUBROUTINE a_horizontal_diffusion_2(rt_tendf,a_rt_tendf,ru_tendf,a_ru_tendf, &
10513    rv_tendf,a_rv_tendf,rw_tendf,a_rw_tendf,tke_tendf,a_tke_tendf,moist_tendf, &
10514 ! Revised by Ning Pan, 2010-08-10
10515 !   a_moist_tendf,n_moist,chem_tendf,a_chem_tendf,n_chem,scalar_tendf,a_scalar_tend &
10516 !   f,n_scalar,tracer_tendf,a_tracer_tendf,n_tracer,thp,a_thp,theta,a_theta,mu, &
10517    a_moist_tendf,n_moist,chem_tendf,a_chem_tendf,n_chem,scalar_tendf,a_scalar_tend&
10518    &f,n_scalar,tracer_tendf,a_tracer_tendf,n_tracer,thp,a_thp,theta,a_theta,mu, &
10519    a_mu,tke,a_tke,config_flags,defor11,a_defor11,defor22,a_defor22,defor12, &
10520    a_defor12,defor13,a_defor13,defor23,a_defor23,nba_mij,a_nba_mij,n_nba_mij, &
10521    div,a_div,moist,a_moist,chem,a_chem,scalar,a_scalar,tracer,a_tracer,msfux, &
10522    msfuy,msfvx,msfvy,msftx,msfty,xkmh,a_xkmh,xkhh,a_xkhh,km_opt,rdx,rdy,rdz,a_rdz, &
10523    rdzw,a_rdzw,fnm,fnp,cf1,cf2,cf3,zx,a_zx,zy,a_zy,dn,dnw,rho,a_rho,ids,ide,jds,jde,kds,kde, &
10524    ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
10525
10526 !PART I: DECLARATION OF VARIABLES
10527
10528    IMPLICIT NONE
10529
10530    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
10531    TYPE(grid_config_rec_type) :: config_flags
10532    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
10533    INTEGER :: n_moist,n_chem,n_scalar,n_tracer,km_opt
10534    REAL :: cf1,cf2,cf3
10535    REAL,DIMENSION(kms:kme) :: fnm
10536    REAL,DIMENSION(kms:kme) :: fnp
10537    REAL,DIMENSION(kms:kme) :: dnw
10538    REAL,DIMENSION(kms:kme) :: dn
10539    REAL,DIMENSION(ims:ime,jms:jme) :: msfux,msfuy,msfvx,msfvy,msftx,msfty,mu,a_mu
10540    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rt_tendf,a_rt_tendf,ru_tendf, &
10541    a_ru_tendf,rv_tendf,a_rv_tendf,rw_tendf,a_rw_tendf,tke_tendf,a_tke_tendf
10542    REAL , DIMENSION( ims:ime, kms:kme, jms:jme) :: &
10543                                                                   u_h_tend,&
10544                                                                   v_h_tend
10545    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist_tendf,a_moist_tendf
10546    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_chem) :: chem_tendf,a_chem_tendf
10547    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_scalar) :: scalar_tendf,a_scalar_tendf
10548    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_tracer) :: tracer_tendf,a_tracer_tendf
10549    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist,a_moist
10550    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_chem) :: chem,a_chem
10551    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_scalar) :: scalar,a_scalar
10552    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_tracer) :: tracer,a_tracer
10553    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor11,a_defor11,defor22,a_defor22, &
10554    defor12,a_defor12,defor13,a_defor13,defor23,a_defor23,div,a_div,xkmh, &
10555    a_xkmh,xkhh,a_xkhh,zx,a_zx,zy,a_zy,theta,a_theta,thp,a_thp,tke,a_tke, &
10556    rdz,a_rdz,rdzw,a_rdzw
10557    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rho, a_rho
10558    REAL :: rdx,rdy
10559    INTEGER :: n_nba_mij
10560    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: nba_mij,a_nba_mij
10561    INTEGER :: im,ic,is
10562
10563    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb0_ru_tendf
10564    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: Keep_Lpb0_nba_mij
10565    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: Keep_Lpb1_nba_mij  ! Added by Ning Pan, 2010-08-11
10566 ! Remarked by Ning Pan, 2010-08-11
10567 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb0_rv_tendf
10568 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb0_rw_tendf
10569 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb0_rt_tendf
10570 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme,ims:ime,kms:kme,jms:jme) :: Keep_Lpb1_tke_tendf
10571 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist,ims:ime,kms:kme,jms:jme,n_moist) &
10572 !    :: Keep_Lpb3_moist_tendf
10573 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_chem,ims:ime,kms:kme,jms:jme,n_chem) &
10574 !    :: Keep_Lpb5_chem_tendf
10575 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_tracer,ims:ime,kms:kme,jms:jme,n_tracer) &
10576 !    :: Keep_Lpb7_tracer_tendf
10577 !!  REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_scalar,ims:ime,kms:kme,jms:jme,n_scalar) &
10578 !!    :: Keep_Lpb9_scalar_tendf
10579 !   INTEGER :: IX1,IX2,IX3,IX4
10580
10581 ! Remarked by Ning Pan, 2010-08-11
10582 !   REAL :: Tmpv_1
10583 !   REAL,DIMENSION(PARAM_FIRST_SCALAR:max0(n_moist,n_chem,n_tracer,n_scalar)) :: Tmpv200
10584 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv400
10585 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv401
10586 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv402
10587 !   REAL,DIMENSION(jms:jme,kms:kme,ims:ime) :: Tmpv403
10588 !   REAL,DIMENSION(n_nba_mij,jms:jme,kms:kme,ims:ime) :: Tmpv500
10589 !   REAL,DIMENSION(n_nba_mij,jms:jme,kms:kme,ims:ime) :: Tmpv501
10590 !   REAL,DIMENSION(n_nba_mij,jms:jme,kms:kme,ims:ime) :: Tmpv502
10591
10592 !PART II: CALCULATIONS OF B. S. TRAJECTORY
10593
10594 ! Remarked by Ning Pan, 2010-08-11: LPB[0]-[7]
10595 !LPB[0]
10596 !   DO IX3=jms,jme
10597 !   DO IX2=kms,kme
10598 !   DO IX1=ims,ime
10599 !       Keep_Lpb0_ru_tendf(IX1,IX2,IX3) =ru_tendf(IX1,IX2,IX3)
10600 !   END DO
10601 !   END DO
10602 !   END DO
10603 !   DO IX4=1,n_nba_mij
10604 !   DO IX3=jms,jme
10605 !   DO IX2=kms,kme
10606 !   DO IX1=ims,ime
10607 !       Keep_Lpb0_nba_mij(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
10608 !   END DO
10609 !   END DO
10610 !   END DO
10611 !   END DO
10612 !   DO IX3=jms,jme
10613 !   DO IX2=kms,kme
10614 !   DO IX1=ims,ime
10615 !       Keep_Lpb0_rv_tendf(IX1,IX2,IX3) =rv_tendf(IX1,IX2,IX3)
10616 !   END DO
10617 !   END DO
10618 !   END DO
10619 !   DO IX3=jms,jme
10620 !   DO IX2=kms,kme
10621 !   DO IX1=ims,ime
10622 !       Keep_Lpb0_rw_tendf(IX1,IX2,IX3) =rw_tendf(IX1,IX2,IX3)
10623 !   END DO
10624 !   END DO
10625 !   END DO
10626 !   DO IX3=jms,jme
10627 !   DO IX2=kms,kme
10628 !   DO IX1=ims,ime
10629 !       Keep_Lpb0_rt_tendf(IX1,IX2,IX3) =rt_tendf(IX1,IX2,IX3)
10630 !   END DO
10631 !   END DO
10632 !   END DO
10633
10634 !       CALL horizontal_diffusion_u_2( ru_tendf, mu, config_flags,               &
10635 !                                      defor11, defor12, div,                    &
10636 !                                      nba_mij, n_nba_mij,                        &
10637 !                                      tke(ims,kms,jms),                         &
10638 !                                      msfux, msfuy, xkmh, rdx, rdy, fnm, fnp,   &
10639 !                                      zx, zy, rdzw,                             &
10640 !                                      ids, ide, jds, jde, kds, kde,             &
10641 !                                      ims, ime, jms, jme, kms, kme,             &
10642 !                                      its, ite, jts, jte, kts, kte           )
10643 !       CALL horizontal_diffusion_v_2( rv_tendf, mu, config_flags,               &
10644 !                                      defor12, defor22, div,                    &
10645 !                                      nba_mij, n_nba_mij,                        &
10646 !                                      tke(ims,kms,jms),                         &
10647 !                                      msfvx, msfvy, xkmh, rdx, rdy, fnm, fnp,   &
10648 !                                      zx, zy, rdzw,                             &
10649 !                                      ids, ide, jds, jde, kds, kde,             &
10650 !                                      ims, ime, jms, jme, kms, kme,             &
10651 !                                      its, ite, jts, jte, kts, kte           )
10652 !       CALL horizontal_diffusion_w_2( rw_tendf, mu, config_flags,               &
10653 !                                      defor13, defor23, div,                    &
10654 !                                      nba_mij, n_nba_mij,                        &
10655 !                                      tke(ims,kms,jms),                         &
10656 !                                      msftx, msfty, xkmh, rdx, rdy, fnm, fnp,   &
10657 !                                      zx, zy, rdz,                              &
10658 !                                      ids, ide, jds, jde, kds, kde,             &
10659 !                                      ims, ime, jms, jme, kms, kme,             &
10660 !                                      its, ite, jts, jte, kts, kte           )
10661 !       CALL horizontal_diffusion_s  ( rt_tendf, mu, config_flags, thp,          &
10662 !                                      msftx, msfty, msfux, msfuy,               &
10663 !                                      msfvx, msfvy, xkhh, rdx, rdy,             &
10664 !                                      fnm, fnp, cf1, cf2, cf3,                  &
10665 !                                      zx, zy, rdz, rdzw, dnw, dn,               &
10666 !                                      .false.,                                  &
10667 !                                      ids, ide, jds, jde, kds, kde,             &
10668 !                                      ims, ime, jms, jme, kms, kme,             &
10669 !                                      its, ite, jts, jte, kts, kte           )
10670
10671 !LPB[1]
10672 !   DO IX3=jms,jme
10673 !   DO IX2=kms,kme
10674 !   DO IX1=ims,ime
10675 !       Keep_Lpb1_tke_tendf(IX1,IX2,IX3) =tke_tendf(IX1,IX2,IX3)
10676 !   END DO
10677 !   END DO
10678 !   END DO
10679
10680 !    IF (km_opt .eq. 2)                                                       &
10681 !    CALL horizontal_diffusion_s  ( tke_tendf(ims,kms,jms),                   &
10682 !                                   mu, config_flags,                         &
10683 !                                   tke(ims,kms,jms),                         &
10684 !                                   msftx, msfty, msfux, msfuy,               &
10685 !                                   msfvx, msfvy, xkhh, rdx, rdy,             &
10686 !                                   fnm, fnp, cf1, cf2, cf3,                  &
10687 !                                   zx, zy, rdz, rdzw, dnw, dn,               &
10688 !                                   .true.,                                   &
10689 !                                   ids, ide, jds, jde, kds, kde,             &
10690 !                                   ims, ime, jms, jme, kms, kme,             &
10691 !                                   its, ite, jts, jte, kts, kte           )
10692
10693 !LPB[2]
10694
10695 !LPB[3]
10696 !   DO IX4=1,n_moist
10697 !   DO IX3=jms,jme
10698 !   DO IX2=kms,kme
10699 !   DO IX1=ims,ime
10700 !       Keep_Lpb3_moist_tendf(IX1,IX2,IX3,IX4) =moist_tendf(IX1,IX2,IX3,IX4)
10701 !   END DO
10702 !   END DO
10703 !   END DO
10704 !   END DO
10705
10706 !    IF (n_moist .ge. PARAM_FIRST_SCALAR) THEN
10707
10708 !         moist_loop: do im = PARAM_FIRST_SCALAR, n_moist
10709 !             CALL horizontal_diffusion_s( moist_tendf(ims,kms,jms,im),         &
10710 !                                          mu, config_flags,                    &
10711 !                                          moist(ims,kms,jms,im),               &
10712 !                                          msftx, msfty, msfux, msfuy,          &
10713 !                                          msfvx, msfvy, xkhh, rdx, rdy,        &
10714 !                                          fnm, fnp, cf1, cf2, cf3,             &
10715 !                                          zx, zy, rdz, rdzw, dnw, dn,          &
10716 !                                          .false.,                             &
10717 !                                          ids, ide, jds, jde, kds, kde,        &
10718 !                                          ims, ime, jms, jme, kms, kme,        &
10719 !                                          its, ite, jts, jte, kts, kte      )
10720 !         ENDDO moist_loop
10721
10722 !   ENDIF
10723
10724 !LPB[4]
10725
10726 !LPB[5]
10727 !   DO IX4=1,n_chem
10728 !   DO IX3=jms,jme
10729 !   DO IX2=kms,kme
10730 !   DO IX1=ims,ime
10731 !       Keep_Lpb5_chem_tendf(IX1,IX2,IX3,IX4) =chem_tendf(IX1,IX2,IX3,IX4)
10732 !   END DO
10733 !   END DO
10734 !   END DO
10735 !   END DO
10736
10737 !    IF (n_chem .ge. PARAM_FIRST_SCALAR) THEN
10738
10739 !         chem_loop: do ic = PARAM_FIRST_SCALAR, n_chem
10740 !           CALL horizontal_diffusion_s( chem_tendf(ims,kms,jms,ic),       &
10741 !                                        mu, config_flags,                   &
10742 !                                        chem(ims,kms,jms,ic),             &
10743 !                                        msftx, msfty, msfux, msfuy,         &
10744 !                                        msfvx, msfvy, xkhh, rdx, rdy,       &
10745 !                                        fnm, fnp, cf1, cf2, cf3,            &
10746 !                                        zx, zy, rdz, rdzw, dnw, dn,         &
10747 !                                        .false.,                            &
10748 !                                        ids, ide, jds, jde, kds, kde,       &
10749 !                                        ims, ime, jms, jme, kms, kme,       &
10750 !                                        its, ite, jts, jte, kts, kte     )
10751 !         ENDDO chem_loop
10752
10753 !   ENDIF
10754
10755 !LPB[6]
10756
10757 !LPB[7]
10758 !   DO IX4=1,n_tracer
10759 !   DO IX3=jms,jme
10760 !   DO IX2=kms,kme
10761 !   DO IX1=ims,ime
10762 !       Keep_Lpb7_tracer_tendf(IX1,IX2,IX3,IX4) =tracer_tendf(IX1,IX2,IX3,IX4)
10763 !   END DO
10764 !   END DO
10765 !   END DO
10766 !   END DO
10767
10768 !    IF (n_tracer .ge. PARAM_FIRST_SCALAR) THEN
10769
10770 !         tracer_loop: do ic = PARAM_FIRST_SCALAR, n_tracer
10771 !           CALL horizontal_diffusion_s( tracer_tendf(ims,kms,jms,ic),       &
10772 !                                        mu, config_flags,                   &
10773 !                                        tracer(ims,kms,jms,ic),             &
10774 !                                        msftx, msfty, msfux, msfuy,         &
10775 !                                        msfvx, msfvy, xkhh, rdx, rdy,       &
10776 !                                        fnm, fnp, cf1, cf2, cf3,            &
10777 !                                        zx, zy, rdz, rdzw, dnw, dn,         &
10778 !                                        .false.,                            &
10779 !                                        ids, ide, jds, jde, kds, kde,       &
10780 !                                        ims, ime, jms, jme, kms, kme,       &
10781 !                                        its, ite, jts, jte, kts, kte     )
10782 !         ENDDO tracer_loop
10783
10784 !   ENDIF
10785
10786 !LPB[8]
10787
10788 !!LPB[9]
10789 !!  DO IX4=1,n_scalar
10790 !!  DO IX3=jms,jme
10791 !!  DO IX2=kms,kme
10792 !!  DO IX1=ims,ime
10793 !    !  Keep_Lpb9_scalar_tendf(IX1,IX2,IX3,IX4) =scalar_tendf(IX1,IX2,IX3,IX4)
10794 !!  END DO
10795 !!  END DO
10796 !!  END DO
10797 !!  END DO
10798
10799 !
10800 !    IF (n_scalar .ge. PARAM_FIRST_SCALAR) THEN
10801
10802 !         scalar_loop: do is = PARAM_FIRST_SCALAR, n_scalar
10803 !           CALL horizontal_diffusion_s( scalar_tendf(ims,kms,jms,is),       &
10804 !                                        mu, config_flags,                   &
10805 !                                        scalar(ims,kms,jms,is),             &
10806 !                                        msftx, msfty, msfux, msfuy,         &
10807 !                                        msfvx, msfvy, xkhh, rdx, rdy,       &
10808 !                                        fnm, fnp, cf1, cf2, cf3,            &
10809 !                                        zx, zy, rdz, rdzw, dnw, dn,         &
10810 !                                        .false.,                            &
10811 !                                        ids, ide, jds, jde, kds, kde,       &
10812 !                                        ims, ime, jms, jme, kms, kme,       &
10813 !                                        its, ite, jts, jte, kts, kte     )
10814 !         ENDDO scalar_loop
10815
10816 !   ENDIF
10817
10818 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
10819
10820 !LPB[9]
10821 !  DO IX4=1,n_scalar
10822 !  DO IX3=jms,jme
10823 !  DO IX2=kms,kme
10824 !  DO IX1=ims,ime
10825 !  scalar_tendf(IX1,IX2,IX3,IX4) =Keep_Lpb9_scalar_tendf(IX1,IX2,IX3,IX4)
10826 !  END DO
10827 !  END DO
10828 !  END DO
10829 !  END DO
10830
10831 !  IF(n_scalar .ge. PARAM_FIRST_SCALAR) THEN
10832 !  DO is =PARAM_FIRST_SCALAR, n_scalar
10833 !  Tmpv200(is) =scalar_tendf(ims,kms,jms,is)
10834 !  CALL horizontal_diffusion_s(scalar_tendf(ims,kms,jms,is),mu,config_flags,scalar(  &
10835 !  ims,kms,jms,is),msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,rdx,rdy,fnm,fnp,cf1,cf2,cf3,  &
10836 !  zx,zy,rdz,rdzw,dnw,dn,.false.,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,  &
10837 !  ite,jts,jte,kts,kte)
10838
10839 !  ENDDO
10840
10841 !  ENDIF
10842
10843    IF(n_scalar .ge. PARAM_FIRST_SCALAR) THEN
10844
10845    DO is =n_scalar, PARAM_FIRST_SCALAR, -1
10846
10847 !   scalar_tendf(ims,kms,jms,is) =Tmpv200(is)  ! Remarked by Ning Pan, 2010-08-11
10848
10849    CALL a_horizontal_diffusion_s(scalar_tendf(ims,kms,jms,is),a_scalar_tendf(ims,  &
10850    kms,jms,is),mu,a_mu,config_flags,scalar(ims,kms,jms,is),a_scalar(ims,kms,jms,is)  &
10851    ,msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,a_xkhh,rdx,rdy,fnm,fnp,cf1,cf2,cf3,zx,  &
10852 ! Revised by Ning Pan, 2010-08-10
10853 !   a_zx,zy,a_zy,rdz,a_rdz,rdzw,a_rdzw,dnw,dn,,ids,ide,jds,jde,kds,kde,ims,ime,  &
10854    a_zx,zy,a_zy,rdz,a_rdz,rdzw,a_rdzw,dnw,dn,rho,a_rho,.false.,ids,ide,jds,jde,kds,kde,ims,ime,  &
10855    jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
10856    ENDDO
10857
10858    ENDIF
10859
10860 !LPB[8]
10861
10862 !LPB[7]
10863 ! Remarked by Ning Pan, 2010-08-10
10864 !   DO IX4=1,n_tracer
10865 !   DO IX3=jms,jme
10866 !   DO IX2=kms,kme
10867 !   DO IX1=ims,ime
10868 !   tracer_tendf(IX1,IX2,IX3,IX4) =Keep_Lpb7_tracer_tendf(IX1,IX2,IX3,IX4)
10869 !   END DO
10870 !   END DO
10871 !   END DO
10872 !   END DO
10873
10874 !  IF(n_tracer .ge. PARAM_FIRST_SCALAR) THEN
10875 !  DO ic =PARAM_FIRST_SCALAR, n_tracer
10876 !  Tmpv200(ic) =tracer_tendf(ims,kms,jms,ic)
10877 !  CALL horizontal_diffusion_s(tracer_tendf(ims,kms,jms,ic),mu,config_flags,tracer(  &
10878 !  ims,kms,jms,ic),msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,rdx,rdy,fnm,fnp,cf1,cf2,cf3,  &
10879 !  zx,zy,rdz,rdzw,dnw,dn,.false.,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,  &
10880 !  ite,jts,jte,kts,kte)
10881
10882 !  ENDDO
10883
10884 !  ENDIF
10885
10886    IF(n_tracer .ge. PARAM_FIRST_SCALAR) THEN
10887
10888    DO ic =n_tracer, PARAM_FIRST_SCALAR, -1
10889
10890 !   tracer_tendf(ims,kms,jms,ic) =Tmpv200(ic)  ! Remarked by Ning Pan, 2010-08-11
10891
10892    CALL a_horizontal_diffusion_s(tracer_tendf(ims,kms,jms,ic),a_tracer_tendf(ims,  &
10893    kms,jms,ic),mu,a_mu,config_flags,tracer(ims,kms,jms,ic),a_tracer(ims,kms,jms,ic)  &
10894    ,msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,a_xkhh,rdx,rdy,fnm,fnp,cf1,cf2,cf3,zx,  &
10895 ! Revised by Ning Pan, 2010-08-10
10896 !   a_zx,zy,a_zy,rdz,a_rdz,rdzw,a_rdzw,dnw,dn,,ids,ide,jds,jde,kds,kde,ims,ime,  &
10897    a_zx,zy,a_zy,rdz,a_rdz,rdzw,a_rdzw,dnw,dn,rho,a_rho,.false.,ids,ide,jds,jde,kds,kde,ims,ime,  &
10898    jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
10899    ENDDO
10900
10901    ENDIF
10902
10903 !LPB[6]
10904
10905 !LPB[5]
10906 ! Remarked by Ning Pan, 2010-08-10
10907 !   DO IX4=1,n_chem
10908 !   DO IX3=jms,jme
10909 !   DO IX2=kms,kme
10910 !   DO IX1=ims,ime
10911 !   chem_tendf(IX1,IX2,IX3,IX4) =Keep_Lpb5_chem_tendf(IX1,IX2,IX3,IX4)
10912 !   END DO
10913 !   END DO
10914 !   END DO
10915 !   END DO
10916
10917 !  IF(n_chem .ge. PARAM_FIRST_SCALAR) THEN
10918 !  DO ic =PARAM_FIRST_SCALAR, n_chem
10919 !  Tmpv200(ic) =chem_tendf(ims,kms,jms,ic)
10920 !  CALL horizontal_diffusion_s(chem_tendf(ims,kms,jms,ic),mu,config_flags,chem(ims,  &
10921 !  kms,jms,ic),msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,rdx,rdy,fnm,fnp,cf1,cf2,cf3,zx,  &
10922 !  zy,rdz,rdzw,dnw,dn,.false.,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,  &
10923 !  jts,jte,kts,kte)
10924
10925 !  ENDDO
10926
10927 !  ENDIF
10928
10929    IF(n_chem .ge. PARAM_FIRST_SCALAR) THEN
10930
10931    DO ic =n_chem, PARAM_FIRST_SCALAR, -1
10932
10933 !   chem_tendf(ims,kms,jms,ic) =Tmpv200(ic)  ! Remarked by Ning Pan, 2010-08-11
10934
10935    CALL a_horizontal_diffusion_s(chem_tendf(ims,kms,jms,ic),a_chem_tendf(ims,kms,  &
10936    jms,ic),mu,a_mu,config_flags,chem(ims,kms,jms,ic),a_chem(ims,kms,jms,ic)  &
10937    ,msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,a_xkhh,rdx,rdy,fnm,fnp,cf1,cf2,cf3,zx,  &
10938 ! Revised by Ning Pan, 2010-08-10
10939 !   a_zx,zy,a_zy,rdz,a_rdz,rdzw,a_rdzw,dnw,dn,,ids,ide,jds,jde,kds,kde,ims,ime,  &
10940    a_zx,zy,a_zy,rdz,a_rdz,rdzw,a_rdzw,dnw,dn,rho,a_rho,.false.,ids,ide,jds,jde,kds,kde,ims,ime,  &
10941    jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
10942    ENDDO
10943
10944    ENDIF
10945
10946 !LPB[4]
10947
10948 !LPB[3]
10949 ! Remarked by Ning Pan, 2010-08-10
10950 !   DO IX4=1,n_moist
10951 !   DO IX3=jms,jme
10952 !   DO IX2=kms,kme
10953 !   DO IX1=ims,ime
10954 !   moist_tendf(IX1,IX2,IX3,IX4) =Keep_Lpb3_moist_tendf(IX1,IX2,IX3,IX4)
10955 !   END DO
10956 !   END DO
10957 !   END DO
10958 !   END DO
10959
10960 !  IF(n_moist .ge. PARAM_FIRST_SCALAR) THEN
10961 !  DO im =PARAM_FIRST_SCALAR, n_moist
10962 !  Tmpv200(im) =moist_tendf(ims,kms,jms,im)
10963 !  CALL horizontal_diffusion_s(moist_tendf(ims,kms,jms,im),mu,config_flags,moist(ims,  &
10964 !  kms,jms,im),msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,rdx,rdy,fnm,fnp,cf1,cf2,cf3,zx,  &
10965 !  zy,rdz,rdzw,dnw,dn,.false.,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,  &
10966 !  jts,jte,kts,kte)
10967
10968 !  ENDDO
10969
10970 !  ENDIF
10971
10972    IF(n_moist .ge. PARAM_FIRST_SCALAR) THEN
10973
10974    DO im =n_moist, PARAM_FIRST_SCALAR, -1
10975
10976 !   moist_tendf(ims,kms,jms,im) =Tmpv200(im)  ! Remarked by Ning Pan, 2010-08-11
10977
10978    CALL a_horizontal_diffusion_s(moist_tendf(ims,kms,jms,im),a_moist_tendf(ims,  &
10979    kms,jms,im),mu,a_mu,config_flags,moist(ims,kms,jms,im),a_moist(ims,kms,jms,im)  &
10980    ,msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,a_xkhh,rdx,rdy,fnm,fnp,cf1,cf2,cf3,zx,  &
10981 ! Revised by Ning Pan, 2010-08-10
10982 !   a_zx,zy,a_zy,rdz,a_rdz,rdzw,a_rdzw,dnw,dn,,ids,ide,jds,jde,kds,kde,ims,ime,  &
10983    a_zx,zy,a_zy,rdz,a_rdz,rdzw,a_rdzw,dnw,dn,rho,a_rho,.false.,ids,ide,jds,jde,kds,kde,ims,ime,  &
10984    jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
10985    ENDDO
10986
10987    ENDIF
10988
10989 !LPB[2]
10990
10991 !LPB[1]
10992 ! Remarked by Ning Pan, 2010-08-10
10993 !   DO IX3=jms,jme
10994 !   DO IX2=kms,kme
10995 !   DO IX1=ims,ime
10996 !   tke_tendf(IX1,IX2,IX3) =Keep_Lpb1_tke_tendf(IX1,IX2,IX3)
10997 !   END DO
10998 !   END DO
10999 !   END DO
11000
11001 !  IF(km_opt .eq. 2) THEN
11002 !  Tmpv_1 =tke_tendf(ims,kms,jms)
11003 !  CALL horizontal_diffusion_s(tke_tendf(ims,kms,jms),mu,config_flags,tke(ims,kms,  &
11004 !  jms),msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,rdx,rdy,fnm,fnp,cf1,cf2,cf3,zx,zy,rdz,  &
11005 !  rdzw,dnw,dn,.true.,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
11006
11007 !  END IF
11008
11009    IF(km_opt .eq. 2) THEN
11010
11011 !   tke_tendf(ims,kms,jms) =Tmpv_1  ! Remarked by Ning Pan, 2010-08-11
11012
11013    CALL a_horizontal_diffusion_s(tke_tendf(ims,kms,jms),a_tke_tendf(ims,kms,jms)  &
11014    ,mu,a_mu,config_flags,tke(ims,kms,jms),a_tke(ims,kms,jms),msftx,msfty,msfux,  &
11015    msfuy,msfvx,msfvy,xkhh,a_xkhh,rdx,rdy,fnm,fnp,cf1,cf2,cf3,zx,a_zx,zy,a_zy,rdz,  &
11016 ! Revised by Ning Pan, 2010-08-10
11017 !   a_rdz,rdzw,a_rdzw,dnw,dn,,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,  &
11018    a_rdz,rdzw,a_rdzw,dnw,dn,rho,a_rho,.true.,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,  &
11019    ite,jts,jte,kts,kte)
11020
11021    END IF
11022
11023 !LPB[0]
11024 ! Remarked by Ning Pan, 2010-08-10
11025 !   DO IX3=jms,jme
11026 !   DO IX2=kms,kme
11027 !   DO IX1=ims,ime
11028 !   ru_tendf(IX1,IX2,IX3) =Keep_Lpb0_ru_tendf(IX1,IX2,IX3)
11029 !   END DO
11030 !   END DO
11031 !   END DO
11032 !   DO IX4=1,n_nba_mij
11033 !   DO IX3=jms,jme
11034 !   DO IX2=kms,kme
11035 !   DO IX1=ims,ime
11036 !   nba_mij(IX1,IX2,IX3,IX4) =Keep_Lpb0_nba_mij(IX1,IX2,IX3,IX4)
11037 !   END DO
11038 !   END DO
11039 !   END DO
11040 !   END DO
11041 !   DO IX3=jms,jme
11042 !   DO IX2=kms,kme
11043 !   DO IX1=ims,ime
11044 !   rv_tendf(IX1,IX2,IX3) =Keep_Lpb0_rv_tendf(IX1,IX2,IX3)
11045 !   END DO
11046 !   END DO
11047 !   END DO
11048 !   DO IX3=jms,jme
11049 !   DO IX2=kms,kme
11050 !   DO IX1=ims,ime
11051 !   rw_tendf(IX1,IX2,IX3) =Keep_Lpb0_rw_tendf(IX1,IX2,IX3)
11052 !   END DO
11053 !   END DO
11054 !   END DO
11055 !   DO IX3=jms,jme
11056 !   DO IX2=kms,kme
11057 !   DO IX1=ims,ime
11058 !   rt_tendf(IX1,IX2,IX3) =Keep_Lpb0_rt_tendf(IX1,IX2,IX3)
11059 !   END DO
11060 !   END DO
11061 !   END DO
11062
11063 ! Remarked by Ning Pan, 2010-08-11
11064 !   DO IX3=jms,jme
11065 !   DO IX2=kms,kme
11066 !   DO IX1=ims,ime
11067 !   Tmpv400(IX1,IX2,IX3) =ru_tendf(IX1,IX2,IX3)
11068 !   END DO
11069 !   END DO
11070 !   END DO
11071
11072 ! Remarked by Ning Pan, 2010-08-11
11073 !   DO IX4=1,n_nba_mij
11074 !   DO IX3=jms,jme
11075 !   DO IX2=kms,kme
11076 !   DO IX1=ims,ime
11077 !   Tmpv500(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
11078 !   END DO
11079 !   END DO
11080 !   END DO
11081 !   END DO
11082
11083    Keep_Lpb0_nba_mij = nba_mij  ! Added by Ning Pan, 2010-08-11
11084    CALL horizontal_diffusion_u_2(ru_tendf,config_flags,defor11,defor12,div,  &
11085    nba_mij,n_nba_mij,tke(ims,kms,jms),msfux,msfuy,xkmh,rdx,rdy,fnm,fnp,dnw,zx,zy,rdzw,rho,ids,  &
11086    ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
11087
11088 ! Remarked by Ning Pan, 2010-08-11: useless recomputation
11089 !   DO IX3=jms,jme
11090 !   DO IX2=kms,kme
11091 !   DO IX1=ims,ime
11092 !   Tmpv401(IX1,IX2,IX3) =rv_tendf(IX1,IX2,IX3)
11093 !   END DO
11094 !   END DO
11095 !   END DO
11096
11097 !   DO IX4=1,n_nba_mij
11098 !   DO IX3=jms,jme
11099 !   DO IX2=kms,kme
11100 !   DO IX1=ims,ime
11101 !   Tmpv501(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
11102 !   END DO
11103 !   END DO
11104 !   END DO
11105 !   END DO
11106
11107    Keep_Lpb1_nba_mij = nba_mij  ! Added by Ning Pan, 2010-08-11
11108    CALL horizontal_diffusion_v_2(rv_tendf,config_flags,defor12,defor22,div,  &
11109    nba_mij,n_nba_mij,tke(ims,kms,jms),msfvx,msfvy,xkmh,rdx,rdy,fnm,fnp,dnw,zx,zy,rdzw,rho,ids,  &
11110    ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
11111
11112 !   DO IX3=jms,jme
11113 !   DO IX2=kms,kme
11114 !   DO IX1=ims,ime
11115 !   Tmpv402(IX1,IX2,IX3) =rw_tendf(IX1,IX2,IX3)
11116 !   END DO
11117 !   END DO
11118 !   END DO
11119
11120 !   DO IX4=1,n_nba_mij
11121 !   DO IX3=jms,jme
11122 !   DO IX2=kms,kme
11123 !   DO IX1=ims,ime
11124 !   Tmpv502(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
11125 !   END DO
11126 !   END DO
11127 !   END DO
11128 !   END DO
11129
11130 !   CALL horizontal_diffusion_w_2(rw_tendf,mu,config_flags,defor13,defor23,div,  &
11131 !   nba_mij,n_nba_mij,tke(ims,kms,jms),msftx,msfty,xkmh,rdx,rdy,fnm,fnp,dn,zx,zy,rdz,rho,ids,  &
11132 !   ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
11133
11134 !   DO IX3=jms,jme
11135 !   DO IX2=kms,kme
11136 !   DO IX1=ims,ime
11137 !   Tmpv403(IX1,IX2,IX3) =rt_tendf(IX1,IX2,IX3)
11138 !   END DO
11139 !   END DO
11140 !   END DO
11141
11142 !   CALL horizontal_diffusion_s(rt_tendf,mu,config_flags,thp,msftx,msfty,msfux,msfuy,  &
11143 !   msfvx,msfvy,xkhh,rdx,rdy,fnm,fnp,cf1,cf2,cf3,zx,zy,rdz,rdzw,dnw,dn,rho,.false.,ids,ide,  &
11144 !   jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
11145
11146 !   DO IX3=jms,jme
11147 !   DO IX2=kms,kme
11148 !   DO IX1=ims,ime
11149 !   rt_tendf(IX1,IX2,IX3) =Tmpv403(IX1,IX2,IX3)
11150 !   END DO
11151 !   END DO
11152 !   END DO
11153
11154    CALL a_horizontal_diffusion_s(rt_tendf,a_rt_tendf,mu,a_mu,config_flags,thp,  &
11155    a_thp,msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,a_xkhh,rdx,rdy,fnm,fnp,cf1,cf2,  &
11156 ! Revised by Ning Pan, 2010-08-10
11157 !   cf3,zx,a_zx,zy,a_zy,rdz,a_rdz,rdzw,a_rdzw,dnw,dn,,ids,ide,jds,jde,kds,kde,  &
11158    cf3,zx,a_zx,zy,a_zy,rdz,a_rdz,rdzw,a_rdzw,dnw,dn,rho,a_rho,.false.,ids,ide,jds,jde,kds,kde,  &
11159    ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
11160
11161 ! Remarked by Ning Pan, 2010-08-11
11162 !   DO IX4=1,n_nba_mij
11163 !   DO IX3=jms,jme
11164 !   DO IX2=kms,kme
11165 !   DO IX1=ims,ime
11166 !   nba_mij(IX1,IX2,IX3,IX4) =Tmpv502(IX1,IX2,IX3,IX4)
11167 !   END DO
11168 !   END DO
11169 !   END DO
11170 !   END DO
11171
11172 !   DO IX3=jms,jme
11173 !   DO IX2=kms,kme
11174 !   DO IX1=ims,ime
11175 !   rw_tendf(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
11176 !   END DO
11177 !   END DO
11178 !   END DO
11179
11180    CALL a_horizontal_diffusion_w_2(rw_tendf,a_rw_tendf,mu,a_mu,config_flags,  &
11181    defor13,a_defor13,defor23,a_defor23,div,a_div,nba_mij,a_nba_mij,n_nba_mij,  &
11182    tke(ims,kms,jms),a_tke(ims,kms,jms),msftx,msfty,xkmh,a_xkmh,rdx,rdy,fnm,fnp,zx,  &
11183    a_zx,zy,a_zy,rdz,a_rdz,rho,a_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,  &
11184    jts,jte,kts,kte)
11185
11186 ! Remarked by Ning Pan, 2010-08-11
11187 !   DO IX4=1,n_nba_mij
11188 !   DO IX3=jms,jme
11189 !   DO IX2=kms,kme
11190 !   DO IX1=ims,ime
11191 !   nba_mij(IX1,IX2,IX3,IX4) =Tmpv501(IX1,IX2,IX3,IX4)
11192 !   END DO
11193 !   END DO
11194 !   END DO
11195 !   END DO
11196
11197 !   DO IX3=jms,jme
11198 !   DO IX2=kms,kme
11199 !   DO IX1=ims,ime
11200 !   rv_tendf(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
11201 !   END DO
11202 !   END DO
11203 !   END DO
11204
11205    nba_mij = Keep_Lpb1_nba_mij  ! Added by Ning Pan, 2010-08-11
11206    CALL a_horizontal_diffusion_v_2(rv_tendf,a_rv_tendf,mu,a_mu,config_flags,  &
11207    defor12,a_defor12,defor22,a_defor22,div,a_div,nba_mij,a_nba_mij,n_nba_mij,  &
11208    tke(ims,kms,jms),a_tke(ims,kms,jms),msfvx,msfvy,xkmh,a_xkmh,rdx,rdy,fnm,fnp,zx,  &
11209    a_zx,zy,a_zy,rdzw,a_rdzw,rho,a_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,  &
11210    ite,jts,jte,kts,kte)
11211
11212 ! Remarked by Ning Pan, 2010-08-11
11213 !   DO IX4=1,n_nba_mij
11214 !   DO IX3=jms,jme
11215 !   DO IX2=kms,kme
11216 !   DO IX1=ims,ime
11217 !   nba_mij(IX1,IX2,IX3,IX4) =Tmpv500(IX1,IX2,IX3,IX4)
11218 !   END DO
11219 !   END DO
11220 !   END DO
11221 !   END DO
11222
11223 ! Remarked by Ning Pan, 2010-08-11
11224 !   DO IX3=jms,jme
11225 !   DO IX2=kms,kme
11226 !   DO IX1=ims,ime
11227 !   ru_tendf(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
11228 !   END DO
11229 !   END DO
11230 !   END DO
11231
11232    nba_mij = Keep_Lpb0_nba_mij  ! Added by Ning Pan, 2010-08-11
11233    CALL a_horizontal_diffusion_u_2(ru_tendf,a_ru_tendf,mu,a_mu,config_flags,  &
11234    defor11,a_defor11,defor12,a_defor12,div,a_div,nba_mij,a_nba_mij,n_nba_mij,  &
11235    tke(ims,kms,jms),a_tke(ims,kms,jms),msfux,msfuy,xkmh,a_xkmh,rdx,rdy,fnm,fnp,zx,  &
11236    a_zx,zy,a_zy,rdzw,a_rdzw,rho,a_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,  &
11237    ite,jts,jte,kts,kte)
11238
11239    END SUBROUTINE a_horizontal_diffusion_2
11240
11241    SUBROUTINE a_horizontal_diffusion_u_2(tendency,a_tendency,mu,a_mu,config_flags, &
11242    defor11,a_defor11,defor12,a_defor12,div,a_div,nba_mij,a_nba_mij,n_nba_mij, &
11243    tke,a_tke,msfux,msfuy,xkmh,a_xkmh,rdx,rdy,fnm,fnp,zx,a_zx,zy,a_zy,rdzw, &
11244    a_rdzw,rho,a_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
11245
11246 !PART I: DECLARATION OF VARIABLES
11247
11248    IMPLICIT NONE
11249
11250    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
11251    TYPE(grid_config_rec_type) :: config_flags
11252    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
11253    REAL,DIMENSION(kms:kme) :: fnm
11254    REAL,DIMENSION(kms:kme) :: fnp
11255    REAL,DIMENSION(ims:ime,jms:jme) :: msfux,msfuy,mu,a_mu
11256    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
11257    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rdzw,a_rdzw
11258    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rho, a_rho
11259    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor11,a_defor11,defor12,a_defor12, &
11260    div,a_div,tke,a_tke,xkmh,a_xkmh,zx,a_zx,zy,a_zy
11261    INTEGER :: n_nba_mij
11262    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: nba_mij,a_nba_mij
11263    REAL :: rdx,rdy
11264    INTEGER :: i,j,k,ktf
11265    INTEGER :: i_start,i_end,j_start,j_end
11266    INTEGER :: is_ext,ie_ext,js_ext,je_ext
11267    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau1avg,a_titau1avg,titau2avg, &
11268    a_titau2avg,titau1,a_titau1,titau2,a_titau2,xkxavg,a_xkxavg,rravg,a_rravg
11269    REAL :: mrdx,a_mrdx,mrdy,a_mrdy,rcoup,a_rcoup
11270    REAL :: tmpzy,a_tmpzy,tmpzeta_z,a_tmpzeta_z
11271    REAL :: term1,a_term1,term2,a_term2,term3,a_term3
11272
11273    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: Keep_Lpb12_nba_mij
11274    INTEGER :: IX1,IX2,IX3,IX4
11275
11276    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
11277    a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,a_Tmpv8,Tmpv008,a_Tmpv9, &
11278    Tmpv009,a_Tmpv10,Tmpv010,a_Tmpv11,Tmpv011
11279
11280    REAL :: Tmpv_1,Tmpv_2
11281    REAL,DIMENSION(its:ite,min0(kts+1,kts):min(kte,kde-1)) :: Tmpv300
11282    REAL,DIMENSION(its:ite,min0(kts+1,kts):min(kte,kde-1)) :: Tmpv301
11283    REAL,DIMENSION(its:ite,min0(kts+1,kts):min(kte,kde-1)) :: Tmpv302
11284    REAL,DIMENSION(its:ite,min0(kts+1,kts):min(kte,kde-1)) :: Tmpv303
11285    REAL,DIMENSION(its:ite,min0(kts+1,kts):min(kte,kde-1)) :: Tmpv304
11286
11287 !PART II: CALCULATIONS OF B. S. TRAJECTORY
11288
11289 !LPB[0]
11290
11291       ktf=MIN(kte,kde-1)
11292       i_start = its
11293       i_end   = ite
11294       j_start = jts
11295       j_end   = MIN(jte,jde-1)
11296
11297 !LPB[1]
11298    IF ( config_flags%open_xs .or. config_flags%specified .or.   &
11299         config_flags%nested) i_start = MAX(ids+1,its)
11300
11301 !LPB[2]
11302
11303 !LPB[3]
11304    IF ( config_flags%open_xe .or. config_flags%specified .or.   &
11305         config_flags%nested) i_end   = MIN(ide-1,ite)
11306
11307 !LPB[4]
11308
11309 !LPB[5]
11310    IF ( config_flags%open_ys .or. config_flags%specified .or.   &
11311         config_flags%nested) j_start = MAX(jds+1,jts)
11312
11313 !LPB[6]
11314
11315 !LPB[7]
11316    IF ( config_flags%open_ye .or. config_flags%specified .or.   &
11317         config_flags%nested) j_end   = MIN(jde-2,jte)
11318
11319 !LPB[8]
11320
11321 !LPB[9]
11322       IF ( config_flags%periodic_x ) i_start = its
11323
11324 !LPB[10]
11325
11326 !LPB[11]
11327       IF ( config_flags%periodic_x ) i_end = ite
11328
11329 !LPB[12]
11330    DO IX4=1,n_nba_mij
11331    DO IX3=jms,jme
11332    DO IX2=kms,kme
11333    DO IX1=ims,ime
11334        Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
11335    END DO
11336    END DO
11337    END DO
11338    END DO
11339 ! Remarked by Ning Pan, 2010-08-10
11340 !   DO IX4=1,n_nba_mij
11341 !   DO IX3=jms,jme
11342 !   DO IX2=kms,kme
11343 !   DO IX1=ims,ime
11344 !       Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
11345 !   END DO
11346 !   END DO
11347 !   END DO
11348 !   END DO
11349
11350       is_ext=1
11351       ie_ext=0
11352       js_ext=0
11353       je_ext=0
11354       CALL cal_titau_11_22_33( config_flags, titau1,              &
11355                                tke, xkmh, defor11,                &
11356                                nba_mij(ims,kms,jms,P_m11), rho,   &
11357                                is_ext, ie_ext, js_ext, je_ext,    &
11358                                ids, ide, jds, jde, kds, kde,      &
11359                                ims, ime, jms, jme, kms, kme,      &
11360                                its, ite, jts, jte, kts, kte     )
11361       is_ext=0
11362       ie_ext=0
11363       js_ext=0
11364       je_ext=1
11365       CALL cal_titau_12_21( config_flags, titau2,              &
11366                             xkmh, defor12,                     &
11367                             nba_mij(ims,kms,jms,P_m12), rho,   &
11368                             is_ext, ie_ext, js_ext, je_ext,    &
11369                             ids, ide, jds, jde, kds, kde,      &
11370                             ims, ime, jms, jme, kms, kme,      &
11371                             its, ite, jts, jte, kts, kte     )
11372
11373 !LPB[13]
11374       DO j = j_start, j_end
11375
11376       DO k = kts+1,ktf
11377       DO i = i_start, i_end
11378          titau1avg(i,k,j)=0.5*(fnm(k)*(titau1(i-1,k  ,j)+titau1(i,k  ,j))+   &
11379                                fnp(k)*(titau1(i-1,k-1,j)+titau1(i,k-1,j)))
11380          titau2avg(i,k,j)=0.5*(fnm(k)*(titau2(i,k  ,j+1)+titau2(i,k  ,j))+   &
11381                                fnp(k)*(titau2(i,k-1,j+1)+titau2(i,k-1,j)))
11382          tmpzy = 0.25*( zy(i-1,k,j  )+zy(i,k,j  )+   &
11383                         zy(i-1,k,j+1)+zy(i,k,j+1)  )
11384          titau1avg(i,k,j)=titau1avg(i,k,j)*zx(i,k,j)
11385          titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy
11386       ENDDO
11387       ENDDO
11388
11389       ENDDO
11390
11391 !LPB[14]
11392       DO j = j_start, j_end
11393
11394       DO i = i_start, i_end
11395          titau1avg(i,kts,j)=0.
11396          titau1avg(i,ktf+1,j)=0.
11397          titau2avg(i,kts,j)=0.
11398          titau2avg(i,ktf+1,j)=0.
11399       ENDDO
11400
11401       ENDDO
11402
11403 !!LPB[15]
11404 !      DO j = j_start, j_end
11405
11406 !      DO k = kts,ktf
11407 !      DO i = i_start, i_end
11408 !         mrdx=msfux(i,j)*rdx
11409 !         mrdy=msfuy(i,j)*rdy
11410 !         tendency(i,k,j)=tendency(i,k,j)-                                      &
11411 !              (mrdx*(titau1(i,k,j  )-titau1(i-1,k,j))+                         &
11412 !               mrdy*(titau2(i,k,j+1)-titau2(i,k,j  ))-                         &
11413 !               msfuy(i,j)*rdzw(i,k,j)*((titau1avg(i,k+1,j)-titau1avg(i,k,j))+   &
11414 !                                      (titau2avg(i,k+1,j)-titau2avg(i,k,j))    &
11415 !                                     )                                      )
11416 !      ENDDO
11417 !      ENDDO
11418
11419 !      ENDDO
11420
11421 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
11422
11423    Do K2_ADJ =jts-1, jte+1
11424    Do K1_ADJ =kts, kte
11425    Do K0_ADJ =its-1, ite+1
11426    a_titau1avg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
11427    End Do
11428    End Do
11429    End Do
11430
11431    Do K2_ADJ =jts-1, jte+1
11432    Do K1_ADJ =kts, kte
11433    Do K0_ADJ =its-1, ite+1
11434    a_titau2avg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
11435    End Do
11436    End Do
11437    End Do
11438
11439    Do K2_ADJ =jts-1, jte+1
11440    Do K1_ADJ =kts, kte
11441    Do K0_ADJ =its-1, ite+1
11442    a_titau1(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
11443    End Do
11444    End Do
11445    End Do
11446
11447    Do K2_ADJ =jts-1, jte+1
11448    Do K1_ADJ =kts, kte
11449    Do K0_ADJ =its-1, ite+1
11450    a_titau2(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
11451    End Do
11452    End Do
11453    End Do
11454
11455    Do K2_ADJ =jts-1, jte+1
11456    Do K1_ADJ =kts, kte
11457    Do K0_ADJ =its-1, ite+1
11458    a_xkxavg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
11459    End Do
11460    End Do
11461    End Do
11462
11463    Do K2_ADJ =jts-1, jte+1
11464    Do K1_ADJ =kts, kte
11465    Do K0_ADJ =its-1, ite+1
11466    a_rravg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
11467    End Do
11468    End Do
11469    End Do
11470
11471 ! Remarked by Ning Pan, 2010-08-10
11472 !   a_mrdx =0.0
11473 !   a_mrdy =0.0
11474 !   a_rcoup =0.0
11475    a_tmpzy =0.0
11476 ! Remarked by Ning Pan, 2010-08-10
11477 !   a_tmpzeta_z =0.0
11478 !   a_term1 =0.0
11479 !   a_term2 =0.0
11480 !   a_term3 =0.0
11481
11482 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
11483
11484 !LPB[15]
11485    DO j =j_end, j_start, -1
11486
11487    DO k =kts, ktf
11488    DO i =i_start, i_end
11489 ! Revised by Ning Pan, 2010-08-10
11490 !   Tmpv300(i,k) =mrdx
11491 !   mrdx =msfux(i,j)*rdx
11492    mrdx =msfux(i,j)*rdx
11493    Tmpv300(i,k) =mrdx
11494
11495 ! Revised by Ning Pan, 2010-08-10
11496 !   Tmpv301(i,k) =mrdy
11497 !   mrdy =msfuy(i,j)*rdy
11498    mrdy =msfuy(i,j)*rdy
11499    Tmpv301(i,k) =mrdy
11500
11501    Tmpv001 =titau1(i,k,j) -titau1(i-1,k,j)
11502    Tmpv302(i,k) =Tmpv001
11503    Tmpv002 =mrdx*Tmpv302(i,k)
11504    Tmpv003 =titau2(i,k,j+1) -titau2(i,k,j)
11505    Tmpv303(i,k) =Tmpv003
11506    Tmpv004 =mrdy*Tmpv303(i,k)
11507    Tmpv005 =Tmpv002 +Tmpv004
11508    Tmpv006 =titau1avg(i,k+1,j) -titau1avg(i,k,j)
11509    Tmpv007 =titau2avg(i,k+1,j) -titau2avg(i,k,j)
11510    Tmpv008 =Tmpv006 +Tmpv007
11511    Tmpv304(i,k) =Tmpv008
11512 ! Remarked by Ning Pan, 2010-08-10
11513 !   Tmpv009 =msfuy(i,j)*rdzw(i,k,j)*Tmpv304(i,k)
11514 !   Tmpv010 =Tmpv005 -Tmpv009
11515 !   Tmpv011 =tendency(i,k,j) -Tmpv010
11516 !   tendency(i,k,j) =Tmpv011
11517
11518    ENDDO
11519    ENDDO
11520
11521    DO k =ktf, kts, -1
11522    DO i =i_end, i_start, -1
11523    mrdx =Tmpv300(i,k)  ! Added by Ning Pan, 2010-08-10
11524    mrdy =Tmpv301(i,k)  ! Added by Ning Pan, 2010-08-10
11525    a_Tmpv11 =a_tendency(i,k,j)
11526    a_tendency(i,k,j) =0.0
11527    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv11
11528    a_Tmpv10 =-a_Tmpv11
11529    a_Tmpv5 =a_Tmpv10
11530    a_Tmpv9 =-a_Tmpv10
11531    a_rdzw(i,k,j) =a_rdzw(i,k,j) +msfuy(i,j)*Tmpv304(i,k)*a_Tmpv9
11532    a_Tmpv8 =msfuy(i,j)*rdzw(i,k,j)*a_Tmpv9
11533    a_Tmpv6 =a_Tmpv8
11534    a_Tmpv7 =a_Tmpv8
11535    a_titau2avg(i,k+1,j) =a_titau2avg(i,k+1,j) +a_Tmpv7
11536    a_titau2avg(i,k,j) =a_titau2avg(i,k,j) -a_Tmpv7
11537    a_titau1avg(i,k+1,j) =a_titau1avg(i,k+1,j) +a_Tmpv6
11538    a_titau1avg(i,k,j) =a_titau1avg(i,k,j) -a_Tmpv6
11539    a_Tmpv2 =a_Tmpv5
11540    a_Tmpv4 =a_Tmpv5
11541    a_mrdy =a_mrdy +Tmpv303(i,k)*a_Tmpv4
11542    a_Tmpv3 =mrdy*a_Tmpv4
11543    a_titau2(i,k,j+1) =a_titau2(i,k,j+1) +a_Tmpv3
11544    a_titau2(i,k,j) =a_titau2(i,k,j) -a_Tmpv3
11545    a_mrdx =a_mrdx +Tmpv302(i,k)*a_Tmpv2
11546    a_Tmpv1 =mrdx*a_Tmpv2
11547    a_titau1(i,k,j) =a_titau1(i,k,j) +a_Tmpv1
11548    a_titau1(i-1,k,j) =a_titau1(i-1,k,j) -a_Tmpv1
11549
11550 ! Remarked by Ning Pan, 2010-08-10
11551 !   mrdy =Tmpv301(i,k)
11552
11553 !   a_mrdy =0.0
11554
11555 !   mrdx =Tmpv300(i,k)
11556
11557 !   a_mrdx =0.0
11558    ENDDO
11559    ENDDO
11560
11561    ENDDO
11562
11563 !LPB[14]
11564    DO j =j_end, j_start, -1
11565
11566 !  DO i =i_start, i_end
11567 !  titau1avg(i,kts,j) =0.
11568
11569 !  titau1avg(i,ktf+1,j) =0.
11570
11571 !  titau2avg(i,kts,j) =0.
11572
11573 !  titau2avg(i,ktf+1,j) =0.
11574
11575 !  ENDDO
11576
11577    DO i =i_end, i_start, -1
11578    a_titau2avg(i,ktf+1,j) =0.0
11579    a_titau2avg(i,kts,j) =0.0
11580    a_titau1avg(i,ktf+1,j) =0.0
11581    a_titau1avg(i,kts,j) =0.0
11582    ENDDO
11583
11584    ENDDO
11585
11586 !LPB[13]
11587    DO j =j_end, j_start, -1
11588
11589    DO k =kts+1, ktf
11590    DO i =i_start, i_end
11591    Tmpv001 =titau1(i-1,k,j) +titau1(i,k,j)
11592    Tmpv002 =fnm(k)*Tmpv001
11593    Tmpv003 =titau1(i-1,k-1,j) +titau1(i,k-1,j)
11594    Tmpv004 =fnp(k)*Tmpv003
11595    Tmpv005 =Tmpv002 +Tmpv004
11596    Tmpv006 =0.5*Tmpv005
11597 ! Revised by Ning Pan, 2010-08-10
11598 !   Tmpv300(i,k) =titau1avg(i,k,j)
11599 !   titau1avg(i,k,j) =Tmpv006
11600    titau1avg(i,k,j) =Tmpv006
11601    Tmpv300(i,k) =titau1avg(i,k,j)
11602
11603    Tmpv001 =titau2(i,k,j+1) +titau2(i,k,j)
11604    Tmpv002 =fnm(k)*Tmpv001
11605    Tmpv003 =titau2(i,k-1,j+1) +titau2(i,k-1,j)
11606    Tmpv004 =fnp(k)*Tmpv003
11607    Tmpv005 =Tmpv002 +Tmpv004
11608    Tmpv006 =0.5*Tmpv005
11609 ! Revised by Ning Pan, 2010-08-10
11610 !   Tmpv301(i,k) =titau2avg(i,k,j)
11611 !   titau2avg(i,k,j) =Tmpv006
11612    titau2avg(i,k,j) =Tmpv006
11613    Tmpv301(i,k) =titau2avg(i,k,j)
11614
11615    Tmpv001 =zy(i-1,k,j) +zy(i,k,j)
11616    Tmpv002 =Tmpv001 +zy(i-1,k,j+1)
11617    Tmpv003 =Tmpv002 +zy(i,k,j+1)
11618    Tmpv004 =0.25*Tmpv003
11619 ! Revised by Ning Pan, 2010-08-10
11620 !   Tmpv302(i,k) =tmpzy
11621 !   tmpzy =Tmpv004
11622    tmpzy =Tmpv004
11623    Tmpv302(i,k) =tmpzy
11624
11625 ! Remarked by Ning Pan, 2010-08-10
11626 !   Tmpv001 =titau1avg(i,k,j)*zx(i,k,j)
11627 !   Tmpv303(i,k) =titau1avg(i,k,j)
11628 !   titau1avg(i,k,j) =Tmpv001
11629
11630 ! Remarked by Ning Pan, 2010-08-10
11631 !   Tmpv001 =titau2avg(i,k,j)*tmpzy
11632 !   Tmpv304(i,k) =titau2avg(i,k,j)
11633 !   titau2avg(i,k,j) =Tmpv001
11634
11635    ENDDO
11636    ENDDO
11637
11638    DO k =ktf, kts+1, -1
11639    DO i =i_end, i_start, -1
11640
11641    tmpzy =Tmpv302(i,k)  ! Added by Ning Pan, 2010-08-10
11642
11643 ! Revised by Ning Pan, 2010-08-10
11644 !   titau2avg(i,k,j) =Tmpv304(i,k)
11645    titau2avg(i,k,j) =Tmpv301(i,k)
11646
11647    a_Tmpv1 =a_titau2avg(i,k,j)
11648    a_titau2avg(i,k,j) =0.0
11649    a_titau2avg(i,k,j) =a_titau2avg(i,k,j) +tmpzy*a_Tmpv1
11650    a_tmpzy =a_tmpzy +titau2avg(i,k,j)*a_Tmpv1
11651
11652 ! Revised by Ning Pan, 2010-08-10
11653 !   titau1avg(i,k,j) =Tmpv303(i,k)
11654    titau1avg(i,k,j) =Tmpv300(i,k)
11655
11656    a_Tmpv1 =a_titau1avg(i,k,j)
11657    a_titau1avg(i,k,j) =0.0
11658    a_titau1avg(i,k,j) =a_titau1avg(i,k,j) +zx(i,k,j)*a_Tmpv1
11659    a_zx(i,k,j) =a_zx(i,k,j) +titau1avg(i,k,j)*a_Tmpv1
11660
11661 !   tmpzy =Tmpv302(i,k)  ! Remarked by Ning Pan, 2010-08-10
11662
11663    a_Tmpv4 =a_tmpzy
11664    a_tmpzy =0.0
11665    a_Tmpv3 =0.25*a_Tmpv4
11666    a_Tmpv2 =a_Tmpv3
11667    a_zy(i,k,j+1) =a_zy(i,k,j+1) +a_Tmpv3
11668    a_Tmpv1 =a_Tmpv2
11669    a_zy(i-1,k,j+1) =a_zy(i-1,k,j+1) +a_Tmpv2
11670    a_zy(i-1,k,j) =a_zy(i-1,k,j) +a_Tmpv1
11671    a_zy(i,k,j) =a_zy(i,k,j) +a_Tmpv1
11672
11673 !   titau2avg(i,k,j) =Tmpv301(i,k)  ! Remarked by Ning Pan, 2010-08-10
11674
11675    a_Tmpv6 =a_titau2avg(i,k,j)
11676    a_titau2avg(i,k,j) =0.0
11677    a_Tmpv5 =0.5*a_Tmpv6
11678    a_Tmpv2 =a_Tmpv5
11679    a_Tmpv4 =a_Tmpv5
11680    a_Tmpv3 =fnp(k)*a_Tmpv4
11681    a_titau2(i,k-1,j+1) =a_titau2(i,k-1,j+1) +a_Tmpv3
11682    a_titau2(i,k-1,j) =a_titau2(i,k-1,j) +a_Tmpv3
11683    a_Tmpv1 =fnm(k)*a_Tmpv2
11684    a_titau2(i,k,j+1) =a_titau2(i,k,j+1) +a_Tmpv1
11685    a_titau2(i,k,j) =a_titau2(i,k,j) +a_Tmpv1
11686
11687 !   titau1avg(i,k,j) =Tmpv300(i,k)  ! Remarked by Ning Pan, 2010-08-10
11688
11689    a_Tmpv6 =a_titau1avg(i,k,j)
11690    a_titau1avg(i,k,j) =0.0
11691    a_Tmpv5 =0.5*a_Tmpv6
11692    a_Tmpv2 =a_Tmpv5
11693    a_Tmpv4 =a_Tmpv5
11694    a_Tmpv3 =fnp(k)*a_Tmpv4
11695    a_titau1(i-1,k-1,j) =a_titau1(i-1,k-1,j) +a_Tmpv3
11696    a_titau1(i,k-1,j) =a_titau1(i,k-1,j) +a_Tmpv3
11697    a_Tmpv1 =fnm(k)*a_Tmpv2
11698    a_titau1(i-1,k,j) =a_titau1(i-1,k,j) +a_Tmpv1
11699    a_titau1(i,k,j) =a_titau1(i,k,j) +a_Tmpv1
11700    ENDDO
11701    ENDDO
11702
11703    ENDDO
11704
11705 !LPB[12]
11706 ! Remarked by Ning Pan, 2010-08-10
11707 !  DO IX4=1,n_nba_mij
11708 !  DO IX3=jms,jme
11709 !  DO IX2=kms,kme
11710 !  DO IX1=ims,ime
11711 !  nba_mij(IX1,IX2,IX3,IX4) =Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4)
11712 !  END DO
11713 !  END DO
11714 !  END DO
11715 !  END DO
11716 !  DO IX4=1,n_nba_mij
11717 !  DO IX3=jms,jme
11718 !  DO IX2=kms,kme
11719 !  DO IX1=ims,ime
11720 !  nba_mij(IX1,IX2,IX3,IX4) =Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4)
11721 !  END DO
11722 !  END DO
11723 !  END DO
11724 !  END DO
11725
11726 ! Remarked by Ning Pan, 2010-08-10
11727 !   is_ext =1
11728 !   ie_ext =0
11729 !   js_ext =0
11730 !   je_ext =0
11731 !   Tmpv_1 =nba_mij(ims,kms,jms,P_m11)
11732 !   CALL cal_titau_11_22_33(config_flags,titau1,mu,tke,xkmh,defor11,nba_mij(ims,kms,  &
11733 !   jms,P_m11),is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
11734 !   kme,its,ite,jts,jte,kts,kte)
11735
11736 !   is_ext =0
11737 !   ie_ext =0
11738 !   js_ext =0
11739 !   je_ext =1
11740 !   Tmpv_2 =nba_mij(ims,kms,jms,P_m12)
11741 !   CALL cal_titau_12_21(config_flags,titau2,mu,xkmh,defor12,nba_mij(ims,kms,jms,  &
11742 !   P_m12),is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
11743 !   its,ite,jts,jte,kts,kte)
11744
11745 !   nba_mij(ims,kms,jms,P_m12) =Tmpv_2
11746
11747 ! Added by Ning Pan, 2010-08-10
11748    is_ext =0
11749    ie_ext =0
11750    js_ext =0
11751    je_ext =1
11752
11753    CALL a_cal_titau_12_21(config_flags,titau2,a_titau2,mu,a_mu,xkmh,a_xkmh,  &
11754    defor12,a_defor12,nba_mij(ims,kms,jms,P_m12),a_nba_mij(ims,kms,jms,P_m12)  &
11755    ,rho, a_rho &
11756    ,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,  &
11757    jts,jte,kts,kte)
11758
11759 !   nba_mij(ims,kms,jms,P_m11) =Tmpv_1  ! Remarked by Ning Pan, 2010-08-10
11760
11761 ! Added by Ning Pan, 2010-08-10
11762    is_ext=1
11763    ie_ext=0
11764    js_ext=0
11765    je_ext=0
11766    DO IX4=1,n_nba_mij
11767    DO IX3=jms,jme
11768    DO IX2=kms,kme
11769    DO IX1=ims,ime
11770    nba_mij(IX1,IX2,IX3,IX4) =Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4)
11771    END DO
11772    END DO
11773    END DO
11774    END DO
11775
11776    CALL a_cal_titau_11_22_33(config_flags,titau1,a_titau1,mu,a_mu,tke,a_tke,  &
11777    xkmh,a_xkmh,defor11,a_defor11,nba_mij(ims,kms,jms,P_m11),a_nba_mij(ims,kms,jms,  &
11778    P_m11),rho,a_rho,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
11779    its,ite,jts,jte,kts,kte)
11780
11781 !LPB[11]
11782
11783 !  IF( config_flags%periodic_x ) THEN
11784 !  i_end =ite
11785 !  END IF
11786
11787 !  IF( config_flags%periodic_x ) THEN
11788
11789 !  END IF
11790
11791 !LPB[10]
11792
11793 !LPB[9]
11794
11795 !  IF( config_flags%periodic_x ) THEN
11796 !  i_start =its
11797 !  END IF
11798
11799 !  IF( config_flags%periodic_x ) THEN
11800
11801 !  END IF
11802
11803 !LPB[8]
11804
11805 !LPB[7]
11806
11807 !  IF( config_flags%open_ye .or. config_flags%specified .or.            config_flags%nested) THEN
11808 !  j_end =min(jde-2, jte)
11809 !  END IF
11810
11811 !  IF( config_flags%open_ye .or. config_flags%specified .or.   &
11812 !           config_flags%nested) THEN
11813
11814 !  END IF
11815
11816 !LPB[6]
11817
11818 !LPB[5]
11819
11820 !  IF( config_flags%open_ys .or. config_flags%specified .or.            config_flags%nested) THEN
11821 !  j_start =max(jds+1, jts)
11822 !  END IF
11823
11824 !  IF( config_flags%open_ys .or. config_flags%specified .or.   &
11825 !           config_flags%nested) THEN
11826
11827 !  END IF
11828
11829 !LPB[4]
11830
11831 !LPB[3]
11832
11833 !  IF( config_flags%open_xe .or. config_flags%specified .or.            config_flags%nested) THEN
11834 !  i_end =min(ide-1, ite)
11835 !  END IF
11836
11837 !  IF( config_flags%open_xe .or. config_flags%specified .or.   &
11838 !           config_flags%nested) THEN
11839
11840 !  END IF
11841
11842 !LPB[2]
11843
11844 !LPB[1]
11845
11846 !  IF( config_flags%open_xs .or. config_flags%specified .or.            config_flags%nested) THEN
11847 !  i_start =max(ids+1, its)
11848 !  END IF
11849
11850 !  IF( config_flags%open_xs .or. config_flags%specified .or.   &
11851 !           config_flags%nested) THEN
11852
11853 !  END IF
11854
11855 !LPB[0]
11856 !  ktf =min(kte, kde-1)
11857 !  i_start =its
11858 !  i_end =ite
11859 !  j_start =jts
11860 !  j_end =min(jte, jde-1)
11861
11862    END SUBROUTINE a_horizontal_diffusion_u_2
11863
11864    SUBROUTINE a_horizontal_diffusion_v_2(tendency,a_tendency,mu,a_mu,config_flags, &
11865    defor12,a_defor12,defor22,a_defor22,div,a_div,nba_mij,a_nba_mij,n_nba_mij, &
11866    tke,a_tke,msfvx,msfvy,xkmh,a_xkmh,rdx,rdy,fnm,fnp,zx,a_zx,zy,a_zy,rdzw, &
11867    a_rdzw,rho,a_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
11868
11869 !PART I: DECLARATION OF VARIABLES
11870
11871    IMPLICIT NONE
11872
11873    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
11874    TYPE(grid_config_rec_type) :: config_flags
11875    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
11876    REAL,DIMENSION(kms:kme) :: fnm
11877    REAL,DIMENSION(kms:kme) :: fnp
11878    REAL,DIMENSION(ims:ime,jms:jme) :: msfvx,msfvy,mu,a_mu
11879    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
11880    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor12,a_defor12,defor22,a_defor22, &
11881    div,a_div,tke,a_tke,xkmh,a_xkmh,zx,a_zx,zy,a_zy,rdzw,a_rdzw
11882    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rho, a_rho
11883    INTEGER :: n_nba_mij
11884    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: nba_mij,a_nba_mij
11885    REAL :: rdx,rdy
11886    INTEGER :: i,j,k,ktf
11887    INTEGER :: i_start,i_end,j_start,j_end
11888    INTEGER :: is_ext,ie_ext,js_ext,je_ext
11889    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau1avg,a_titau1avg,titau2avg, &
11890    a_titau2avg,titau1,a_titau1,titau2,a_titau2,xkxavg,a_xkxavg,rravg,a_rravg
11891    REAL :: mrdx,a_mrdx,mrdy,a_mrdy,rcoup,a_rcoup
11892    REAL :: tmpzx,a_tmpzx,tmpzeta_z,a_tmpzeta_z
11893
11894    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: Keep_Lpb12_nba_mij
11895    INTEGER :: IX1,IX2,IX3,IX4
11896
11897    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
11898    a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,a_Tmpv8,Tmpv008,a_Tmpv9, &
11899    Tmpv009,a_Tmpv10,Tmpv010,a_Tmpv11,Tmpv011
11900
11901    REAL :: Tmpv_1,Tmpv_2
11902    REAL,DIMENSION(its:min(ite,ide-1),min0(kts+1,kts):min(kte,kde-1)) :: Tmpv300
11903    REAL,DIMENSION(its:min(ite,ide-1),min0(kts+1,kts):min(kte,kde-1)) :: Tmpv301
11904    REAL,DIMENSION(its:min(ite,ide-1),min0(kts+1,kts):min(kte,kde-1)) :: Tmpv302
11905    REAL,DIMENSION(its:min(ite,ide-1),min0(kts+1,kts):min(kte,kde-1)) :: Tmpv303
11906    REAL,DIMENSION(its:min(ite,ide-1),min0(kts+1,kts):min(kte,kde-1)) :: Tmpv304
11907
11908 !PART II: CALCULATIONS OF B. S. TRAJECTORY
11909
11910 !LPB[0]
11911       ktf=MIN(kte,kde-1)
11912       i_start = its
11913       i_end   = MIN(ite,ide-1)
11914       j_start = jts
11915       j_end   = jte
11916
11917 !LPB[1]
11918    IF ( config_flags%open_xs .or. config_flags%specified .or.   &
11919         config_flags%nested) i_start = MAX(ids+1,its)
11920
11921 !LPB[2]
11922
11923 !LPB[3]
11924    IF ( config_flags%open_xe .or. config_flags%specified .or.   &
11925         config_flags%nested) i_end   = MIN(ide-2,ite)
11926
11927 !LPB[4]
11928
11929 !LPB[5]
11930    IF ( config_flags%open_ys .or. config_flags%specified .or.   &
11931         config_flags%nested) j_start = MAX(jds+1,jts)
11932
11933 !LPB[6]
11934
11935 !LPB[7]
11936    IF ( config_flags%open_ye .or. config_flags%specified .or.   &
11937         config_flags%nested) j_end   = MIN(jde-1,jte)
11938
11939 !LPB[8]
11940
11941 !LPB[9]
11942       IF ( config_flags%periodic_x ) i_start = its
11943
11944 !LPB[10]
11945
11946 !LPB[11]
11947       IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
11948
11949 !LPB[12]
11950    DO IX4=1,n_nba_mij
11951    DO IX3=jms,jme
11952    DO IX2=kms,kme
11953    DO IX1=ims,ime
11954        Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
11955    END DO
11956    END DO
11957    END DO
11958    END DO
11959 ! Remarked by Ning Pan, 2010-08-10
11960 !   DO IX4=1,n_nba_mij
11961 !   DO IX3=jms,jme
11962 !   DO IX2=kms,kme
11963 !   DO IX1=ims,ime
11964 !       Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
11965 !   END DO
11966 !   END DO
11967 !   END DO
11968 !   END DO
11969
11970       is_ext=0
11971       ie_ext=1
11972       js_ext=0
11973       je_ext=0
11974       CALL cal_titau_12_21( config_flags, titau1,            &
11975                             xkmh, defor12,                   &
11976                             nba_mij(ims,kms,jms,P_m12), rho, &
11977                             is_ext,ie_ext,js_ext,je_ext,     &
11978                             ids, ide, jds, jde, kds, kde,    &
11979                             ims, ime, jms, jme, kms, kme,    &
11980                             its, ite, jts, jte, kts, kte   )
11981       is_ext=0
11982       ie_ext=0
11983       js_ext=1
11984       je_ext=0
11985       CALL cal_titau_11_22_33( config_flags, titau2,             &
11986                                tke, xkmh, defor22,               &
11987                                nba_mij(ims,kms,jms,P_m22), rho,  &
11988                                is_ext, ie_ext, js_ext, je_ext,   &
11989                                ids, ide, jds, jde, kds, kde,     &
11990                                ims, ime, jms, jme, kms, kme,     &
11991                                its, ite, jts, jte, kts, kte    )
11992
11993 !LPB[13]
11994       DO j = j_start, j_end
11995
11996       DO k = kts+1,ktf
11997       DO i = i_start, i_end
11998          titau1avg(i,k,j)=0.5*(fnm(k)*(titau1(i+1,k  ,j)+titau1(i,k  ,j))+   &
11999                                fnp(k)*(titau1(i+1,k-1,j)+titau1(i,k-1,j)))
12000          titau2avg(i,k,j)=0.5*(fnm(k)*(titau2(i,k  ,j-1)+titau2(i,k  ,j))+   &
12001                                fnp(k)*(titau2(i,k-1,j-1)+titau2(i,k-1,j)))
12002          tmpzx = 0.25*( zx(i,k,j  )+zx(i+1,k,j  )+   &
12003                         zx(i,k,j-1)+zx(i+1,k,j-1)  )
12004          titau1avg(i,k,j)=titau1avg(i,k,j)*tmpzx
12005          titau2avg(i,k,j)=titau2avg(i,k,j)*zy(i,k,j)
12006       ENDDO
12007       ENDDO
12008
12009       ENDDO
12010
12011 !LPB[14]
12012       DO j = j_start, j_end
12013
12014       DO i = i_start, i_end
12015          titau1avg(i,kts,j)=0.
12016          titau1avg(i,ktf+1,j)=0.
12017          titau2avg(i,kts,j)=0.
12018          titau2avg(i,ktf+1,j)=0.
12019       ENDDO
12020
12021       ENDDO
12022
12023 !!LPB[15]
12024 !      DO j = j_start, j_end
12025
12026 !      DO k = kts,ktf
12027 !      DO i = i_start, i_end
12028 !         mrdx=msfvx(i,j)*rdx
12029 !         mrdy=msfvy(i,j)*rdy
12030 !         tendency(i,k,j)=tendency(i,k,j)-                                      &
12031 !              (mrdy*(titau2(i  ,k,j)-titau2(i,k,j-1))+                         &
12032 !               mrdx*(titau1(i+1,k,j)-titau1(i,k,j  ))-                         &
12033 !              msfvy(i,j)*rdzw(i,k,j)*((titau1avg(i,k+1,j)-titau1avg(i,k,j))+   &
12034 !                                      (titau2avg(i,k+1,j)-titau2avg(i,k,j))    &
12035 !                                   )                                            &
12036 !              )
12037 !      ENDDO
12038 !      ENDDO
12039
12040 !      ENDDO
12041
12042 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
12043
12044    Do K2_ADJ =jts-1, jte+1
12045    Do K1_ADJ =kts, kte
12046    Do K0_ADJ =its-1, ite+1
12047    a_titau1avg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
12048    End Do
12049    End Do
12050    End Do
12051
12052    Do K2_ADJ =jts-1, jte+1
12053    Do K1_ADJ =kts, kte
12054    Do K0_ADJ =its-1, ite+1
12055    a_titau2avg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
12056    End Do
12057    End Do
12058    End Do
12059
12060    Do K2_ADJ =jts-1, jte+1
12061    Do K1_ADJ =kts, kte
12062    Do K0_ADJ =its-1, ite+1
12063    a_titau1(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
12064    End Do
12065    End Do
12066    End Do
12067
12068    Do K2_ADJ =jts-1, jte+1
12069    Do K1_ADJ =kts, kte
12070    Do K0_ADJ =its-1, ite+1
12071    a_titau2(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
12072    End Do
12073    End Do
12074    End Do
12075
12076    Do K2_ADJ =jts-1, jte+1
12077    Do K1_ADJ =kts, kte
12078    Do K0_ADJ =its-1, ite+1
12079    a_xkxavg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
12080    End Do
12081    End Do
12082    End Do
12083
12084    Do K2_ADJ =jts-1, jte+1
12085    Do K1_ADJ =kts, kte
12086    Do K0_ADJ =its-1, ite+1
12087    a_rravg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
12088    End Do
12089    End Do
12090    End Do
12091
12092 ! Remarked by Ning Pan, 2010-08-10
12093 !   a_mrdx =0.0
12094 !   a_mrdy =0.0
12095 !   a_rcoup =0.0
12096    a_tmpzx =0.0
12097 !   a_tmpzeta_z =0.0  ! Remarked by Ning Pan, 2010-08-10
12098
12099 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
12100
12101 !LPB[15]
12102    DO j =j_end, j_start, -1
12103
12104    DO k =kts, ktf
12105    DO i =i_start, i_end
12106 ! Revised by Ning Pan, 2010-08-10
12107 !   Tmpv300(i,k) =mrdx
12108 !   mrdx =msfvx(i,j)*rdx
12109    mrdx =msfvx(i,j)*rdx
12110    Tmpv300(i,k) =mrdx
12111
12112 ! Revised by Ning Pan, 2010-08-10
12113 !   Tmpv301(i,k) =mrdy
12114 !   mrdy =msfvy(i,j)*rdy
12115    mrdy =msfvy(i,j)*rdy
12116    Tmpv301(i,k) =mrdy
12117
12118    Tmpv001 =titau2(i,k,j) -titau2(i,k,j-1)
12119    Tmpv302(i,k) =Tmpv001
12120    Tmpv002 =mrdy*Tmpv302(i,k)
12121    Tmpv003 =titau1(i+1,k,j) -titau1(i,k,j)
12122    Tmpv303(i,k) =Tmpv003
12123    Tmpv004 =mrdx*Tmpv303(i,k)
12124    Tmpv005 =Tmpv002 +Tmpv004
12125    Tmpv006 =titau1avg(i,k+1,j) -titau1avg(i,k,j)
12126    Tmpv007 =titau2avg(i,k+1,j) -titau2avg(i,k,j)
12127    Tmpv008 =Tmpv006 +Tmpv007
12128    Tmpv304(i,k) =Tmpv008
12129 ! Remarked by Ning Pan, 2010-08-10
12130 !   Tmpv009 =msfvy(i,j)*rdzw(i,k,j)*Tmpv304(i,k)
12131 !   Tmpv010 =Tmpv005 -Tmpv009
12132 !   Tmpv011 =tendency(i,k,j) -Tmpv010
12133 !   tendency(i,k,j) =Tmpv011
12134
12135    ENDDO
12136    ENDDO
12137
12138    DO k =ktf, kts, -1
12139    DO i =i_end, i_start, -1
12140    mrdx =Tmpv300(i,k)  ! Added by Ning Pan, 2010-08-10
12141    mrdy =Tmpv301(i,k)  ! Added by Ning Pan, 2010-08-10
12142    a_Tmpv11 =a_tendency(i,k,j)
12143    a_tendency(i,k,j) =0.0
12144    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv11
12145    a_Tmpv10 =-a_Tmpv11
12146    a_Tmpv5 =a_Tmpv10
12147    a_Tmpv9 =-a_Tmpv10
12148    a_rdzw(i,k,j) =a_rdzw(i,k,j) +msfvy(i,j)*Tmpv304(i,k)*a_Tmpv9
12149    a_Tmpv8 =msfvy(i,j)*rdzw(i,k,j)*a_Tmpv9
12150    a_Tmpv6 =a_Tmpv8
12151    a_Tmpv7 =a_Tmpv8
12152    a_titau2avg(i,k+1,j) =a_titau2avg(i,k+1,j) +a_Tmpv7
12153    a_titau2avg(i,k,j) =a_titau2avg(i,k,j) -a_Tmpv7
12154    a_titau1avg(i,k+1,j) =a_titau1avg(i,k+1,j) +a_Tmpv6
12155    a_titau1avg(i,k,j) =a_titau1avg(i,k,j) -a_Tmpv6
12156    a_Tmpv2 =a_Tmpv5
12157    a_Tmpv4 =a_Tmpv5
12158    a_mrdx =a_mrdx +Tmpv303(i,k)*a_Tmpv4
12159    a_Tmpv3 =mrdx*a_Tmpv4
12160    a_titau1(i+1,k,j) =a_titau1(i+1,k,j) +a_Tmpv3
12161    a_titau1(i,k,j) =a_titau1(i,k,j) -a_Tmpv3
12162    a_mrdy =a_mrdy +Tmpv302(i,k)*a_Tmpv2
12163    a_Tmpv1 =mrdy*a_Tmpv2
12164    a_titau2(i,k,j) =a_titau2(i,k,j) +a_Tmpv1
12165    a_titau2(i,k,j-1) =a_titau2(i,k,j-1) -a_Tmpv1
12166
12167 ! Remarked by Ning Pan, 2010-08-10
12168 !   mrdy =Tmpv301(i,k)
12169
12170 !   a_mrdy =0.0
12171
12172 !   mrdx =Tmpv300(i,k)
12173
12174 !   a_mrdx =0.0
12175    ENDDO
12176    ENDDO
12177
12178    ENDDO
12179
12180 !LPB[14]
12181    DO j =j_end, j_start, -1
12182
12183 !  DO i =i_start, i_end
12184 !  titau1avg(i,kts,j) =0.
12185
12186 !  titau1avg(i,ktf+1,j) =0.
12187
12188 !  titau2avg(i,kts,j) =0.
12189
12190 !  titau2avg(i,ktf+1,j) =0.
12191
12192 !  ENDDO
12193
12194    DO i =i_end, i_start, -1
12195    a_titau2avg(i,ktf+1,j) =0.0
12196    a_titau2avg(i,kts,j) =0.0
12197    a_titau1avg(i,ktf+1,j) =0.0
12198    a_titau1avg(i,kts,j) =0.0
12199    ENDDO
12200
12201    ENDDO
12202
12203 !LPB[13]
12204    DO j =j_end, j_start, -1
12205
12206    DO k =kts+1, ktf
12207    DO i =i_start, i_end
12208    Tmpv001 =titau1(i+1,k,j) +titau1(i,k,j)
12209    Tmpv002 =fnm(k)*Tmpv001
12210    Tmpv003 =titau1(i+1,k-1,j) +titau1(i,k-1,j)
12211    Tmpv004 =fnp(k)*Tmpv003
12212    Tmpv005 =Tmpv002 +Tmpv004
12213    Tmpv006 =0.5*Tmpv005
12214 ! Revised by Ning Pan, 2010-08-10
12215 !   Tmpv300(i,k) =titau1avg(i,k,j)
12216 !   titau1avg(i,k,j) =Tmpv006
12217    titau1avg(i,k,j) =Tmpv006
12218    Tmpv300(i,k) =titau1avg(i,k,j)
12219
12220    Tmpv001 =titau2(i,k,j-1) +titau2(i,k,j)
12221    Tmpv002 =fnm(k)*Tmpv001
12222    Tmpv003 =titau2(i,k-1,j-1) +titau2(i,k-1,j)
12223    Tmpv004 =fnp(k)*Tmpv003
12224    Tmpv005 =Tmpv002 +Tmpv004
12225    Tmpv006 =0.5*Tmpv005
12226 ! Revised by Ning Pan, 2010-08-10
12227 !   Tmpv301(i,k) =titau2avg(i,k,j)
12228 !   titau2avg(i,k,j) =Tmpv006
12229    titau2avg(i,k,j) =Tmpv006
12230    Tmpv301(i,k) =titau2avg(i,k,j)
12231
12232    Tmpv001 =zx(i,k,j) +zx(i+1,k,j)
12233    Tmpv002 =Tmpv001 +zx(i,k,j-1)
12234    Tmpv003 =Tmpv002 +zx(i+1,k,j-1)
12235    Tmpv004 =0.25*Tmpv003
12236 ! Revised by Ning Pan, 2010-08-10
12237 !   Tmpv302(i,k) =tmpzx
12238 !   tmpzx =Tmpv004
12239    tmpzx =Tmpv004
12240    Tmpv302(i,k) =tmpzx
12241
12242 ! Remarked by Ning Pan, 2010-08-10
12243 !   Tmpv001 =titau1avg(i,k,j)*tmpzx
12244 !   Tmpv303(i,k) =titau1avg(i,k,j)
12245 !   titau1avg(i,k,j) =Tmpv001
12246
12247 ! Remarked by Ning Pan, 2010-08-10
12248 !   Tmpv001 =titau2avg(i,k,j)*zy(i,k,j)
12249 !   Tmpv304(i,k) =titau2avg(i,k,j)
12250 !   titau2avg(i,k,j) =Tmpv001
12251
12252    ENDDO
12253    ENDDO
12254
12255    DO k =ktf, kts+1, -1
12256    DO i =i_end, i_start, -1
12257
12258 ! Revised by Ning Pan, 2010-08-10
12259 !   titau2avg(i,k,j) =Tmpv304(i,k)
12260    titau2avg(i,k,j) =Tmpv301(i,k)
12261
12262    a_Tmpv1 =a_titau2avg(i,k,j)
12263    a_titau2avg(i,k,j) =0.0
12264    a_titau2avg(i,k,j) =a_titau2avg(i,k,j) +zy(i,k,j)*a_Tmpv1
12265    a_zy(i,k,j) =a_zy(i,k,j) +titau2avg(i,k,j)*a_Tmpv1
12266
12267    tmpzx =Tmpv302(i,k)  ! Added by Ning Pan, 2010-08-10
12268 ! Revised by Ning Pan, 2010-08-10
12269 !   titau1avg(i,k,j) =Tmpv303(i,k)
12270    titau1avg(i,k,j) =Tmpv300(i,k)
12271
12272    a_Tmpv1 =a_titau1avg(i,k,j)
12273    a_titau1avg(i,k,j) =0.0
12274    a_titau1avg(i,k,j) =a_titau1avg(i,k,j) +tmpzx*a_Tmpv1
12275    a_tmpzx =a_tmpzx +titau1avg(i,k,j)*a_Tmpv1
12276
12277 !   tmpzx =Tmpv302(i,k)  ! Remarked by Ning Pan, 2010-08-10
12278
12279    a_Tmpv4 =a_tmpzx
12280    a_tmpzx =0.0
12281    a_Tmpv3 =0.25*a_Tmpv4
12282    a_Tmpv2 =a_Tmpv3
12283    a_zx(i+1,k,j-1) =a_zx(i+1,k,j-1) +a_Tmpv3
12284    a_Tmpv1 =a_Tmpv2
12285    a_zx(i,k,j-1) =a_zx(i,k,j-1) +a_Tmpv2
12286    a_zx(i,k,j) =a_zx(i,k,j) +a_Tmpv1
12287    a_zx(i+1,k,j) =a_zx(i+1,k,j) +a_Tmpv1
12288
12289 !   titau2avg(i,k,j) =Tmpv301(i,k)  ! Remarked by Ning Pan, 2010-08-10
12290
12291    a_Tmpv6 =a_titau2avg(i,k,j)
12292    a_titau2avg(i,k,j) =0.0
12293    a_Tmpv5 =0.5*a_Tmpv6
12294    a_Tmpv2 =a_Tmpv5
12295    a_Tmpv4 =a_Tmpv5
12296    a_Tmpv3 =fnp(k)*a_Tmpv4
12297    a_titau2(i,k-1,j-1) =a_titau2(i,k-1,j-1) +a_Tmpv3
12298    a_titau2(i,k-1,j) =a_titau2(i,k-1,j) +a_Tmpv3
12299    a_Tmpv1 =fnm(k)*a_Tmpv2
12300    a_titau2(i,k,j-1) =a_titau2(i,k,j-1) +a_Tmpv1
12301    a_titau2(i,k,j) =a_titau2(i,k,j) +a_Tmpv1
12302
12303 !   titau1avg(i,k,j) =Tmpv300(i,k)  ! Remarked by Ning Pan, 2010-08-10
12304
12305    a_Tmpv6 =a_titau1avg(i,k,j)
12306    a_titau1avg(i,k,j) =0.0
12307    a_Tmpv5 =0.5*a_Tmpv6
12308    a_Tmpv2 =a_Tmpv5
12309    a_Tmpv4 =a_Tmpv5
12310    a_Tmpv3 =fnp(k)*a_Tmpv4
12311    a_titau1(i+1,k-1,j) =a_titau1(i+1,k-1,j) +a_Tmpv3
12312    a_titau1(i,k-1,j) =a_titau1(i,k-1,j) +a_Tmpv3
12313    a_Tmpv1 =fnm(k)*a_Tmpv2
12314    a_titau1(i+1,k,j) =a_titau1(i+1,k,j) +a_Tmpv1
12315    a_titau1(i,k,j) =a_titau1(i,k,j) +a_Tmpv1
12316    ENDDO
12317    ENDDO
12318
12319    ENDDO
12320
12321 !LPB[12]
12322 ! Remarked by Ning Pan, 2010-08-10
12323 !   DO IX4=1,n_nba_mij
12324 !   DO IX3=jms,jme
12325 !   DO IX2=kms,kme
12326 !   DO IX1=ims,ime
12327 !   nba_mij(IX1,IX2,IX3,IX4) =Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4)
12328 !   END DO
12329 !   END DO
12330 !   END DO
12331 !   END DO
12332 !   DO IX4=1,n_nba_mij
12333 !   DO IX3=jms,jme
12334 !   DO IX2=kms,kme
12335 !   DO IX1=ims,ime
12336 !   nba_mij(IX1,IX2,IX3,IX4) =Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4)
12337 !   END DO
12338 !   END DO
12339 !   END DO
12340 !   END DO
12341
12342 ! Remarked by Ning Pan, 2010-08-10
12343 !   is_ext =0
12344 !   ie_ext =1
12345 !   js_ext =0
12346 !   je_ext =0
12347 !   Tmpv_1 =nba_mij(ims,kms,jms,P_m12)
12348 !   CALL cal_titau_12_21(config_flags,titau1,mu,xkmh,defor12,nba_mij(ims,kms,jms,  &
12349 !   P_m12),is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
12350 !   its,ite,jts,jte,kts,kte)
12351
12352 ! Remarked by Ning Pan, 2010-08-10
12353 !   is_ext =0
12354 !   ie_ext =0
12355 !   js_ext =1
12356 !   je_ext =0
12357 !   Tmpv_2 =nba_mij(ims,kms,jms,P_m22)
12358 !   CALL cal_titau_11_22_33(config_flags,titau2,mu,tke,xkmh,defor22,nba_mij(ims,kms,  &
12359 !   jms,P_m22),is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
12360 !   kme,its,ite,jts,jte,kts,kte)
12361
12362 !   nba_mij(ims,kms,jms,P_m22) =Tmpv_2
12363
12364 ! Added by Ning Pan, 2010-08-10
12365    is_ext =0
12366    ie_ext =0
12367    js_ext =1
12368    je_ext =0
12369
12370    CALL a_cal_titau_11_22_33(config_flags,titau2,a_titau2,mu,a_mu,tke,a_tke,  &
12371    xkmh,a_xkmh,defor22,a_defor22,nba_mij(ims,kms,jms,P_m22),a_nba_mij(ims,kms,jms,  &
12372    P_m22),rho,a_rho,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
12373    its,ite,jts,jte,kts,kte)
12374
12375 !   nba_mij(ims,kms,jms,P_m12) =Tmpv_1  ! Remarked by Ning Pan, 2010-08-10
12376
12377 ! Added by Ning Pan, 2010-08-10
12378    is_ext =0
12379    ie_ext =1
12380    js_ext =0
12381    je_ext =0
12382    DO IX4=1,n_nba_mij
12383    DO IX3=jms,jme
12384    DO IX2=kms,kme
12385    DO IX1=ims,ime
12386    nba_mij(IX1,IX2,IX3,IX4) =Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4)
12387    END DO
12388    END DO
12389    END DO
12390    END DO
12391
12392    CALL a_cal_titau_12_21(config_flags,titau1,a_titau1,mu,a_mu,xkmh,a_xkmh,  &
12393    defor12,a_defor12,nba_mij(ims,kms,jms,P_m12),a_nba_mij(ims,kms,jms,P_m12)  &
12394    ,rho,a_rho &
12395    ,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,  &
12396    jts,jte,kts,kte)
12397
12398 !LPB[11]
12399
12400 !  IF( config_flags%periodic_x ) THEN
12401 !  i_end =min(ite, ide-1)
12402 !  END IF
12403
12404 !  IF( config_flags%periodic_x ) THEN
12405
12406 !  END IF
12407
12408 !LPB[10]
12409
12410 !LPB[9]
12411
12412 !  IF( config_flags%periodic_x ) THEN
12413 !  i_start =its
12414 !  END IF
12415
12416 !  IF( config_flags%periodic_x ) THEN
12417
12418 !  END IF
12419
12420 !LPB[8]
12421
12422 !LPB[7]
12423
12424 !  IF( config_flags%open_ye .or. config_flags%specified .or.            config_flags%nested) THEN
12425 !  j_end =min(jde-1, jte)
12426 !  END IF
12427
12428 !  IF( config_flags%open_ye .or. config_flags%specified .or.   &
12429 !           config_flags%nested) THEN
12430
12431 !  END IF
12432
12433 !LPB[6]
12434
12435 !LPB[5]
12436
12437 !  IF( config_flags%open_ys .or. config_flags%specified .or.            config_flags%nested) THEN
12438 !  j_start =max(jds+1, jts)
12439 !  END IF
12440
12441 !  IF( config_flags%open_ys .or. config_flags%specified .or.   &
12442 !           config_flags%nested) THEN
12443
12444 !  END IF
12445
12446 !LPB[4]
12447
12448 !LPB[3]
12449
12450 !  IF( config_flags%open_xe .or. config_flags%specified .or.            config_flags%nested) THEN
12451 !  i_end =min(ide-2, ite)
12452 !  END IF
12453
12454 !  IF( config_flags%open_xe .or. config_flags%specified .or.   &
12455 !           config_flags%nested) THEN
12456
12457 !  END IF
12458
12459 !LPB[2]
12460
12461 !LPB[1]
12462
12463 !  IF( config_flags%open_xs .or. config_flags%specified .or.            config_flags%nested) THEN
12464 !  i_start =max(ids+1, its)
12465 !  END IF
12466
12467 !  IF( config_flags%open_xs .or. config_flags%specified .or.   &
12468 !           config_flags%nested) THEN
12469
12470 !  END IF
12471
12472 !LPB[0]
12473 !  ktf =min(kte, kde-1)
12474 !  i_start =its
12475 !  i_end =min(ite, ide-1)
12476 !  j_start =jts
12477 !  j_end =jte
12478
12479    END SUBROUTINE a_horizontal_diffusion_v_2
12480
12481    SUBROUTINE a_horizontal_diffusion_w_2(tendency,a_tendency,mu,a_mu,config_flags, &
12482    defor13,a_defor13,defor23,a_defor23,div,a_div,nba_mij,a_nba_mij,n_nba_mij, &
12483    tke,a_tke,msftx,msfty,xkmh,a_xkmh,rdx,rdy,fnm,fnp,zx,a_zx,zy,a_zy,rdz, &
12484    a_rdz,rho,a_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
12485
12486 !PART I: DECLARATION OF VARIABLES
12487
12488    IMPLICIT NONE
12489
12490    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
12491    TYPE(grid_config_rec_type) :: config_flags
12492    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
12493    REAL,DIMENSION(kms:kme) :: fnm
12494    REAL,DIMENSION(kms:kme) :: fnp
12495    REAL,DIMENSION(ims:ime,jms:jme) :: msftx,msfty,mu,a_mu
12496    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
12497    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor13,a_defor13,defor23,a_defor23, &
12498    div,a_div,tke,a_tke,xkmh,a_xkmh,zx,a_zx,zy,a_zy,rdz,a_rdz
12499    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rho, a_rho
12500    INTEGER :: n_nba_mij
12501    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: nba_mij,a_nba_mij
12502    REAL :: rdx,rdy
12503    INTEGER :: i,j,k,ktf
12504    INTEGER :: i_start,i_end,j_start,j_end
12505    INTEGER :: is_ext,ie_ext,js_ext,je_ext
12506    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau1avg,a_titau1avg,titau2avg, &
12507    a_titau2avg,titau1,a_titau1,titau2,a_titau2,xkxavg,a_xkxavg,rravg,a_rravg
12508    REAL :: mrdx,a_mrdx,mrdy,a_mrdy,rcoup,a_rcoup
12509    REAL :: tmpzx,a_tmpzx,tmpzy,a_tmpzy,tmpzeta_z,a_tmpzeta_z
12510
12511    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: Keep_Lpb12_nba_mij
12512    INTEGER :: IX1,IX2,IX3,IX4
12513
12514    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
12515    a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,a_Tmpv8,Tmpv008,a_Tmpv9, &
12516    Tmpv009,a_Tmpv10,Tmpv010,a_Tmpv11,Tmpv011
12517
12518    REAL :: Tmpv_1,Tmpv_2
12519    REAL,DIMENSION(its:min(ite,ide-1),min0(kts,kts+1):min(kte,kde-1)) :: Tmpv300
12520    REAL,DIMENSION(its:min(ite,ide-1),min0(kts,kts+1):min(kte,kde-1)) :: Tmpv301
12521    REAL,DIMENSION(its:min(ite,ide-1),min0(kts,kts+1):min(kte,kde-1)) :: Tmpv302
12522    REAL,DIMENSION(its:min(ite,ide-1),min0(kts,kts+1):min(kte,kde-1)) :: Tmpv303
12523    REAL,DIMENSION(its:min(ite,ide-1),min0(kts,kts+1):min(kte,kde-1)) :: Tmpv304
12524    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv305
12525
12526 !PART II: CALCULATIONS OF B. S. TRAJECTORY
12527
12528 !LPB[0]
12529       ktf=MIN(kte,kde-1)
12530       i_start = its
12531       i_end   = MIN(ite,ide-1)
12532       j_start = jts
12533       j_end   = MIN(jte,jde-1)
12534
12535 !LPB[1]
12536    IF ( config_flags%open_xs .or. config_flags%specified .or.   &
12537         config_flags%nested) i_start = MAX(ids+1,its)
12538
12539 !LPB[2]
12540
12541 !LPB[3]
12542    IF ( config_flags%open_xe .or. config_flags%specified .or.   &
12543         config_flags%nested) i_end   = MIN(ide-2,ite)
12544
12545 !LPB[4]
12546
12547 !LPB[5]
12548    IF ( config_flags%open_ys .or. config_flags%specified .or.   &
12549         config_flags%nested) j_start = MAX(jds+1,jts)
12550
12551 !LPB[6]
12552
12553 !LPB[7]
12554    IF ( config_flags%open_ye .or. config_flags%specified .or.   &
12555         config_flags%nested) j_end   = MIN(jde-2,jte)
12556
12557 !LPB[8]
12558
12559 !LPB[9]
12560       IF ( config_flags%periodic_x ) i_start = its
12561
12562 !LPB[10]
12563
12564 !LPB[11]
12565       IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
12566
12567 !LPB[12]
12568    DO IX4=1,n_nba_mij
12569    DO IX3=jms,jme
12570    DO IX2=kms,kme
12571    DO IX1=ims,ime
12572        Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
12573    END DO
12574    END DO
12575    END DO
12576    END DO
12577 ! Remarked by Ning Pan, 2010-08-10
12578 !   DO IX4=1,n_nba_mij
12579 !   DO IX3=jms,jme
12580 !   DO IX2=kms,kme
12581 !   DO IX1=ims,ime
12582 !       Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
12583 !   END DO
12584 !   END DO
12585 !   END DO
12586 !   END DO
12587
12588       is_ext=0
12589       ie_ext=1
12590       js_ext=0
12591       je_ext=0
12592       CALL cal_titau_13_31( config_flags, titau1, defor13,     &
12593                             nba_mij(ims,kms,jms,P_m13),        &
12594                             xkmh, fnm, fnp, rho,               &
12595                             is_ext, ie_ext, js_ext, je_ext,    &
12596                             ids, ide, jds, jde, kds, kde,      &
12597                             ims, ime, jms, jme, kms, kme,      &
12598                             its, ite, jts, jte, kts, kte     )
12599       is_ext=0
12600       ie_ext=0
12601       js_ext=0
12602       je_ext=1
12603       CALL cal_titau_23_32( config_flags, titau2, defor23,     &
12604                             nba_mij(ims,kms,jms,P_m23),        &
12605                             xkmh, fnm, fnp, rho,               &
12606                             is_ext, ie_ext, js_ext, je_ext,    &
12607                             ids, ide, jds, jde, kds, kde,      &
12608                             ims, ime, jms, jme, kms, kme,      &
12609                             its, ite, jts, jte, kts, kte     )
12610
12611 !LPB[13]
12612       DO j = j_start, j_end
12613
12614       DO k = kts,ktf
12615       DO i = i_start, i_end
12616          titau1avg(i,k,j)=0.25*(titau1(i+1,k+1,j)+titau1(i,k+1,j)+   &
12617                                 titau1(i+1,k  ,j)+titau1(i,k  ,j))
12618          titau2avg(i,k,j)=0.25*(titau2(i,k+1,j+1)+titau2(i,k+1,j)+   &
12619                                 titau2(i,k  ,j+1)+titau2(i,k  ,j))
12620          tmpzx  =0.25*( zx(i,k  ,j)+zx(i+1,k  ,j)+   &
12621                         zx(i,k+1,j)+zx(i+1,k+1,j)  )
12622          tmpzy  =0.25*( zy(i,k  ,j)+zy(i,k  ,j+1)+   &
12623                         zy(i,k+1,j)+zy(i,k+1,j+1)  )
12624          titau1avg(i,k,j)=titau1avg(i,k,j)*tmpzx
12625          titau2avg(i,k,j)=titau2avg(i,k,j)*tmpzy
12626       ENDDO
12627       ENDDO
12628
12629       ENDDO
12630
12631 !LPB[14]
12632       DO j = j_start, j_end
12633
12634       DO i = i_start, i_end
12635          titau1avg(i,ktf+1,j)=0.
12636          titau2avg(i,ktf+1,j)=0.
12637       ENDDO
12638
12639       ENDDO
12640
12641 !!LPB[15]
12642 !      DO j = j_start, j_end
12643
12644 !      DO k = kts+1,ktf
12645 !      DO i = i_start, i_end
12646 !         mrdx=msftx(i,j)*rdx
12647 !         mrdy=msfty(i,j)*rdy
12648 !         tendency(i,k,j)=tendency(i,k,j)-                                   &
12649 !              (mrdx*(titau1(i+1,k,j)-titau1(i,k,j))+                        &
12650 !               mrdy*(titau2(i,k,j+1)-titau2(i,k,j))-                        &
12651 !              msfty(i,j)*rdz(i,k,j)*(titau1avg(i,k,j)-titau1avg(i,k-1,j)+   &
12652 !                                     titau2avg(i,k,j)-titau2avg(i,k-1,j)    &
12653 !                                  )                                         &
12654 !              )
12655 !      ENDDO
12656 !      ENDDO
12657
12658 !      ENDDO
12659
12660 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
12661
12662    Do K2_ADJ =jts-1, jte+1
12663    Do K1_ADJ =kts, kte
12664    Do K0_ADJ =its-1, ite+1
12665    a_titau1avg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
12666    End Do
12667    End Do
12668    End Do
12669
12670    Do K2_ADJ =jts-1, jte+1
12671    Do K1_ADJ =kts, kte
12672    Do K0_ADJ =its-1, ite+1
12673    a_titau2avg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
12674    End Do
12675    End Do
12676    End Do
12677
12678    Do K2_ADJ =jts-1, jte+1
12679    Do K1_ADJ =kts, kte
12680    Do K0_ADJ =its-1, ite+1
12681    a_titau1(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
12682    End Do
12683    End Do
12684    End Do
12685
12686    Do K2_ADJ =jts-1, jte+1
12687    Do K1_ADJ =kts, kte
12688    Do K0_ADJ =its-1, ite+1
12689    a_titau2(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
12690    End Do
12691    End Do
12692    End Do
12693
12694    Do K2_ADJ =jts-1, jte+1
12695    Do K1_ADJ =kts, kte
12696    Do K0_ADJ =its-1, ite+1
12697    a_xkxavg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
12698    End Do
12699    End Do
12700    End Do
12701
12702    Do K2_ADJ =jts-1, jte+1
12703    Do K1_ADJ =kts, kte
12704    Do K0_ADJ =its-1, ite+1
12705    a_rravg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
12706    End Do
12707    End Do
12708    End Do
12709
12710 ! Remarked by Ning Pan, 2010-08-10
12711 !   a_mrdx =0.0
12712 !   a_mrdy =0.0
12713 !   a_rcoup =0.0
12714    a_tmpzx =0.0
12715    a_tmpzy =0.0
12716 !   a_tmpzeta_z =0.0  ! Remarked by Ning Pan, 2010-08-10
12717
12718 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
12719
12720 !LPB[15]
12721    DO j =j_end, j_start, -1
12722
12723    DO k =kts+1, ktf
12724    DO i =i_start, i_end
12725 ! Revised by Ning Pan, 2010-08-10
12726 !   Tmpv300(i,k) =mrdx
12727 !   mrdx =msftx(i,j)*rdx
12728    mrdx =msftx(i,j)*rdx
12729    Tmpv300(i,k) =mrdx
12730
12731 ! Revised by Ning Pan, 2010-08-10
12732 !   Tmpv301(i,k) =mrdy
12733 !   mrdy =msfty(i,j)*rdy
12734    mrdy =msfty(i,j)*rdy
12735    Tmpv301(i,k) =mrdy
12736
12737    Tmpv001 =titau1(i+1,k,j) -titau1(i,k,j)
12738    Tmpv302(i,k) =Tmpv001
12739    Tmpv002 =mrdx*Tmpv302(i,k)
12740    Tmpv003 =titau2(i,k,j+1) -titau2(i,k,j)
12741    Tmpv303(i,k) =Tmpv003
12742    Tmpv004 =mrdy*Tmpv303(i,k)
12743    Tmpv005 =Tmpv002 +Tmpv004
12744    Tmpv006 =titau1avg(i,k,j) -titau1avg(i,k-1,j)
12745    Tmpv007 =Tmpv006 +titau2avg(i,k,j)
12746    Tmpv008 =Tmpv007 -titau2avg(i,k-1,j)
12747    Tmpv304(i,k) =Tmpv008
12748 ! Remarked by Ning Pan, 2010-08-10
12749 !   Tmpv009 =msfty(i,j)*rdz(i,k,j)*Tmpv304(i,k)
12750 !   Tmpv010 =Tmpv005 -Tmpv009
12751 !   Tmpv011 =tendency(i,k,j) -Tmpv010
12752 !   tendency(i,k,j) =Tmpv011
12753
12754    ENDDO
12755    ENDDO
12756
12757    DO k =ktf, kts+1, -1
12758    DO i =i_end, i_start, -1
12759    mrdx =Tmpv300(i,k)  ! Added by Ning Pan, 2010-08-10
12760    mrdy =Tmpv301(i,k)  ! Added by Ning Pan, 2010-08-10
12761    a_Tmpv11 =a_tendency(i,k,j)
12762    a_tendency(i,k,j) =0.0
12763    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv11
12764    a_Tmpv10 =-a_Tmpv11
12765    a_Tmpv5 =a_Tmpv10
12766    a_Tmpv9 =-a_Tmpv10
12767    a_rdz(i,k,j) =a_rdz(i,k,j) +msfty(i,j)*Tmpv304(i,k)*a_Tmpv9
12768    a_Tmpv8 =msfty(i,j)*rdz(i,k,j)*a_Tmpv9
12769    a_Tmpv7 =a_Tmpv8
12770    a_titau2avg(i,k-1,j) =a_titau2avg(i,k-1,j) -a_Tmpv8
12771    a_Tmpv6 =a_Tmpv7
12772    a_titau2avg(i,k,j) =a_titau2avg(i,k,j) +a_Tmpv7
12773    a_titau1avg(i,k,j) =a_titau1avg(i,k,j) +a_Tmpv6
12774    a_titau1avg(i,k-1,j) =a_titau1avg(i,k-1,j) -a_Tmpv6
12775    a_Tmpv2 =a_Tmpv5
12776    a_Tmpv4 =a_Tmpv5
12777    a_mrdy =a_mrdy +Tmpv303(i,k)*a_Tmpv4
12778    a_Tmpv3 =mrdy*a_Tmpv4
12779    a_titau2(i,k,j+1) =a_titau2(i,k,j+1) +a_Tmpv3
12780    a_titau2(i,k,j) =a_titau2(i,k,j) -a_Tmpv3
12781    a_mrdx =a_mrdx +Tmpv302(i,k)*a_Tmpv2
12782    a_Tmpv1 =mrdx*a_Tmpv2
12783    a_titau1(i+1,k,j) =a_titau1(i+1,k,j) +a_Tmpv1
12784    a_titau1(i,k,j) =a_titau1(i,k,j) -a_Tmpv1
12785
12786 ! Remarked by Ning Pan, 2010-08-10
12787 !   mrdy =Tmpv301(i,k)
12788
12789 !   a_mrdy =0.0
12790
12791 !   mrdx =Tmpv300(i,k)
12792
12793 !   a_mrdx =0.0
12794    ENDDO
12795    ENDDO
12796
12797    ENDDO
12798
12799 !LPB[14]
12800    DO j =j_end, j_start, -1
12801
12802 !  DO i =i_start, i_end
12803 !  titau1avg(i,ktf+1,j) =0.
12804
12805 !  titau2avg(i,ktf+1,j) =0.
12806
12807 !  ENDDO
12808
12809    DO i =i_end, i_start, -1
12810    a_titau2avg(i,ktf+1,j) =0.0
12811    a_titau1avg(i,ktf+1,j) =0.0
12812    ENDDO
12813
12814    ENDDO
12815
12816 !LPB[13]
12817    DO j =j_end, j_start, -1
12818
12819    DO k =kts, ktf
12820    DO i =i_start, i_end
12821    Tmpv001 =titau1(i+1,k+1,j) +titau1(i,k+1,j)
12822    Tmpv002 =Tmpv001 +titau1(i+1,k,j)
12823    Tmpv003 =Tmpv002 +titau1(i,k,j)
12824    Tmpv004 =0.25*Tmpv003
12825 ! Revised by Ning Pan, 2010-08-10
12826 !   Tmpv300(i,k) =titau1avg(i,k,j)
12827 !   titau1avg(i,k,j) =Tmpv004
12828    titau1avg(i,k,j) =Tmpv004
12829    Tmpv300(i,k) =titau1avg(i,k,j)
12830
12831    Tmpv001 =titau2(i,k+1,j+1) +titau2(i,k+1,j)
12832    Tmpv002 =Tmpv001 +titau2(i,k,j+1)
12833    Tmpv003 =Tmpv002 +titau2(i,k,j)
12834    Tmpv004 =0.25*Tmpv003
12835 ! Revised by Ning Pan, 2010-08-10
12836 !   Tmpv301(i,k) =titau2avg(i,k,j)
12837 !   titau2avg(i,k,j) =Tmpv004
12838    titau2avg(i,k,j) =Tmpv004
12839    Tmpv301(i,k) =titau2avg(i,k,j)
12840
12841    Tmpv001 =zx(i,k,j) +zx(i+1,k,j)
12842    Tmpv002 =Tmpv001 +zx(i,k+1,j)
12843    Tmpv003 =Tmpv002 +zx(i+1,k+1,j)
12844    Tmpv004 =0.25*Tmpv003
12845 ! Revised by Ning Pan, 2010-08-10
12846 !   Tmpv302(i,k) =tmpzx
12847 !   tmpzx =Tmpv004
12848    tmpzx =Tmpv004
12849    Tmpv302(i,k) =tmpzx
12850
12851    Tmpv001 =zy(i,k,j) +zy(i,k,j+1)
12852    Tmpv002 =Tmpv001 +zy(i,k+1,j)
12853    Tmpv003 =Tmpv002 +zy(i,k+1,j+1)
12854    Tmpv004 =0.25*Tmpv003
12855 ! Revised by Ning Pan, 2010-08-10
12856 !   Tmpv303(i,k) =tmpzy
12857 !   tmpzy =Tmpv004
12858    tmpzy =Tmpv004
12859    Tmpv303(i,k) =tmpzy
12860
12861 ! Remarked by Ning Pan, 2010-08-10
12862 !   Tmpv001 =titau1avg(i,k,j)*tmpzx
12863 !   Tmpv304(i,k) =titau1avg(i,k,j)
12864 !   titau1avg(i,k,j) =Tmpv001
12865
12866 ! Remarked by Ning Pan, 2010-08-10
12867 !   Tmpv001 =titau2avg(i,k,j)*tmpzy
12868 !   Tmpv305(i,k) =titau2avg(i,k,j)
12869 !   titau2avg(i,k,j) =Tmpv001
12870
12871    ENDDO
12872    ENDDO
12873
12874    DO k =ktf, kts, -1
12875    DO i =i_end, i_start, -1
12876
12877    tmpzy =Tmpv303(i,k)  ! Added by Ning Pan, 2010-08-10
12878 ! Revised by Ning Pan, 2010-08-10
12879 !   titau2avg(i,k,j) =Tmpv305(i,k)
12880    titau2avg(i,k,j) =Tmpv301(i,k)
12881
12882    a_Tmpv1 =a_titau2avg(i,k,j)
12883    a_titau2avg(i,k,j) =0.0
12884    a_titau2avg(i,k,j) =a_titau2avg(i,k,j) +tmpzy*a_Tmpv1
12885    a_tmpzy =a_tmpzy +titau2avg(i,k,j)*a_Tmpv1
12886
12887    tmpzx =Tmpv302(i,k)  ! Added by Ning Pan, 2010-08-10
12888 ! Revised by Ning Pan, 2010-08-10
12889 !   titau1avg(i,k,j) =Tmpv304(i,k)
12890    titau1avg(i,k,j) =Tmpv300(i,k)
12891
12892    a_Tmpv1 =a_titau1avg(i,k,j)
12893    a_titau1avg(i,k,j) =0.0
12894    a_titau1avg(i,k,j) =a_titau1avg(i,k,j) +tmpzx*a_Tmpv1
12895    a_tmpzx =a_tmpzx +titau1avg(i,k,j)*a_Tmpv1
12896
12897 !   tmpzy =Tmpv303(i,k)  ! Remarked by Ning Pan, 2010-08-10
12898
12899    a_Tmpv4 =a_tmpzy
12900    a_tmpzy =0.0
12901    a_Tmpv3 =0.25*a_Tmpv4
12902    a_Tmpv2 =a_Tmpv3
12903    a_zy(i,k+1,j+1) =a_zy(i,k+1,j+1) +a_Tmpv3
12904    a_Tmpv1 =a_Tmpv2
12905    a_zy(i,k+1,j) =a_zy(i,k+1,j) +a_Tmpv2
12906    a_zy(i,k,j) =a_zy(i,k,j) +a_Tmpv1
12907    a_zy(i,k,j+1) =a_zy(i,k,j+1) +a_Tmpv1
12908
12909 !   tmpzx =Tmpv302(i,k)  ! Remarked by Ning Pan, 2010-08-10
12910
12911    a_Tmpv4 =a_tmpzx
12912    a_tmpzx =0.0
12913    a_Tmpv3 =0.25*a_Tmpv4
12914    a_Tmpv2 =a_Tmpv3
12915    a_zx(i+1,k+1,j) =a_zx(i+1,k+1,j) +a_Tmpv3
12916    a_Tmpv1 =a_Tmpv2
12917    a_zx(i,k+1,j) =a_zx(i,k+1,j) +a_Tmpv2
12918    a_zx(i,k,j) =a_zx(i,k,j) +a_Tmpv1
12919    a_zx(i+1,k,j) =a_zx(i+1,k,j) +a_Tmpv1
12920
12921 !   titau2avg(i,k,j) =Tmpv301(i,k)  ! Remarked by Ning Pan, 2010-08-10
12922
12923    a_Tmpv4 =a_titau2avg(i,k,j)
12924    a_titau2avg(i,k,j) =0.0
12925    a_Tmpv3 =0.25*a_Tmpv4
12926    a_Tmpv2 =a_Tmpv3
12927    a_titau2(i,k,j) =a_titau2(i,k,j) +a_Tmpv3
12928    a_Tmpv1 =a_Tmpv2
12929    a_titau2(i,k,j+1) =a_titau2(i,k,j+1) +a_Tmpv2
12930    a_titau2(i,k+1,j+1) =a_titau2(i,k+1,j+1) +a_Tmpv1
12931    a_titau2(i,k+1,j) =a_titau2(i,k+1,j) +a_Tmpv1
12932
12933 !   titau1avg(i,k,j) =Tmpv300(i,k)  ! Remarked by Ning Pan, 2010-08-10
12934
12935    a_Tmpv4 =a_titau1avg(i,k,j)
12936    a_titau1avg(i,k,j) =0.0
12937    a_Tmpv3 =0.25*a_Tmpv4
12938    a_Tmpv2 =a_Tmpv3
12939    a_titau1(i,k,j) =a_titau1(i,k,j) +a_Tmpv3
12940    a_Tmpv1 =a_Tmpv2
12941    a_titau1(i+1,k,j) =a_titau1(i+1,k,j) +a_Tmpv2
12942    a_titau1(i+1,k+1,j) =a_titau1(i+1,k+1,j) +a_Tmpv1
12943    a_titau1(i,k+1,j) =a_titau1(i,k+1,j) +a_Tmpv1
12944    ENDDO
12945    ENDDO
12946
12947    ENDDO
12948
12949 !LPB[12]
12950 ! Remarked by Ning Pan, 2010-08-10
12951 !   DO IX4=1,n_nba_mij
12952 !   DO IX3=jms,jme
12953 !   DO IX2=kms,kme
12954 !   DO IX1=ims,ime
12955 !   nba_mij(IX1,IX2,IX3,IX4) =Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4)
12956 !   END DO
12957 !   END DO
12958 !   END DO
12959 !   END DO
12960 !   DO IX4=1,n_nba_mij
12961 !   DO IX3=jms,jme
12962 !   DO IX2=kms,kme
12963 !   DO IX1=ims,ime
12964 !   nba_mij(IX1,IX2,IX3,IX4) =Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4)
12965 !   END DO
12966 !   END DO
12967 !   END DO
12968 !   END DO
12969
12970 ! Remarked by Ning Pan, 2010-08-10
12971 !   is_ext =0
12972 !   ie_ext =1
12973 !   js_ext =0
12974 !   je_ext =0
12975 !   Tmpv_1 =nba_mij(ims,kms,jms,P_m13)
12976 !   CALL cal_titau_13_31(config_flags,titau1,defor13,nba_mij(ims,kms,jms,P_m13)  &
12977 !   ,mu,xkmh,fnm,fnp,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
12978 !   kms,kme,its,ite,jts,jte,kts,kte)
12979
12980 !   is_ext =0
12981 !   ie_ext =0
12982 !   js_ext =0
12983 !   je_ext =1
12984 !   Tmpv_2 =nba_mij(ims,kms,jms,P_m23)
12985 !   CALL cal_titau_23_32(config_flags,titau2,defor23,nba_mij(ims,kms,jms,P_m23)  &
12986 !   ,mu,xkmh,fnm,fnp,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
12987 !   kms,kme,its,ite,jts,jte,kts,kte)
12988
12989 !   nba_mij(ims,kms,jms,P_m23) =Tmpv_2
12990
12991 ! Added by Ning Pan, 2010-08-10
12992    is_ext =0
12993    ie_ext =0
12994    js_ext =0
12995    je_ext =1
12996
12997    CALL a_cal_titau_23_32(config_flags,titau2,a_titau2,defor23,a_defor23,  &
12998    nba_mij(ims,kms,jms,P_m23),a_nba_mij(ims,kms,jms,P_m23),mu,a_mu,xkmh,a_xkmh,  &
12999    fnm,fnp,rho,a_rho,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
13000    its,ite,jts,jte,kts,kte)
13001
13002 !   nba_mij(ims,kms,jms,P_m13) =Tmpv_1  ! Remarked by Ning Pan, 2010-08-10
13003
13004 ! Added by Ning Pan, 2010-08-10
13005    is_ext =0
13006    ie_ext =1
13007    js_ext =0
13008    je_ext =0
13009    DO IX4=1,n_nba_mij
13010    DO IX3=jms,jme
13011    DO IX2=kms,kme
13012    DO IX1=ims,ime
13013    nba_mij(IX1,IX2,IX3,IX4) =Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4)
13014    END DO
13015    END DO
13016    END DO
13017    END DO
13018
13019    CALL a_cal_titau_13_31(config_flags,titau1,a_titau1,defor13,a_defor13,  &
13020    nba_mij(ims,kms,jms,P_m13),a_nba_mij(ims,kms,jms,P_m13),mu,a_mu,xkmh,a_xkmh,  &
13021    fnm,fnp,rho,a_rho,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
13022    its,ite,jts,jte,kts,kte)
13023
13024 !LPB[11]
13025
13026 !  IF( config_flags%periodic_x ) THEN
13027 !  i_end =min(ite, ide-1)
13028 !  END IF
13029
13030 !  IF( config_flags%periodic_x ) THEN
13031
13032 !  END IF
13033
13034 !LPB[10]
13035
13036 !LPB[9]
13037
13038 !  IF( config_flags%periodic_x ) THEN
13039 !  i_start =its
13040 !  END IF
13041
13042 !  IF( config_flags%periodic_x ) THEN
13043
13044 !  END IF
13045
13046 !LPB[8]
13047
13048 !LPB[7]
13049
13050 !  IF( config_flags%open_ye .or. config_flags%specified .or.            config_flags%nested) THEN
13051 !  j_end =min(jde-2, jte)
13052 !  END IF
13053
13054 !  IF( config_flags%open_ye .or. config_flags%specified .or.   &
13055 !           config_flags%nested) THEN
13056
13057 !  END IF
13058
13059 !LPB[6]
13060
13061 !LPB[5]
13062
13063 !  IF( config_flags%open_ys .or. config_flags%specified .or.            config_flags%nested) THEN
13064 !  j_start =max(jds+1, jts)
13065 !  END IF
13066
13067 !  IF( config_flags%open_ys .or. config_flags%specified .or.   &
13068 !           config_flags%nested) THEN
13069
13070 !  END IF
13071
13072 !LPB[4]
13073
13074 !LPB[3]
13075
13076 !  IF( config_flags%open_xe .or. config_flags%specified .or.            config_flags%nested) THEN
13077 !  i_end =min(ide-2, ite)
13078 !  END IF
13079
13080 !  IF( config_flags%open_xe .or. config_flags%specified .or.   &
13081 !           config_flags%nested) THEN
13082
13083 !  END IF
13084
13085 !LPB[2]
13086
13087 !LPB[1]
13088
13089 !  IF( config_flags%open_xs .or. config_flags%specified .or.            config_flags%nested) THEN
13090 !  i_start =max(ids+1, its)
13091 !  END IF
13092
13093 !  IF( config_flags%open_xs .or. config_flags%specified .or.   &
13094 !           config_flags%nested) THEN
13095
13096 !  END IF
13097
13098 !LPB[0]
13099 !  ktf =min(kte, kde-1)
13100 !  i_start =its
13101 !  i_end =min(ite, ide-1)
13102 !  j_start =jts
13103 !  j_end =min(jte, jde-1)
13104
13105    END SUBROUTINE a_horizontal_diffusion_w_2
13106
13107    SUBROUTINE a_horizontal_diffusion_s(tendency,a_tendency,mu,a_mu,config_flags, &
13108    var,a_var,msftx,msfty,msfux,msfuy,msfvx,msfvy,xkhh,a_xkhh,rdx,rdy,fnm,fnp,cf1, &
13109    cf2,cf3,zx,a_zx,zy,a_zy,rdz,a_rdz,rdzw,a_rdzw,dnw,dn,rho,a_rho,doing_tke,ids,ide,jds, &
13110    jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
13111
13112 !PART I: DECLARATION OF VARIABLES
13113
13114    IMPLICIT NONE
13115
13116    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
13117    TYPE(grid_config_rec_type) :: config_flags
13118    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
13119    LOGICAL :: doing_tke
13120    REAL :: cf1,cf2,cf3
13121    REAL,DIMENSION(kms:kme) :: fnm
13122    REAL,DIMENSION(kms:kme) :: fnp
13123    REAL,DIMENSION(kms:kme) :: dn
13124    REAL,DIMENSION(kms:kme) :: dnw
13125    REAL,DIMENSION(ims:ime,jms:jme) :: msfux
13126    REAL,DIMENSION(ims:ime,jms:jme) :: msfuy
13127    REAL,DIMENSION(ims:ime,jms:jme) :: msfvx
13128    REAL,DIMENSION(ims:ime,jms:jme) :: msfvy
13129    REAL,DIMENSION(ims:ime,jms:jme) :: msftx
13130    REAL,DIMENSION(ims:ime,jms:jme) :: msfty
13131    REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
13132    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
13133    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: xkhh,a_xkhh,rdz,a_rdz,rdzw,a_rdzw
13134    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rho, a_rho
13135    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: var,a_var,zx,a_zx,zy,a_zy
13136    REAL :: rdx,rdy
13137    INTEGER :: i,j,k,ktf
13138    INTEGER :: i_start,i_end,j_start,j_end
13139    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: H1avg,a_H1avg,H2avg,a_H2avg, &
13140    H1,a_H1,H2,a_H2,xkxavg,a_xkxavg
13141    REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: tmptendf,a_tmptendf
13142    REAL :: mrdx,a_mrdx,mrdy,a_mrdy,rcoup,a_rcoup
13143    REAL :: tmpzx,a_tmpzx,tmpzy,a_tmpzy,tmpzeta_z,a_tmpzeta_z,rdzu,a_rdzu,rdzv,a_rdzv
13144    INTEGER :: ktes1,ktes2
13145
13146    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: Keep_Lpb22_H1avg
13147    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: Keep_Lpb22_H2avg
13148    REAL,DIMENSION(max(jds+1,jts):min(jde-2,jte)) :: Keep_Lpb22_tmpzx
13149    REAL,DIMENSION(max(jds+1,jts):min(jde-2,jte)) :: Keep_Lpb22_tmpzy
13150    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
13151    a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,a_Tmpv8,Tmpv008,a_Tmpv9, &
13152    Tmpv009,a_Tmpv10,Tmpv010,a_Tmpv11,Tmpv011,a_Tmpv12,Tmpv012,a_Tmpv13,Tmpv013, &
13153    a_Tmpv14,Tmpv014,a_Tmpv15,Tmpv015,a_Tmpv16,Tmpv016,a_Tmpv17,Tmpv017, &
13154    a_Tmpv18,Tmpv018,a_Tmpv19,Tmpv019,a_Tmpv20,Tmpv020
13155    REAL,DIMENSION(its:max0(min(ite,ide-1)+1,min(ite,ide-1)),min0(kts,kts+1) &
13156    :min(kte,kde-1)) :: Tmpv300
13157    REAL,DIMENSION(its:max0(min(ite,ide-1)+1,min(ite,ide-1)),min0(kts,kts+1) &
13158    :min(kte,kde-1)) :: Tmpv301
13159    REAL,DIMENSION(its:max0(min(ite,ide-1)+1,min(ite,ide-1)),min0(kts,kts+1) &
13160    :min(kte,kde-1)) :: Tmpv302
13161    REAL,DIMENSION(its:max0(min(ite,ide-1)+1,min(ite,ide-1)),min0(kts,kts+1) &
13162    :min(kte,kde-1)) :: Tmpv303
13163    REAL,DIMENSION(its:max0(min(ite,ide-1)+1,min(ite,ide-1)),min0(kts,kts+1) &
13164    :min(kte,kde-1)) :: Tmpv304
13165    REAL,DIMENSION(its:min(ite,ide-1),min0(kts+1,kts):min(kte,kde-1)) :: Tmpv305
13166    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv306
13167    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv307
13168    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv308
13169    REAL,DIMENSION(its:min(ite,ide-1),kts:min(kte,kde-1)) :: Tmpv309
13170 ! Added by Ning Pan, 2010-08-10
13171    REAL,DIMENSION(its:max0(min(ite,ide-1)+1,min(ite,ide-1)),min0(kts,kts+1) &
13172    :min(kte,kde-1)) :: Tmpv3010, Tmpv3011
13173 !PART II: CALCULATIONS OF B. S. TRAJECTORY
13174
13175 !LPB[0]
13176       ktf=MIN(kte,kde-1)
13177       ktes1=kte-1
13178       ktes2=kte-2
13179       i_start = its
13180       i_end   = MIN(ite,ide-1)
13181       j_start = jts
13182       j_end   = MIN(jte,jde-1)
13183
13184 !LPB[1]
13185    IF ( config_flags%open_xs .or. config_flags%specified .or.   &
13186         config_flags%nested) i_start = MAX(ids+1,its)
13187
13188 !LPB[2]
13189
13190 !LPB[3]
13191    IF ( config_flags%open_xe .or. config_flags%specified .or.   &
13192         config_flags%nested) i_end   = MIN(ide-2,ite)
13193
13194 !LPB[4]
13195
13196 !LPB[5]
13197    IF ( config_flags%open_ys .or. config_flags%specified .or.   &
13198         config_flags%nested) j_start = MAX(jds+1,jts)
13199
13200 !LPB[6]
13201
13202 !LPB[7]
13203    IF ( config_flags%open_ye .or. config_flags%specified .or.   &
13204         config_flags%nested) j_end   = MIN(jde-2,jte)
13205
13206 !LPB[8]
13207
13208 !LPB[9]
13209       IF ( config_flags%periodic_x ) i_start = its
13210
13211 !LPB[10]
13212
13213 !LPB[11]
13214       IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
13215
13216 !LPB[12]
13217
13218 !LPB[13]
13219 ! Remarked by Ning Pan, 2010-08-10
13220 !   IF ( doing_tke ) THEN
13221
13222 !         DO j = j_start, j_end
13223 !         DO k = kts,ktf
13224 !         DO i = i_start, i_end
13225 !            tmptendf(i,k,j)=tendency(i,k,j)
13226 !         ENDDO
13227 !         ENDDO
13228 !         ENDDO
13229
13230 !   ENDIF
13231
13232 !LPB[14]
13233       DO j = j_start, j_end
13234
13235       DO k = kts, ktf
13236       DO i = i_start, i_end + 1
13237          xkxavg(i,k,j)=0.5*(xkhh(i-1,k,j)+xkhh(i,k,j))
13238       ENDDO
13239       ENDDO
13240
13241       ENDDO
13242
13243 !LPB[15]
13244       DO j = j_start, j_end
13245
13246       DO k = kts+1, ktf
13247       DO i = i_start, i_end + 1
13248          H1avg(i,k,j)=0.5*(fnm(k)*(var(i-1,k  ,j)+var(i,k  ,j))+    &
13249                            fnp(k)*(var(i-1,k-1,j)+var(i,k-1,j)))
13250       ENDDO
13251       ENDDO
13252
13253       ENDDO
13254
13255 !LPB[16]
13256       DO j = j_start, j_end
13257
13258       DO i = i_start, i_end + 1
13259          H1avg(i,kts  ,j)=0.5*(cf1*var(i  ,1,j)+cf2*var(i  ,2,j)+   &
13260                                cf3*var(i  ,3,j)+cf1*var(i-1,1,j)+    &
13261                                cf2*var(i-1,2,j)+cf3*var(i-1,3,j))
13262          H1avg(i,ktf+1,j)=0.5*(var(i,ktes1,j)+(var(i,ktes1,j)-   &
13263                                var(i,ktes2,j))*0.5*dnw(ktes1)/dn(ktes1)+   &
13264                                var(i-1,ktes1,j)+(var(i-1,ktes1,j)-   &
13265                                var(i-1,ktes2,j))*0.5*dnw(ktes1)/dn(ktes1))
13266       ENDDO
13267
13268       ENDDO
13269
13270 !LPB[17]
13271       DO j = j_start, j_end
13272
13273       DO k = kts, ktf
13274       DO i = i_start, i_end + 1
13275          tmpzx = 0.5*( zx(i,k,j)+ zx(i,k+1,j))
13276          rdzu = 2./(1./rdzw(i,k,j) + 1./rdzw(i-1,k,j))
13277          H1(i,k,j)=-msfuy(i,j)*xkxavg(i,k,j)*(                        &
13278                     rdx*(var(i,k,j)-var(i-1,k,j)) - tmpzx*           &
13279                         (H1avg(i,k+1,j)-H1avg(i,k,j))*rdzu )
13280       ENDDO
13281       ENDDO
13282
13283       ENDDO
13284
13285 !LPB[18]
13286       DO j = j_start, j_end + 1
13287
13288       DO k = kts, ktf
13289       DO i = i_start, i_end
13290          xkxavg(i,k,j)=0.5*(xkhh(i,k,j-1)+xkhh(i,k,j))
13291       ENDDO
13292       ENDDO
13293
13294       ENDDO
13295
13296 !LPB[19]
13297       DO j = j_start, j_end + 1
13298
13299       DO k = kts+1,   ktf
13300       DO i = i_start, i_end
13301          H2avg(i,k,j)=0.5*(fnm(k)*(var(i,k  ,j-1)+var(i,k  ,j))+    &
13302                            fnp(k)*(var(i,k-1,j-1)+var(i,k-1,j)))
13303       ENDDO
13304       ENDDO
13305
13306       ENDDO
13307
13308 !LPB[20]
13309       DO j = j_start, j_end + 1
13310
13311       DO i = i_start, i_end
13312          H2avg(i,kts  ,j)=0.5*(cf1*var(i,1,j  )+cf2*var(i  ,2,j)+   &
13313                                cf3*var(i,3,j  )+cf1*var(i,1,j-1)+    &
13314                                cf2*var(i,2,j-1)+cf3*var(i,3,j-1))
13315          H2avg(i,ktf+1,j)=0.5*(var(i,ktes1,j)+(var(i,ktes1,j)-   &
13316                                var(i,ktes2,j))*0.5*dnw(ktes1)/dn(ktes1)+   &
13317                                var(i,ktes1,j-1)+(var(i,ktes1,j-1)-   &
13318                                var(i,ktes2,j-1))*0.5*dnw(ktes1)/dn(ktes1))
13319       ENDDO
13320
13321       ENDDO
13322
13323 !LPB[21]
13324       DO j = j_start, j_end + 1
13325
13326       DO k = kts, ktf
13327       DO i = i_start, i_end
13328          tmpzy = 0.5*( zy(i,k,j)+ zy(i,k+1,j))
13329          rdzv = 2./(1./rdzw(i,k,j) + 1./rdzw(i,k,j-1))
13330          H2(i,k,j)=-msfvy(i,j)*xkxavg(i,k,j)*(                         &
13331                     rdy*(var(i,k,j)-var(i,k,j-1)) - tmpzy*            &
13332                         (H2avg(i ,k+1,j)-H2avg(i,k,j))*rdzv)
13333       ENDDO
13334       ENDDO
13335
13336       ENDDO
13337
13338 ! Added by Ning Pan, 2010-08-10
13339        DO j = j_start, j_end
13340        DO k = kts, ktf+1
13341        DO i = i_start, i_end+1
13342        Keep_Lpb22_H1avg(i,k,j) =H1avg(i,k,j)
13343        END DO
13344        END DO
13345        END DO
13346        DO j = j_start, j_end+1
13347        DO k = kts, ktf+1
13348        DO i = i_start, i_end
13349        Keep_Lpb22_H2avg(i,k,j) =H2avg(i,k,j)
13350        END DO
13351        END DO
13352        END DO
13353
13354 !LPB[22]
13355       DO j = j_start, j_end
13356
13357 ! Remarked by Ning Pan, 2010-08-10
13358 !       DO k=kts+1, min(kte,kde-1)
13359 !       DO i=its, min(ite,ide-1)
13360 !       Keep_Lpb22_H1avg(i,k,j) =H1avg(i,k,j)
13361 !       END DO
13362 !       END DO
13363 !       DO k=kts+1, min(kte,kde-1)
13364 !       DO i=its, min(ite,ide-1)
13365 !       Keep_Lpb22_H2avg(i,k,j) =H2avg(i,k,j)
13366 !       END DO
13367 !       END DO
13368 !       Keep_Lpb22_tmpzx(j) =tmpzx
13369 !       Keep_Lpb22_tmpzy(j) =tmpzy
13370
13371       DO k = kts+1, ktf
13372       DO i = i_start, i_end
13373          H1avg(i,k,j)=0.5*(fnm(k)*(H1(i+1,k  ,j)+H1(i,k  ,j))+    &
13374                            fnp(k)*(H1(i+1,k-1,j)+H1(i,k-1,j)))
13375          H2avg(i,k,j)=0.5*(fnm(k)*(H2(i,k  ,j+1)+H2(i,k  ,j))+    &
13376                            fnp(k)*(H2(i,k-1,j+1)+H2(i,k-1,j)))
13377          tmpzx = 0.5*( zx(i,k,j)+ zx(i+1,k,j  ))
13378          tmpzy = 0.5*( zy(i,k,j)+ zy(i  ,k,j+1))
13379          H1avg(i,k,j)=H1avg(i,k,j)*tmpzx
13380          H2avg(i,k,j)=H2avg(i,k,j)*tmpzy
13381       ENDDO
13382       ENDDO
13383
13384       ENDDO
13385
13386 !LPB[23]
13387       DO j = j_start, j_end
13388
13389       DO i = i_start, i_end
13390          H1avg(i,kts  ,j)=0.
13391          H1avg(i,ktf+1,j)=0.
13392          H2avg(i,kts  ,j)=0.
13393          H2avg(i,ktf+1,j)=0.
13394       ENDDO
13395
13396       ENDDO
13397
13398 !!LPB[24]
13399 !      DO j = j_start, j_end
13400
13401 !      DO k = kts,ktf
13402 !      DO i = i_start, i_end
13403 !         mrdx=msftx(i,j)*rdx
13404 !         mrdy=msfty(i,j)*rdy
13405 !         tendency(i,k,j)=tendency(i,k,j)-                        &
13406 !              (mrdx*0.5*((mu(i+1,j)+mu(i,j))*H1(i+1,k,j)-        &
13407 !                         (mu(i-1,j)+mu(i,j))*H1(i  ,k,j))+       &
13408 !               mrdy*0.5*((mu(i,j+1)+mu(i,j))*H2(i,k,j+1)-        &
13409 !                         (mu(i,j-1)+mu(i,j))*H2(i,k,j  ))-       &
13410 !              msfty(i,j)*mu(i,j)*(H1avg(i,k+1,j)-H1avg(i,k,j)+   &
13411 !                          H2avg(i,k+1,j)-H2avg(i,k,j)            &
13412 !                                   )*rdzw(i,k,j)                 &
13413 !                                                             )
13414 !      ENDDO
13415 !      ENDDO
13416
13417 !      ENDDO
13418
13419 !!LPB[25]
13420
13421 !!LPB[26]
13422 !   IF ( doing_tke ) THEN
13423
13424 !         DO j = j_start, j_end
13425 !         DO k = kts,ktf
13426 !         DO i = i_start, i_end
13427 !             tendency(i,k,j)=tmptendf(i,k,j)+2.*   &
13428 !                             (tendency(i,k,j)-tmptendf(i,k,j))
13429 !         ENDDO
13430 !         ENDDO
13431 !         ENDDO
13432
13433 !   ENDIF
13434
13435 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
13436
13437    Do K2_ADJ =jts-1, jte+1
13438    Do K1_ADJ =kts, kte
13439    Do K0_ADJ =its-1, ite+1
13440    a_H1avg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
13441    End Do
13442    End Do
13443    End Do
13444
13445    Do K2_ADJ =jts-1, jte+1
13446    Do K1_ADJ =kts, kte
13447    Do K0_ADJ =its-1, ite+1
13448    a_H2avg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
13449    End Do
13450    End Do
13451    End Do
13452
13453    Do K2_ADJ =jts-1, jte+1
13454    Do K1_ADJ =kts, kte
13455    Do K0_ADJ =its-1, ite+1
13456    a_H1(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
13457    End Do
13458    End Do
13459    End Do
13460
13461    Do K2_ADJ =jts-1, jte+1
13462    Do K1_ADJ =kts, kte
13463    Do K0_ADJ =its-1, ite+1
13464    a_H2(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
13465    End Do
13466    End Do
13467    End Do
13468
13469    Do K2_ADJ =jts-1, jte+1
13470    Do K1_ADJ =kts, kte
13471    Do K0_ADJ =its-1, ite+1
13472    a_xkxavg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
13473    End Do
13474    End Do
13475    End Do
13476
13477    Do K2_ADJ =jts, jte
13478    Do K1_ADJ =kts, kte
13479    Do K0_ADJ =its, ite
13480    a_tmptendf(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
13481    End Do
13482    End Do
13483    End Do
13484
13485 ! Remarked by Ning Pan, 2010-08-10
13486 !   a_mrdx =0.0
13487 !   a_mrdy =0.0
13488 !   a_rcoup =0.0
13489    a_tmpzx =0.0
13490    a_tmpzy =0.0
13491 !   a_tmpzeta_z =0.0  ! Remarked by Ning Pan, 2010-08-10
13492    a_rdzu =0.0
13493    a_rdzv =0.0
13494
13495 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
13496
13497 !LPB[26]
13498
13499 !  IF( doing_tke ) THEN
13500 !  DO j =j_start, j_end
13501 !  DO k =kts, ktf
13502 !  DO i =i_start, i_end
13503 !  Tmpv001 =tendency(i,k,j) -tmptendf(i,k,j)
13504 !  Tmpv002 =2.*Tmpv001
13505 !  Tmpv003 =tmptendf(i,k,j) +Tmpv002
13506 !  tendency(i,k,j) =Tmpv003
13507
13508 !  ENDDO
13509 !  ENDDO
13510 !  ENDDO
13511 !  ENDIF
13512
13513    IF( doing_tke ) THEN
13514
13515    DO j =j_end, j_start, -1
13516    DO k =ktf, kts, -1
13517    DO i =i_end, i_start, -1
13518    a_Tmpv3 =a_tendency(i,k,j)
13519    a_tendency(i,k,j) =0.0
13520    a_tmptendf(i,k,j) =a_tmptendf(i,k,j) +a_Tmpv3
13521    a_Tmpv2 =a_Tmpv3
13522    a_Tmpv1 =2.*a_Tmpv2
13523    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv1
13524    a_tmptendf(i,k,j) =a_tmptendf(i,k,j) -a_Tmpv1
13525    ENDDO
13526    ENDDO
13527    ENDDO
13528
13529    ENDIF
13530
13531 !LPB[25]
13532
13533 !LPB[24]
13534    DO j =j_end, j_start, -1
13535
13536    DO k =kts, ktf
13537    DO i =i_start, i_end
13538 ! Revised by Ning Pan, 2010-08-10
13539 !   Tmpv300(i,k) =mrdx
13540 !   mrdx =msftx(i,j)*rdx
13541    mrdx =msftx(i,j)*rdx
13542    Tmpv300(i,k) =mrdx
13543
13544 ! Revised by Ning Pan, 2010-08-10
13545 !   Tmpv301(i,k) =mrdy
13546 !   mrdy =msfty(i,j)*rdy
13547    mrdy =msfty(i,j)*rdy
13548    Tmpv301(i,k) =mrdy
13549
13550    Tmpv001 =mu(i+1,j) +mu(i,j)
13551    Tmpv302(i,k) =Tmpv001
13552    Tmpv002 =Tmpv302(i,k)*H1(i+1,k,j)
13553    Tmpv003 =mu(i-1,j) +mu(i,j)
13554    Tmpv303(i,k) =Tmpv003
13555    Tmpv004 =Tmpv303(i,k)*H1(i,k,j)
13556    Tmpv005 =Tmpv002 -Tmpv004
13557    Tmpv304(i,k) =Tmpv005
13558    Tmpv006 =mrdx*0.5*Tmpv304(i,k)
13559    Tmpv007 =mu(i,j+1) +mu(i,j)
13560    Tmpv305(i,k) =Tmpv007
13561    Tmpv008 =Tmpv305(i,k)*H2(i,k,j+1)
13562    Tmpv009 =mu(i,j-1) +mu(i,j)
13563    Tmpv306(i,k) =Tmpv009
13564    Tmpv010 =Tmpv306(i,k)*H2(i,k,j)
13565    Tmpv011 =Tmpv008 -Tmpv010
13566    Tmpv307(i,k) =Tmpv011
13567    Tmpv012 =mrdy*0.5*Tmpv307(i,k)
13568    Tmpv013 =Tmpv006 +Tmpv012
13569    Tmpv014 =H1avg(i,k+1,j) -H1avg(i,k,j)
13570    Tmpv015 =Tmpv014 +H2avg(i,k+1,j)
13571    Tmpv016 =Tmpv015 -H2avg(i,k,j)
13572    Tmpv308(i,k) =Tmpv016
13573    Tmpv017 =msfty(i,j)*mu(i,j)*Tmpv308(i,k)
13574    Tmpv309(i,k) =Tmpv017
13575 ! Remarked by Ning Pan, 2010-08-10
13576 !   Tmpv018 =Tmpv309(i,k)*rdzw(i,k,j)
13577 !   Tmpv019 =Tmpv013 -Tmpv018
13578 !   Tmpv020 =tendency(i,k,j) -Tmpv019
13579 !   tendency(i,k,j) =Tmpv020
13580
13581    ENDDO
13582    ENDDO
13583
13584    DO k =ktf, kts, -1
13585    DO i =i_end, i_start, -1
13586    mrdx =Tmpv300(i,k)  ! Added by Ning Pan, 2010-08-10
13587    mrdy =Tmpv301(i,k)  ! Added by Ning Pan, 2010-08-10
13588    a_Tmpv20 =a_tendency(i,k,j)
13589    a_tendency(i,k,j) =0.0
13590    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv20
13591    a_Tmpv19 =-a_Tmpv20
13592    a_Tmpv13 =a_Tmpv19
13593    a_Tmpv18 =-a_Tmpv19
13594    a_Tmpv17 =rdzw(i,k,j)*a_Tmpv18
13595    a_rdzw(i,k,j) =a_rdzw(i,k,j) +Tmpv309(i,k)*a_Tmpv18
13596    a_mu(i,j) =a_mu(i,j) +msfty(i,j)*Tmpv308(i,k)*a_Tmpv17
13597    a_Tmpv16 =msfty(i,j)*mu(i,j)*a_Tmpv17
13598    a_Tmpv15 =a_Tmpv16
13599    a_H2avg(i,k,j) =a_H2avg(i,k,j) -a_Tmpv16
13600    a_Tmpv14 =a_Tmpv15
13601    a_H2avg(i,k+1,j) =a_H2avg(i,k+1,j) +a_Tmpv15
13602    a_H1avg(i,k+1,j) =a_H1avg(i,k+1,j) +a_Tmpv14
13603    a_H1avg(i,k,j) =a_H1avg(i,k,j) -a_Tmpv14
13604    a_Tmpv6 =a_Tmpv13
13605    a_Tmpv12 =a_Tmpv13
13606    a_mrdy =a_mrdy +0.5*Tmpv307(i,k)*a_Tmpv12
13607    a_Tmpv11 =mrdy*0.5*a_Tmpv12
13608    a_Tmpv8 =a_Tmpv11
13609    a_Tmpv10 =-a_Tmpv11
13610    a_Tmpv9 =H2(i,k,j)*a_Tmpv10
13611    a_H2(i,k,j) =a_H2(i,k,j) +Tmpv306(i,k)*a_Tmpv10
13612    a_mu(i,j-1) =a_mu(i,j-1) +a_Tmpv9
13613    a_mu(i,j) =a_mu(i,j) +a_Tmpv9
13614    a_Tmpv7 =H2(i,k,j+1)*a_Tmpv8
13615    a_H2(i,k,j+1) =a_H2(i,k,j+1) +Tmpv305(i,k)*a_Tmpv8
13616    a_mu(i,j+1) =a_mu(i,j+1) +a_Tmpv7
13617    a_mu(i,j) =a_mu(i,j) +a_Tmpv7
13618    a_mrdx =a_mrdx +0.5*Tmpv304(i,k)*a_Tmpv6
13619    a_Tmpv5 =mrdx*0.5*a_Tmpv6
13620    a_Tmpv2 =a_Tmpv5
13621    a_Tmpv4 =-a_Tmpv5
13622    a_Tmpv3 =H1(i,k,j)*a_Tmpv4
13623    a_H1(i,k,j) =a_H1(i,k,j) +Tmpv303(i,k)*a_Tmpv4
13624    a_mu(i-1,j) =a_mu(i-1,j) +a_Tmpv3
13625    a_mu(i,j) =a_mu(i,j) +a_Tmpv3
13626    a_Tmpv1 =H1(i+1,k,j)*a_Tmpv2
13627    a_H1(i+1,k,j) =a_H1(i+1,k,j) +Tmpv302(i,k)*a_Tmpv2
13628    a_mu(i+1,j) =a_mu(i+1,j) +a_Tmpv1
13629    a_mu(i,j) =a_mu(i,j) +a_Tmpv1
13630
13631 ! Remarked by Ning Pan, 2010-08-10
13632 !   mrdy =Tmpv301(i,k)
13633
13634 !   a_mrdy =0.0
13635
13636 !   mrdx =Tmpv300(i,k)
13637
13638 !   a_mrdx =0.0
13639    ENDDO
13640    ENDDO
13641
13642    ENDDO
13643
13644 !LPB[23]
13645    DO j =j_end, j_start, -1
13646
13647 !  DO i =i_start, i_end
13648 !  H1avg(i,kts,j) =0.
13649
13650 !  H1avg(i,ktf+1,j) =0.
13651
13652 !  H2avg(i,kts,j) =0.
13653
13654 !  H2avg(i,ktf+1,j) =0.
13655
13656 !  ENDDO
13657
13658    DO i =i_end, i_start, -1
13659    a_H2avg(i,ktf+1,j) =0.0
13660    a_H2avg(i,kts,j) =0.0
13661    a_H1avg(i,ktf+1,j) =0.0
13662    a_H1avg(i,kts,j) =0.0
13663    ENDDO
13664
13665    ENDDO
13666
13667 !LPB[22]
13668    DO j =j_end, j_start, -1
13669
13670 ! Remarked by Ning Pan, 2010-08-10
13671 !   DO k=kts+1, min(kte,kde-1)
13672 !   DO i=its, min(ite,ide-1)
13673 !   H1avg(i,k,j) =Keep_Lpb22_H1avg(i,k,j)
13674 !   END DO
13675 !   END DO
13676 !   DO k=kts+1, min(kte,kde-1)
13677 !   DO i=its, min(ite,ide-1)
13678 !   H2avg(i,k,j) =Keep_Lpb22_H2avg(i,k,j)
13679 !   END DO
13680 !   END DO
13681 !   tmpzx =Keep_Lpb22_tmpzx(j)
13682 !   tmpzy =Keep_Lpb22_tmpzy(j)
13683
13684    DO k =kts+1, ktf
13685    DO i =i_start, i_end
13686    Tmpv001 =H1(i+1,k,j) +H1(i,k,j)
13687    Tmpv002 =fnm(k)*Tmpv001
13688    Tmpv003 =H1(i+1,k-1,j) +H1(i,k-1,j)
13689    Tmpv004 =fnp(k)*Tmpv003
13690    Tmpv005 =Tmpv002 +Tmpv004
13691    Tmpv006 =0.5*Tmpv005
13692 ! Revised by Ning Pan, 2010-08-10
13693 !   Tmpv300(i,k) =H1avg(i,k,j)
13694 !   H1avg(i,k,j) =Tmpv006
13695    H1avg(i,k,j) =Tmpv006
13696    Tmpv300(i,k) =H1avg(i,k,j)
13697
13698    Tmpv001 =H2(i,k,j+1) +H2(i,k,j)
13699    Tmpv002 =fnm(k)*Tmpv001
13700    Tmpv003 =H2(i,k-1,j+1) +H2(i,k-1,j)
13701    Tmpv004 =fnp(k)*Tmpv003
13702    Tmpv005 =Tmpv002 +Tmpv004
13703    Tmpv006 =0.5*Tmpv005
13704 ! Revised by Ning Pan, 2010-08-10
13705 !   Tmpv301(i,k) =H2avg(i,k,j)
13706 !   H2avg(i,k,j) =Tmpv006
13707    H2avg(i,k,j) =Tmpv006
13708    Tmpv301(i,k) =H2avg(i,k,j)
13709
13710    Tmpv001 =zx(i,k,j) +zx(i+1,k,j)
13711    Tmpv002 =0.5*Tmpv001
13712 ! Revised by Ning Pan, 2010-08-10
13713 !   Tmpv302(i,k) =tmpzx
13714 !   tmpzx =Tmpv002
13715    tmpzx =Tmpv002
13716    Tmpv302(i,k) =tmpzx
13717
13718    Tmpv001 =zy(i,k,j) +zy(i,k,j+1)
13719    Tmpv002 =0.5*Tmpv001
13720 ! Revised by Ning Pan, 2010-08-10
13721 !   Tmpv303(i,k) =tmpzy
13722 !   tmpzy =Tmpv002
13723    tmpzy =Tmpv002
13724    Tmpv303(i,k) =tmpzy
13725
13726 ! Remarked by Ning Pan, 2010-08-10
13727 !   Tmpv001 =H1avg(i,k,j)*tmpzx
13728 !   Tmpv304(i,k) =H1avg(i,k,j)
13729 !   H1avg(i,k,j) =Tmpv001
13730
13731 ! Remarked by Ning Pan, 2010-08-10
13732 !   Tmpv001 =H2avg(i,k,j)*tmpzy
13733 !   Tmpv305(i,k) =H2avg(i,k,j)
13734 !   H2avg(i,k,j) =Tmpv001
13735
13736    ENDDO
13737    ENDDO
13738
13739    DO k =ktf, kts+1, -1
13740    DO i =i_end, i_start, -1
13741
13742    tmpzy =Tmpv303(i,k)  ! Added by Ning Pan, 2010-08-10
13743 ! Revised by Ning Pan, 2010-08-10
13744 !   H2avg(i,k,j) =Tmpv305(i,k)
13745    H2avg(i,k,j) =Tmpv301(i,k)
13746
13747    a_Tmpv1 =a_H2avg(i,k,j)
13748    a_H2avg(i,k,j) =0.0
13749    a_H2avg(i,k,j) =a_H2avg(i,k,j) +tmpzy*a_Tmpv1
13750    a_tmpzy =a_tmpzy +H2avg(i,k,j)*a_Tmpv1
13751
13752    tmpzx =Tmpv302(i,k)  ! Added by Ning Pan, 2010-08-10
13753 ! Revised by Ning Pan, 2010-08-10
13754 !   H1avg(i,k,j) =Tmpv304(i,k)
13755    H1avg(i,k,j) =Tmpv300(i,k)
13756
13757    a_Tmpv1 =a_H1avg(i,k,j)
13758    a_H1avg(i,k,j) =0.0
13759    a_H1avg(i,k,j) =a_H1avg(i,k,j) +tmpzx*a_Tmpv1
13760    a_tmpzx =a_tmpzx +H1avg(i,k,j)*a_Tmpv1
13761
13762 !   tmpzy =Tmpv303(i,k)  ! Remarked by Ning Pan, 2010-08-10
13763
13764    a_Tmpv2 =a_tmpzy
13765    a_tmpzy =0.0
13766    a_Tmpv1 =0.5*a_Tmpv2
13767    a_zy(i,k,j) =a_zy(i,k,j) +a_Tmpv1
13768    a_zy(i,k,j+1) =a_zy(i,k,j+1) +a_Tmpv1
13769
13770 !   tmpzx =Tmpv302(i,k)  ! Remarked by Ning Pan, 2010-08-10
13771
13772    a_Tmpv2 =a_tmpzx
13773    a_tmpzx =0.0
13774    a_Tmpv1 =0.5*a_Tmpv2
13775    a_zx(i,k,j) =a_zx(i,k,j) +a_Tmpv1
13776    a_zx(i+1,k,j) =a_zx(i+1,k,j) +a_Tmpv1
13777
13778 !   H2avg(i,k,j) =Tmpv301(i,k)  ! Remarked by Ning Pan, 2010-08-10
13779
13780    a_Tmpv6 =a_H2avg(i,k,j)
13781    a_H2avg(i,k,j) =0.0
13782    a_Tmpv5 =0.5*a_Tmpv6
13783    a_Tmpv2 =a_Tmpv5
13784    a_Tmpv4 =a_Tmpv5
13785    a_Tmpv3 =fnp(k)*a_Tmpv4
13786    a_H2(i,k-1,j+1) =a_H2(i,k-1,j+1) +a_Tmpv3
13787    a_H2(i,k-1,j) =a_H2(i,k-1,j) +a_Tmpv3
13788    a_Tmpv1 =fnm(k)*a_Tmpv2
13789    a_H2(i,k,j+1) =a_H2(i,k,j+1) +a_Tmpv1
13790    a_H2(i,k,j) =a_H2(i,k,j) +a_Tmpv1
13791
13792 !   H1avg(i,k,j) =Tmpv300(i,k)  ! Remarked by Ning Pan, 2010-08-10
13793
13794    a_Tmpv6 =a_H1avg(i,k,j)
13795    a_H1avg(i,k,j) =0.0
13796    a_Tmpv5 =0.5*a_Tmpv6
13797    a_Tmpv2 =a_Tmpv5
13798    a_Tmpv4 =a_Tmpv5
13799    a_Tmpv3 =fnp(k)*a_Tmpv4
13800    a_H1(i+1,k-1,j) =a_H1(i+1,k-1,j) +a_Tmpv3
13801    a_H1(i,k-1,j) =a_H1(i,k-1,j) +a_Tmpv3
13802    a_Tmpv1 =fnm(k)*a_Tmpv2
13803    a_H1(i+1,k,j) =a_H1(i+1,k,j) +a_Tmpv1
13804    a_H1(i,k,j) =a_H1(i,k,j) +a_Tmpv1
13805    ENDDO
13806    ENDDO
13807
13808    ENDDO
13809
13810 ! Added by Ning Pan, 2010-08-10
13811    DO j = j_start, j_end+1
13812    DO k = kts, ktf+1
13813    DO i = i_start, i_end
13814    H2avg(i,k,j) = Keep_Lpb22_H2avg(i,k,j)
13815    END DO
13816    END DO
13817    END DO
13818
13819 !LPB[21]
13820    DO j =j_end+1, j_start, -1
13821
13822    DO k =kts, ktf
13823    DO i =i_start, i_end
13824    Tmpv001 =zy(i,k,j) +zy(i,k+1,j)
13825    Tmpv002 =0.5*Tmpv001
13826 ! Revised by Ning Pan, 2010-08-10
13827 !   Tmpv300(i,k) =tmpzy
13828 !   tmpzy =Tmpv002
13829    tmpzy =Tmpv002
13830    Tmpv300(i,k) =tmpzy
13831
13832    Tmpv001 =1./rdzw(i,k,j) +1./rdzw(i,k,j-1)
13833    Tmpv3010(i,k) =Tmpv001  ! Added by Ning Pan, 2010-08-10
13834    Tmpv002 =2./Tmpv001
13835 ! Revised by Ning Pan, 2010-08-10
13836 !   Tmpv301(i,k) =rdzv
13837 !   rdzv =Tmpv002
13838    rdzv =Tmpv002
13839    Tmpv301(i,k) =rdzv
13840
13841    Tmpv001 =var(i,k,j) -var(i,k,j-1)
13842    Tmpv002 =rdy*Tmpv001
13843    Tmpv003 =H2avg(i,k+1,j) -H2avg(i,k,j)
13844    Tmpv302(i,k) =Tmpv003
13845    Tmpv004 =tmpzy*Tmpv302(i,k)
13846    Tmpv303(i,k) =Tmpv004
13847    Tmpv005 =Tmpv303(i,k)*rdzv
13848    Tmpv006 =Tmpv002 -Tmpv005
13849    Tmpv304(i,k) =Tmpv006
13850 ! Remarked by Ning Pan, 2010-08-10
13851 !   Tmpv007 =-msfvy(i,j)*xkxavg(i,k,j)*Tmpv304(i,k)
13852 !   H2(i,k,j) =Tmpv007
13853
13854    ENDDO
13855    ENDDO
13856
13857    DO k =ktf, kts, -1
13858    DO i =i_end, i_start, -1
13859 ! Added by Ning Pan, 2010-08-10
13860    xkxavg(i,k,j)=0.5*(xkhh(i,k,j-1)+xkhh(i,k,j))
13861    tmpzy =Tmpv300(i,k)
13862    rdzv =Tmpv301(i,k)
13863
13864    a_Tmpv7 =a_H2(i,k,j)
13865    a_H2(i,k,j) =0.0
13866    a_xkxavg(i,k,j) =a_xkxavg(i,k,j) -msfvy(i,j)*Tmpv304(i,k)*a_Tmpv7
13867    a_Tmpv6 =-msfvy(i,j)*xkxavg(i,k,j)*a_Tmpv7
13868    a_Tmpv2 =a_Tmpv6
13869    a_Tmpv5 =-a_Tmpv6
13870    a_Tmpv4 =rdzv*a_Tmpv5
13871    a_rdzv =a_rdzv +Tmpv303(i,k)*a_Tmpv5
13872    a_tmpzy =a_tmpzy +Tmpv302(i,k)*a_Tmpv4
13873    a_Tmpv3 =tmpzy*a_Tmpv4
13874    a_H2avg(i,k+1,j) =a_H2avg(i,k+1,j) +a_Tmpv3
13875    a_H2avg(i,k,j) =a_H2avg(i,k,j) -a_Tmpv3
13876    a_Tmpv1 =rdy*a_Tmpv2
13877    a_var(i,k,j) =a_var(i,k,j) +a_Tmpv1
13878    a_var(i,k,j-1) =a_var(i,k,j-1) -a_Tmpv1
13879
13880 !   rdzv =Tmpv301(i,k)  ! Remarked by Ning Pan, 2010-08-10
13881
13882    a_Tmpv2 =a_rdzv
13883    a_rdzv =0.0
13884 ! Revised by Ning Pan, 2010-08-10
13885 !   a_Tmpv1 =-(2.)*a_Tmpv2/(Tmpv001*Tmpv001)
13886    a_Tmpv1 =-(2.)*a_Tmpv2/(Tmpv3010(i,k)*Tmpv3010(i,k))
13887    a_rdzw(i,k,j) =a_rdzw(i,k,j) -1./(rdzw(i,k,j)*rdzw(i,k,j))*a_Tmpv1
13888    a_rdzw(i,k,j-1) =a_rdzw(i,k,j-1) -1./(rdzw(i,k,j-1)*rdzw(i,k,j-1))*a_Tmpv1
13889
13890 !   tmpzy =Tmpv300(i,k)  ! Remarked by Ning Pan, 2010-08-10
13891
13892    a_Tmpv2 =a_tmpzy
13893    a_tmpzy =0.0
13894    a_Tmpv1 =0.5*a_Tmpv2
13895    a_zy(i,k,j) =a_zy(i,k,j) +a_Tmpv1
13896    a_zy(i,k+1,j) =a_zy(i,k+1,j) +a_Tmpv1
13897    ENDDO
13898    ENDDO
13899
13900    ENDDO
13901
13902 !LPB[20]
13903    DO j =j_end+1, j_start, -1
13904
13905 !  DO i =i_start, i_end
13906 !  Tmpv001 =cf1*var(i,1,j) +cf2*var(i,2,j)
13907 !  Tmpv002 =Tmpv001 +cf3*var(i,3,j)
13908 !  Tmpv003 =Tmpv002 +cf1*var(i,1,j-1)
13909 !  Tmpv004 =Tmpv003 +cf2*var(i,2,j-1)
13910 !  Tmpv005 =Tmpv004 +cf3*var(i,3,j-1)
13911 !  Tmpv006 =0.5*Tmpv005
13912 !  H2avg(i,kts,j) =Tmpv006
13913
13914 !  Tmpv001 =var(i,ktes1,j) -var(i,ktes2,j)
13915 !  Tmpv002 =Tmpv001*0.5
13916 !  Tmpv003 =Tmpv002*dnw(ktes1)
13917 !  Tmpv004 =Tmpv003/dn(ktes1)
13918 !  Tmpv005 =var(i,ktes1,j) +Tmpv004
13919 !  Tmpv006 =Tmpv005 +var(i,ktes1,j-1)
13920 !  Tmpv007 =var(i,ktes1,j-1) -var(i,ktes2,j-1)
13921 !  Tmpv008 =Tmpv007*0.5
13922 !  Tmpv009 =Tmpv008*dnw(ktes1)
13923 !  Tmpv010 =Tmpv009/dn(ktes1)
13924 !  Tmpv011 =Tmpv006 +Tmpv010
13925 !  Tmpv012 =0.5*Tmpv011
13926 !  H2avg(i,ktf+1,j) =Tmpv012
13927
13928 !  ENDDO
13929
13930    DO i =i_end, i_start, -1
13931    a_Tmpv12 =a_H2avg(i,ktf+1,j)
13932    a_H2avg(i,ktf+1,j) =0.0
13933    a_Tmpv11 =0.5*a_Tmpv12
13934    a_Tmpv6 =a_Tmpv11
13935    a_Tmpv10 =a_Tmpv11
13936    a_Tmpv9 =a_Tmpv10/dn(ktes1)
13937    a_Tmpv8 =dnw(ktes1)*a_Tmpv9
13938    a_Tmpv7 =0.5*a_Tmpv8
13939    a_var(i,ktes1,j-1) =a_var(i,ktes1,j-1) +a_Tmpv7
13940    a_var(i,ktes2,j-1) =a_var(i,ktes2,j-1) -a_Tmpv7
13941    a_Tmpv5 =a_Tmpv6
13942    a_var(i,ktes1,j-1) =a_var(i,ktes1,j-1) +a_Tmpv6
13943    a_var(i,ktes1,j) =a_var(i,ktes1,j) +a_Tmpv5
13944    a_Tmpv4 =a_Tmpv5
13945    a_Tmpv3 =a_Tmpv4/dn(ktes1)
13946    a_Tmpv2 =dnw(ktes1)*a_Tmpv3
13947    a_Tmpv1 =0.5*a_Tmpv2
13948    a_var(i,ktes1,j) =a_var(i,ktes1,j) +a_Tmpv1
13949    a_var(i,ktes2,j) =a_var(i,ktes2,j) -a_Tmpv1
13950    a_Tmpv6 =a_H2avg(i,kts,j)
13951    a_H2avg(i,kts,j) =0.0
13952    a_Tmpv5 =0.5*a_Tmpv6
13953    a_Tmpv4 =a_Tmpv5
13954    a_var(i,3,j-1) =a_var(i,3,j-1) +cf3*a_Tmpv5
13955    a_Tmpv3 =a_Tmpv4
13956    a_var(i,2,j-1) =a_var(i,2,j-1) +cf2*a_Tmpv4
13957    a_Tmpv2 =a_Tmpv3
13958    a_var(i,1,j-1) =a_var(i,1,j-1) +cf1*a_Tmpv3
13959    a_Tmpv1 =a_Tmpv2
13960    a_var(i,3,j) =a_var(i,3,j) +cf3*a_Tmpv2
13961    a_var(i,1,j) =a_var(i,1,j) +cf1*a_Tmpv1
13962    a_var(i,2,j) =a_var(i,2,j) +cf2*a_Tmpv1
13963    ENDDO
13964
13965    ENDDO
13966
13967 !LPB[19]
13968    DO j =j_end+1, j_start, -1
13969
13970 !  DO k =kts+1, ktf
13971 !  DO i =i_start, i_end
13972 !  Tmpv001 =var(i,k,j-1) +var(i,k,j)
13973 !  Tmpv002 =fnm(k)*Tmpv001
13974 !  Tmpv003 =var(i,k-1,j-1) +var(i,k-1,j)
13975 !  Tmpv004 =fnp(k)*Tmpv003
13976 !  Tmpv005 =Tmpv002 +Tmpv004
13977 !  Tmpv006 =0.5*Tmpv005
13978 !  H2avg(i,k,j) =Tmpv006
13979
13980 !  ENDDO
13981 !  ENDDO
13982
13983    DO k =ktf, kts+1, -1
13984    DO i =i_end, i_start, -1
13985    a_Tmpv6 =a_H2avg(i,k,j)
13986    a_H2avg(i,k,j) =0.0
13987    a_Tmpv5 =0.5*a_Tmpv6
13988    a_Tmpv2 =a_Tmpv5
13989    a_Tmpv4 =a_Tmpv5
13990    a_Tmpv3 =fnp(k)*a_Tmpv4
13991    a_var(i,k-1,j-1) =a_var(i,k-1,j-1) +a_Tmpv3
13992    a_var(i,k-1,j) =a_var(i,k-1,j) +a_Tmpv3
13993    a_Tmpv1 =fnm(k)*a_Tmpv2
13994    a_var(i,k,j-1) =a_var(i,k,j-1) +a_Tmpv1
13995    a_var(i,k,j) =a_var(i,k,j) +a_Tmpv1
13996    ENDDO
13997    ENDDO
13998
13999    ENDDO
14000
14001 !LPB[18]
14002    DO j =j_end+1, j_start, -1
14003
14004 !  DO k =kts, ktf
14005 !  DO i =i_start, i_end
14006 !  Tmpv001 =xkhh(i,k,j-1) +xkhh(i,k,j)
14007 !  Tmpv002 =0.5*Tmpv001
14008 !  xkxavg(i,k,j) =Tmpv002
14009
14010 !  ENDDO
14011 !  ENDDO
14012
14013    DO k =ktf, kts, -1
14014    DO i =i_end, i_start, -1
14015    a_Tmpv2 =a_xkxavg(i,k,j)
14016    a_xkxavg(i,k,j) =0.0
14017    a_Tmpv1 =0.5*a_Tmpv2
14018    a_xkhh(i,k,j-1) =a_xkhh(i,k,j-1) +a_Tmpv1
14019    a_xkhh(i,k,j) =a_xkhh(i,k,j) +a_Tmpv1
14020    ENDDO
14021    ENDDO
14022
14023    ENDDO
14024
14025 ! Added by Ning Pan, 2010-08-10
14026    DO j = j_start, j_end
14027    DO k = kts, ktf+1
14028    DO i = i_start, i_end+1
14029    H1avg(i,k,j) = Keep_Lpb22_H1avg(i,k,j)
14030    END DO
14031    END DO
14032    END DO
14033
14034 !LPB[17]
14035    DO j =j_end, j_start, -1
14036
14037    DO k =kts, ktf
14038    DO i =i_start, i_end+1
14039    Tmpv001 =zx(i,k,j) +zx(i,k+1,j)
14040    Tmpv002 =0.5*Tmpv001
14041 ! Revised by Ning Pan, 2010-08-10
14042 !   Tmpv300(i,k) =tmpzx
14043 !   tmpzx =Tmpv002
14044    tmpzx =Tmpv002
14045    Tmpv300(i,k) =tmpzx
14046
14047    Tmpv001 =1./rdzw(i,k,j) +1./rdzw(i-1,k,j)
14048    Tmpv3010(i,k) =Tmpv001  ! Added by Ning Pan, 2010-08-10
14049    Tmpv002 =2./Tmpv001
14050 ! Revised by Ning Pan, 2010-08-10
14051 !   Tmpv301(i,k) =rdzu
14052 !   rdzu =Tmpv002
14053    rdzu =Tmpv002
14054    Tmpv301(i,k) =rdzu
14055
14056    Tmpv001 =var(i,k,j) -var(i-1,k,j)
14057    Tmpv002 =rdx*Tmpv001
14058    Tmpv003 =H1avg(i,k+1,j) -H1avg(i,k,j)
14059    Tmpv302(i,k) =Tmpv003
14060    Tmpv004 =tmpzx*Tmpv302(i,k)
14061    Tmpv303(i,k) =Tmpv004
14062    Tmpv005 =Tmpv303(i,k)*rdzu
14063    Tmpv006 =Tmpv002 -Tmpv005
14064    Tmpv304(i,k) =Tmpv006
14065 ! Remarked by Ning Pan, 2010-08-10
14066 !   Tmpv007 =-msfuy(i,j)*xkxavg(i,k,j)*Tmpv304(i,k)
14067 !   H1(i,k,j) =Tmpv007
14068
14069    ENDDO
14070    ENDDO
14071
14072    DO k =ktf, kts, -1
14073    DO i =i_end+1, i_start, -1
14074 ! Added by Ning Pan, 2010-08-10
14075    xkxavg(i,k,j)=0.5*(xkhh(i-1,k,j)+xkhh(i,k,j))
14076    tmpzx =Tmpv300(i,k)
14077    rdzu =Tmpv301(i,k)
14078
14079    a_Tmpv7 =a_H1(i,k,j)
14080    a_H1(i,k,j) =0.0
14081    a_xkxavg(i,k,j) =a_xkxavg(i,k,j) -msfuy(i,j)*Tmpv304(i,k)*a_Tmpv7
14082    a_Tmpv6 =-msfuy(i,j)*xkxavg(i,k,j)*a_Tmpv7
14083    a_Tmpv2 =a_Tmpv6
14084    a_Tmpv5 =-a_Tmpv6
14085    a_Tmpv4 =rdzu*a_Tmpv5
14086    a_rdzu =a_rdzu +Tmpv303(i,k)*a_Tmpv5
14087    a_tmpzx =a_tmpzx +Tmpv302(i,k)*a_Tmpv4
14088    a_Tmpv3 =tmpzx*a_Tmpv4
14089    a_H1avg(i,k+1,j) =a_H1avg(i,k+1,j) +a_Tmpv3
14090    a_H1avg(i,k,j) =a_H1avg(i,k,j) -a_Tmpv3
14091    a_Tmpv1 =rdx*a_Tmpv2
14092    a_var(i,k,j) =a_var(i,k,j) +a_Tmpv1
14093    a_var(i-1,k,j) =a_var(i-1,k,j) -a_Tmpv1
14094
14095 !   rdzu =Tmpv301(i,k)  ! Remarked by Ning Pan, 2010-08-10
14096
14097    a_Tmpv2 =a_rdzu
14098    a_rdzu =0.0
14099 ! Revised by Ning Pan, 2010-08-10
14100 !   a_Tmpv1 =-(2.)*a_Tmpv2/(Tmpv001*Tmpv001)
14101    a_Tmpv1 =-(2.)*a_Tmpv2/(Tmpv3010(i,k)*Tmpv3010(i,k))
14102    a_rdzw(i,k,j) =a_rdzw(i,k,j) -1./(rdzw(i,k,j)*rdzw(i,k,j))*a_Tmpv1
14103    a_rdzw(i-1,k,j) =a_rdzw(i-1,k,j) -1./(rdzw(i-1,k,j)*rdzw(i-1,k,j))*a_Tmpv1
14104
14105 !   tmpzx =Tmpv300(i,k)  ! Remarked by Ning Pan, 2010-08-10
14106
14107    a_Tmpv2 =a_tmpzx
14108    a_tmpzx =0.0
14109    a_Tmpv1 =0.5*a_Tmpv2
14110    a_zx(i,k,j) =a_zx(i,k,j) +a_Tmpv1
14111    a_zx(i,k+1,j) =a_zx(i,k+1,j) +a_Tmpv1
14112    ENDDO
14113    ENDDO
14114
14115    ENDDO
14116
14117 !LPB[16]
14118    DO j =j_end, j_start, -1
14119
14120 !  DO i =i_start, i_end+1
14121 !  Tmpv001 =cf1*var(i,1,j) +cf2*var(i,2,j)
14122 !  Tmpv002 =Tmpv001 +cf3*var(i,3,j)
14123 !  Tmpv003 =Tmpv002 +cf1*var(i-1,1,j)
14124 !  Tmpv004 =Tmpv003 +cf2*var(i-1,2,j)
14125 !  Tmpv005 =Tmpv004 +cf3*var(i-1,3,j)
14126 !  Tmpv006 =0.5*Tmpv005
14127 !  H1avg(i,kts,j) =Tmpv006
14128
14129 !  Tmpv001 =var(i,ktes1,j) -var(i,ktes2,j)
14130 !  Tmpv002 =Tmpv001*0.5
14131 !  Tmpv003 =Tmpv002*dnw(ktes1)
14132 !  Tmpv004 =Tmpv003/dn(ktes1)
14133 !  Tmpv005 =var(i,ktes1,j) +Tmpv004
14134 !  Tmpv006 =Tmpv005 +var(i-1,ktes1,j)
14135 !  Tmpv007 =var(i-1,ktes1,j) -var(i-1,ktes2,j)
14136 !  Tmpv008 =Tmpv007*0.5
14137 !  Tmpv009 =Tmpv008*dnw(ktes1)
14138 !  Tmpv010 =Tmpv009/dn(ktes1)
14139 !  Tmpv011 =Tmpv006 +Tmpv010
14140 !  Tmpv012 =0.5*Tmpv011
14141 !  H1avg(i,ktf+1,j) =Tmpv012
14142
14143 !  ENDDO
14144
14145    DO i =i_end+1, i_start, -1
14146    a_Tmpv12 =a_H1avg(i,ktf+1,j)
14147    a_H1avg(i,ktf+1,j) =0.0
14148    a_Tmpv11 =0.5*a_Tmpv12
14149    a_Tmpv6 =a_Tmpv11
14150    a_Tmpv10 =a_Tmpv11
14151    a_Tmpv9 =a_Tmpv10/dn(ktes1)
14152    a_Tmpv8 =dnw(ktes1)*a_Tmpv9
14153    a_Tmpv7 =0.5*a_Tmpv8
14154    a_var(i-1,ktes1,j) =a_var(i-1,ktes1,j) +a_Tmpv7
14155    a_var(i-1,ktes2,j) =a_var(i-1,ktes2,j) -a_Tmpv7
14156    a_Tmpv5 =a_Tmpv6
14157    a_var(i-1,ktes1,j) =a_var(i-1,ktes1,j) +a_Tmpv6
14158    a_var(i,ktes1,j) =a_var(i,ktes1,j) +a_Tmpv5
14159    a_Tmpv4 =a_Tmpv5
14160    a_Tmpv3 =a_Tmpv4/dn(ktes1)
14161    a_Tmpv2 =dnw(ktes1)*a_Tmpv3
14162    a_Tmpv1 =0.5*a_Tmpv2
14163    a_var(i,ktes1,j) =a_var(i,ktes1,j) +a_Tmpv1
14164    a_var(i,ktes2,j) =a_var(i,ktes2,j) -a_Tmpv1
14165    a_Tmpv6 =a_H1avg(i,kts,j)
14166    a_H1avg(i,kts,j) =0.0
14167    a_Tmpv5 =0.5*a_Tmpv6
14168    a_Tmpv4 =a_Tmpv5
14169    a_var(i-1,3,j) =a_var(i-1,3,j) +cf3*a_Tmpv5
14170    a_Tmpv3 =a_Tmpv4
14171    a_var(i-1,2,j) =a_var(i-1,2,j) +cf2*a_Tmpv4
14172    a_Tmpv2 =a_Tmpv3
14173    a_var(i-1,1,j) =a_var(i-1,1,j) +cf1*a_Tmpv3
14174    a_Tmpv1 =a_Tmpv2
14175    a_var(i,3,j) =a_var(i,3,j) +cf3*a_Tmpv2
14176    a_var(i,1,j) =a_var(i,1,j) +cf1*a_Tmpv1
14177    a_var(i,2,j) =a_var(i,2,j) +cf2*a_Tmpv1
14178    ENDDO
14179
14180    ENDDO
14181
14182 !LPB[15]
14183    DO j =j_end, j_start, -1
14184
14185 !  DO k =kts+1, ktf
14186 !  DO i =i_start, i_end+1
14187 !  Tmpv001 =var(i-1,k,j) +var(i,k,j)
14188 !  Tmpv002 =fnm(k)*Tmpv001
14189 !  Tmpv003 =var(i-1,k-1,j) +var(i,k-1,j)
14190 !  Tmpv004 =fnp(k)*Tmpv003
14191 !  Tmpv005 =Tmpv002 +Tmpv004
14192 !  Tmpv006 =0.5*Tmpv005
14193 !  H1avg(i,k,j) =Tmpv006
14194
14195 !  ENDDO
14196 !  ENDDO
14197
14198    DO k =ktf, kts+1, -1
14199    DO i =i_end+1, i_start, -1
14200    a_Tmpv6 =a_H1avg(i,k,j)
14201    a_H1avg(i,k,j) =0.0
14202    a_Tmpv5 =0.5*a_Tmpv6
14203    a_Tmpv2 =a_Tmpv5
14204    a_Tmpv4 =a_Tmpv5
14205    a_Tmpv3 =fnp(k)*a_Tmpv4
14206    a_var(i-1,k-1,j) =a_var(i-1,k-1,j) +a_Tmpv3
14207    a_var(i,k-1,j) =a_var(i,k-1,j) +a_Tmpv3
14208    a_Tmpv1 =fnm(k)*a_Tmpv2
14209    a_var(i-1,k,j) =a_var(i-1,k,j) +a_Tmpv1
14210    a_var(i,k,j) =a_var(i,k,j) +a_Tmpv1
14211    ENDDO
14212    ENDDO
14213
14214    ENDDO
14215
14216 !LPB[14]
14217    DO j =j_end, j_start, -1
14218
14219 !  DO k =kts, ktf
14220 !  DO i =i_start, i_end+1
14221 !  Tmpv001 =xkhh(i-1,k,j) +xkhh(i,k,j)
14222 !  Tmpv002 =0.5*Tmpv001
14223 !  xkxavg(i,k,j) =Tmpv002
14224
14225 !  ENDDO
14226 !  ENDDO
14227
14228    DO k =ktf, kts, -1
14229    DO i =i_end+1, i_start, -1
14230    a_Tmpv2 =a_xkxavg(i,k,j)
14231    a_xkxavg(i,k,j) =0.0
14232    a_Tmpv1 =0.5*a_Tmpv2
14233    a_xkhh(i-1,k,j) =a_xkhh(i-1,k,j) +a_Tmpv1
14234    a_xkhh(i,k,j) =a_xkhh(i,k,j) +a_Tmpv1
14235    ENDDO
14236    ENDDO
14237
14238    ENDDO
14239
14240 !LPB[13]
14241
14242 !  IF( doing_tke ) THEN
14243 !  DO j =j_start, j_end
14244 !  DO k =kts, ktf
14245 !  DO i =i_start, i_end
14246 !  tmptendf(i,k,j) =tendency(i,k,j)
14247
14248 !  ENDDO
14249 !  ENDDO
14250 !  ENDDO
14251 !  ENDIF
14252
14253    IF( doing_tke ) THEN
14254
14255    DO j =j_end, j_start, -1
14256    DO k =ktf, kts, -1
14257    DO i =i_end, i_start, -1
14258    a_tendency(i,k,j) =a_tendency(i,k,j) +a_tmptendf(i,k,j)
14259    a_tmptendf(i,k,j) =0.0
14260    ENDDO
14261    ENDDO
14262    ENDDO
14263
14264    ENDIF
14265
14266 !LPB[12]
14267
14268 !LPB[11]
14269
14270 !  IF( config_flags%periodic_x ) THEN
14271 !  i_end =min(ite, ide-1)
14272 !  END IF
14273
14274 !  IF( config_flags%periodic_x ) THEN
14275
14276 !  END IF
14277
14278 !LPB[10]
14279
14280 !LPB[9]
14281
14282 !  IF( config_flags%periodic_x ) THEN
14283 !  i_start =its
14284 !  END IF
14285
14286 !  IF( config_flags%periodic_x ) THEN
14287
14288 !  END IF
14289
14290 !LPB[8]
14291
14292 !LPB[7]
14293
14294 !  IF( config_flags%open_ye .or. config_flags%specified .or.            config_flags%nested) THEN
14295 !  j_end =min(jde-2, jte)
14296 !  END IF
14297
14298 !  IF( config_flags%open_ye .or. config_flags%specified .or.   &
14299 !           config_flags%nested) THEN
14300
14301 !  END IF
14302
14303 !LPB[6]
14304
14305 !LPB[5]
14306
14307 !  IF( config_flags%open_ys .or. config_flags%specified .or.            config_flags%nested) THEN
14308 !  j_start =max(jds+1, jts)
14309 !  END IF
14310
14311 !  IF( config_flags%open_ys .or. config_flags%specified .or.   &
14312 !           config_flags%nested) THEN
14313
14314 !  END IF
14315
14316 !LPB[4]
14317
14318 !LPB[3]
14319
14320 !  IF( config_flags%open_xe .or. config_flags%specified .or.            config_flags%nested) THEN
14321 !  i_end =min(ide-2, ite)
14322 !  END IF
14323
14324 !  IF( config_flags%open_xe .or. config_flags%specified .or.   &
14325 !           config_flags%nested) THEN
14326
14327 !  END IF
14328
14329 !LPB[2]
14330
14331 !LPB[1]
14332
14333 !  IF( config_flags%open_xs .or. config_flags%specified .or.            config_flags%nested) THEN
14334 !  i_start =max(ids+1, its)
14335 !  END IF
14336
14337 !  IF( config_flags%open_xs .or. config_flags%specified .or.   &
14338 !           config_flags%nested) THEN
14339
14340 !  END IF
14341
14342 !LPB[0]
14343 !  ktf =min(kte, kde-1)
14344 !  ktes1 =kte-1
14345 !  ktes2 =kte-2
14346 !  i_start =its
14347 !  i_end =min(ite, ide-1)
14348 !  j_start =jts
14349 !  j_end =min(jte, jde-1)
14350
14351    END SUBROUTINE a_horizontal_diffusion_s
14352
14353    SUBROUTINE a_vertical_diffusion_2(ru_tendf,a_ru_tendf,rv_tendf,a_rv_tendf, &
14354    rw_tendf,a_rw_tendf,rt_tendf,a_rt_tendf,tke_tendf,a_tke_tendf,moist_tendf, &
14355 ! Revised by Ning Pan, 2010-08-10
14356 !   a_moist_tendf,n_moist,chem_tendf,a_chem_tendf,n_chem,scalar_tendf,a_scalar_tend &
14357 !   f,n_scalar,tracer_tendf,a_tracer_tendf,n_tracer,u_2,a_u_2,v_2,a_v_2,thp, &
14358    a_moist_tendf,n_moist,chem_tendf,a_chem_tendf,n_chem,scalar_tendf,a_scalar_tend&
14359    &f,n_scalar,tracer_tendf,a_tracer_tendf,n_tracer,u_2,a_u_2,v_2,a_v_2,thp, &
14360    a_thp,u_base,v_base,t_base,qv_base,mu,a_mu,tke,a_tke,config_flags,defor13, &
14361    a_defor13,defor23,a_defor23,defor33,a_defor33,nba_mij,a_nba_mij,n_nba_mij, &
14362    div,a_div,moist,a_moist,chem,a_chem,scalar,a_scalar,tracer,a_tracer,xkmv, &
14363    a_xkmv,xkhv,a_xkhv,km_opt,fnm,fnp,dn,dnw,rdz,a_rdz,rdzw,a_rdzw,hfx,a_hfx, &
14364    qfx,a_qfx,ust,a_ust,rho,a_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, &
14365    its,ite,jts,jte,kts,kte)
14366
14367 !PART I: DECLARATION OF VARIABLES
14368
14369    IMPLICIT NONE
14370
14371    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
14372    TYPE(grid_config_rec_type) :: config_flags
14373    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
14374    INTEGER :: n_moist,n_chem,n_scalar,n_tracer,km_opt
14375    REAL,DIMENSION(kms:kme) :: fnm
14376    REAL,DIMENSION(kms:kme) :: fnp
14377    REAL,DIMENSION(kms:kme) :: dnw
14378    REAL,DIMENSION(kms:kme) :: dn
14379    REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
14380    REAL,DIMENSION(kms:kme) :: qv_base
14381    REAL,DIMENSION(kms:kme) :: u_base
14382    REAL,DIMENSION(kms:kme) :: v_base
14383    REAL,DIMENSION(kms:kme) :: t_base
14384    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: ru_tendf,a_ru_tendf,rv_tendf, &
14385    a_rv_tendf,rw_tendf,a_rw_tendf,tke_tendf,a_tke_tendf,rt_tendf,a_rt_tendf
14386    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist_tendf,a_moist_tendf
14387    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_chem) :: chem_tendf,a_chem_tendf
14388    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_scalar) :: scalar_tendf,a_scalar_tendf
14389    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_tracer) :: tracer_tendf,a_tracer_tendf
14390    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist) :: moist,a_moist
14391    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_chem) :: chem,a_chem
14392    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_scalar) :: scalar,a_scalar
14393    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_tracer) :: tracer,a_tracer
14394    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor13,a_defor13,defor23,a_defor23, &
14395    defor33,a_defor33,div,a_div,xkmv,a_xkmv,xkhv,a_xkhv,tke,a_tke,rdz,a_rdz, &
14396    u_2,a_u_2,v_2,a_v_2,rdzw,a_rdzw
14397    INTEGER :: n_nba_mij
14398    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: nba_mij,a_nba_mij
14399    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rho,a_rho
14400    REAL,DIMENSION(ims:ime,jms:jme) :: hfx,a_hfx,qfx,a_qfx
14401    REAL,DIMENSION(ims:ime,jms:jme) :: ust,a_ust
14402    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: thp,a_thp
14403    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: var_mix,a_var_mix
14404    INTEGER :: im,i,j,k
14405    INTEGER :: i_start,i_end,j_start,j_end
14406    REAL :: V0_u,a_V0_u,V0_v,a_V0_v,tao_xz,a_tao_xz,tao_yz,a_tao_yz,ustar, &
14407    a_ustar,cd0,a_cd0
14408    REAL :: xsfc,a_xsfc,psi1,a_psi1,vk2,a_vk2,zrough,a_zrough,lnz,a_lnz
14409    REAL :: heat_flux,a_heat_flux,moist_flux,a_moist_flux,heat_flux0,a_heat_flux0
14410    REAL :: cpm,a_cpm
14411
14412 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: Keep_Lpb12_nba_mij
14413 ! Remarked by Ning Pan, 2010-08-11
14414 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb0_ru_tendf
14415    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: Keep_Lpb0_nba_mij
14416    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: Keep_Lpb1_nba_mij
14417 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb0_rv_tendf
14418 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb0_rw_tendf
14419 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb4_rt_tendf
14420 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme,ims:ime,kms:kme,jms:jme) :: Keep_Lpb7_tke_tendf
14421 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb9_var_mix
14422 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_moist,ims:ime,kms:kme,jms:jme,n_moist) &
14423 !    :: Keep_Lpb9_moist_tendf
14424 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_chem,ims:ime,kms:kme,jms:jme,n_chem) &
14425 !    :: Keep_Lpb11_chem_tendf
14426 !   REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_tracer,ims:ime,kms:kme,jms:jme,n_tracer) &
14427 !    :: Keep_Lpb13_tracer_tendf
14428 !!  REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_scalar,ims:ime,kms:kme,jms:jme,n_scalar) &
14429 !!    :: Keep_Lpb15_scalar_tendf
14430    INTEGER :: IX1,IX2,IX3,IX4
14431
14432    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
14433    a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006,a_Tmpv7,Tmpv007,a_Tmpv8,Tmpv008
14434
14435    REAL :: Tmpv_1
14436    REAL,DIMENSION(PARAM_FIRST_SCALAR:max0(n_moist,n_chem,n_tracer,n_scalar)) :: Tmpv200
14437    REAL,DIMENSION(its:max0(ite,min(ite,ide-1)),jts:min(jte,jde-1)) :: Tmpv300
14438    REAL,DIMENSION(its:max0(ite,min(ite,ide-1)),jts:min(jte,jde-1)) :: Tmpv301
14439    REAL,DIMENSION(its:max0(ite,min(ite,ide-1)),jts:min(jte,jde-1)) :: Tmpv302
14440    REAL,DIMENSION(its:max0(ite,min(ite,ide-1)),jts:min(jte,jde-1)) :: Tmpv303
14441    REAL,DIMENSION(its:max0(ite,min(ite,ide-1)),jts:min(jte,jde-1)) :: Tmpv304
14442    REAL,DIMENSION(its:ite,jts:min(jte,jde-1)) :: Tmpv305
14443    REAL,DIMENSION(its:ite,jts:min(jte,jde-1)) :: Tmpv306
14444    REAL,DIMENSION(its:ite,jts:min(jte,jde-1)) :: Tmpv307
14445    REAL,DIMENSION(its:ite,jts:min(jte,jde-1)) :: Tmpv308
14446    REAL,DIMENSION(its:ite,jts:min(jte,jde-1)) :: Tmpv309
14447    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3010
14448    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3011
14449    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3012
14450    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3013
14451    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3014
14452    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3015
14453    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3016
14454    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3017
14455    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3018
14456    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3019
14457    REAL,DIMENSION(its:ite,jts:min(jte,jde-1)) :: Tmpv3020
14458    REAL,DIMENSION(its:ite,jts:min(jte,jde-1)) :: Tmpv3021
14459    REAL,DIMENSION(its:ite,jts:min(jte,jde-1)) :: Tmpv3022
14460    REAL,DIMENSION(its:ite,jts:min(jte,jde-1)) :: Tmpv3023
14461    REAL,DIMENSION(its:ite,jts:min(jte,jde-1)) :: Tmpv3024
14462    REAL,DIMENSION(its:ite,jts:min(jte,jde-1)) :: Tmpv3025
14463    REAL,DIMENSION(its:ite,jts:min(jte,jde-1)) :: Tmpv3026
14464    REAL,DIMENSION(its:ite,jts:min(jte,jde-1)) :: Tmpv3027
14465    REAL,DIMENSION(its:ite,jts:min(jte,jde-1)) :: Tmpv3028
14466    REAL,DIMENSION(its:ite,jts:min(jte,jde-1)) :: Tmpv3029
14467    REAL,DIMENSION(its:ite,jts:min(jte,jde-1)) :: Tmpv3030
14468    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3031
14469    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3032
14470    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3033
14471    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3034
14472    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3035
14473    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3036
14474    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3037
14475    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3038
14476    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3039
14477    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3040
14478    REAL,DIMENSION(its:min(ite,ide-1),jts:jte) :: Tmpv3041
14479    REAL,DIMENSION(min0(jms,its):max0(jme,min(ite,ide-1)),min0(kms,jts):max0(kme,min(jte, &
14480    jde-1)),min0(ims,PARAM_FIRST_SCALAR):max0(ime,n_moist)) :: Tmpv400
14481    REAL,DIMENSION(min0(jms,its):max0(jme,min(ite,ide-1)),min0(kms,jts):max0(kme,min(jte, &
14482    jde-1)),min0(ims,PARAM_FIRST_SCALAR):max0(ime,n_moist)) :: Tmpv401
14483    REAL,DIMENSION(min0(jms,its):max0(jme,min(ite,ide-1)),min0(kms,jts):max0(kme,min(jte, &
14484    jde-1)),min0(ims,PARAM_FIRST_SCALAR):max0(ime,n_moist)) :: Tmpv402
14485    REAL,DIMENSION(its:min(ite,ide-1),jts:min(jte,jde-1),PARAM_FIRST_SCALAR:n_moist) :: Tmpv403
14486    REAL,DIMENSION(min0(1,its):max0(n_nba_mij,min(ite, ide-1)),min0(jms,kts) &
14487    :max0(jme,kte-1),min0(kms,jts):max0(kme,min(jte, jde-1)),min0(ims,PARAM_FIRST_SCALAR) &
14488    :max0(ime,n_moist)) :: Tmpv500
14489    REAL,DIMENSION(min0(1,its):max0(n_nba_mij,min(ite, ide-1)),min0(jms,kts) &
14490    :max0(jme,kte-1),min0(kms,jts):max0(kme,min(jte, jde-1)),min0(ims,PARAM_FIRST_SCALAR) &
14491    :max0(ime,n_moist)) :: Tmpv501
14492    REAL,DIMENSION(n_nba_mij,jms:jme,kms:kme,ims:ime) :: Tmpv502
14493
14494    REAL :: g_Sqrt
14495
14496 !PART II: CALCULATIONS OF B. S. TRAJECTORY
14497
14498 !LPB[0]
14499 ! Remarked by Ning Pan, 2010-08-10
14500 !   DO IX3=jms,jme
14501 !   DO IX2=kms,kme
14502 !   DO IX1=ims,ime
14503 !       Keep_Lpb0_ru_tendf(IX1,IX2,IX3) =ru_tendf(IX1,IX2,IX3)
14504 !   END DO
14505 !   END DO
14506 !   END DO
14507 !   DO IX4=1,n_nba_mij
14508 !   DO IX3=jms,jme
14509 !   DO IX2=kms,kme
14510 !   DO IX1=ims,ime
14511 !       Keep_Lpb0_nba_mij(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
14512 !   END DO
14513 !   END DO
14514 !   END DO
14515 !   END DO
14516 !   DO IX3=jms,jme
14517 !   DO IX2=kms,kme
14518 !   DO IX1=ims,ime
14519 !       Keep_Lpb0_rv_tendf(IX1,IX2,IX3) =rv_tendf(IX1,IX2,IX3)
14520 !   END DO
14521 !   END DO
14522 !   END DO
14523 !   DO IX3=jms,jme
14524 !   DO IX2=kms,kme
14525 !   DO IX1=ims,ime
14526 !       Keep_Lpb0_rw_tendf(IX1,IX2,IX3) =rw_tendf(IX1,IX2,IX3)
14527 !   END DO
14528 !   END DO
14529 !   END DO
14530
14531       i_start = its
14532       i_end   = MIN(ite,ide-1)
14533       j_start = jts
14534       j_end   = MIN(jte,jde-1)
14535 !! Remarked by Ning Pan, 2010-08-10: r3997-r4319
14536 !         CALL vertical_diffusion_u_2( ru_tendf, config_flags, mu,      &
14537 !                                      defor13, xkmv,                   &
14538 !                                      nba_mij, n_nba_mij,               &
14539 !                                      dnw, rdzw, fnm, fnp,             &
14540 !                                      ids, ide, jds, jde, kds, kde,    &
14541 !                                      ims, ime, jms, jme, kms, kme,    &
14542 !                                      its, ite, jts, jte, kts, kte  )
14543 !         CALL vertical_diffusion_v_2( rv_tendf, config_flags, mu,      &
14544 !                                      defor23, xkmv,                   &
14545 !                                      nba_mij, n_nba_mij,               &
14546 !                                      dnw, rdzw, fnm, fnp,             &
14547 !                                      ids, ide, jds, jde, kds, kde,    &
14548 !                                      ims, ime, jms, jme, kms, kme,    &
14549 !                                      its, ite, jts, jte, kts, kte  )
14550 !         CALL vertical_diffusion_w_2( rw_tendf, config_flags, mu,      &
14551 !                                      defor33, tke(ims,kms,jms),       &
14552 !                                      nba_mij, n_nba_mij,               &
14553 !                                      div, xkmv,                       &
14554 !                                      dn, rdz,                           &
14555 !                                      ids, ide, jds, jde, kds, kde,    &
14556 !                                      ims, ime, jms, jme, kms, kme,    &
14557 !                                      its, ite, jts, jte, kts, kte  )
14558
14559 !LPB[1]
14560 !  vflux: SELECT CASE( config_flags%isfflx )
14561
14562 !     CASE (0)
14563 !       cd0 = config_flags%tke_drag_coefficient
14564
14565 !       DO j = j_start, j_end
14566 !       DO i = i_start, ite
14567 !          V0_u=0.
14568 !          tao_xz=0.
14569 !          V0_u=    sqrt((u_2(i,kts,j)**2) +           &
14570 !                           (((v_2(i  ,kts,j  )+            &
14571 !                              v_2(i  ,kts,j+1)+            &
14572 !                              v_2(i-1,kts,j  )+            &
14573 !                              v_2(i-1,kts,j+1))/4)**2))+epsilon
14574 !          tao_xz=cd0*V0_u*u_2(i,kts,j)
14575 !          ru_tendf(i,kts,j)=ru_tendf(i,kts,j)              &
14576 !                            -0.25*(mu(i,j)+mu(i-1,j))*tao_xz*(rdzw(i,kts,j)+rdzw(i-1,kts,j))
14577 !       ENDDO
14578 !       ENDDO
14579
14580 !       DO j = j_start, jte
14581 !       DO i = i_start, i_end
14582 !          V0_v=0.
14583 !          tao_yz=0.
14584 !          V0_v=    sqrt((v_2(i,kts,j)**2) +           &
14585 !                           (((u_2(i  ,kts,j  )+            &
14586 !                              u_2(i  ,kts,j-1)+            &
14587 !                              u_2(i+1,kts,j  )+            &
14588 !                              u_2(i+1,kts,j-1))/4)**2))+epsilon
14589 !          tao_yz=cd0*V0_v*v_2(i,kts,j)
14590 !          rv_tendf(i,kts,j)=rv_tendf(i,kts,j)              &
14591 !                            -0.25*(mu(i,j)+mu(i,j-1))*tao_yz*(rdzw(i,kts,j)+rdzw(i,kts,j-1))
14592 !       ENDDO
14593 !       ENDDO
14594 !     CASE (1,2)
14595
14596 !       DO j = j_start, j_end
14597 !       DO i = i_start, ite
14598 !          V0_u=0.
14599 !          tao_xz=0.
14600 !          V0_u=    sqrt((u_2(i,kts,j)**2) +           &
14601 !                           (((v_2(i  ,kts,j  )+            &
14602 !                              v_2(i  ,kts,j+1)+            &
14603 !                              v_2(i-1,kts,j  )+            &
14604 !                              v_2(i-1,kts,j+1))/4)**2))+epsilon
14605 !          ustar=0.5*(ust(i,j)+ust(i-1,j))
14606 !          tao_xz=ustar*ustar*u_2(i,kts,j)/V0_u
14607 !          ru_tendf(i,kts,j)=ru_tendf(i,kts,j)              &
14608 !                            -0.25*(mu(i,j)+mu(i-1,j))*tao_xz*(rdzw(i,kts,j)+rdzw(i-1,kts,j))
14609 !       ENDDO
14610 !       ENDDO
14611
14612 !       DO j = j_start, jte
14613 !       DO i = i_start, i_end
14614 !          V0_v=0.
14615 !          tao_yz=0.
14616 !          V0_v=    sqrt((v_2(i,kts,j)**2) +           &
14617 !                           (((u_2(i  ,kts,j  )+            &
14618 !                              u_2(i  ,kts,j-1)+            &
14619 !                              u_2(i+1,kts,j  )+            &
14620 !                              u_2(i+1,kts,j-1))/4)**2))+epsilon
14621 !          ustar=0.5*(ust(i,j)+ust(i,j-1))
14622 !          tao_yz=ustar*ustar*v_2(i,kts,j)/V0_v
14623 !          rv_tendf(i,kts,j)=rv_tendf(i,kts,j)              &
14624 !                            -0.25*(mu(i,j)+mu(i,j-1))*tao_yz*(rdzw(i,kts,j)+rdzw(i,kts,j-1))
14625 !       ENDDO
14626 !       ENDDO
14627 !     CASE DEFAULT
14628 !       CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' )
14629
14630 !   END SELECT vflux
14631
14632 !LPB[2]
14633
14634 !LPB[3]
14635 !   IF ( config_flags%mix_full_fields ) THEN
14636
14637 !        DO j=jts,min(jte,jde-1)
14638 !        DO k=kts,kte-1
14639 !        DO i=its,min(ite,ide-1)
14640 !          var_mix(i,k,j) = thp(i,k,j)
14641 !        ENDDO
14642 !        ENDDO
14643 !        ENDDO
14644 !      ELSE
14645
14646 !        DO j=jts,min(jte,jde-1)
14647 !        DO k=kts,kte-1
14648 !        DO i=its,min(ite,ide-1)
14649 !          var_mix(i,k,j) = thp(i,k,j) - t_base(k)
14650 !        ENDDO
14651 !        ENDDO
14652 !        ENDDO
14653
14654 !   END IF
14655
14656 !LPB[4]
14657 !   DO IX3=jms,jme
14658 !   DO IX2=kms,kme
14659 !   DO IX1=ims,ime
14660 !       Keep_Lpb4_rt_tendf(IX1,IX2,IX3) =rt_tendf(IX1,IX2,IX3)
14661 !   END DO
14662 !   END DO
14663 !   END DO
14664
14665 !      CALL vertical_diffusion_s( rt_tendf, config_flags, var_mix, mu, xkhv,   &
14666 !                                 dn, dnw, rdz, rdzw, fnm, fnp,            &
14667 !                                 .false.,                                 &
14668 !                                 ids, ide, jds, jde, kds, kde,            &
14669 !                                 ims, ime, jms, jme, kms, kme,            &
14670 !                                 its, ite, jts, jte, kts, kte          )
14671
14672 !LPB[5]
14673 !  hflux: SELECT CASE( config_flags%isfflx )
14674
14675 !     CASE (0,2)
14676 !       heat_flux = config_flags%tke_heat_flux
14677
14678 !       DO j = j_start, j_end
14679 !       DO i = i_start, i_end
14680 !          cpm = cp * (1. + 0.8 * moist(i,kts,j,P_QV))
14681 !          hfx(i,j)=heat_flux*cp*rho(i,1,j)         ! provided for output only
14682 !          rt_tendf(i,kts,j)=rt_tendf(i,kts,j)    &
14683 !               +mu(i,j)*heat_flux*rdzw(i,kts,j)
14684 !       ENDDO
14685 !       ENDDO
14686 !     CASE (1)
14687
14688 !       DO j = j_start, j_end
14689 !       DO i = i_start, i_end
14690 !          cpm = cp * (1. + 0.8 * moist(i,kts,j,P_QV))
14691 !          heat_flux = hfx(i,j)/cpm/rho(i,1,j)
14692 !          rt_tendf(i,kts,j)=rt_tendf(i,kts,j)    &
14693 !               +mu(i,j)*heat_flux*rdzw(i,kts,j)
14694 !       ENDDO
14695 !       ENDDO
14696 !     CASE DEFAULT
14697 !       CALL wrf_error_fatal( 'isfflx value invalid for iff_opt=2' )
14698
14699 !   END SELECT hflux
14700
14701 !LPB[6]
14702
14703 !LPB[7]
14704 !   DO IX3=jms,jme
14705 !   DO IX2=kms,kme
14706 !   DO IX1=ims,ime
14707 !       Keep_Lpb7_tke_tendf(IX1,IX2,IX3) =tke_tendf(IX1,IX2,IX3)
14708 !   END DO
14709 !   END DO
14710 !   END DO
14711
14712 !   If (km_opt .eq. 2) then
14713
14714 !      CALL vertical_diffusion_s( tke_tendf(ims,kms,jms),                 &
14715 !                                 config_flags, tke(ims,kms,jms),         &
14716 !                                 mu, xkhv,                               &
14717 !                                 dn, dnw, rdz, rdzw, fnm, fnp,           &
14718 !                                 .true.,                                 &
14719 !                                 ids, ide, jds, jde, kds, kde,           &
14720 !                                 ims, ime, jms, jme, kms, kme,           &
14721 !                                 its, ite, jts, jte, kts, kte         )
14722
14723 !   endif
14724
14725 !LPB[8]
14726
14727 !LPB[9]
14728 !   DO IX3=jms,jme
14729 !   DO IX2=kms,kme
14730 !   DO IX1=ims,ime
14731 !       Keep_Lpb9_var_mix(IX1,IX2,IX3) =var_mix(IX1,IX2,IX3)
14732 !   END DO
14733 !   END DO
14734 !   END DO
14735 !   DO IX4=1,n_moist
14736 !   DO IX3=jms,jme
14737 !   DO IX2=kms,kme
14738 !   DO IX1=ims,ime
14739 !       Keep_Lpb9_moist_tendf(IX1,IX2,IX3,IX4) =moist_tendf(IX1,IX2,IX3,IX4)
14740 !   END DO
14741 !   END DO
14742 !   END DO
14743 !   END DO
14744 !   DO IX4=1,n_moist
14745 !   DO IX3=jms,jme
14746 !   DO IX2=kms,kme
14747 !   DO IX1=ims,ime
14748 !       Keep_Lpb9_moist_tendf(IX1,IX2,IX3,IX4) =moist_tendf(IX1,IX2,IX3,IX4)
14749 !   END DO
14750 !   END DO
14751 !   END DO
14752 !   END DO
14753
14754 !   IF (n_moist .ge. PARAM_FIRST_SCALAR) THEN
14755
14756 !        moist_loop: do im = PARAM_FIRST_SCALAR, n_moist
14757 !       IF ( (.not. config_flags%mix_full_fields) .and. (im == P_QV) ) THEN
14758
14759 !            DO j=jts,min(jte,jde-1)
14760 !            DO k=kts,kte-1
14761 !            DO i=its,min(ite,ide-1)
14762 !             var_mix(i,k,j) = moist(i,k,j,im) - qv_base(k)
14763 !            ENDDO
14764 !            ENDDO
14765 !            ENDDO
14766 !          ELSE
14767
14768 !            DO j=jts,min(jte,jde-1)
14769 !            DO k=kts,kte-1
14770 !            DO i=its,min(ite,ide-1)
14771 !             var_mix(i,k,j) = moist(i,k,j,im)
14772 !            ENDDO
14773 !            ENDDO
14774 !            ENDDO
14775 !          END IF
14776 !             CALL vertical_diffusion_s( moist_tendf(ims,kms,jms,im),           &
14777 !                                        config_flags, var_mix,                 &
14778 !                                        mu, xkhv,                              &
14779 !                                        dn, dnw, rdz, rdzw, fnm, fnp,          &
14780 !                                        .false.,                               &
14781 !                                        ids, ide, jds, jde, kds, kde,          &
14782 !                                        ims, ime, jms, jme, kms, kme,          &
14783 !                                        its, ite, jts, jte, kts, kte        )
14784 !  qflux: SELECT CASE( config_flags%isfflx )
14785
14786 !     CASE (0)
14787 !     CASE (1,2)
14788 !    IF ( im == P_QV ) THEN
14789
14790 !          DO j = j_start, j_end
14791 !          DO i = i_start, i_end
14792 !             moist_flux = qfx(i,j)/rho(i,1,j)/(1.+moist(i,kts,j,P_QV))
14793 !             moist_tendf(i,kts,j,im)=moist_tendf(i,kts,j,im)    &
14794 !                  +mu(i,j)*moist_flux*rdzw(i,kts,j)
14795 !          ENDDO
14796 !          ENDDO
14797 !       ENDIF
14798 !     CASE DEFAULT
14799 !       CALL wrf_error_fatal( 'isfflx value invalid for diff_opt=2' )
14800 !     END SELECT qflux
14801 !        ENDDO moist_loop
14802
14803 !   ENDIF
14804
14805 !LPB[10]
14806
14807 !LPB[11]
14808 !   DO IX4=1,n_chem
14809 !   DO IX3=jms,jme
14810 !   DO IX2=kms,kme
14811 !   DO IX1=ims,ime
14812 !       Keep_Lpb11_chem_tendf(IX1,IX2,IX3,IX4) =chem_tendf(IX1,IX2,IX3,IX4)
14813 !   END DO
14814 !   END DO
14815 !   END DO
14816 !   END DO
14817
14818 !   IF (n_chem .ge. PARAM_FIRST_SCALAR) THEN
14819
14820 !        chem_loop: do im = PARAM_FIRST_SCALAR, n_chem
14821 !             CALL vertical_diffusion_s( chem_tendf(ims,kms,jms,im),           &
14822 !                                        config_flags, chem(ims,kms,jms,im),   &
14823 !                                        mu, xkhv,                               &
14824 !                                        dn, dnw, rdz, rdzw, fnm, fnp,           &
14825 !                                        .false.,                                &
14826 !                                        ids, ide, jds, jde, kds, kde,           &
14827 !                                        ims, ime, jms, jme, kms, kme,           &
14828 !                                        its, ite, jts, jte, kts, kte         )
14829 !        ENDDO chem_loop
14830
14831 !   ENDIF
14832
14833 !LPB[12]
14834
14835 !LPB[13]
14836 !   DO IX4=1,n_tracer
14837 !   DO IX3=jms,jme
14838 !   DO IX2=kms,kme
14839 !   DO IX1=ims,ime
14840 !       Keep_Lpb13_tracer_tendf(IX1,IX2,IX3,IX4) =tracer_tendf(IX1,IX2,IX3,IX4)
14841 !   END DO
14842 !   END DO
14843 !   END DO
14844 !   END DO
14845
14846 !   IF (n_tracer .ge. PARAM_FIRST_SCALAR) THEN
14847
14848 !        tracer_loop: do im = PARAM_FIRST_SCALAR, n_tracer
14849 !             CALL vertical_diffusion_s( tracer_tendf(ims,kms,jms,im),           &
14850 !                                        config_flags, tracer(ims,kms,jms,im),   &
14851 !                                        mu, xkhv,                               &
14852 !                                        dn, dnw, rdz, rdzw, fnm, fnp,           &
14853 !                                        .false.,                                &
14854 !                                        ids, ide, jds, jde, kds, kde,           &
14855 !                                        ims, ime, jms, jme, kms, kme,           &
14856 !                                        its, ite, jts, jte, kts, kte         )
14857 !        ENDDO tracer_loop
14858
14859 !   ENDIF
14860
14861 !LPB[14]
14862
14863 !!LPB[15]
14864 !!  DO IX4=1,n_scalar
14865 !!  DO IX3=jms,jme
14866 !!  DO IX2=kms,kme
14867 !!  DO IX1=ims,ime
14868 !    !  Keep_Lpb15_scalar_tendf(IX1,IX2,IX3,IX4) =scalar_tendf(IX1,IX2,IX3,IX4)
14869 !!  END DO
14870 !!  END DO
14871 !!  END DO
14872 !!  END DO
14873
14874 !
14875 !   IF (n_scalar .ge. PARAM_FIRST_SCALAR) THEN
14876
14877 !        scalar_loop: do im = PARAM_FIRST_SCALAR, n_scalar
14878 !             CALL vertical_diffusion_s( scalar_tendf(ims,kms,jms,im),           &
14879 !                                        config_flags, scalar(ims,kms,jms,im),   &
14880 !                                        mu, xkhv,                               &
14881 !                                        dn, dnw, rdz, rdzw, fnm, fnp,           &
14882 !                                        .false.,                                &
14883 !                                        ids, ide, jds, jde, kds, kde,           &
14884 !                                        ims, ime, jms, jme, kms, kme,           &
14885 !                                        its, ite, jts, jte, kts, kte         )
14886 !        ENDDO scalar_loop
14887
14888 !   ENDIF
14889
14890 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
14891
14892    Do K2_ADJ =jms, jme
14893    Do K1_ADJ =kms, kme
14894    Do K0_ADJ =ims, ime
14895    a_var_mix(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
14896    End Do
14897    End Do
14898    End Do
14899
14900    a_V0_u =0.0
14901    a_V0_v =0.0
14902    a_tao_xz =0.0
14903    a_tao_yz =0.0
14904    a_ustar =0.0
14905 ! Remarked by Ning Pan, 2010-08-11
14906 !   a_cd0 =0.0
14907 !   a_xsfc =0.0
14908 !   a_psi1 =0.0
14909 !   a_vk2 =0.0
14910 !   a_zrough =0.0
14911 !   a_lnz =0.0
14912    a_heat_flux =0.0
14913    a_moist_flux =0.0
14914 !   a_heat_flux0 =0.0  ! Remarked by Ning Pan, 2010-08-11
14915    a_cpm =0.0
14916
14917 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
14918
14919 !LPB[15]
14920 !  DO IX4=1,n_scalar
14921 !  DO IX3=jms,jme
14922 !  DO IX2=kms,kme
14923 !  DO IX1=ims,ime
14924 !  scalar_tendf(IX1,IX2,IX3,IX4) =Keep_Lpb15_scalar_tendf(IX1,IX2,IX3,IX4)
14925 !  END DO
14926 !  END DO
14927 !  END DO
14928 !  END DO
14929
14930 !  IF(n_scalar .ge. PARAM_FIRST_SCALAR) THEN
14931 !  DO im =PARAM_FIRST_SCALAR, n_scalar
14932 !  Tmpv200(im) =scalar_tendf(ims,kms,jms,im)
14933 !  CALL vertical_diffusion_s(scalar_tendf(ims,kms,jms,im),config_flags,scalar(ims,  &
14934 !  kms,jms,im),mu,xkhv,dn,dnw,rdz,rdzw,fnm,fnp,.false.,ids,ide,jds,jde,kds,kde,ims,ime,  &
14935 !  jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
14936
14937 !  ENDDO
14938
14939 !  ENDIF
14940
14941    IF(n_scalar .ge. PARAM_FIRST_SCALAR) THEN
14942
14943    DO im =n_scalar, PARAM_FIRST_SCALAR, -1
14944
14945 !   scalar_tendf(ims,kms,jms,im) =Tmpv200(im)  ! Remarked by Ning Pan, 2010-08-11
14946
14947    CALL a_vertical_diffusion_s(scalar_tendf(ims,kms,jms,im),a_scalar_tendf(ims,  &
14948    kms,jms,im),config_flags,scalar(ims,kms,jms,im),a_scalar(ims,kms,jms,im)  &
14949 ! Revised by Ning Pan, 2010-08-10
14950 !   ,mu,a_mu,xkhv,a_xkhv,dn,dnw,rdz,a_rdz,rdzw,a_rdzw,fnm,fnp,,ids,ide,jds,jde,  &
14951    ,mu,a_mu,xkhv,a_xkhv,dn,dnw,rdz,a_rdz,rdzw,a_rdzw,fnm,fnp,rho,a_rho,.false.,ids,ide,jds,jde,  &
14952    kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
14953    ENDDO
14954
14955    ENDIF
14956
14957 !LPB[14]
14958
14959 !LPB[13]
14960 ! Remarked by Ning Pan, 2010-08-10
14961 !   DO IX4=1,n_tracer
14962 !   DO IX3=jms,jme
14963 !   DO IX2=kms,kme
14964 !   DO IX1=ims,ime
14965 !   tracer_tendf(IX1,IX2,IX3,IX4) =Keep_Lpb13_tracer_tendf(IX1,IX2,IX3,IX4)
14966 !   END DO
14967 !   END DO
14968 !   END DO
14969 !   END DO
14970
14971 !  IF(n_tracer .ge. PARAM_FIRST_SCALAR) THEN
14972 !  DO im =PARAM_FIRST_SCALAR, n_tracer
14973 !  Tmpv200(im) =tracer_tendf(ims,kms,jms,im)
14974 !  CALL vertical_diffusion_s(tracer_tendf(ims,kms,jms,im),config_flags,tracer(ims,  &
14975 !  kms,jms,im),mu,xkhv,dn,dnw,rdz,rdzw,fnm,fnp,.false.,ids,ide,jds,jde,kds,kde,ims,ime,  &
14976 !  jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
14977
14978 !  ENDDO
14979
14980 !  ENDIF
14981
14982    IF(n_tracer .ge. PARAM_FIRST_SCALAR) THEN
14983
14984    DO im =n_tracer, PARAM_FIRST_SCALAR, -1
14985
14986 !   tracer_tendf(ims,kms,jms,im) =Tmpv200(im)  ! Remarked by Ning Pan, 2010-08-11
14987
14988    CALL a_vertical_diffusion_s(tracer_tendf(ims,kms,jms,im),a_tracer_tendf(ims,  &
14989    kms,jms,im),config_flags,tracer(ims,kms,jms,im),a_tracer(ims,kms,jms,im)  &
14990 ! Revised by Ning Pan, 2010-08-10
14991 !   ,mu,a_mu,xkhv,a_xkhv,dn,dnw,rdz,a_rdz,rdzw,a_rdzw,fnm,fnp,,ids,ide,jds,jde,  &
14992    ,mu,a_mu,xkhv,a_xkhv,dn,dnw,rdz,a_rdz,rdzw,a_rdzw,fnm,fnp,rho,a_rho,.false.,ids,ide,jds,jde,  &
14993    kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
14994    ENDDO
14995
14996    ENDIF
14997
14998 !LPB[12]
14999
15000 !LPB[11]
15001 ! Remarked by Ning Pan, 2010-08-10
15002 !   DO IX4=1,n_chem
15003 !   DO IX3=jms,jme
15004 !   DO IX2=kms,kme
15005 !   DO IX1=ims,ime
15006 !   chem_tendf(IX1,IX2,IX3,IX4) =Keep_Lpb11_chem_tendf(IX1,IX2,IX3,IX4)
15007 !   END DO
15008 !   END DO
15009 !   END DO
15010 !   END DO
15011
15012 !  IF(n_chem .ge. PARAM_FIRST_SCALAR) THEN
15013 !  DO im =PARAM_FIRST_SCALAR, n_chem
15014 !  Tmpv200(im) =chem_tendf(ims,kms,jms,im)
15015 !  CALL vertical_diffusion_s(chem_tendf(ims,kms,jms,im),config_flags,chem(ims,kms,  &
15016 !  jms,im),mu,xkhv,dn,dnw,rdz,rdzw,fnm,fnp,.false.,ids,ide,jds,jde,kds,kde,ims,ime,jms,  &
15017 !  jme,kms,kme,its,ite,jts,jte,kts,kte)
15018
15019 !  ENDDO
15020
15021 !  ENDIF
15022
15023    IF(n_chem .ge. PARAM_FIRST_SCALAR) THEN
15024
15025    DO im =n_chem, PARAM_FIRST_SCALAR, -1
15026
15027 !   chem_tendf(ims,kms,jms,im) =Tmpv200(im)  ! Remarked by Ning Pan, 2010-08-11
15028
15029    CALL a_vertical_diffusion_s(chem_tendf(ims,kms,jms,im),a_chem_tendf(ims,kms,  &
15030    jms,im),config_flags,chem(ims,kms,jms,im),a_chem(ims,kms,jms,im),mu,a_mu,xkhv,  &
15031 ! Revised by Ning Pan, 2010-08-10
15032 !   a_xkhv,dn,dnw,rdz,a_rdz,rdzw,a_rdzw,fnm,fnp,,ids,ide,jds,jde,kds,kde,ims,ime,  &
15033    a_xkhv,dn,dnw,rdz,a_rdz,rdzw,a_rdzw,fnm,fnp,rho,a_rho,.false.,ids,ide,jds,jde,kds,kde,ims,ime,  &
15034    jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
15035    ENDDO
15036
15037    ENDIF
15038
15039 !LPB[10]
15040
15041 !LPB[9]
15042 ! Remarked by Ning Pan, 2010-08-10
15043 !  DO IX3=jms,jme
15044 !  DO IX2=kms,kme
15045 !  DO IX1=ims,ime
15046 !  var_mix(IX1,IX2,IX3) =Keep_Lpb9_var_mix(IX1,IX2,IX3)
15047 !  END DO
15048 !  END DO
15049 !  END DO
15050 !  DO IX4=1,n_moist
15051 !  DO IX3=jms,jme
15052 !  DO IX2=kms,kme
15053 !  DO IX1=ims,ime
15054 !  moist_tendf(IX1,IX2,IX3,IX4) =Keep_Lpb9_moist_tendf(IX1,IX2,IX3,IX4)
15055 !  END DO
15056 !  END DO
15057 !  END DO
15058 !  END DO
15059 !  DO IX4=1,n_moist
15060 !  DO IX3=jms,jme
15061 !  DO IX2=kms,kme
15062 !  DO IX1=ims,ime
15063 !  moist_tendf(IX1,IX2,IX3,IX4) =Keep_Lpb9_moist_tendf(IX1,IX2,IX3,IX4)
15064 !  END DO
15065 !  END DO
15066 !  END DO
15067 !  END DO
15068
15069    IF(n_moist .ge. PARAM_FIRST_SCALAR) THEN
15070    DO im =PARAM_FIRST_SCALAR, n_moist
15071    IF( (.not. config_flags%mix_full_fields) .and. (im == P_QV) ) THEN
15072
15073    DO j =jts, min(jte, jde-1)
15074    DO k =kts, kte-1
15075    DO i =its, min(ite, ide-1)
15076 !   Tmpv500(i,k,j,im) =var_mix(i,k,j)  ! Remarked by Ning Pan, 2010-08-11
15077    var_mix(i,k,j) =moist(i,k,j,im) -qv_base(k)
15078
15079    ENDDO
15080    ENDDO
15081    ENDDO
15082    ELSE
15083
15084    DO j =jts, min(jte, jde-1)
15085    DO k =kts, kte-1
15086    DO i =its, min(ite, ide-1)
15087 !   Tmpv501(i,k,j,im) =var_mix(i,k,j)  ! Remarked by Ning Pan, 2010-08-11
15088    var_mix(i,k,j) =moist(i,k,j,im)
15089
15090    ENDDO
15091    ENDDO
15092    ENDDO
15093    END IF
15094 ! Remarked by Ning Pan, 2010-08-10
15095 !   Tmpv200(im) =moist_tendf(ims,kms,jms,im)
15096 !   CALL vertical_diffusion_s(moist_tendf(ims,kms,jms,im),config_flags,var_mix,mu,  &
15097 !   xkhv,dn,dnw,rdz,rdzw,fnm,fnp,.false.,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
15098 !   its,ite,jts,jte,kts,kte)
15099
15100    SELECT CASE (config_flags%isfflx)
15101    CASE(0)
15102    CASE(1,2)
15103    IF( im == P_QV ) THEN
15104
15105    DO j =j_start, j_end
15106    DO i =i_start, i_end
15107    Tmpv001 =qfx(i,j)/rho(i,1,j)
15108    Tmpv400(i,j,im) =Tmpv001
15109    Tmpv002 =Tmpv400(i,j,im)/(1. +moist(i,kts,j,P_QV))
15110 ! Revised by Ning Pan, 2010-08-11
15111 !   Tmpv401(i,j,im) =moist_flux
15112 !   moist_flux =Tmpv002
15113    moist_flux =Tmpv002
15114    Tmpv401(i,j,im) =moist_flux
15115
15116    Tmpv001 =mu(i,j)*moist_flux
15117    Tmpv402(i,j,im) =Tmpv001
15118 ! Remarked by Ning Pan, 2010-08-11
15119 !   Tmpv002 =Tmpv402(i,j,im)*rdzw(i,kts,j)
15120 !   Tmpv003 =moist_tendf(i,kts,j,im) +Tmpv002
15121 !   Tmpv403(i,j,im) =moist_tendf(i,kts,j,im)
15122 !   moist_tendf(i,kts,j,im) =Tmpv003
15123
15124    ENDDO
15125    ENDDO
15126    ENDIF
15127    CASE DEFAULT
15128    CALL wrf_error_fatal('isfflx value invalid for diff_opt=2')
15129
15130 ! Revised by Ning Pan, 2010-08-10
15131 !   END SELECT qflux
15132    END SELECT
15133    ENDDO
15134
15135    ENDIF
15136
15137    IF(n_moist .ge. PARAM_FIRST_SCALAR) THEN
15138
15139    DO im =n_moist, PARAM_FIRST_SCALAR, -1
15140
15141    SELECT CASE (config_flags%isfflx)
15142
15143    CASE(0)
15144
15145    CASE(1,2)
15146
15147    IF( im == P_QV ) THEN
15148
15149    DO j =j_end, j_start, -1
15150    DO i =i_end, i_start, -1
15151
15152 !   moist_tendf(i,kts,j,im) =Tmpv403(i,j,im)  ! Remarked by Ning Pan, 2010-08-11
15153 ! Added by Ning Pan, 2010-08-11
15154    moist_flux =Tmpv401(i,j,im)
15155
15156    a_Tmpv3 =a_moist_tendf(i,kts,j,im)
15157    a_moist_tendf(i,kts,j,im) =0.0
15158    a_moist_tendf(i,kts,j,im) =a_moist_tendf(i,kts,j,im) +a_Tmpv3
15159    a_Tmpv2 =a_Tmpv3
15160    a_Tmpv1 =rdzw(i,kts,j)*a_Tmpv2
15161    a_rdzw(i,kts,j) =a_rdzw(i,kts,j) +Tmpv402(i,j,im)*a_Tmpv2
15162    a_mu(i,j) =a_mu(i,j) +moist_flux*a_Tmpv1
15163    a_moist_flux =a_moist_flux +mu(i,j)*a_Tmpv1
15164
15165 !   moist_flux =Tmpv401(i,j,im)  ! Remarked by Ning Pan, 2010-08-11
15166
15167    a_Tmpv2 =a_moist_flux
15168    a_moist_flux =0.0
15169    a_Tmpv1 =a_Tmpv2/(1. +moist(i,kts,j,P_QV))
15170    a_moist(i,kts,j,P_QV) =a_moist(i,kts,j,P_QV) -Tmpv400(i,j,im)/((1. +moist(i,  &
15171    kts,j,P_QV))*(1. +moist(i,kts,j,P_QV)))*a_Tmpv2
15172    a_qfx(i,j) =a_qfx(i,j) +a_Tmpv1/rho(i,1,j)
15173    a_rho(i,1,j) =a_rho(i,1,j) -qfx(i,j)/(rho(i,1,j)*rho(i,1,j))*a_Tmpv1
15174    ENDDO
15175    ENDDO
15176
15177    ENDIF
15178
15179    CASE DEFAULT
15180
15181 ! Revised by Ning Pan, 2010-08-10
15182 !   CALL a_wrf_error_fatal('isfflx value invalid for diff_opt=2')
15183    CALL wrf_error_fatal('isfflx value invalid for diff_opt=2')
15184
15185 ! Revised by Ning Pan, 2010-08-10
15186 !   END SELECT qflux
15187    END SELECT
15188
15189 !   moist_tendf(ims,kms,jms,im) =Tmpv200(im)  ! Remarked by Ning Pan, 2010-08-11
15190
15191    CALL a_vertical_diffusion_s(moist_tendf(ims,kms,jms,im),a_moist_tendf(ims,kms,  &
15192    jms,im),config_flags,var_mix,a_var_mix,mu,a_mu,xkhv,a_xkhv,dn,dnw,rdz,a_rdz,  &
15193 ! Revised by Ning Pan, 2010-08-10
15194 !   rdzw,a_rdzw,fnm,fnp,,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,  &
15195    rdzw,a_rdzw,fnm,fnp,rho,a_rho,.false.,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,  &
15196    jte,kts,kte)
15197
15198    IF( (.not. config_flags%mix_full_fields) .and. (im == P_QV) ) THEN
15199
15200    DO j =min(jte, jde-1), jts, -1
15201    DO k =kte-1, kts, -1
15202    DO i =min(ite, ide-1), its, -1
15203
15204 !   var_mix(i,k,j) =Tmpv500(i,k,j,im)  ! Remarked by Ning Pan, 2010-08-11
15205
15206    a_moist(i,k,j,im) =a_moist(i,k,j,im) +a_var_mix(i,k,j)
15207    a_var_mix(i,k,j) =0.0
15208    ENDDO
15209    ENDDO
15210    ENDDO
15211
15212    ELSE
15213
15214    DO j =min(jte, jde-1), jts, -1
15215    DO k =kte-1, kts, -1
15216    DO i =min(ite, ide-1), its, -1
15217
15218 !   var_mix(i,k,j) =Tmpv501(i,k,j,im)  ! Remarked by Ning Pan, 2010-08-11
15219
15220    a_moist(i,k,j,im) =a_moist(i,k,j,im) +a_var_mix(i,k,j)
15221    a_var_mix(i,k,j) =0.0
15222    ENDDO
15223    ENDDO
15224    ENDDO
15225
15226    END IF
15227    ENDDO
15228
15229    ENDIF
15230
15231 !LPB[8]
15232
15233 !LPB[7]
15234 ! Remarked by Ning Pan, 2010-08-10
15235 !   DO IX3=jms,jme
15236 !   DO IX2=kms,kme
15237 !   DO IX1=ims,ime
15238 !   tke_tendf(IX1,IX2,IX3) =Keep_Lpb7_tke_tendf(IX1,IX2,IX3)
15239 !   END DO
15240 !   END DO
15241 !   END DO
15242
15243 !  IF(km_opt .eq. 2) THEN
15244 !  Tmpv_1 =tke_tendf(ims,kms,jms)
15245 !  CALL vertical_diffusion_s(tke_tendf(ims,kms,jms),config_flags,tke(ims,kms,jms)  &
15246 !  ,mu,xkhv,dn,dnw,rdz,rdzw,fnm,fnp,.true.,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
15247 !  kme,its,ite,jts,jte,kts,kte)
15248
15249 !  endif
15250
15251    IF(km_opt .eq. 2) THEN
15252
15253 !   tke_tendf(ims,kms,jms) =Tmpv_1  ! Remarked by Ning Pan, 2010-08-11
15254
15255    CALL a_vertical_diffusion_s(tke_tendf(ims,kms,jms),a_tke_tendf(ims,kms,jms)  &
15256    ,config_flags,tke(ims,kms,jms),a_tke(ims,kms,jms),mu,a_mu,xkhv,a_xkhv,dn,dnw,  &
15257 ! Revised by Ning Pan, 2010-08-10
15258 !   rdz,a_rdz,rdzw,a_rdzw,fnm,fnp,,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
15259    rdz,a_rdz,rdzw,a_rdzw,fnm,fnp,rho,a_rho,.true.,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
15260    its,ite,jts,jte,kts,kte)
15261
15262    endif
15263
15264 !LPB[6]
15265
15266 !LPB[5]
15267
15268    SELECT CASE (config_flags%isfflx)
15269    CASE(0,2)
15270    heat_flux =config_flags%tke_heat_flux
15271
15272    DO j =j_start, j_end
15273    DO i =i_start, i_end
15274    Tmpv001 =mu(i,j)*heat_flux
15275    Tmpv300(i,j) =Tmpv001
15276 ! Remarked by Ning Pan, 2010-08-11
15277 !   Tmpv002 =Tmpv300(i,j)*rdzw(i,kts,j)
15278 !   Tmpv003 =rt_tendf(i,kts,j) +Tmpv002
15279 !   rt_tendf(i,kts,j) =Tmpv003
15280
15281    ENDDO
15282    ENDDO
15283    CASE(1)
15284    DO j =j_start, j_end
15285    DO i =i_start, i_end
15286 ! Revised by Ning Pan, 2010-08-11
15287 !   Tmpv301(i,j) =cpm
15288 !   cpm =cp*(1. +0.8*moist(i,kts,j,P_QV))
15289    cpm =cp*(1. +0.8*moist(i,kts,j,P_QV))
15290    Tmpv301(i,j) =cpm
15291
15292    Tmpv001 =hfx(i,j)/cpm
15293    Tmpv302(i,j) =Tmpv001
15294    Tmpv002 =Tmpv302(i,j)/rho(i,1,j)
15295 ! Revised by Ning Pan, 2010-08-11
15296 !   Tmpv303(i,j) =heat_flux
15297 !   heat_flux =Tmpv002
15298    heat_flux =Tmpv002
15299    Tmpv303(i,j) =heat_flux
15300
15301    Tmpv001 =mu(i,j)*heat_flux
15302    Tmpv304(i,j) =Tmpv001
15303 ! Remarked by Ning Pan, 2010-08-11
15304 !   Tmpv002 =Tmpv304(i,j)*rdzw(i,kts,j)
15305 !   Tmpv003 =rt_tendf(i,kts,j) +Tmpv002
15306 !   rt_tendf(i,kts,j) =Tmpv003
15307
15308    ENDDO
15309    ENDDO
15310    CASE DEFAULT
15311    CALL wrf_error_fatal('isfflx value invalid for diff_opt=2')
15312
15313 ! Revised by Ning Pan, 2010-08-10
15314 !   END SELECT hflux
15315    END SELECT
15316
15317    SELECT CASE (config_flags%isfflx)
15318
15319    CASE(0,2)
15320
15321    DO j =j_end, j_start, -1
15322    DO i =i_end, i_start, -1
15323    a_Tmpv3 =a_rt_tendf(i,kts,j)
15324    a_rt_tendf(i,kts,j) =0.0
15325    a_rt_tendf(i,kts,j) =a_rt_tendf(i,kts,j) +a_Tmpv3
15326    a_Tmpv2 =a_Tmpv3
15327    a_Tmpv1 =rdzw(i,kts,j)*a_Tmpv2
15328    a_rdzw(i,kts,j) =a_rdzw(i,kts,j) +Tmpv300(i,j)*a_Tmpv2
15329    a_mu(i,j) =a_mu(i,j) +heat_flux*a_Tmpv1
15330 !   a_heat_flux =a_heat_flux +mu(i,j)*a_Tmpv1  ! Remarked by Ning Pan, 2010-08-11
15331    ENDDO
15332    ENDDO
15333 ! Remarked by Ning Pan, 2010-08-10
15334 !   a_config_flags%tke_heat_flux =a_config_flags%tke_heat_flux +a_heat_flux
15335    a_heat_flux =0.0
15336
15337    CASE(1)
15338
15339    DO j =j_end, j_start, -1
15340    DO i =i_end, i_start, -1
15341    heat_flux =Tmpv303(i,j)  ! Added by Ning Pan, 2010-08-11
15342    a_Tmpv3 =a_rt_tendf(i,kts,j)
15343    a_rt_tendf(i,kts,j) =0.0
15344    a_rt_tendf(i,kts,j) =a_rt_tendf(i,kts,j) +a_Tmpv3
15345    a_Tmpv2 =a_Tmpv3
15346    a_Tmpv1 =rdzw(i,kts,j)*a_Tmpv2
15347    a_rdzw(i,kts,j) =a_rdzw(i,kts,j) +Tmpv304(i,j)*a_Tmpv2
15348    a_mu(i,j) =a_mu(i,j) +heat_flux*a_Tmpv1
15349    a_heat_flux =a_heat_flux +mu(i,j)*a_Tmpv1
15350
15351 !   heat_flux =Tmpv303(i,j)  ! Remarked by Ning Pan, 2010-08-11
15352
15353    cpm =Tmpv301(i,j)  ! Added by Ning Pan, 2010-08-11
15354    a_Tmpv2 =a_heat_flux
15355    a_heat_flux =0.0
15356    a_Tmpv1 =a_Tmpv2/rho(i,1,j)
15357    a_rho(i,1,j) =a_rho(i,1,j) -Tmpv302(i,j)/(rho(i,1,j)*rho(i,1,j))*a_Tmpv2
15358    a_hfx(i,j) =a_hfx(i,j) +a_Tmpv1/cpm
15359    a_cpm =a_cpm -hfx(i,j)/(cpm*cpm)*a_Tmpv1
15360
15361 !   cpm =Tmpv301(i,j)  ! Remarked by Ning Pan, 2010-08-11
15362
15363    a_moist(i,kts,j,P_QV) =a_moist(i,kts,j,P_QV) +cp*0.8*a_cpm
15364    a_cpm =0.0
15365    ENDDO
15366    ENDDO
15367
15368    CASE DEFAULT
15369
15370 ! Revised by Ning Pan, 2010-08-10
15371 !   CALL a_wrf_error_fatal('isfflx value invalid for diff_opt=2')
15372    CALL wrf_error_fatal('isfflx value invalid for diff_opt=2')
15373
15374 ! Revised by Ning Pan, 2010-08-10
15375 !   END SELECT hflux
15376    END SELECT
15377
15378 !LPB[4]
15379 ! Remarked by Ning Pan, 2010-08-10
15380 !  DO IX3=jms,jme
15381 !  DO IX2=kms,kme
15382 !  DO IX1=ims,ime
15383 !  rt_tendf(IX1,IX2,IX3) =Keep_Lpb4_rt_tendf(IX1,IX2,IX3)
15384 !  END DO
15385 !  END DO
15386 !  END DO
15387
15388 !  DO IX3=jms,jme
15389 !  DO IX2=kms,kme
15390 !  DO IX1=ims,ime
15391 !  Tmpv400(IX1,IX2,IX3) =rt_tendf(IX1,IX2,IX3)
15392 !  END DO
15393 !  END DO
15394 !  END DO
15395
15396 !  CALL vertical_diffusion_s(rt_tendf,config_flags,var_mix,mu,xkhv,dn,dnw,rdz,rdzw,  &
15397 !  fnm,fnp,.false.,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
15398
15399 ! Remarked by Ning Pan, 2010-08-11
15400 !   DO IX3=jms,jme
15401 !   DO IX2=kms,kme
15402 !   DO IX1=ims,ime
15403 !   rt_tendf(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
15404 !   END DO
15405 !   END DO
15406 !   END DO
15407
15408 ! Added by Ning Pan, 2010-08-11
15409   var_mix = 0.0
15410   IF( config_flags%mix_full_fields ) THEN
15411   DO j =jts, min(jte, jde-1)
15412   DO k =kts, kte-1
15413   DO i =its, min(ite, ide-1)
15414   var_mix(i,k,j) =thp(i,k,j)
15415   ENDDO
15416   ENDDO
15417   ENDDO
15418   ELSE
15419   DO j =jts, min(jte, jde-1)
15420   DO k =kts, kte-1
15421   DO i =its, min(ite, ide-1)
15422   var_mix(i,k,j) =thp(i,k,j) -t_base(k)
15423   ENDDO
15424   ENDDO
15425   ENDDO
15426   END IF
15427
15428   CALL a_vertical_diffusion_s(rt_tendf,a_rt_tendf,config_flags,var_mix,  &
15429 ! Revised by Ning Pan, 2010-08-10
15430 !   a_var_mix,mu,a_mu,xkhv,a_xkhv,dn,dnw,rdz,a_rdz,rdzw,a_rdzw,fnm,fnp,,ids,  &
15431    a_var_mix,mu,a_mu,xkhv,a_xkhv,dn,dnw,rdz,a_rdz,rdzw,a_rdzw,fnm,fnp,rho,a_rho,.false.,ids,  &
15432    ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
15433
15434 !LPB[3]
15435
15436 !  IF( config_flags%mix_full_fields ) THEN
15437 !  DO j =jts, min(jte, jde-1)
15438 !  DO k =kts, kte-1
15439 !  DO i =its, min(ite, ide-1)
15440 !  var_mix(i,k,j) =thp(i,k,j)
15441
15442 !  ENDDO
15443 !  ENDDO
15444 !  ENDDO
15445 !  ELSE
15446 !  DO j =jts, min(jte, jde-1)
15447 !  DO k =kts, kte-1
15448 !  DO i =its, min(ite, ide-1)
15449 !  var_mix(i,k,j) =thp(i,k,j) -t_base(k)
15450
15451 !  ENDDO
15452 !  ENDDO
15453 !  ENDDO
15454 !  END IF
15455
15456    IF( config_flags%mix_full_fields ) THEN
15457
15458    DO j =min(jte, jde-1), jts, -1
15459    DO k =kte-1, kts, -1
15460    DO i =min(ite, ide-1), its, -1
15461    a_thp(i,k,j) =a_thp(i,k,j) +a_var_mix(i,k,j)
15462    a_var_mix(i,k,j) =0.0
15463    ENDDO
15464    ENDDO
15465    ENDDO
15466
15467    ELSE
15468
15469    DO j =min(jte, jde-1), jts, -1
15470    DO k =kte-1, kts, -1
15471    DO i =min(ite, ide-1), its, -1
15472    a_thp(i,k,j) =a_thp(i,k,j) +a_var_mix(i,k,j)
15473    a_var_mix(i,k,j) =0.0
15474    ENDDO
15475    ENDDO
15476    ENDDO
15477
15478    END IF
15479
15480 !LPB[2]
15481
15482 !LPB[1]
15483
15484    SELECT CASE (config_flags%isfflx)
15485    CASE(0)
15486    cd0 =config_flags%tke_drag_coefficient
15487
15488    DO j =j_start, j_end
15489    DO i =i_start, ite
15490 !   Tmpv300(i,j) =V0_u  ! Remarked by Ning Pan, 2010-08-11
15491    V0_u =0.
15492
15493 !   Tmpv301(i,j) =tao_xz  ! Remarked by Ning Pan, 2010-08-11
15494    tao_xz =0.
15495
15496    Tmpv001 =v_2(i,kts,j) +v_2(i,kts,j+1)
15497    Tmpv002 =Tmpv001 +v_2(i-1,kts,j)
15498    Tmpv003 =Tmpv002 +v_2(i-1,kts,j+1)
15499    Tmpv004 =Tmpv003/4
15500    Tmpv302(i,j) =Tmpv004
15501    Tmpv005 =Tmpv302(i,j)**2
15502    Tmpv006 =(u_2(i,kts,j)**2) +Tmpv005
15503    Tmpv303(i,j) =Tmpv006
15504    Tmpv007 =sqrt(Tmpv303(i,j))
15505    Tmpv008 =Tmpv007 +epsilon
15506 ! Revised by Ning Pan, 2010-08-11
15507 !   Tmpv304(i,j) =V0_u
15508 !   V0_u =Tmpv008
15509    V0_u =Tmpv008
15510    Tmpv304(i,j) =V0_u
15511
15512    Tmpv001 =cd0*V0_u
15513    Tmpv305(i,j) =Tmpv001
15514    Tmpv002 =Tmpv305(i,j)*u_2(i,kts,j)
15515 ! Revised by Ning Pan, 2010-08-11
15516 !   Tmpv306(i,j) =tao_xz
15517 !   tao_xz =Tmpv002
15518    tao_xz =Tmpv002
15519    Tmpv306(i,j) =tao_xz
15520
15521    Tmpv001 =mu(i,j) +mu(i-1,j)
15522    Tmpv002 =0.25*Tmpv001
15523    Tmpv307(i,j) =Tmpv002
15524    Tmpv003 =Tmpv307(i,j)*tao_xz
15525    Tmpv004 =rdzw(i,kts,j) +rdzw(i-1,kts,j)
15526    Tmpv308(i,j) =Tmpv003
15527    Tmpv309(i,j) =Tmpv004
15528 ! Remarked by Ning Pan, 2010-08-11
15529 !   Tmpv005 =Tmpv308(i,j)*Tmpv309(i,j)
15530 !   Tmpv006 =ru_tendf(i,kts,j) -Tmpv005
15531 !   ru_tendf(i,kts,j) =Tmpv006
15532
15533    ENDDO
15534    ENDDO
15535    DO j =j_start, jte
15536    DO i =i_start, i_end
15537 !   Tmpv3010(i,j) =V0_v  ! Remarked by Ning Pan, 2010-08-11
15538    V0_v =0.
15539
15540 !   Tmpv3011(i,j) =tao_yz  ! Remarked by Ning Pan, 2010-08-11
15541    tao_yz =0.
15542
15543    Tmpv001 =u_2(i,kts,j) +u_2(i,kts,j-1)
15544    Tmpv002 =Tmpv001 +u_2(i+1,kts,j)
15545    Tmpv003 =Tmpv002 +u_2(i+1,kts,j-1)
15546    Tmpv004 =Tmpv003/4
15547    Tmpv3012(i,j) =Tmpv004
15548    Tmpv005 =Tmpv3012(i,j)**2
15549    Tmpv006 =(v_2(i,kts,j)**2) +Tmpv005
15550    Tmpv3013(i,j) =Tmpv006
15551    Tmpv007 =sqrt(Tmpv3013(i,j))
15552    Tmpv008 =Tmpv007 +epsilon
15553 ! Revised by Ning Pan, 2010-08-11
15554 !   Tmpv3014(i,j) =V0_v
15555 !   V0_v =Tmpv008
15556    V0_v =Tmpv008
15557    Tmpv3014(i,j) =V0_v
15558
15559    Tmpv001 =cd0*V0_v
15560    Tmpv3015(i,j) =Tmpv001
15561    Tmpv002 =Tmpv3015(i,j)*v_2(i,kts,j)
15562 ! Revised by Ning Pan, 2010-08-11
15563 !   Tmpv3016(i,j) =tao_yz
15564 !   tao_yz =Tmpv002
15565    tao_yz =Tmpv002
15566    Tmpv3016(i,j) =tao_yz
15567
15568    Tmpv001 =mu(i,j) +mu(i,j-1)
15569    Tmpv002 =0.25*Tmpv001
15570    Tmpv3017(i,j) =Tmpv002
15571    Tmpv003 =Tmpv3017(i,j)*tao_yz
15572    Tmpv004 =rdzw(i,kts,j) +rdzw(i,kts,j-1)
15573    Tmpv3018(i,j) =Tmpv003
15574    Tmpv3019(i,j) =Tmpv004
15575 ! Remarked by Ning Pan, 2010-08-11
15576 !   Tmpv005 =Tmpv3018(i,j)*Tmpv3019(i,j)
15577 !   Tmpv006 =rv_tendf(i,kts,j) -Tmpv005
15578 !   rv_tendf(i,kts,j) =Tmpv006
15579
15580    ENDDO
15581    ENDDO
15582    CASE(1,2)
15583    DO j =j_start, j_end
15584    DO i =i_start, ite
15585 !   Tmpv3020(i,j) =V0_u  ! Remarked by Ning Pan, 2010-08-11
15586    V0_u =0.
15587
15588 !   Tmpv3021(i,j) =tao_xz  ! Remarked by Ning Pan, 2010-08-11
15589    tao_xz =0.
15590
15591    Tmpv001 =v_2(i,kts,j) +v_2(i,kts,j+1)
15592    Tmpv002 =Tmpv001 +v_2(i-1,kts,j)
15593    Tmpv003 =Tmpv002 +v_2(i-1,kts,j+1)
15594    Tmpv004 =Tmpv003/4
15595    Tmpv3022(i,j) =Tmpv004
15596    Tmpv005 =Tmpv3022(i,j)**2
15597    Tmpv006 =(u_2(i,kts,j)**2) +Tmpv005
15598    Tmpv3023(i,j) =Tmpv006
15599    Tmpv007 =sqrt(Tmpv3023(i,j))
15600    Tmpv008 =Tmpv007 +epsilon
15601 ! Revised by Ning Pan, 2010-08-11
15602 !   Tmpv3024(i,j) =V0_u
15603 !   V0_u =Tmpv008
15604    V0_u =Tmpv008
15605    Tmpv3024(i,j) =V0_u
15606
15607    Tmpv001 =ust(i,j) +ust(i-1,j)
15608    Tmpv002 =0.5*Tmpv001
15609 ! Revised by Ning Pan, 2010-08-11
15610 !   Tmpv3025(i,j) =ustar
15611 !   ustar =Tmpv002
15612    ustar =Tmpv002
15613    Tmpv3025(i,j) =ustar
15614
15615    Tmpv001 =ustar*ustar*u_2(i,kts,j)
15616    Tmpv3026(i,j) =Tmpv001
15617    Tmpv002 =Tmpv3026(i,j)/V0_u
15618 ! Revised by Ning Pan, 2010-08-11
15619 !   Tmpv3027(i,j) =tao_xz
15620 !   tao_xz =Tmpv002
15621    tao_xz =Tmpv002
15622    Tmpv3027(i,j) =tao_xz
15623
15624    Tmpv001 =mu(i,j) +mu(i-1,j)
15625    Tmpv002 =0.25*Tmpv001
15626    Tmpv3028(i,j) =Tmpv002
15627    Tmpv003 =Tmpv3028(i,j)*tao_xz
15628    Tmpv004 =rdzw(i,kts,j) +rdzw(i-1,kts,j)
15629    Tmpv3029(i,j) =Tmpv003
15630    Tmpv3030(i,j) =Tmpv004
15631 ! Remarked by Ning Pan, 2010-08-11
15632 !   Tmpv005 =Tmpv3029(i,j)*Tmpv3030(i,j)
15633 !   Tmpv006 =ru_tendf(i,kts,j) -Tmpv005
15634 !   ru_tendf(i,kts,j) =Tmpv006
15635
15636    ENDDO
15637    ENDDO
15638    DO j =j_start, jte
15639    DO i =i_start, i_end
15640 !   Tmpv3031(i,j) =V0_v  ! Remakred by Ning Pan, 2010-08-11
15641    V0_v =0.
15642
15643 !   Tmpv3032(i,j) =tao_yz  ! Remarked by Ning Pan, 2010-08-11
15644    tao_yz =0.
15645
15646    Tmpv001 =u_2(i,kts,j) +u_2(i,kts,j-1)
15647    Tmpv002 =Tmpv001 +u_2(i+1,kts,j)
15648    Tmpv003 =Tmpv002 +u_2(i+1,kts,j-1)
15649    Tmpv004 =Tmpv003/4
15650    Tmpv3033(i,j) =Tmpv004
15651    Tmpv005 =Tmpv3033(i,j)**2
15652    Tmpv006 =(v_2(i,kts,j)**2) +Tmpv005
15653    Tmpv3034(i,j) =Tmpv006
15654    Tmpv007 =sqrt(Tmpv3034(i,j))
15655    Tmpv008 =Tmpv007 +epsilon
15656 ! Revised by Ning Pan, 2010-08-11
15657 !   Tmpv3035(i,j) =V0_v
15658 !   V0_v =Tmpv008
15659    V0_v =Tmpv008
15660    Tmpv3035(i,j) =V0_v
15661
15662    Tmpv001 =ust(i,j) +ust(i,j-1)
15663    Tmpv002 =0.5*Tmpv001
15664 ! Revised by Ning Pan, 2010-08-11
15665 !   Tmpv3036(i,j) =ustar
15666 !   ustar =Tmpv002
15667    ustar =Tmpv002
15668    Tmpv3036(i,j) =ustar
15669
15670    Tmpv001 =ustar*ustar*v_2(i,kts,j)
15671    Tmpv3037(i,j) =Tmpv001
15672    Tmpv002 =Tmpv3037(i,j)/V0_v
15673 ! Revised by Ning Pan, 2010-08-11
15674 !   Tmpv3038(i,j) =tao_yz
15675 !   tao_yz =Tmpv002
15676    tao_yz =Tmpv002
15677    Tmpv3038(i,j) =tao_yz
15678
15679    Tmpv001 =mu(i,j) +mu(i,j-1)
15680    Tmpv002 =0.25*Tmpv001
15681    Tmpv3039(i,j) =Tmpv002
15682    Tmpv003 =Tmpv3039(i,j)*tao_yz
15683    Tmpv004 =rdzw(i,kts,j) +rdzw(i,kts,j-1)
15684    Tmpv3040(i,j) =Tmpv003
15685    Tmpv3041(i,j) =Tmpv004
15686 ! Remarked by Ning Pan, 2010-08-11
15687 !   Tmpv005 =Tmpv3040(i,j)*Tmpv3041(i,j)
15688 !   Tmpv006 =rv_tendf(i,kts,j) -Tmpv005
15689 !   rv_tendf(i,kts,j) =Tmpv006
15690
15691    ENDDO
15692    ENDDO
15693    CASE DEFAULT
15694    CALL wrf_error_fatal('isfflx value invalid for diff_opt=2')
15695
15696 ! Revised by Ning Pan, 2010-08-10
15697 !   END SELECT vflux
15698    END SELECT
15699
15700    SELECT CASE (config_flags%isfflx)
15701
15702    CASE(0)
15703
15704    DO j =jte, j_start, -1
15705    DO i =i_end, i_start, -1
15706    IF ( (config_flags%m_opt .EQ. 1) .OR. (config_flags%sfs_opt .GT. 0) ) THEN
15707       a_tao_yz = -a_nba_mij(i, kts, j, p_m23)
15708       a_nba_mij(i, kts, j, p_m23) = 0.0
15709    ELSE
15710       a_tao_yz = 0.0
15711    ENDIF
15712    tao_yz =Tmpv3016(i,j)  ! Added by Ning Pan, 2010-08-11
15713    a_Tmpv6 =a_rv_tendf(i,kts,j)
15714    a_rv_tendf(i,kts,j) =0.0
15715    a_rv_tendf(i,kts,j) =a_rv_tendf(i,kts,j) +a_Tmpv6
15716    a_Tmpv5 =-a_Tmpv6
15717    a_Tmpv3 =Tmpv3019(i,j)*a_Tmpv5
15718    a_Tmpv4 =Tmpv3018(i,j)*a_Tmpv5
15719    a_rdzw(i,kts,j) =a_rdzw(i,kts,j) +a_Tmpv4
15720    a_rdzw(i,kts,j-1) =a_rdzw(i,kts,j-1) +a_Tmpv4
15721    a_Tmpv2 =tao_yz*a_Tmpv3
15722    a_tao_yz =a_tao_yz +Tmpv3017(i,j)*a_Tmpv3
15723    a_Tmpv1 =0.25*a_Tmpv2
15724    a_mu(i,j) =a_mu(i,j) +a_Tmpv1
15725    a_mu(i,j-1) =a_mu(i,j-1) +a_Tmpv1
15726
15727 !   tao_yz =Tmpv3016(i,j)  ! Remarked by Ning Pan, 2010-08-11
15728
15729    a_Tmpv2 =a_tao_yz
15730    a_tao_yz =0.0
15731    a_Tmpv1 =v_2(i,kts,j)*a_Tmpv2
15732    a_v_2(i,kts,j) =a_v_2(i,kts,j) +Tmpv3015(i,j)*a_Tmpv2
15733 !   a_cd0 =a_cd0 +V0_v*a_Tmpv1  ! Remarked by Ning Pan, 2010-08-11
15734    a_V0_v =a_V0_v +cd0*a_Tmpv1
15735
15736 !   V0_v =Tmpv3014(i,j)  ! Remarked by Ning Pan, 2010-08-11
15737
15738    a_Tmpv8 =a_V0_v
15739    a_V0_v =0.0
15740    a_Tmpv7 =a_Tmpv8
15741    a_Tmpv6 =g_Sqrt(1.0, Tmpv3013(i,j))*a_Tmpv7
15742    a_v_2(i,kts,j) =a_v_2(i,kts,j) +2.0*v_2(i,kts,j)*a_Tmpv6
15743    a_Tmpv5 =a_Tmpv6
15744    a_Tmpv4 =2.0*Tmpv3012(i,j)*a_Tmpv5
15745    a_Tmpv3 =a_Tmpv4/4
15746    a_Tmpv2 =a_Tmpv3
15747    a_u_2(i+1,kts,j-1) =a_u_2(i+1,kts,j-1) +a_Tmpv3
15748    a_Tmpv1 =a_Tmpv2
15749    a_u_2(i+1,kts,j) =a_u_2(i+1,kts,j) +a_Tmpv2
15750    a_u_2(i,kts,j) =a_u_2(i,kts,j) +a_Tmpv1
15751    a_u_2(i,kts,j-1) =a_u_2(i,kts,j-1) +a_Tmpv1
15752
15753 !   tao_yz =Tmpv3011(i,j)  ! Remarked by Ning Pan, 2010-08-11
15754
15755    a_tao_yz =0.0
15756
15757 !   V0_v =Tmpv3010(i,j)  ! Remarked by Ning Pan, 2010-08-11
15758
15759    a_V0_v =0.0
15760    ENDDO
15761    ENDDO
15762    DO j =j_end, j_start, -1
15763    DO i =ite, i_start, -1
15764    IF ( (config_flags%m_opt .EQ. 1) .OR. (config_flags%sfs_opt .GT. 0) ) THEN
15765       a_tao_xz = -a_nba_mij(i, kts, j, p_m13)
15766       a_nba_mij(i, kts, j, p_m13) = 0.0
15767    ELSE
15768       a_tao_xz = 0.0
15769    ENDIF
15770    tao_xz =Tmpv306(i,j)  ! Added by Ning Pan, 2010-08-11
15771    a_Tmpv6 =a_ru_tendf(i,kts,j)
15772    a_ru_tendf(i,kts,j) =0.0
15773    a_ru_tendf(i,kts,j) =a_ru_tendf(i,kts,j) +a_Tmpv6
15774    a_Tmpv5 =-a_Tmpv6
15775    a_Tmpv3 =Tmpv309(i,j)*a_Tmpv5
15776    a_Tmpv4 =Tmpv308(i,j)*a_Tmpv5
15777    a_rdzw(i,kts,j) =a_rdzw(i,kts,j) +a_Tmpv4
15778    a_rdzw(i-1,kts,j) =a_rdzw(i-1,kts,j) +a_Tmpv4
15779    a_Tmpv2 =tao_xz*a_Tmpv3
15780    a_tao_xz =a_tao_xz +Tmpv307(i,j)*a_Tmpv3
15781    a_Tmpv1 =0.25*a_Tmpv2
15782    a_mu(i,j) =a_mu(i,j) +a_Tmpv1
15783    a_mu(i-1,j) =a_mu(i-1,j) +a_Tmpv1
15784
15785 !   tao_xz =Tmpv306(i,j)  ! Remarked by Ning Pan, 2010-08-11
15786
15787    a_Tmpv2 =a_tao_xz
15788    a_tao_xz =0.0
15789    a_Tmpv1 =u_2(i,kts,j)*a_Tmpv2
15790    a_u_2(i,kts,j) =a_u_2(i,kts,j) +Tmpv305(i,j)*a_Tmpv2
15791 !   a_cd0 =a_cd0 +V0_u*a_Tmpv1  ! Remarked by Ning Pan, 2010-08-11
15792    a_V0_u =a_V0_u +cd0*a_Tmpv1
15793
15794 !   V0_u =Tmpv304(i,j)  ! Remarked by Ning Pan, 2010-08-11
15795
15796    a_Tmpv8 =a_V0_u
15797    a_V0_u =0.0
15798    a_Tmpv7 =a_Tmpv8
15799    a_Tmpv6 =g_Sqrt(1.0, Tmpv303(i,j))*a_Tmpv7
15800    a_u_2(i,kts,j) =a_u_2(i,kts,j) +2.0*u_2(i,kts,j)*a_Tmpv6
15801    a_Tmpv5 =a_Tmpv6
15802    a_Tmpv4 =2.0*Tmpv302(i,j)*a_Tmpv5
15803    a_Tmpv3 =a_Tmpv4/4
15804    a_Tmpv2 =a_Tmpv3
15805    a_v_2(i-1,kts,j+1) =a_v_2(i-1,kts,j+1) +a_Tmpv3
15806    a_Tmpv1 =a_Tmpv2
15807    a_v_2(i-1,kts,j) =a_v_2(i-1,kts,j) +a_Tmpv2
15808    a_v_2(i,kts,j) =a_v_2(i,kts,j) +a_Tmpv1
15809    a_v_2(i,kts,j+1) =a_v_2(i,kts,j+1) +a_Tmpv1
15810
15811 !   tao_xz =Tmpv301(i,j)  ! Remarked by Ning Pan, 2010-08-11
15812
15813    a_tao_xz =0.0
15814
15815 !   V0_u =Tmpv300(i,j)  ! Remarked by Ning Pan, 2010-08-11
15816
15817    a_V0_u =0.0
15818    ENDDO
15819    ENDDO
15820 !   a_config_flags%tke_drag_coefficient =a_config_flags%tke_drag_coefficient +a_cd0
15821 !   a_cd0 =0.0  ! Remarked by Ning Pan, 2010-08-11
15822
15823    CASE(1,2)
15824
15825    DO j =jte, j_start, -1
15826    DO i =i_end, i_start, -1
15827    IF ( (config_flags%m_opt .EQ. 1) .OR. (config_flags%sfs_opt .GT. 0) ) THEN
15828       a_tao_yz = -a_nba_mij(i, kts, j, p_m23)
15829       a_nba_mij(i, kts, j, p_m23) = 0.0
15830    ELSE
15831       a_tao_yz = 0.0
15832    ENDIF
15833    tao_yz =Tmpv3038(i,j)  ! Added by Ning Pan, 2010-08-11
15834    a_Tmpv6 =a_rv_tendf(i,kts,j)
15835    a_rv_tendf(i,kts,j) =0.0
15836    a_rv_tendf(i,kts,j) =a_rv_tendf(i,kts,j) +a_Tmpv6
15837    a_Tmpv5 =-a_Tmpv6
15838    a_Tmpv3 =Tmpv3041(i,j)*a_Tmpv5
15839    a_Tmpv4 =Tmpv3040(i,j)*a_Tmpv5
15840    a_rdzw(i,kts,j) =a_rdzw(i,kts,j) +a_Tmpv4
15841    a_rdzw(i,kts,j-1) =a_rdzw(i,kts,j-1) +a_Tmpv4
15842    a_Tmpv2 =tao_yz*a_Tmpv3
15843    a_tao_yz =a_tao_yz +Tmpv3039(i,j)*a_Tmpv3
15844    a_Tmpv1 =0.25*a_Tmpv2
15845    a_mu(i,j) =a_mu(i,j) +a_Tmpv1
15846    a_mu(i,j-1) =a_mu(i,j-1) +a_Tmpv1
15847
15848 !   tao_yz =Tmpv3038(i,j)  ! Remarked by Ning Pan, 2010-08-11
15849
15850 ! Added by Ning Pan, 2010-08-11
15851    V0_v =Tmpv3035(i,j)
15852    ustar =Tmpv3036(i,j)
15853
15854    a_Tmpv2 =a_tao_yz
15855    a_tao_yz =0.0
15856    a_Tmpv1 =a_Tmpv2/V0_v
15857    a_V0_v =a_V0_v -Tmpv3037(i,j)/(V0_v*V0_v)*a_Tmpv2
15858    a_ustar =a_ustar +2.0*ustar*v_2(i,kts,j)*a_Tmpv1
15859    a_v_2(i,kts,j) =a_v_2(i,kts,j) +ustar*ustar*a_Tmpv1
15860
15861 !   ustar =Tmpv3036(i,j)  ! Remarked by Ning Pan, 2010-08-11
15862
15863    a_Tmpv2 =a_ustar
15864    a_ustar =0.0
15865    a_Tmpv1 =0.5*a_Tmpv2
15866    a_ust(i,j) =a_ust(i,j) +a_Tmpv1
15867    a_ust(i,j-1) =a_ust(i,j-1) +a_Tmpv1
15868
15869 !   V0_v =Tmpv3035(i,j)  ! Remarked by Ning Pan, 2010-08-11
15870
15871    a_Tmpv8 =a_V0_v
15872    a_V0_v =0.0
15873    a_Tmpv7 =a_Tmpv8
15874    a_Tmpv6 =g_Sqrt(1.0, Tmpv3034(i,j))*a_Tmpv7
15875    a_v_2(i,kts,j) =a_v_2(i,kts,j) +2.0*v_2(i,kts,j)*a_Tmpv6
15876    a_Tmpv5 =a_Tmpv6
15877    a_Tmpv4 =2.0*Tmpv3033(i,j)*a_Tmpv5
15878    a_Tmpv3 =a_Tmpv4/4
15879    a_Tmpv2 =a_Tmpv3
15880    a_u_2(i+1,kts,j-1) =a_u_2(i+1,kts,j-1) +a_Tmpv3
15881    a_Tmpv1 =a_Tmpv2
15882    a_u_2(i+1,kts,j) =a_u_2(i+1,kts,j) +a_Tmpv2
15883    a_u_2(i,kts,j) =a_u_2(i,kts,j) +a_Tmpv1
15884    a_u_2(i,kts,j-1) =a_u_2(i,kts,j-1) +a_Tmpv1
15885
15886 !   tao_yz =Tmpv3032(i,j)  ! Remarked by Ning Pan, 2010-08-11
15887
15888    a_tao_yz =0.0
15889
15890 !   V0_v =Tmpv3031(i,j)  ! Remarked by Ning Pan, 2010-08-11
15891
15892    a_V0_v =0.0
15893    ENDDO
15894    ENDDO
15895    DO j =j_end, j_start, -1
15896    DO i =ite, i_start, -1
15897    IF ( (config_flags%m_opt .EQ. 1) .OR. (config_flags%sfs_opt .GT. 0) ) THEN
15898       a_tao_xz = -a_nba_mij(i, kts, j, p_m13)
15899       a_nba_mij(i, kts, j, p_m13) = 0.0
15900    ELSE
15901       a_tao_xz = 0.0
15902    ENDIF
15903    tao_xz =Tmpv3027(i,j)  ! Added by Ning Pan, 2010-08-11
15904    a_Tmpv6 =a_ru_tendf(i,kts,j)
15905    a_ru_tendf(i,kts,j) =0.0
15906    a_ru_tendf(i,kts,j) =a_ru_tendf(i,kts,j) +a_Tmpv6
15907    a_Tmpv5 =-a_Tmpv6
15908    a_Tmpv3 =Tmpv3030(i,j)*a_Tmpv5
15909    a_Tmpv4 =Tmpv3029(i,j)*a_Tmpv5
15910    a_rdzw(i,kts,j) =a_rdzw(i,kts,j) +a_Tmpv4
15911    a_rdzw(i-1,kts,j) =a_rdzw(i-1,kts,j) +a_Tmpv4
15912    a_Tmpv2 =tao_xz*a_Tmpv3
15913    a_tao_xz =a_tao_xz +Tmpv3028(i,j)*a_Tmpv3
15914    a_Tmpv1 =0.25*a_Tmpv2
15915    a_mu(i,j) =a_mu(i,j) +a_Tmpv1
15916    a_mu(i-1,j) =a_mu(i-1,j) +a_Tmpv1
15917
15918 !   tao_xz =Tmpv3027(i,j)  ! Remarked by Ning Pan, 2010-08-11
15919
15920 ! Added by Ning Pan, 2010-08-11
15921    V0_u =Tmpv3024(i,j)
15922    ustar =Tmpv3025(i,j)
15923
15924    a_Tmpv2 =a_tao_xz
15925    a_tao_xz =0.0
15926    a_Tmpv1 =a_Tmpv2/V0_u
15927    a_V0_u =a_V0_u -Tmpv3026(i,j)/(V0_u*V0_u)*a_Tmpv2
15928    a_ustar =a_ustar +2.0*ustar*u_2(i,kts,j)*a_Tmpv1
15929    a_u_2(i,kts,j) =a_u_2(i,kts,j) +ustar*ustar*a_Tmpv1
15930
15931 !   ustar =Tmpv3025(i,j)  ! Remarked by Ning Pan, 2010-08-11
15932
15933    a_Tmpv2 =a_ustar
15934    a_ustar =0.0
15935    a_Tmpv1 =0.5*a_Tmpv2
15936    a_ust(i,j) =a_ust(i,j) +a_Tmpv1
15937    a_ust(i-1,j) =a_ust(i-1,j) +a_Tmpv1
15938
15939 !   V0_u =Tmpv3024(i,j)  ! Remarked by Ning Pan, 2010-08-11
15940
15941    a_Tmpv8 =a_V0_u
15942    a_V0_u =0.0
15943    a_Tmpv7 =a_Tmpv8
15944    a_Tmpv6 =g_Sqrt(1.0, Tmpv3023(i,j))*a_Tmpv7
15945    a_u_2(i,kts,j) =a_u_2(i,kts,j) +2.0*u_2(i,kts,j)*a_Tmpv6
15946    a_Tmpv5 =a_Tmpv6
15947    a_Tmpv4 =2.0*Tmpv3022(i,j)*a_Tmpv5
15948    a_Tmpv3 =a_Tmpv4/4
15949    a_Tmpv2 =a_Tmpv3
15950    a_v_2(i-1,kts,j+1) =a_v_2(i-1,kts,j+1) +a_Tmpv3
15951    a_Tmpv1 =a_Tmpv2
15952    a_v_2(i-1,kts,j) =a_v_2(i-1,kts,j) +a_Tmpv2
15953    a_v_2(i,kts,j) =a_v_2(i,kts,j) +a_Tmpv1
15954    a_v_2(i,kts,j+1) =a_v_2(i,kts,j+1) +a_Tmpv1
15955
15956 !   tao_xz =Tmpv3021(i,j)  ! Remarked by Ning Pan, 2010-08-11
15957
15958    a_tao_xz =0.0
15959
15960 !   V0_u =Tmpv3020(i,j)  ! Remarked by Ning Pan, 2010-08-11
15961
15962    a_V0_u =0.0
15963    ENDDO
15964    ENDDO
15965
15966    CASE DEFAULT
15967
15968 ! Revised by Ning Pan, 2010-08-10
15969 !   CALL a_wrf_error_fatal('isfflx value invalid for diff_opt=2')
15970    CALL wrf_error_fatal('isfflx value invalid for diff_opt=2')
15971
15972 ! Revised by Ning Pan, 2010-08-10
15973 !   END SELECT vflux
15974    END SELECT
15975
15976 !LPB[0]
15977 ! Remarked by Ning Pan, 2010-08-10
15978 !   DO IX3=jms,jme
15979 !   DO IX2=kms,kme
15980 !   DO IX1=ims,ime
15981 !   ru_tendf(IX1,IX2,IX3) =Keep_Lpb0_ru_tendf(IX1,IX2,IX3)
15982 !   END DO
15983 !   END DO
15984 !   END DO
15985 !   DO IX4=1,n_nba_mij
15986 !   DO IX3=jms,jme
15987 !   DO IX2=kms,kme
15988 !   DO IX1=ims,ime
15989 !   nba_mij(IX1,IX2,IX3,IX4) =Keep_Lpb0_nba_mij(IX1,IX2,IX3,IX4)
15990 !   END DO
15991 !   END DO
15992 !   END DO
15993 !   END DO
15994 !   DO IX3=jms,jme
15995 !   DO IX2=kms,kme
15996 !   DO IX1=ims,ime
15997 !   rv_tendf(IX1,IX2,IX3) =Keep_Lpb0_rv_tendf(IX1,IX2,IX3)
15998 !   END DO
15999 !   END DO
16000 !   END DO
16001 !   DO IX3=jms,jme
16002 !   DO IX2=kms,kme
16003 !   DO IX1=ims,ime
16004 !   rw_tendf(IX1,IX2,IX3) =Keep_Lpb0_rw_tendf(IX1,IX2,IX3)
16005 !   END DO
16006 !   END DO
16007 !   END DO
16008
16009 ! Remarked by Ning Pan, 2010-08-11
16010 !   i_start =its
16011 !   i_end =min(ite, ide-1)
16012 !   j_start =jts
16013 !   j_end =min(jte, jde-1)
16014 !   DO IX3=jms,jme
16015 !   DO IX2=kms,kme
16016 !   DO IX1=ims,ime
16017 !   Tmpv400(IX1,IX2,IX3) =ru_tendf(IX1,IX2,IX3)
16018 !   END DO
16019 !   END DO
16020 !   END DO
16021
16022 !   DO IX4=1,n_nba_mij
16023 !   DO IX3=jms,jme
16024 !   DO IX2=kms,kme
16025 !   DO IX1=ims,ime
16026 !   Tmpv500(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
16027 !   END DO
16028 !   END DO
16029 !   END DO
16030 !   END DO
16031
16032    Keep_Lpb0_nba_mij = nba_mij
16033    CALL vertical_diffusion_u_2(ru_tendf,config_flags,defor13,xkmv,nba_mij,  &
16034    n_nba_mij,dnw,rdzw,fnm,fnp,rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,  &
16035    jts,jte,kts,kte)
16036
16037 !   DO IX3=jms,jme
16038 !   DO IX2=kms,kme
16039 !   DO IX1=ims,ime
16040 !   Tmpv401(IX1,IX2,IX3) =rv_tendf(IX1,IX2,IX3)
16041 !   END DO
16042 !   END DO
16043 !   END DO
16044
16045 !   DO IX4=1,n_nba_mij
16046 !   DO IX3=jms,jme
16047 !   DO IX2=kms,kme
16048 !   DO IX1=ims,ime
16049 !   Tmpv501(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
16050 !   END DO
16051 !   END DO
16052 !   END DO
16053 !   END DO
16054
16055    Keep_Lpb1_nba_mij = nba_mij
16056    CALL vertical_diffusion_v_2(rv_tendf,config_flags,defor23,xkmv,nba_mij,  &
16057    n_nba_mij,dnw,rdzw,fnm,fnp,rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,  &
16058    jts,jte,kts,kte)
16059
16060 !   DO IX3=jms,jme
16061 !   DO IX2=kms,kme
16062 !   DO IX1=ims,ime
16063 !   Tmpv402(IX1,IX2,IX3) =rw_tendf(IX1,IX2,IX3)
16064 !   END DO
16065 !   END DO
16066 !   END DO
16067
16068 !   DO IX4=1,n_nba_mij
16069 !   DO IX3=jms,jme
16070 !   DO IX2=kms,kme
16071 !   DO IX1=ims,ime
16072 !   Tmpv502(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
16073 !   END DO
16074 !   END DO
16075 !   END DO
16076 !   END DO
16077
16078 !   CALL vertical_diffusion_w_2(rw_tendf,config_flags,defor33,tke(ims,kms,jms)  &
16079 !   ,nba_mij,n_nba_mij,div,xkmv,dn,rdz,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
16080 !   its,ite,jts,jte,kts,kte)
16081
16082 !   DO IX4=1,n_nba_mij
16083 !   DO IX3=jms,jme
16084 !   DO IX2=kms,kme
16085 !   DO IX1=ims,ime
16086 !   nba_mij(IX1,IX2,IX3,IX4) =Tmpv502(IX1,IX2,IX3,IX4)
16087 !   END DO
16088 !   END DO
16089 !   END DO
16090 !   END DO
16091
16092 !   DO IX3=jms,jme
16093 !   DO IX2=kms,kme
16094 !   DO IX1=ims,ime
16095 !   rw_tendf(IX1,IX2,IX3) =Tmpv402(IX1,IX2,IX3)
16096 !   END DO
16097 !   END DO
16098 !   END DO
16099
16100    CALL a_vertical_diffusion_w_2(rw_tendf,a_rw_tendf,config_flags,mu,a_mu,  &
16101    defor33,a_defor33,tke(ims,kms,jms),a_tke(ims,kms,jms),nba_mij,a_nba_mij,  &
16102    n_nba_mij,div,a_div,xkmv,a_xkmv,dn,rdz,a_rdz,rho,a_rho,ids,ide,jds,jde,kds,kde,ims,ime,  &
16103    jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
16104
16105 ! Remarked by Ning Pan, 2010-08-11
16106 !   DO IX4=1,n_nba_mij
16107 !   DO IX3=jms,jme
16108 !   DO IX2=kms,kme
16109 !   DO IX1=ims,ime
16110 !   nba_mij(IX1,IX2,IX3,IX4) =Tmpv501(IX1,IX2,IX3,IX4)
16111 !   END DO
16112 !   END DO
16113 !   END DO
16114 !   END DO
16115
16116 !   DO IX3=jms,jme
16117 !   DO IX2=kms,kme
16118 !   DO IX1=ims,ime
16119 !   rv_tendf(IX1,IX2,IX3) =Tmpv401(IX1,IX2,IX3)
16120 !   END DO
16121 !   END DO
16122 !   END DO
16123
16124    nba_mij = Keep_Lpb1_nba_mij
16125    CALL a_vertical_diffusion_v_2(rv_tendf,a_rv_tendf,config_flags,mu,a_mu,  &
16126    defor23,a_defor23,xkmv,a_xkmv,nba_mij,a_nba_mij,n_nba_mij,dnw,rdzw,a_rdzw,  &
16127    fnm,fnp,rho,a_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
16128
16129 ! Remarked by Ning Pan, 2010-08-11
16130 !   DO IX4=1,n_nba_mij
16131 !   DO IX3=jms,jme
16132 !   DO IX2=kms,kme
16133 !   DO IX1=ims,ime
16134 !   nba_mij(IX1,IX2,IX3,IX4) =Tmpv500(IX1,IX2,IX3,IX4)
16135 !   END DO
16136 !   END DO
16137 !   END DO
16138 !   END DO
16139
16140 !   DO IX3=jms,jme
16141 !   DO IX2=kms,kme
16142 !   DO IX1=ims,ime
16143 !   ru_tendf(IX1,IX2,IX3) =Tmpv400(IX1,IX2,IX3)
16144 !   END DO
16145 !   END DO
16146 !   END DO
16147
16148    nba_mij = Keep_Lpb0_nba_mij
16149    CALL a_vertical_diffusion_u_2(ru_tendf,a_ru_tendf,config_flags,mu,a_mu,  &
16150    defor13,a_defor13,xkmv,a_xkmv,nba_mij,a_nba_mij,n_nba_mij,dnw,rdzw,a_rdzw,  &
16151    fnm,fnp,rho,a_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
16152
16153    END SUBROUTINE a_vertical_diffusion_2
16154
16155    SUBROUTINE a_vertical_diffusion_u_2(tendency,a_tendency,config_flags,mu,a_mu, &
16156    defor13,a_defor13,xkmv,a_xkmv,nba_mij,a_nba_mij,n_nba_mij,dnw,rdzw,a_rdzw, &
16157    fnm,fnp,rho,a_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
16158
16159 !PART I: DECLARATION OF VARIABLES
16160
16161    IMPLICIT NONE
16162
16163    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
16164    TYPE(grid_config_rec_type) :: config_flags
16165    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
16166    REAL,DIMENSION(kms:kme) :: fnm
16167    REAL,DIMENSION(kms:kme) :: fnp
16168    REAL,DIMENSION(kms:kme) :: dnw
16169    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
16170    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor13,a_defor13,xkmv,a_xkmv,rdzw,a_rdzw
16171    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rho, a_rho
16172    INTEGER :: n_nba_mij
16173    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: nba_mij,a_nba_mij
16174    REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
16175    INTEGER :: i,j,k,ktf
16176    INTEGER :: i_start,i_end,j_start,j_end
16177    INTEGER :: is_ext,ie_ext,js_ext,je_ext
16178    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau3,a_titau3
16179    REAL,DIMENSION(its:ite,jts:jte) :: zzavg,a_zzavg
16180    REAL :: rdzu,a_rdzu
16181
16182    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: Keep_Lpb12_nba_mij
16183 !  REAL,DIMENSION(max(jds+1,jts):min(jde-2,jte)) :: Keep_Lpb14_rdzu
16184    INTEGER :: IX1,IX2,IX3,IX4
16185
16186    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003
16187
16188    REAL :: Tmpv_1
16189    REAL,DIMENSION(its:ite) :: Tmpv200
16190    REAL,DIMENSION(its:ite) :: Tmpv201  ! Added by Ning Pan, 2010-08-10
16191    REAL,DIMENSION(its:ite,kts+1:min(kte,kde-1)) :: Tmpv300
16192    REAL,DIMENSION(its:ite,kts+1:min(kte,kde-1)) :: Tmpv301
16193    REAL,DIMENSION(its:ite,kts+1:min(kte,kde-1)) :: Tmpv302  ! Added by Ning Pan, 2010-08-10
16194
16195 !PART II: CALCULATIONS OF B. S. TRAJECTORY
16196
16197 !LPB[0]
16198
16199       ktf=MIN(kte,kde-1)
16200       i_start = its
16201       i_end   = ite
16202       j_start = jts
16203       j_end   = MIN(jte,jde-1)
16204
16205 !LPB[1]
16206    IF ( config_flags%open_xs .or. config_flags%specified .or.   &
16207         config_flags%nested) i_start = MAX(ids+1,its)
16208
16209 !LPB[2]
16210
16211 !LPB[3]
16212    IF ( config_flags%open_xe .or. config_flags%specified .or.   &
16213         config_flags%nested) i_end   = MIN(ide-1,ite)
16214
16215 !LPB[4]
16216
16217 !LPB[5]
16218    IF ( config_flags%open_ys .or. config_flags%specified .or.   &
16219         config_flags%nested) j_start = MAX(jds+1,jts)
16220
16221 !LPB[6]
16222
16223 !LPB[7]
16224    IF ( config_flags%open_ye .or. config_flags%specified .or.   &
16225         config_flags%nested) j_end   = MIN(jde-2,jte)
16226
16227 !LPB[8]
16228
16229 !LPB[9]
16230       IF ( config_flags%periodic_x ) i_start = its
16231
16232 !LPB[10]
16233
16234 !LPB[11]
16235       IF ( config_flags%periodic_x ) i_end = ite
16236
16237 !LPB[12]
16238    DO IX4=1,n_nba_mij
16239    DO IX3=jms,jme
16240    DO IX2=kms,kme
16241    DO IX1=ims,ime
16242        Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
16243    END DO
16244    END DO
16245    END DO
16246    END DO
16247
16248       is_ext=0
16249       ie_ext=0
16250       js_ext=0
16251       je_ext=0
16252       CALL cal_titau_13_31( config_flags, titau3, defor13,     &
16253                             nba_mij(ims,kms,jms,P_m13),        &
16254                             xkmv, fnm, fnp, rho,               &
16255                             is_ext, ie_ext, js_ext, je_ext,    &
16256                             ids, ide, jds, jde, kds, kde,      &
16257                             ims, ime, jms, jme, kms, kme,      &
16258                             its, ite, jts, jte, kts, kte     )
16259
16260 !LPB[13]
16261 ! Remarked by Ning Pan, 2010-08-10
16262 !         DO j = j_start, j_end
16263
16264 !         DO k=kts+1,ktf
16265 !         DO i = i_start, i_end
16266 !            rdzu = 2./(1./rdzw(i,k,j) + 1./rdzw(i-1,k,j))
16267 !            tendency(i,k,j)=tendency(i,k,j)-rdzu*(titau3(i,k+1,j)-titau3(i,k,j))
16268 !         ENDDO
16269 !         ENDDO
16270
16271 !         ENDDO
16272
16273 !!LPB[14]
16274 !          DO j = j_start, j_end
16275
16276 !    !  Keep_Lpb14_rdzu(j) =rdzu
16277
16278 !          k=kts
16279
16280 !          DO i = i_start, i_end
16281 !             rdzu = 2./(1./rdzw(i,k,j) + 1./rdzw(i-1,k,j))
16282 !             tendency(i,k,j)=tendency(i,k,j)-rdzu*(titau3(i,k+1,j))
16283 !          ENDDO
16284
16285 !          ENDDO
16286
16287 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
16288
16289    Do K2_ADJ =jts-1, jte+1
16290    Do K1_ADJ =kts, kte
16291    Do K0_ADJ =its-1, ite+1
16292    a_titau3(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
16293    End Do
16294    End Do
16295    End Do
16296
16297    Do K1_ADJ =jts, jte
16298    Do K0_ADJ =its, ite
16299    a_zzavg(K0_ADJ,K1_ADJ) =0.0
16300    End Do
16301    End Do
16302
16303    a_rdzu =0.0
16304
16305 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
16306
16307 !LPB[14]
16308    DO j =j_end, j_start, -1
16309
16310 !  rdzu =Keep_Lpb14_rdzu(j)
16311
16312    k =kts
16313    DO i =i_start, i_end
16314    Tmpv001 =1./rdzw(i,k,j) +1./rdzw(i-1,k,j)
16315    Tmpv201(i) =Tmpv001  ! Added by Ning Pan, 2010-08-10
16316    Tmpv002 =2./Tmpv001
16317 ! Revised by Ning Pan, 2010-08-10
16318 !   Tmpv200(i) =rdzu
16319 !   rdzu =Tmpv002
16320    rdzu =Tmpv002
16321    Tmpv200(i) =rdzu
16322
16323 ! Remarked by Ning Pan, 2010-08-10
16324 !   Tmpv001 =rdzu*(titau3(i,k+1,j))
16325 !   Tmpv002 =tendency(i,k,j) -Tmpv001
16326 !   tendency(i,k,j) =Tmpv002
16327
16328    ENDDO
16329
16330    DO i =i_end, i_start, -1
16331    rdzu =Tmpv200(i)  ! Added by Ning Pan, 2010-08-10
16332    a_Tmpv2 =a_tendency(i,k,j)
16333    a_tendency(i,k,j) =0.0
16334    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv2
16335    a_Tmpv1 =-a_Tmpv2
16336    a_rdzu =a_rdzu +(titau3(i,k+1,j))*a_Tmpv1
16337    a_titau3(i,k+1,j) =a_titau3(i,k+1,j) +rdzu*a_Tmpv1
16338
16339 !   rdzu =Tmpv200(i)  ! Remarked by Ning Pan, 2010-08-10
16340
16341    a_Tmpv2 =a_rdzu
16342    a_rdzu =0.0
16343 ! Revised by Ning Pan, 2010-08-10
16344 !   a_Tmpv1 =-(2.)*a_Tmpv2/(Tmpv001*Tmpv001)
16345    a_Tmpv1 =-(2.)*a_Tmpv2/(Tmpv201(i)*Tmpv201(i))
16346    a_rdzw(i,k,j) =a_rdzw(i,k,j) -1./(rdzw(i,k,j)*rdzw(i,k,j))*a_Tmpv1
16347    a_rdzw(i-1,k,j) =a_rdzw(i-1,k,j) -1./(rdzw(i-1,k,j)*rdzw(i-1,k,j))*a_Tmpv1
16348    ENDDO
16349
16350    ENDDO
16351
16352 !LPB[13]
16353    DO j =j_end, j_start, -1
16354
16355    DO k =kts+1, ktf
16356    DO i =i_start, i_end
16357    Tmpv001 =1./rdzw(i,k,j) +1./rdzw(i-1,k,j)
16358    Tmpv302(i,k) =Tmpv001  ! Added by Ning Pan, 2010-08-10
16359    Tmpv002 =2./Tmpv001
16360 ! Revised by Ning Pan, 2010-08-10
16361 !   Tmpv300(i,k) =rdzu
16362 !   rdzu =Tmpv002
16363    rdzu =Tmpv002
16364    Tmpv300(i,k) =rdzu
16365
16366    Tmpv001 =titau3(i,k+1,j) -titau3(i,k,j)
16367    Tmpv301(i,k) =Tmpv001
16368 ! Remarked by Ning Pan, 2010-08-10
16369 !   Tmpv002 =rdzu*Tmpv301(i,k)
16370 !   Tmpv003 =tendency(i,k,j) -Tmpv002
16371 !   tendency(i,k,j) =Tmpv003
16372
16373    ENDDO
16374    ENDDO
16375
16376    DO k =ktf, kts+1, -1
16377    DO i =i_end, i_start, -1
16378    rdzu =Tmpv300(i,k)  ! Added by Ning Pan, 2010-08-10
16379    a_Tmpv3 =a_tendency(i,k,j)
16380    a_tendency(i,k,j) =0.0
16381    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv3
16382    a_Tmpv2 =-a_Tmpv3
16383    a_rdzu =a_rdzu +Tmpv301(i,k)*a_Tmpv2
16384    a_Tmpv1 =rdzu*a_Tmpv2
16385    a_titau3(i,k+1,j) =a_titau3(i,k+1,j) +a_Tmpv1
16386    a_titau3(i,k,j) =a_titau3(i,k,j) -a_Tmpv1
16387
16388 !   rdzu =Tmpv300(i,k)  ! Remarked by Ning Pan, 2010-08-10
16389
16390    a_Tmpv2 =a_rdzu
16391    a_rdzu =0.0
16392 ! Revised by Ning Pan, 2010-08-10
16393 !   a_Tmpv1 =-(2.)*a_Tmpv2/(Tmpv001*Tmpv001)
16394    a_Tmpv1 =-(2.)*a_Tmpv2/(Tmpv302(i,k)*Tmpv302(i,k))
16395    a_rdzw(i,k,j) =a_rdzw(i,k,j) -1./(rdzw(i,k,j)*rdzw(i,k,j))*a_Tmpv1
16396    a_rdzw(i-1,k,j) =a_rdzw(i-1,k,j) -1./(rdzw(i-1,k,j)*rdzw(i-1,k,j))*a_Tmpv1
16397    ENDDO
16398    ENDDO
16399
16400    ENDDO
16401
16402 !LPB[12]
16403    DO IX4=1,n_nba_mij
16404    DO IX3=jms,jme
16405    DO IX2=kms,kme
16406    DO IX1=ims,ime
16407    nba_mij(IX1,IX2,IX3,IX4) =Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4)
16408    END DO
16409    END DO
16410    END DO
16411    END DO
16412
16413 ! Remarked by Ning Pan, 2010-08-10
16414 !   is_ext =0
16415 !   ie_ext =0
16416 !   js_ext =0
16417 !   je_ext =0
16418 !   Tmpv_1 =nba_mij(ims,kms,jms,P_m13)
16419 !   CALL cal_titau_13_31(config_flags,titau3,defor13,nba_mij(ims,kms,jms,P_m13)  &
16420 !   ,mu,xkmv,fnm,fnp,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
16421 !   kms,kme,its,ite,jts,jte,kts,kte)
16422
16423 !   nba_mij(ims,kms,jms,P_m13) =Tmpv_1
16424
16425    CALL a_cal_titau_13_31(config_flags,titau3,a_titau3,defor13,a_defor13,  &
16426    nba_mij(ims,kms,jms,P_m13),a_nba_mij(ims,kms,jms,P_m13),mu,a_mu,xkmv,a_xkmv,  &
16427    fnm,fnp,rho,a_rho,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
16428    its,ite,jts,jte,kts,kte)
16429
16430 !LPB[11]
16431
16432 !  IF( config_flags%periodic_x ) THEN
16433 !  i_end =ite
16434 !  END IF
16435
16436 !  IF( config_flags%periodic_x ) THEN
16437
16438 !  END IF
16439
16440 !LPB[10]
16441
16442 !LPB[9]
16443
16444 !  IF( config_flags%periodic_x ) THEN
16445 !  i_start =its
16446 !  END IF
16447
16448 !  IF( config_flags%periodic_x ) THEN
16449
16450 !  END IF
16451
16452 !LPB[8]
16453
16454 !LPB[7]
16455
16456 !  IF( config_flags%open_ye .or. config_flags%specified .or.            config_flags%nested) THEN
16457 !  j_end =min(jde-2, jte)
16458 !  END IF
16459
16460 !  IF( config_flags%open_ye .or. config_flags%specified .or.   &
16461 !           config_flags%nested) THEN
16462
16463 !  END IF
16464
16465 !LPB[6]
16466
16467 !LPB[5]
16468
16469 !  IF( config_flags%open_ys .or. config_flags%specified .or.            config_flags%nested) THEN
16470 !  j_start =max(jds+1, jts)
16471 !  END IF
16472
16473 !  IF( config_flags%open_ys .or. config_flags%specified .or.   &
16474 !           config_flags%nested) THEN
16475
16476 !  END IF
16477
16478 !LPB[4]
16479
16480 !LPB[3]
16481
16482 !  IF( config_flags%open_xe .or. config_flags%specified .or.            config_flags%nested) THEN
16483 !  i_end =min(ide-1, ite)
16484 !  END IF
16485
16486 !  IF( config_flags%open_xe .or. config_flags%specified .or.   &
16487 !           config_flags%nested) THEN
16488
16489 !  END IF
16490
16491 !LPB[2]
16492
16493 !LPB[1]
16494
16495 !  IF( config_flags%open_xs .or. config_flags%specified .or.            config_flags%nested) THEN
16496 !  i_start =max(ids+1, its)
16497 !  END IF
16498
16499 !  IF( config_flags%open_xs .or. config_flags%specified .or.   &
16500 !           config_flags%nested) THEN
16501
16502 !  END IF
16503
16504 !LPB[0]
16505 !  ktf =min(kte, kde-1)
16506 !  i_start =its
16507 !  i_end =ite
16508 !  j_start =jts
16509 !  j_end =min(jte, jde-1)
16510
16511    END SUBROUTINE a_vertical_diffusion_u_2
16512
16513    SUBROUTINE a_vertical_diffusion_v_2(tendency,a_tendency,config_flags,mu,a_mu, &
16514    defor23,a_defor23,xkmv,a_xkmv,nba_mij,a_nba_mij,n_nba_mij,dnw,rdzw,a_rdzw, &
16515    fnm,fnp,rho,a_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
16516
16517 !PART I: DECLARATION OF VARIABLES
16518
16519    IMPLICIT NONE
16520
16521    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
16522    TYPE(grid_config_rec_type) :: config_flags
16523    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
16524    REAL,DIMENSION(kms:kme) :: fnm
16525    REAL,DIMENSION(kms:kme) :: fnp
16526    REAL,DIMENSION(kms:kme) :: dnw
16527    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
16528    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor23,a_defor23,xkmv,a_xkmv,rdzw,a_rdzw
16529    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rho, a_rho
16530    INTEGER :: n_nba_mij
16531    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: nba_mij,a_nba_mij
16532    REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
16533    INTEGER :: i,j,k,ktf
16534    INTEGER :: i_start,i_end,j_start,j_end
16535    INTEGER :: is_ext,ie_ext,js_ext,je_ext
16536    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau3,a_titau3
16537    REAL,DIMENSION(its:ite,jts:jte) :: zzavg,a_zzavg
16538    REAL :: rdzv,a_rdzv
16539
16540    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: Keep_Lpb12_nba_mij
16541 !  REAL,DIMENSION(max(jds+1,jts):min(jde-1,jte)) :: Keep_Lpb14_rdzv
16542    INTEGER :: IX1,IX2,IX3,IX4
16543
16544    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003
16545
16546    REAL :: Tmpv_1
16547    REAL,DIMENSION(its:min(ite,ide-1)) :: Tmpv200
16548    REAL,DIMENSION(its:min(ite,ide-1)) :: Tmpv201  ! Added by Ning Pan, 2010-08-10
16549    REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1)) :: Tmpv300
16550    REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1)) :: Tmpv301
16551    REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1)) :: Tmpv302  ! Added by Ning Pan, 2010-08-10
16552
16553 !PART II: CALCULATIONS OF B. S. TRAJECTORY
16554
16555 !LPB[0]
16556       ktf=MIN(kte,kde-1)
16557       i_start = its
16558       i_end   = MIN(ite,ide-1)
16559       j_start = jts
16560       j_end   = jte
16561
16562 !LPB[1]
16563    IF ( config_flags%open_xs .or. config_flags%specified .or.   &
16564         config_flags%nested) i_start = MAX(ids+1,its)
16565
16566 !LPB[2]
16567
16568 !LPB[3]
16569    IF ( config_flags%open_xe .or. config_flags%specified .or.   &
16570         config_flags%nested) i_end   = MIN(ide-2,ite)
16571
16572 !LPB[4]
16573
16574 !LPB[5]
16575    IF ( config_flags%open_ys .or. config_flags%specified .or.   &
16576         config_flags%nested) j_start = MAX(jds+1,jts)
16577
16578 !LPB[6]
16579
16580 !LPB[7]
16581    IF ( config_flags%open_ye .or. config_flags%specified .or.   &
16582         config_flags%nested) j_end   = MIN(jde-1,jte)
16583
16584 !LPB[8]
16585
16586 !LPB[9]
16587       IF ( config_flags%periodic_x ) i_start = its
16588
16589 !LPB[10]
16590
16591 !LPB[11]
16592       IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
16593
16594 !LPB[12]
16595    DO IX4=1,n_nba_mij
16596    DO IX3=jms,jme
16597    DO IX2=kms,kme
16598    DO IX1=ims,ime
16599        Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
16600    END DO
16601    END DO
16602    END DO
16603    END DO
16604
16605       is_ext=0
16606       ie_ext=0
16607       js_ext=0
16608       je_ext=0
16609       CALL cal_titau_23_32( config_flags, titau3, defor23,     &
16610                             nba_mij(ims,kms,jms,P_m23),        &
16611                             xkmv, fnm, fnp, rho,               &
16612                             is_ext, ie_ext, js_ext, je_ext,    &
16613                             ids, ide, jds, jde, kds, kde,      &
16614                             ims, ime, jms, jme, kms, kme,      &
16615                             its, ite, jts, jte, kts, kte     )
16616
16617 !LPB[13]
16618 ! Remarked by Ning Pan, 2010-08-10
16619 !      DO j = j_start, j_end
16620
16621 !      DO k = kts+1,ktf
16622 !      DO i = i_start, i_end
16623 !         rdzv = 2./(1./rdzw(i,k,j) + 1./rdzw(i,k,j-1))
16624 !         tendency(i,k,j)=tendency(i,k,j)-rdzv*(titau3(i,k+1,j)-titau3(i,k,j))
16625 !      ENDDO
16626 !      ENDDO
16627
16628 !      ENDDO
16629
16630 !!LPB[14]
16631 !          DO j = j_start, j_end
16632
16633 !    !  Keep_Lpb14_rdzv(j) =rdzv
16634
16635 !          k=kts
16636
16637 !          DO i = i_start, i_end
16638 !             rdzv = 2./(1./rdzw(i,k,j) + 1./rdzw(i,k,j-1))
16639 !             tendency(i,k,j)=tendency(i,k,j)-rdzv*(titau3(i,k+1,j))
16640 !          ENDDO
16641
16642 !          ENDDO
16643
16644 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
16645
16646    Do K2_ADJ =jts-1, jte+1
16647    Do K1_ADJ =kts, kte
16648    Do K0_ADJ =its-1, ite+1
16649    a_titau3(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
16650    End Do
16651    End Do
16652    End Do
16653
16654    Do K1_ADJ =jts, jte
16655    Do K0_ADJ =its, ite
16656    a_zzavg(K0_ADJ,K1_ADJ) =0.0
16657    End Do
16658    End Do
16659
16660    a_rdzv =0.0
16661
16662 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
16663
16664 !LPB[14]
16665    DO j =j_end, j_start, -1
16666
16667 !  rdzv =Keep_Lpb14_rdzv(j)
16668
16669    k =kts
16670    DO i =i_start, i_end
16671    Tmpv001 =1./rdzw(i,k,j) +1./rdzw(i,k,j-1)
16672    Tmpv201(i) =Tmpv001  ! Added by Ning Pan, 2010-08-10
16673    Tmpv002 =2./Tmpv001
16674 ! Revised by Ning Pan, 2010-08-10
16675 !   Tmpv200(i) =rdzv
16676 !   rdzv =Tmpv002
16677    rdzv =Tmpv002
16678    Tmpv200(i) =rdzv
16679
16680 ! Remarked by Ning Pan, 2010-08-10
16681 !   Tmpv001 =rdzv*(titau3(i,k+1,j))
16682 !   Tmpv002 =tendency(i,k,j) -Tmpv001
16683 !   tendency(i,k,j) =Tmpv002
16684
16685    ENDDO
16686
16687    DO i =i_end, i_start, -1
16688    rdzv =Tmpv200(i)  ! Added by Ning Pan, 2010-08-10
16689    a_Tmpv2 =a_tendency(i,k,j)
16690    a_tendency(i,k,j) =0.0
16691    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv2
16692    a_Tmpv1 =-a_Tmpv2
16693    a_rdzv =a_rdzv +(titau3(i,k+1,j))*a_Tmpv1
16694    a_titau3(i,k+1,j) =a_titau3(i,k+1,j) +rdzv*a_Tmpv1
16695
16696 !   rdzv =Tmpv200(i)  ! Remarked by Ning Pan, 2010-08-10
16697
16698    a_Tmpv2 =a_rdzv
16699    a_rdzv =0.0
16700 ! Revised by Ning Pan, 2010-08-10
16701 !   a_Tmpv1 =-(2.)*a_Tmpv2/(Tmpv001*Tmpv001)
16702    a_Tmpv1 =-(2.)*a_Tmpv2/(Tmpv201(i)*Tmpv201(i))
16703    a_rdzw(i,k,j) =a_rdzw(i,k,j) -1./(rdzw(i,k,j)*rdzw(i,k,j))*a_Tmpv1
16704    a_rdzw(i,k,j-1) =a_rdzw(i,k,j-1) -1./(rdzw(i,k,j-1)*rdzw(i,k,j-1))*a_Tmpv1
16705    ENDDO
16706
16707    ENDDO
16708
16709 !LPB[13]
16710    DO j =j_end, j_start, -1
16711
16712    DO k =kts+1, ktf
16713    DO i =i_start, i_end
16714    Tmpv001 =1./rdzw(i,k,j) +1./rdzw(i,k,j-1)
16715    Tmpv302(i,k) =Tmpv001  ! Added by Ning Pan, 2010-08-10
16716    Tmpv002 =2./Tmpv001
16717 ! Revised by Ning Pan, 2010-08-10
16718 !   Tmpv300(i,k) =rdzv
16719 !   rdzv =Tmpv002
16720    rdzv =Tmpv002
16721    Tmpv300(i,k) =rdzv
16722
16723    Tmpv001 =titau3(i,k+1,j) -titau3(i,k,j)
16724    Tmpv301(i,k) =Tmpv001
16725 ! Remarked by Ning Pan, 2010-08-10
16726 !   Tmpv002 =rdzv*Tmpv301(i,k)
16727 !   Tmpv003 =tendency(i,k,j) -Tmpv002
16728 !   tendency(i,k,j) =Tmpv003
16729
16730    ENDDO
16731    ENDDO
16732
16733    DO k =ktf, kts+1, -1
16734    DO i =i_end, i_start, -1
16735    rdzv =Tmpv300(i,k)  ! Added by Ning Pan, 2010-08-10
16736    a_Tmpv3 =a_tendency(i,k,j)
16737    a_tendency(i,k,j) =0.0
16738    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv3
16739    a_Tmpv2 =-a_Tmpv3
16740    a_rdzv =a_rdzv +Tmpv301(i,k)*a_Tmpv2
16741    a_Tmpv1 =rdzv*a_Tmpv2
16742    a_titau3(i,k+1,j) =a_titau3(i,k+1,j) +a_Tmpv1
16743    a_titau3(i,k,j) =a_titau3(i,k,j) -a_Tmpv1
16744
16745 !   rdzv =Tmpv300(i,k)  ! Remarked by Ning Pan, 2010-08-10
16746
16747    a_Tmpv2 =a_rdzv
16748    a_rdzv =0.0
16749 ! Revised by Ning Pan, 2010-08-10
16750 !   a_Tmpv1 =-(2.)*a_Tmpv2/(Tmpv001*Tmpv001)
16751    a_Tmpv1 =-(2.)*a_Tmpv2/(Tmpv302(i,k)*Tmpv302(i,k))
16752    a_rdzw(i,k,j) =a_rdzw(i,k,j) -1./(rdzw(i,k,j)*rdzw(i,k,j))*a_Tmpv1
16753    a_rdzw(i,k,j-1) =a_rdzw(i,k,j-1) -1./(rdzw(i,k,j-1)*rdzw(i,k,j-1))*a_Tmpv1
16754    ENDDO
16755    ENDDO
16756
16757    ENDDO
16758
16759 !LPB[12]
16760    DO IX4=1,n_nba_mij
16761    DO IX3=jms,jme
16762    DO IX2=kms,kme
16763    DO IX1=ims,ime
16764    nba_mij(IX1,IX2,IX3,IX4) =Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4)
16765    END DO
16766    END DO
16767    END DO
16768    END DO
16769
16770 ! Remarked by Ning Pan, 2010-08-10
16771 !   is_ext =0
16772 !   ie_ext =0
16773 !   js_ext =0
16774 !   je_ext =0
16775 !   Tmpv_1 =nba_mij(ims,kms,jms,P_m23)
16776 !   CALL cal_titau_23_32(config_flags,titau3,defor23,nba_mij(ims,kms,jms,P_m23)  &
16777 !   ,mu,xkmv,fnm,fnp,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,  &
16778 !   kms,kme,its,ite,jts,jte,kts,kte)
16779
16780 !   nba_mij(ims,kms,jms,P_m23) =Tmpv_1
16781
16782    CALL a_cal_titau_23_32(config_flags,titau3,a_titau3,defor23,a_defor23,  &
16783    nba_mij(ims,kms,jms,P_m23),a_nba_mij(ims,kms,jms,P_m23),mu,a_mu,xkmv,a_xkmv,  &
16784    fnm,fnp,rho,a_rho,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
16785    its,ite,jts,jte,kts,kte)
16786
16787 !LPB[11]
16788
16789 !  IF( config_flags%periodic_x ) THEN
16790 !  i_end =min(ite, ide-1)
16791 !  END IF
16792
16793 !  IF( config_flags%periodic_x ) THEN
16794
16795 !  END IF
16796
16797 !LPB[10]
16798
16799 !LPB[9]
16800
16801 !  IF( config_flags%periodic_x ) THEN
16802 !  i_start =its
16803 !  END IF
16804
16805 !  IF( config_flags%periodic_x ) THEN
16806
16807 !  END IF
16808
16809 !LPB[8]
16810
16811 !LPB[7]
16812
16813 !  IF( config_flags%open_ye .or. config_flags%specified .or.            config_flags%nested) THEN
16814 !  j_end =min(jde-1, jte)
16815 !  END IF
16816
16817 !  IF( config_flags%open_ye .or. config_flags%specified .or.   &
16818 !           config_flags%nested) THEN
16819
16820 !  END IF
16821
16822 !LPB[6]
16823
16824 !LPB[5]
16825
16826 !  IF( config_flags%open_ys .or. config_flags%specified .or.            config_flags%nested) THEN
16827 !  j_start =max(jds+1, jts)
16828 !  END IF
16829
16830 !  IF( config_flags%open_ys .or. config_flags%specified .or.   &
16831 !           config_flags%nested) THEN
16832
16833 !  END IF
16834
16835 !LPB[4]
16836
16837 !LPB[3]
16838
16839 !  IF( config_flags%open_xe .or. config_flags%specified .or.            config_flags%nested) THEN
16840 !  i_end =min(ide-2, ite)
16841 !  END IF
16842
16843 !  IF( config_flags%open_xe .or. config_flags%specified .or.   &
16844 !           config_flags%nested) THEN
16845
16846 !  END IF
16847
16848 !LPB[2]
16849
16850 !LPB[1]
16851
16852 !  IF( config_flags%open_xs .or. config_flags%specified .or.            config_flags%nested) THEN
16853 !  i_start =max(ids+1, its)
16854 !  END IF
16855
16856 !  IF( config_flags%open_xs .or. config_flags%specified .or.   &
16857 !           config_flags%nested) THEN
16858
16859 !  END IF
16860
16861 !LPB[0]
16862 !  ktf =min(kte, kde-1)
16863 !  i_start =its
16864 !  i_end =min(ite, ide-1)
16865 !  j_start =jts
16866 !  j_end =jte
16867
16868    END SUBROUTINE a_vertical_diffusion_v_2
16869
16870    SUBROUTINE a_vertical_diffusion_w_2(tendency,a_tendency,config_flags,mu,a_mu, &
16871    defor33,a_defor33,tke,a_tke,nba_mij,a_nba_mij,n_nba_mij,div,a_div,xkmv, &
16872    a_xkmv,dn,rdz,a_rdz,rho,a_rho,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts, &
16873    jte,kts,kte)
16874
16875 !PART I: DECLARATION OF VARIABLES
16876
16877    IMPLICIT NONE
16878
16879    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
16880    TYPE(grid_config_rec_type) :: config_flags
16881    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
16882    REAL,DIMENSION(kms:kme) :: dn
16883    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
16884    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor33,a_defor33,tke,a_tke,div, &
16885    a_div,xkmv,a_xkmv,rdz,a_rdz
16886    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rho, a_rho
16887    INTEGER :: n_nba_mij
16888    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: nba_mij,a_nba_mij
16889    REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
16890    INTEGER :: i,j,k,ktf
16891    INTEGER :: i_start,i_end,j_start,j_end
16892    INTEGER :: is_ext,ie_ext,js_ext,je_ext
16893    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau3,a_titau3
16894
16895    REAL,DIMENSION(ims:ime,kms:kme,jms:jme,n_nba_mij) :: Keep_Lpb12_nba_mij
16896    INTEGER :: IX1,IX2,IX3,IX4
16897
16898    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003
16899
16900    REAL :: Tmpv_1
16901    REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1)) :: Tmpv300
16902
16903 !PART II: CALCULATIONS OF B. S. TRAJECTORY
16904
16905 !LPB[0]
16906       ktf=MIN(kte,kde-1)
16907       i_start = its
16908       i_end   = MIN(ite,ide-1)
16909       j_start = jts
16910       j_end   = MIN(jte,jde-1)
16911
16912 !LPB[1]
16913    IF ( config_flags%open_xs .or. config_flags%specified .or.   &
16914         config_flags%nested) i_start = MAX(ids+1,its)
16915
16916 !LPB[2]
16917
16918 !LPB[3]
16919    IF ( config_flags%open_xe .or. config_flags%specified .or.   &
16920         config_flags%nested) i_end   = MIN(ide-2,ite)
16921
16922 !LPB[4]
16923
16924 !LPB[5]
16925    IF ( config_flags%open_ys .or. config_flags%specified .or.   &
16926         config_flags%nested) j_start = MAX(jds+1,jts)
16927
16928 !LPB[6]
16929
16930 !LPB[7]
16931    IF ( config_flags%open_ye .or. config_flags%specified .or.   &
16932         config_flags%nested) j_end   = MIN(jde-2,jte)
16933
16934 !LPB[8]
16935
16936 !LPB[9]
16937       IF ( config_flags%periodic_x ) i_start = its
16938
16939 !LPB[10]
16940
16941 !LPB[11]
16942       IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
16943
16944 !LPB[12]
16945    DO IX4=1,n_nba_mij
16946    DO IX3=jms,jme
16947    DO IX2=kms,kme
16948    DO IX1=ims,ime
16949        Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4) =nba_mij(IX1,IX2,IX3,IX4)
16950    END DO
16951    END DO
16952    END DO
16953    END DO
16954
16955       is_ext=0
16956       ie_ext=0
16957       js_ext=0
16958       je_ext=0
16959       CALL cal_titau_11_22_33( config_flags, titau3,              &
16960                                tke, xkmv, defor33,                &
16961                                nba_mij(ims,kms,jms,P_m33), rho,   &
16962                                is_ext, ie_ext, js_ext, je_ext,    &
16963                                ids, ide, jds, jde, kds, kde,      &
16964                                ims, ime, jms, jme, kms, kme,      &
16965                                its, ite, jts, jte, kts, kte     )
16966
16967 !!LPB[13]
16968 !      DO j = j_start, j_end
16969
16970 !      DO k = kts+1, ktf
16971 !      DO i = i_start, i_end
16972 !         tendency(i,k,j)=tendency(i,k,j)-rdz(i,k,j)*(titau3(i,k,j)-titau3(i,k-1,j))
16973 !      ENDDO
16974 !      ENDDO
16975
16976 !      ENDDO
16977
16978 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
16979
16980    Do K2_ADJ =jts-1, jte+1
16981    Do K1_ADJ =kts, kte
16982    Do K0_ADJ =its-1, ite+1
16983    a_titau3(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
16984    End Do
16985    End Do
16986    End Do
16987
16988 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
16989
16990 !LPB[13]
16991    DO j =j_end, j_start, -1
16992
16993    DO k =kts+1, ktf
16994    DO i =i_start, i_end
16995    Tmpv001 =titau3(i,k,j) -titau3(i,k-1,j)
16996    Tmpv300(i,k) =Tmpv001
16997 ! Remarked by Ning Pan, 2010-08-10
16998 !   Tmpv002 =rdz(i,k,j)*Tmpv300(i,k)
16999 !   Tmpv003 =tendency(i,k,j) -Tmpv002
17000 !   tendency(i,k,j) =Tmpv003
17001
17002    ENDDO
17003    ENDDO
17004
17005    DO k =ktf, kts+1, -1
17006    DO i =i_end, i_start, -1
17007    a_Tmpv3 =a_tendency(i,k,j)
17008    a_tendency(i,k,j) =0.0
17009    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv3
17010    a_Tmpv2 =-a_Tmpv3
17011    a_rdz(i,k,j) =a_rdz(i,k,j) +Tmpv300(i,k)*a_Tmpv2
17012    a_Tmpv1 =rdz(i,k,j)*a_Tmpv2
17013    a_titau3(i,k,j) =a_titau3(i,k,j) +a_Tmpv1
17014    a_titau3(i,k-1,j) =a_titau3(i,k-1,j) -a_Tmpv1
17015    ENDDO
17016    ENDDO
17017
17018    ENDDO
17019
17020 !LPB[12]
17021    DO IX4=1,n_nba_mij
17022    DO IX3=jms,jme
17023    DO IX2=kms,kme
17024    DO IX1=ims,ime
17025    nba_mij(IX1,IX2,IX3,IX4) =Keep_Lpb12_nba_mij(IX1,IX2,IX3,IX4)
17026    END DO
17027    END DO
17028    END DO
17029    END DO
17030
17031 ! Remarked by Ning Pan, 2010-08-10
17032 !   is_ext =0
17033 !   ie_ext =0
17034 !   js_ext =0
17035 !   je_ext =0
17036 !   Tmpv_1 =nba_mij(ims,kms,jms,P_m33)
17037 !   CALL cal_titau_11_22_33(config_flags,titau3,mu,tke,xkmv,defor33,nba_mij(ims,kms,  &
17038 !   jms,P_m33),is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,  &
17039 !   kme,its,ite,jts,jte,kts,kte)
17040
17041 !   nba_mij(ims,kms,jms,P_m33) =Tmpv_1
17042
17043    CALL a_cal_titau_11_22_33(config_flags,titau3,a_titau3,mu,a_mu,tke,a_tke,  &
17044    xkmv,a_xkmv,defor33,a_defor33,nba_mij(ims,kms,jms,P_m33),a_nba_mij(ims,kms,jms,  &
17045    P_m33),rho,a_rho,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,  &
17046    its,ite,jts,jte,kts,kte)
17047
17048 !LPB[11]
17049
17050 !  IF( config_flags%periodic_x ) THEN
17051 !  i_end =min(ite, ide-1)
17052 !  END IF
17053
17054 !  IF( config_flags%periodic_x ) THEN
17055
17056 !  END IF
17057
17058 !LPB[10]
17059
17060 !LPB[9]
17061
17062 !  IF( config_flags%periodic_x ) THEN
17063 !  i_start =its
17064 !  END IF
17065
17066 !  IF( config_flags%periodic_x ) THEN
17067
17068 !  END IF
17069
17070 !LPB[8]
17071
17072 !LPB[7]
17073
17074 !  IF( config_flags%open_ye .or. config_flags%specified .or.            config_flags%nested) THEN
17075 !  j_end =min(jde-2, jte)
17076 !  END IF
17077
17078 !  IF( config_flags%open_ye .or. config_flags%specified .or.   &
17079 !           config_flags%nested) THEN
17080
17081 !  END IF
17082
17083 !LPB[6]
17084
17085 !LPB[5]
17086
17087 !  IF( config_flags%open_ys .or. config_flags%specified .or.            config_flags%nested) THEN
17088 !  j_start =max(jds+1, jts)
17089 !  END IF
17090
17091 !  IF( config_flags%open_ys .or. config_flags%specified .or.   &
17092 !           config_flags%nested) THEN
17093
17094 !  END IF
17095
17096 !LPB[4]
17097
17098 !LPB[3]
17099
17100 !  IF( config_flags%open_xe .or. config_flags%specified .or.            config_flags%nested) THEN
17101 !  i_end =min(ide-2, ite)
17102 !  END IF
17103
17104 !  IF( config_flags%open_xe .or. config_flags%specified .or.   &
17105 !           config_flags%nested) THEN
17106
17107 !  END IF
17108
17109 !LPB[2]
17110
17111 !LPB[1]
17112
17113 !  IF( config_flags%open_xs .or. config_flags%specified .or.            config_flags%nested) THEN
17114 !  i_start =max(ids+1, its)
17115 !  END IF
17116
17117 !  IF( config_flags%open_xs .or. config_flags%specified .or.   &
17118 !           config_flags%nested) THEN
17119
17120 !  END IF
17121
17122 !LPB[0]
17123 !  ktf =min(kte, kde-1)
17124 !  i_start =its
17125 !  i_end =min(ite, ide-1)
17126 !  j_start =jts
17127 !  j_end =min(jte, jde-1)
17128
17129    END SUBROUTINE a_vertical_diffusion_w_2
17130
17131    SUBROUTINE a_vertical_diffusion_s(tendency,a_tendency,config_flags,var,a_var, &
17132    mu,a_mu,xkhv,a_xkhv,dn,dnw,rdz,a_rdz,rdzw,a_rdzw,fnm,fnp,rho,a_rho,doing_tke,ids,ide, &
17133    jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
17134
17135 !PART I: DECLARATION OF VARIABLES
17136
17137    IMPLICIT NONE
17138
17139    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
17140    TYPE(grid_config_rec_type) :: config_flags
17141    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
17142    LOGICAL :: doing_tke
17143    REAL,DIMENSION(kms:kme) :: fnm
17144    REAL,DIMENSION(kms:kme) :: fnp
17145    REAL,DIMENSION(kms:kme) :: dn
17146    REAL,DIMENSION(kms:kme) :: dnw
17147    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: tendency,a_tendency
17148    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: xkhv,a_xkhv
17149    REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
17150    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: var,a_var,rdz,a_rdz,rdzw,a_rdzw
17151    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rho, a_rho
17152    INTEGER :: i,j,k,ktf
17153    INTEGER :: i_start,i_end,j_start,j_end
17154    REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: H3,a_H3,xkxavg,a_xkxavg,rravg,a_rravg
17155    REAL,DIMENSION(its:ite,kts:kte,jts:jte) :: tmptendf,a_tmptendf
17156
17157    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004
17158    REAL,DIMENSION(its:min(ite,ide-1),min0(kts+1,kts):min(kte,kde-1)) :: Tmpv300
17159    REAL,DIMENSION(its:min(ite,ide-1),min0(kts+1,kts):min(kte,kde-1)) :: Tmpv301
17160    REAL,DIMENSION(its:min(ite,ide-1),kts+1:min(kte,kde-1)) :: Tmpv302
17161
17162 !PART II: CALCULATIONS OF B. S. TRAJECTORY
17163
17164 !LPB[0]
17165       ktf=MIN(kte,kde-1)
17166       i_start = its
17167       i_end   = MIN(ite,ide-1)
17168       j_start = jts
17169       j_end   = MIN(jte,jde-1)
17170
17171 !LPB[1]
17172    IF ( config_flags%open_xs .or. config_flags%specified .or.   &
17173         config_flags%nested) i_start = MAX(ids+1,its)
17174
17175 !LPB[2]
17176
17177 !LPB[3]
17178    IF ( config_flags%open_xe .or. config_flags%specified .or.   &
17179         config_flags%nested) i_end   = MIN(ide-2,ite)
17180
17181 !LPB[4]
17182
17183 !LPB[5]
17184    IF ( config_flags%open_ys .or. config_flags%specified .or.   &
17185         config_flags%nested) j_start = MAX(jds+1,jts)
17186
17187 !LPB[6]
17188
17189 !LPB[7]
17190    IF ( config_flags%open_ye .or. config_flags%specified .or.   &
17191         config_flags%nested) j_end   = MIN(jde-2,jte)
17192
17193 !LPB[8]
17194
17195 !LPB[9]
17196       IF ( config_flags%periodic_x ) i_start = its
17197
17198 !LPB[10]
17199
17200 !LPB[11]
17201       IF ( config_flags%periodic_x ) i_end = MIN(ite,ide-1)
17202
17203 !LPB[12]
17204
17205 !LPB[13]
17206 ! Remarked by Ning Pan, 2010-08-10
17207 !   IF (doing_tke) THEN
17208
17209 !         DO j = j_start, j_end
17210 !         DO k = kts,ktf
17211 !         DO i = i_start, i_end
17212 !            tmptendf(i,k,j)=tendency(i,k,j)
17213 !         ENDDO
17214 !         ENDDO
17215 !         ENDDO
17216
17217 !   ENDIF
17218
17219 !LPB[14]
17220
17221       xkxavg = 0.
17222
17223 !LPB[15]
17224       DO j = j_start, j_end
17225
17226       DO k = kts+1,ktf
17227       DO i = i_start, i_end
17228          xkxavg(i,k,j)=fnm(k)*xkhv(i,k,j)+fnp(k)*xkhv(i,k-1,j)
17229          H3(i,k,j)=-xkxavg(i,k,j)*(var(i,k,j)-var(i,k-1,j))*rdz(i,k,j)
17230       ENDDO
17231       ENDDO
17232
17233       ENDDO
17234
17235 !LPB[16]
17236       DO j = j_start, j_end
17237
17238       DO i = i_start, i_end
17239          H3(i,kts,j)=0.
17240          H3(i,ktf+1,j)=0.
17241       ENDDO
17242
17243       ENDDO
17244
17245 !!LPB[17]
17246 !      DO j = j_start, j_end
17247
17248 !      DO k = kts,ktf
17249 !      DO i = i_start, i_end
17250 !         tendency(i,k,j)=tendency(i,k,j)    &
17251 !                          -mu(i,j)*(H3(i,k+1,j)-H3(i,k,j))*rdzw(i,k,j)
17252 !      ENDDO
17253 !      ENDDO
17254
17255 !      ENDDO
17256
17257 !!LPB[18]
17258
17259 !!LPB[19]
17260 !   IF (doing_tke) THEN
17261
17262 !         DO j = j_start, j_end
17263 !         DO k = kts,ktf
17264 !         DO i = i_start, i_end
17265 !             tendency(i,k,j)=tmptendf(i,k,j)+2.*   &
17266 !                             (tendency(i,k,j)-tmptendf(i,k,j))
17267 !         ENDDO
17268 !         ENDDO
17269 !         ENDDO
17270
17271 !   ENDIF
17272
17273 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
17274
17275    Do K2_ADJ =jts, jte
17276    Do K1_ADJ =kts, kte
17277    Do K0_ADJ =its, ite
17278    a_H3(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
17279    End Do
17280    End Do
17281    End Do
17282
17283    Do K2_ADJ =jts, jte
17284    Do K1_ADJ =kts, kte
17285    Do K0_ADJ =its, ite
17286    a_xkxavg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
17287    End Do
17288    End Do
17289    End Do
17290
17291    Do K2_ADJ =jts, jte
17292    Do K1_ADJ =kts, kte
17293    Do K0_ADJ =its, ite
17294    a_rravg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
17295    End Do
17296    End Do
17297    End Do
17298
17299    Do K2_ADJ =jts, jte
17300    Do K1_ADJ =kts, kte
17301    Do K0_ADJ =its, ite
17302    a_tmptendf(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
17303    End Do
17304    End Do
17305    End Do
17306
17307 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
17308
17309 !LPB[19]
17310
17311 !  IF(doing_tke) THEN
17312 !  DO j =j_start, j_end
17313 !  DO k =kts, ktf
17314 !  DO i =i_start, i_end
17315 !  Tmpv001 =tendency(i,k,j) -tmptendf(i,k,j)
17316 !  Tmpv002 =2.*Tmpv001
17317 !  Tmpv003 =tmptendf(i,k,j) +Tmpv002
17318 !  tendency(i,k,j) =Tmpv003
17319
17320 !  ENDDO
17321 !  ENDDO
17322 !  ENDDO
17323 !  ENDIF
17324
17325    IF(doing_tke) THEN
17326
17327    DO j =j_end, j_start, -1
17328    DO k =ktf, kts, -1
17329    DO i =i_end, i_start, -1
17330    a_Tmpv3 =a_tendency(i,k,j)
17331    a_tendency(i,k,j) =0.0
17332    a_tmptendf(i,k,j) =a_tmptendf(i,k,j) +a_Tmpv3
17333    a_Tmpv2 =a_Tmpv3
17334    a_Tmpv1 =2.*a_Tmpv2
17335    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv1
17336    a_tmptendf(i,k,j) =a_tmptendf(i,k,j) -a_Tmpv1
17337    ENDDO
17338    ENDDO
17339    ENDDO
17340
17341    ENDIF
17342
17343 !LPB[18]
17344
17345 !LPB[17]
17346    DO j =j_end, j_start, -1
17347
17348    DO k =kts, ktf
17349    DO i =i_start, i_end
17350    Tmpv001 =H3(i,k+1,j) -H3(i,k,j)
17351    Tmpv300(i,k) =Tmpv001
17352    Tmpv002 =mu(i,j)*Tmpv300(i,k)
17353    Tmpv301(i,k) =Tmpv002
17354 ! Remarked by Ning Pan, 2010-08-10
17355 !   Tmpv003 =Tmpv301(i,k)*rdzw(i,k,j)
17356 !   Tmpv004 =tendency(i,k,j) -Tmpv003
17357 !   tendency(i,k,j) =Tmpv004
17358
17359    ENDDO
17360    ENDDO
17361
17362    DO k =ktf, kts, -1
17363    DO i =i_end, i_start, -1
17364    a_Tmpv4 =a_tendency(i,k,j)
17365    a_tendency(i,k,j) =0.0
17366    a_tendency(i,k,j) =a_tendency(i,k,j) +a_Tmpv4
17367    a_Tmpv3 =-a_Tmpv4
17368    a_Tmpv2 =rdzw(i,k,j)*a_Tmpv3
17369    a_rdzw(i,k,j) =a_rdzw(i,k,j) +Tmpv301(i,k)*a_Tmpv3
17370    a_mu(i,j) =a_mu(i,j) +Tmpv300(i,k)*a_Tmpv2
17371    a_Tmpv1 =mu(i,j)*a_Tmpv2
17372    a_H3(i,k+1,j) =a_H3(i,k+1,j) +a_Tmpv1
17373    a_H3(i,k,j) =a_H3(i,k,j) -a_Tmpv1
17374    ENDDO
17375    ENDDO
17376
17377    ENDDO
17378
17379 !LPB[16]
17380    DO j =j_end, j_start, -1
17381
17382 !  DO i =i_start, i_end
17383 !  H3(i,kts,j) =0.
17384
17385 !  H3(i,ktf+1,j) =0.
17386
17387 !  ENDDO
17388
17389    DO i =i_end, i_start, -1
17390    a_H3(i,ktf+1,j) =0.0
17391    a_H3(i,kts,j) =0.0
17392    ENDDO
17393
17394    ENDDO
17395
17396    xkxavg = 0.  ! Added by Ning Pan, 2010-08-10
17397 !LPB[15]
17398    DO j =j_end, j_start, -1
17399
17400    DO k =kts+1, ktf
17401    DO i =i_start, i_end
17402    Tmpv001 =fnm(k)*xkhv(i,k,j) +fnp(k)*xkhv(i,k-1,j)
17403 ! Revised by Ning Pan, 2010-08-10
17404 !   Tmpv300(i,k) =xkxavg(i,k,j)
17405 !   xkxavg(i,k,j) =Tmpv001
17406    xkxavg(i,k,j) =Tmpv001
17407    Tmpv300(i,k) =xkxavg(i,k,j)
17408
17409    Tmpv001 =var(i,k,j) -var(i,k-1,j)
17410    Tmpv301(i,k) =Tmpv001
17411    Tmpv002 =-xkxavg(i,k,j)*Tmpv301(i,k)
17412    Tmpv302(i,k) =Tmpv002
17413 ! Remarked by Ning Pan, 2010-08-10
17414 !   Tmpv003 =Tmpv302(i,k)*rdz(i,k,j)
17415 !   H3(i,k,j) =Tmpv003
17416
17417    ENDDO
17418    ENDDO
17419
17420    DO k =ktf, kts+1, -1
17421    DO i =i_end, i_start, -1
17422    xkxavg(i,k,j) =Tmpv300(i,k)  ! Added by Ning Pan, 2010-08-10
17423    a_Tmpv3 =a_H3(i,k,j)
17424    a_H3(i,k,j) =0.0
17425    a_Tmpv2 =rdz(i,k,j)*a_Tmpv3
17426    a_rdz(i,k,j) =a_rdz(i,k,j) +Tmpv302(i,k)*a_Tmpv3
17427    a_xkxavg(i,k,j) =a_xkxavg(i,k,j) -Tmpv301(i,k)*a_Tmpv2
17428    a_Tmpv1 =-xkxavg(i,k,j)*a_Tmpv2
17429    a_var(i,k,j) =a_var(i,k,j) +a_Tmpv1
17430    a_var(i,k-1,j) =a_var(i,k-1,j) -a_Tmpv1
17431
17432 !   xkxavg(i,k,j) =Tmpv300(i,k)  ! Remarked by Ning Pan, 2010-08-10
17433
17434    a_Tmpv1 =a_xkxavg(i,k,j)
17435    a_xkxavg(i,k,j) =0.0
17436    a_xkhv(i,k,j) =a_xkhv(i,k,j) +fnm(k)*a_Tmpv1
17437    a_xkhv(i,k-1,j) =a_xkhv(i,k-1,j) +fnp(k)*a_Tmpv1
17438    ENDDO
17439    ENDDO
17440
17441    ENDDO
17442
17443 !LPB[14]
17444 !  xkxavg =0.
17445
17446    a_xkxavg =0.0
17447
17448 !LPB[13]
17449
17450 !  IF(doing_tke) THEN
17451 !  DO j =j_start, j_end
17452 !  DO k =kts, ktf
17453 !  DO i =i_start, i_end
17454 !  tmptendf(i,k,j) =tendency(i,k,j)
17455
17456 !  ENDDO
17457 !  ENDDO
17458 !  ENDDO
17459 !  ENDIF
17460
17461    IF(doing_tke) THEN
17462
17463    DO j =j_end, j_start, -1
17464    DO k =ktf, kts, -1
17465    DO i =i_end, i_start, -1
17466    a_tendency(i,k,j) =a_tendency(i,k,j) +a_tmptendf(i,k,j)
17467    a_tmptendf(i,k,j) =0.0
17468    ENDDO
17469    ENDDO
17470    ENDDO
17471
17472    ENDIF
17473
17474 !LPB[12]
17475
17476 !LPB[11]
17477
17478 !  IF( config_flags%periodic_x ) THEN
17479 !  i_end =min(ite, ide-1)
17480 !  END IF
17481
17482 !  IF( config_flags%periodic_x ) THEN
17483
17484 !  END IF
17485
17486 !LPB[10]
17487
17488 !LPB[9]
17489
17490 !  IF( config_flags%periodic_x ) THEN
17491 !  i_start =its
17492 !  END IF
17493
17494 !  IF( config_flags%periodic_x ) THEN
17495
17496 !  END IF
17497
17498 !LPB[8]
17499
17500 !LPB[7]
17501
17502 !  IF( config_flags%open_ye .or. config_flags%specified .or.            config_flags%nested) THEN
17503 !  j_end =min(jde-2, jte)
17504 !  END IF
17505
17506 !  IF( config_flags%open_ye .or. config_flags%specified .or.   &
17507 !           config_flags%nested) THEN
17508
17509 !  END IF
17510
17511 !LPB[6]
17512
17513 !LPB[5]
17514
17515 !  IF( config_flags%open_ys .or. config_flags%specified .or.            config_flags%nested) THEN
17516 !  j_start =max(jds+1, jts)
17517 !  END IF
17518
17519 !  IF( config_flags%open_ys .or. config_flags%specified .or.   &
17520 !           config_flags%nested) THEN
17521
17522 !  END IF
17523
17524 !LPB[4]
17525
17526 !LPB[3]
17527
17528 !  IF( config_flags%open_xe .or. config_flags%specified .or.            config_flags%nested) THEN
17529 !  i_end =min(ide-2, ite)
17530 !  END IF
17531
17532 !  IF( config_flags%open_xe .or. config_flags%specified .or.   &
17533 !           config_flags%nested) THEN
17534
17535 !  END IF
17536
17537 !LPB[2]
17538
17539 !LPB[1]
17540
17541 !  IF( config_flags%open_xs .or. config_flags%specified .or.            config_flags%nested) THEN
17542 !  i_start =max(ids+1, its)
17543 !  END IF
17544
17545 !  IF( config_flags%open_xs .or. config_flags%specified .or.   &
17546 !           config_flags%nested) THEN
17547
17548 !  END IF
17549
17550 !LPB[0]
17551 !  ktf =min(kte, kde-1)
17552 !  i_start =its
17553 !  i_end =min(ite, ide-1)
17554 !  j_start =jts
17555 !  j_end =min(jte, jde-1)
17556
17557    END SUBROUTINE a_vertical_diffusion_s
17558
17559    SUBROUTINE a_cal_titau_11_22_33(config_flags,titau,a_titau,mu,a_mu,tke,a_tke, &
17560    xkx,a_xkx,defor,a_defor,mtau,a_mtau,rho,a_rho,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds, &
17561    jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
17562
17563 !PART I: DECLARATION OF VARIABLES
17564
17565    IMPLICIT NONE
17566
17567    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
17568    TYPE(grid_config_rec_type) :: config_flags
17569    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
17570    INTEGER :: is_ext,ie_ext,js_ext,je_ext
17571    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau,a_titau
17572    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor,a_defor,xkx,a_xkx,tke,a_tke
17573    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: mtau,a_mtau
17574    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rho, a_rho
17575    REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
17576    INTEGER :: i,j,k,ktf,i_start,i_end,j_start,j_end
17577
17578 !  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb13_mtau
17579    INTEGER :: IX1,IX2,IX3
17580
17581    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002
17582 ! Revised by Ning Pan, 2010-08-10
17583 !   REAL,DIMENSION(i_start-is_ext:i_end+ie_ext,kts:min(kte,kde-1),j_start-js_ext:j_end+ &
17584 !   je_ext) :: Tmpv400
17585 !   REAL,DIMENSION(i_start-is_ext:i_end+ie_ext,kts:min(kte,kde-1),j_start-js_ext:j_end+ &
17586 !   je_ext) :: Tmpv401
17587 !   REAL,DIMENSION(i_start-is_ext:i_end+ie_ext,kts:min(kte,kde-1),j_start-js_ext:j_end+ &
17588 !   je_ext) :: Tmpv402
17589    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: Tmpv400, Tmpv401, Tmpv402
17590
17591 !PART II: CALCULATIONS OF B. S. TRAJECTORY
17592
17593 !LPB[0]
17594
17595        ktf = MIN( kte, kde-1 )
17596        i_start = its
17597        i_end   = ite
17598        j_start = jts
17599        j_end   = jte
17600
17601 !LPB[1]
17602     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
17603          config_flags%nested) i_start = MAX( ids+1, its )
17604
17605 !LPB[2]
17606
17607 !LPB[3]
17608     IF ( config_flags%open_xe .OR. config_flags%specified .OR.   &
17609          config_flags%nested) i_end   = MIN( ide-1, ite )
17610
17611 !LPB[4]
17612
17613 !LPB[5]
17614     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
17615          config_flags%nested) j_start = MAX( jds+1, jts )
17616
17617 !LPB[6]
17618
17619 !LPB[7]
17620     IF ( config_flags%open_ye .OR. config_flags%specified .OR.   &
17621          config_flags%nested) j_end   = MIN( jde-1, jte )
17622
17623 !LPB[8]
17624
17625 !LPB[9]
17626       IF ( config_flags%periodic_x ) i_start = its
17627
17628 !LPB[10]
17629
17630 !LPB[11]
17631       IF ( config_flags%periodic_x ) i_end = ite
17632
17633 !LPB[12]
17634        i_start = i_start - is_ext
17635        i_end   = i_end   + ie_ext
17636        j_start = j_start - js_ext
17637        j_end   = j_end   + je_ext
17638
17639 !!LPB[13]
17640 !!  DO IX3=jms,jme
17641 !!  DO IX2=kms,kme
17642 !!  DO IX1=ims,ime
17643 !    !  Keep_Lpb13_mtau(IX1,IX2,IX3) =mtau(IX1,IX2,IX3)
17644 !!  END DO
17645 !!  END DO
17646 !!  END DO
17647
17648 !    IF ( config_flags%sfs_opt .GT. 0 ) THEN
17649
17650 !         DO j = j_start, j_end
17651 !         DO k = kts, ktf
17652 !         DO i = i_start, i_end
17653 !           titau(i,k,j) = mu(i,j) * mtau(i,k,j)
17654 !         END DO
17655 !         END DO
17656 !         END DO
17657 !       ELSE
17658 !      IF ( config_flags%m_opt .EQ. 1 ) THEN
17659
17660 !           DO j = j_start, j_end
17661 !           DO k = kts, ktf
17662 !           DO i = i_start, i_end
17663 !             titau(i,k,j) = - mu(i,j) * xkx(i,k,j) * defor(i,k,j)
17664 !             mtau(i,k,j) = - xkx(i,k,j) * defor(i,k,j)
17665 !           END DO
17666 !           END DO
17667 !           END DO
17668 !         ELSE
17669
17670 !           DO j = j_start, j_end
17671 !           DO k = kts, ktf
17672 !           DO i = i_start, i_end
17673 !             titau(i,k,j) = - mu(i,j) * xkx(i,k,j) * defor(i,k,j)
17674 !           END DO
17675 !           END DO
17676 !           END DO
17677 !         ENDIF
17678
17679 !   ENDIF
17680
17681 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
17682
17683 !LPB[13]
17684 !  DO IX3=jms,jme
17685 !  DO IX2=kms,kme
17686 !  DO IX1=ims,ime
17687 !  mtau(IX1,IX2,IX3) =Keep_Lpb13_mtau(IX1,IX2,IX3)
17688 !  END DO
17689 !  END DO
17690 !  END DO
17691
17692    IF( config_flags%sfs_opt .GT. 0 ) THEN
17693 ! Remarked by Ning Pan, 2010-08-10
17694 !   DO j =j_start, j_end
17695 !   DO k =kts, ktf
17696 !   DO i =i_start, i_end
17697 !   Tmpv001 =mu(i,j)*mtau(i,k,j)
17698 !   titau(i,k,j) =Tmpv001
17699
17700 !   ENDDO
17701 !   ENDDO
17702 !   ENDDO
17703    ELSE
17704    IF( config_flags%m_opt .EQ. 1 ) THEN
17705    DO j =j_start, j_end
17706    DO k =kts, ktf
17707    DO i =i_start, i_end
17708    Tmpv001 =-mu(i,j)*xkx(i,k,j)
17709    Tmpv400(i,k,j) =Tmpv001
17710 ! Remarked by Ning Pan, 2010-08-10
17711 !   Tmpv002 =Tmpv400(i,k,j)*defor(i,k,j)
17712 !   titau(i,k,j) =Tmpv002
17713
17714 ! Remarked by Ning Pan, 2010-08-10
17715 !   Tmpv001 =-xkx(i,k,j)*defor(i,k,j)
17716 !   Tmpv401(i,k,j) =mtau(i,k,j)
17717 !   mtau(i,k,j) =Tmpv001
17718
17719    ENDDO
17720    ENDDO
17721    ENDDO
17722    ELSE
17723    DO j =j_start, j_end
17724    DO k =kts, ktf
17725    DO i =i_start, i_end
17726    Tmpv001 =-mu(i,j)*xkx(i,k,j)
17727    Tmpv402(i,k,j) =Tmpv001
17728 ! Remarked by Ning Pan, 2010-08-10
17729 !   Tmpv002 =Tmpv402(i,k,j)*defor(i,k,j)
17730 !   titau(i,k,j) =Tmpv002
17731
17732    ENDDO
17733    ENDDO
17734    ENDDO
17735    ENDIF
17736    ENDIF
17737
17738    IF( config_flags%sfs_opt .GT. 0 ) THEN
17739
17740    DO j =j_end, j_start, -1
17741    DO k =ktf, kts, -1
17742    DO i =i_end, i_start, -1
17743    a_Tmpv1 =a_titau(i,k,j)
17744    a_titau(i,k,j) =0.0
17745    a_mu(i,j) =a_mu(i,j) +mtau(i,k,j)*a_Tmpv1
17746    a_mtau(i,k,j) =a_mtau(i,k,j) +mu(i,j)*a_Tmpv1
17747    ENDDO
17748    ENDDO
17749    ENDDO
17750
17751    ELSE
17752
17753    IF( config_flags%m_opt .EQ. 1 ) THEN
17754
17755    DO j =j_end, j_start, -1
17756    DO k =ktf, kts, -1
17757    DO i =i_end, i_start, -1
17758
17759 !   mtau(i,k,j) =Tmpv401(i,k,j)  ! Remarked by Ning Pan, 2010-08-10
17760
17761    a_Tmpv1 =a_mtau(i,k,j)
17762    a_mtau(i,k,j) =0.0
17763    a_xkx(i,k,j) =a_xkx(i,k,j) -defor(i,k,j)*a_Tmpv1
17764    a_defor(i,k,j) =a_defor(i,k,j) -xkx(i,k,j)*a_Tmpv1
17765    a_Tmpv2 =a_titau(i,k,j)
17766    a_titau(i,k,j) =0.0
17767    a_Tmpv1 =defor(i,k,j)*a_Tmpv2
17768    a_defor(i,k,j) =a_defor(i,k,j) +Tmpv400(i,k,j)*a_Tmpv2
17769    a_mu(i,j) =a_mu(i,j) -xkx(i,k,j)*a_Tmpv1
17770    a_xkx(i,k,j) =a_xkx(i,k,j) -mu(i,j)*a_Tmpv1
17771    ENDDO
17772    ENDDO
17773    ENDDO
17774
17775    ELSE
17776
17777    DO j =j_end, j_start, -1
17778    DO k =ktf, kts, -1
17779    DO i =i_end, i_start, -1
17780    a_Tmpv2 =a_titau(i,k,j)
17781    a_titau(i,k,j) =0.0
17782    a_Tmpv1 =defor(i,k,j)*a_Tmpv2
17783    a_defor(i,k,j) =a_defor(i,k,j) +Tmpv402(i,k,j)*a_Tmpv2
17784    a_mu(i,j) =a_mu(i,j) -xkx(i,k,j)*a_Tmpv1
17785    a_xkx(i,k,j) =a_xkx(i,k,j) -mu(i,j)*a_Tmpv1
17786    ENDDO
17787    ENDDO
17788    ENDDO
17789
17790    ENDIF
17791
17792    ENDIF
17793
17794 !LPB[12]
17795 !  i_start =i_start-is_ext
17796 !  i_end =i_end+ie_ext
17797 !  j_start =j_start-js_ext
17798 !  j_end =j_end+je_ext
17799
17800 !LPB[11]
17801
17802 !  IF( config_flags%periodic_x ) THEN
17803 !  i_end =ite
17804 !  END IF
17805
17806 !  IF( config_flags%periodic_x ) THEN
17807
17808 !  END IF
17809
17810 !LPB[10]
17811
17812 !LPB[9]
17813
17814 !  IF( config_flags%periodic_x ) THEN
17815 !  i_start =its
17816 !  END IF
17817
17818 !  IF( config_flags%periodic_x ) THEN
17819
17820 !  END IF
17821
17822 !LPB[8]
17823
17824 !LPB[7]
17825
17826 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.             config_flags%nested) THEN
17827 !  j_end =min(jde-1, jte)
17828 !  END IF
17829
17830 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
17831 !            config_flags%nested) THEN
17832
17833 !  END IF
17834
17835 !LPB[6]
17836
17837 !LPB[5]
17838
17839 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.             config_flags%nested) THEN
17840 !  j_start =max(jds+1, jts)
17841 !  END IF
17842
17843 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
17844 !            config_flags%nested) THEN
17845
17846 !  END IF
17847
17848 !LPB[4]
17849
17850 !LPB[3]
17851
17852 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.             config_flags%nested) THEN
17853 !  i_end =min(ide-1, ite)
17854 !  END IF
17855
17856 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
17857 !            config_flags%nested) THEN
17858
17859 !  END IF
17860
17861 !LPB[2]
17862
17863 !LPB[1]
17864
17865 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.             config_flags%nested) THEN
17866 !  i_start =max(ids+1, its)
17867 !  END IF
17868
17869 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
17870 !            config_flags%nested) THEN
17871
17872 !  END IF
17873
17874 !LPB[0]
17875 !  ktf =min(kte, kde-1)
17876 !  i_start =its
17877 !  i_end =ite
17878 !  j_start =jts
17879 !  j_end =jte
17880
17881    END SUBROUTINE a_cal_titau_11_22_33
17882
17883    SUBROUTINE a_cal_titau_12_21(config_flags,titau,a_titau,mu,a_mu,xkx,a_xkx, &
17884    defor,a_defor,mtau,a_mtau,rho,a_rho,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde,kds,kde, &
17885    ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
17886
17887 !PART I: DECLARATION OF VARIABLES
17888
17889    IMPLICIT NONE
17890
17891    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
17892    TYPE(grid_config_rec_type) :: config_flags
17893    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
17894    INTEGER :: is_ext,ie_ext,js_ext,je_ext
17895    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau,a_titau
17896    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor,a_defor,xkx,a_xkx
17897    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: mtau,a_mtau
17898    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rho, a_rho
17899    REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
17900    INTEGER :: i,j,k,ktf,i_start,i_end,j_start,j_end
17901    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: xkxavg,a_xkxavg
17902    REAL,DIMENSION(its-1:ite+1,jts-1:jte+1) :: muavg,a_muavg
17903
17904 !  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb16_mtau
17905    INTEGER :: IX1,IX2,IX3
17906
17907    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004
17908 ! Revised by Ning Pan, 2010-08-10
17909 !  REAL,DIMENSION(i_start-is_ext:i_end+ie_ext,kts:min(kte,kde-1),j_start-js_ext:j_end+ &
17910 !  je_ext) :: Tmpv400
17911 !  REAL,DIMENSION(i_start-is_ext:i_end+ie_ext,kts:min(kte,kde-1),j_start-js_ext:j_end+ &
17912 !  je_ext) :: Tmpv401
17913 !  REAL,DIMENSION(i_start-is_ext:i_end+ie_ext,kts:min(kte,kde-1),j_start-js_ext:j_end+ &
17914 !  je_ext) :: Tmpv402
17915    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: Tmpv400, Tmpv401, Tmpv402
17916
17917 !PART II: CALCULATIONS OF B. S. TRAJECTORY
17918
17919 !LPB[0]
17920
17921        ktf = MIN( kte, kde-1 )
17922        i_start = its
17923        i_end   = ite
17924        j_start = jts
17925        j_end   = jte
17926
17927 !LPB[1]
17928     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
17929          config_flags%nested ) i_start = MAX( ids+1, its )
17930
17931 !LPB[2]
17932
17933 !LPB[3]
17934     IF ( config_flags%open_xe .OR. config_flags%specified .OR.   &
17935          config_flags%nested ) i_end   = MIN( ide-1, ite )
17936
17937 !LPB[4]
17938
17939 !LPB[5]
17940     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
17941          config_flags%nested ) j_start = MAX( jds+1, jts )
17942
17943 !LPB[6]
17944
17945 !LPB[7]
17946     IF ( config_flags%open_ye .OR. config_flags%specified .OR.   &
17947          config_flags%nested ) j_end   = MIN( jde-1, jte )
17948
17949 !LPB[8]
17950
17951 !LPB[9]
17952       IF ( config_flags%periodic_x ) i_start = its
17953
17954 !LPB[10]
17955
17956 !LPB[11]
17957       IF ( config_flags%periodic_x ) i_end = ite
17958
17959 !LPB[12]
17960        i_start = i_start - is_ext
17961        i_end   = i_end   + ie_ext
17962        j_start = j_start - js_ext
17963        j_end   = j_end   + je_ext
17964
17965 !LPB[13]
17966        DO j = j_start, j_end
17967
17968        DO k = kts, ktf
17969        DO i = i_start, i_end
17970          xkxavg(i,k,j) = 0.25 * ( xkx(i-1,k,j  ) + xkx(i,k,j  ) +    &
17971                                   xkx(i-1,k,j-1) + xkx(i,k,j-1) )
17972        END DO
17973        END DO
17974
17975        END DO
17976
17977 !LPB[14]
17978        DO j = j_start, j_end
17979
17980        DO i = i_start, i_end
17981          muavg(i,j) = 0.25 * ( mu(i-1,j  ) + mu(i,j  ) +    &
17982                                mu(i-1,j-1) + mu(i,j-1) )
17983        END DO
17984
17985        END DO
17986
17987 !LPB[15]
17988
17989 !!LPB[16]
17990 !!  DO IX3=jms,jme
17991 !!  DO IX2=kms,kme
17992 !!  DO IX1=ims,ime
17993 !    !  Keep_Lpb16_mtau(IX1,IX2,IX3) =mtau(IX1,IX2,IX3)
17994 !!  END DO
17995 !!  END DO
17996 !!  END DO
17997
17998 !    IF ( config_flags%sfs_opt .GT. 0 ) THEN
17999
18000 !         DO j = j_start, j_end
18001 !         DO k = kts, ktf
18002 !         DO i = i_start, i_end
18003 !           titau(i,k,j) = muavg(i,j)  * mtau(i,k,j)
18004 !         END DO
18005 !         END DO
18006 !         END DO
18007 !       ELSE
18008 !      IF ( config_flags%m_opt .EQ. 1 ) THEN
18009
18010 !           DO j = j_start, j_end
18011 !           DO k = kts, ktf
18012 !           DO i = i_start, i_end
18013 !             titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j)
18014 !             mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j)
18015 !           END DO
18016 !           END DO
18017 !           END DO
18018 !         ELSE
18019
18020 !           DO j = j_start, j_end
18021 !           DO k = kts, ktf
18022 !           DO i = i_start, i_end
18023 !             titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j)
18024 !           END DO
18025 !           END DO
18026 !           END DO
18027 !         ENDIF
18028
18029 !   ENDIF
18030
18031 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
18032
18033    Do K2_ADJ =jts-1, jte+1
18034    Do K1_ADJ =kts, kte
18035    Do K0_ADJ =its-1, ite+1
18036    a_xkxavg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
18037    End Do
18038    End Do
18039    End Do
18040
18041    Do K1_ADJ =jts-1, jte+1
18042    Do K0_ADJ =its-1, ite+1
18043    a_muavg(K0_ADJ,K1_ADJ) =0.0
18044    End Do
18045    End Do
18046
18047 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
18048
18049 !LPB[16]
18050 !  DO IX3=jms,jme
18051 !  DO IX2=kms,kme
18052 !  DO IX1=ims,ime
18053 !  mtau(IX1,IX2,IX3) =Keep_Lpb16_mtau(IX1,IX2,IX3)
18054 !  END DO
18055 !  END DO
18056 !  END DO
18057
18058    IF( config_flags%sfs_opt .GT. 0 ) THEN
18059 ! Remarked by Ning Pan, 2010-08-10
18060 !   DO j =j_start, j_end
18061 !   DO k =kts, ktf
18062 !   DO i =i_start, i_end
18063 !   Tmpv001 =muavg(i,j)*mtau(i,k,j)
18064 !   titau(i,k,j) =Tmpv001
18065
18066 !   ENDDO
18067 !   ENDDO
18068 !   ENDDO
18069    ELSE
18070    IF( config_flags%m_opt .EQ. 1 ) THEN
18071    DO j =j_start, j_end
18072    DO k =kts, ktf
18073    DO i =i_start, i_end
18074    Tmpv001 =-muavg(i,j)*xkxavg(i,k,j)
18075    Tmpv400(i,k,j) =Tmpv001
18076 ! Remarked by Ning Pan, 2010-08-10
18077 !   Tmpv002 =Tmpv400(i,k,j)*defor(i,k,j)
18078 !   titau(i,k,j) =Tmpv002
18079
18080 ! Remarked by Ning Pan, 2010-08-10
18081 !   Tmpv001 =-xkxavg(i,k,j)*defor(i,k,j)
18082 !   Tmpv401(i,k,j) =mtau(i,k,j)
18083 !   mtau(i,k,j) =Tmpv001
18084
18085    ENDDO
18086    ENDDO
18087    ENDDO
18088    ELSE
18089    DO j =j_start, j_end
18090    DO k =kts, ktf
18091    DO i =i_start, i_end
18092    Tmpv001 =-muavg(i,j)*xkxavg(i,k,j)
18093    Tmpv402(i,k,j) =Tmpv001
18094 ! Remarked by Ning Pan, 2010-08-10
18095 !   Tmpv002 =Tmpv402(i,k,j)*defor(i,k,j)
18096 !   titau(i,k,j) =Tmpv002
18097
18098    ENDDO
18099    ENDDO
18100    ENDDO
18101    ENDIF
18102    ENDIF
18103
18104    IF( config_flags%sfs_opt .GT. 0 ) THEN
18105
18106    DO j =j_end, j_start, -1
18107    DO k =ktf, kts, -1
18108    DO i =i_end, i_start, -1
18109    a_Tmpv1 =a_titau(i,k,j)
18110    a_titau(i,k,j) =0.0
18111    a_muavg(i,j) =a_muavg(i,j) +mtau(i,k,j)*a_Tmpv1
18112    a_mtau(i,k,j) =a_mtau(i,k,j) +muavg(i,j)*a_Tmpv1
18113    ENDDO
18114    ENDDO
18115    ENDDO
18116
18117    ELSE
18118
18119    IF( config_flags%m_opt .EQ. 1 ) THEN
18120
18121    DO j =j_end, j_start, -1
18122    DO k =ktf, kts, -1
18123    DO i =i_end, i_start, -1
18124
18125 !   mtau(i,k,j) =Tmpv401(i,k,j)  ! Remarked by Ning Pan, 2010-08-10
18126
18127    a_Tmpv1 =a_mtau(i,k,j)
18128    a_mtau(i,k,j) =0.0
18129    a_xkxavg(i,k,j) =a_xkxavg(i,k,j) -defor(i,k,j)*a_Tmpv1
18130    a_defor(i,k,j) =a_defor(i,k,j) -xkxavg(i,k,j)*a_Tmpv1
18131    a_Tmpv2 =a_titau(i,k,j)
18132    a_titau(i,k,j) =0.0
18133    a_Tmpv1 =defor(i,k,j)*a_Tmpv2
18134    a_defor(i,k,j) =a_defor(i,k,j) +Tmpv400(i,k,j)*a_Tmpv2
18135    a_muavg(i,j) =a_muavg(i,j) -xkxavg(i,k,j)*a_Tmpv1
18136    a_xkxavg(i,k,j) =a_xkxavg(i,k,j) -muavg(i,j)*a_Tmpv1
18137    ENDDO
18138    ENDDO
18139    ENDDO
18140
18141    ELSE
18142
18143    DO j =j_end, j_start, -1
18144    DO k =ktf, kts, -1
18145    DO i =i_end, i_start, -1
18146    a_Tmpv2 =a_titau(i,k,j)
18147    a_titau(i,k,j) =0.0
18148    a_Tmpv1 =defor(i,k,j)*a_Tmpv2
18149    a_defor(i,k,j) =a_defor(i,k,j) +Tmpv402(i,k,j)*a_Tmpv2
18150    a_muavg(i,j) =a_muavg(i,j) -xkxavg(i,k,j)*a_Tmpv1
18151    a_xkxavg(i,k,j) =a_xkxavg(i,k,j) -muavg(i,j)*a_Tmpv1
18152    ENDDO
18153    ENDDO
18154    ENDDO
18155
18156    ENDIF
18157
18158    ENDIF
18159
18160 !LPB[15]
18161
18162 !LPB[14]
18163    DO j =j_end, j_start, -1
18164
18165 !  DO i =i_start, i_end
18166 !  Tmpv001 =mu(i-1,j) +mu(i,j)
18167 !  Tmpv002 =Tmpv001 +mu(i-1,j-1)
18168 !  Tmpv003 =Tmpv002 +mu(i,j-1)
18169 !  Tmpv004 =0.25*Tmpv003
18170 !  muavg(i,j) =Tmpv004
18171
18172 !  ENDDO
18173
18174    DO i =i_end, i_start, -1
18175    a_Tmpv4 =a_muavg(i,j)
18176    a_muavg(i,j) =0.0
18177    a_Tmpv3 =0.25*a_Tmpv4
18178    a_Tmpv2 =a_Tmpv3
18179    a_mu(i,j-1) =a_mu(i,j-1) +a_Tmpv3
18180    a_Tmpv1 =a_Tmpv2
18181    a_mu(i-1,j-1) =a_mu(i-1,j-1) +a_Tmpv2
18182    a_mu(i-1,j) =a_mu(i-1,j) +a_Tmpv1
18183    a_mu(i,j) =a_mu(i,j) +a_Tmpv1
18184    ENDDO
18185
18186    ENDDO
18187
18188 !LPB[13]
18189    DO j =j_end, j_start, -1
18190
18191 !  DO k =kts, ktf
18192 !  DO i =i_start, i_end
18193 !  Tmpv001 =xkx(i-1,k,j) +xkx(i,k,j)
18194 !  Tmpv002 =Tmpv001 +xkx(i-1,k,j-1)
18195 !  Tmpv003 =Tmpv002 +xkx(i,k,j-1)
18196 !  Tmpv004 =0.25*Tmpv003
18197 !  xkxavg(i,k,j) =Tmpv004
18198
18199 !  ENDDO
18200 !  ENDDO
18201
18202    DO k =ktf, kts, -1
18203    DO i =i_end, i_start, -1
18204    a_Tmpv4 =a_xkxavg(i,k,j)
18205    a_xkxavg(i,k,j) =0.0
18206    a_Tmpv3 =0.25*a_Tmpv4
18207    a_Tmpv2 =a_Tmpv3
18208    a_xkx(i,k,j-1) =a_xkx(i,k,j-1) +a_Tmpv3
18209    a_Tmpv1 =a_Tmpv2
18210    a_xkx(i-1,k,j-1) =a_xkx(i-1,k,j-1) +a_Tmpv2
18211    a_xkx(i-1,k,j) =a_xkx(i-1,k,j) +a_Tmpv1
18212    a_xkx(i,k,j) =a_xkx(i,k,j) +a_Tmpv1
18213    ENDDO
18214    ENDDO
18215
18216    ENDDO
18217
18218 !LPB[12]
18219 !  i_start =i_start-is_ext
18220 !  i_end =i_end+ie_ext
18221 !  j_start =j_start-js_ext
18222 !  j_end =j_end+je_ext
18223
18224 !LPB[11]
18225
18226 !  IF( config_flags%periodic_x ) THEN
18227 !  i_end =ite
18228 !  END IF
18229
18230 !  IF( config_flags%periodic_x ) THEN
18231
18232 !  END IF
18233
18234 !LPB[10]
18235
18236 !LPB[9]
18237
18238 !  IF( config_flags%periodic_x ) THEN
18239 !  i_start =its
18240 !  END IF
18241
18242 !  IF( config_flags%periodic_x ) THEN
18243
18244 !  END IF
18245
18246 !LPB[8]
18247
18248 !LPB[7]
18249
18250 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.             config_flags%nested ) THEN
18251 !  j_end =min(jde-1, jte)
18252 !  END IF
18253
18254 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
18255 !            config_flags%nested ) THEN
18256
18257 !  END IF
18258
18259 !LPB[6]
18260
18261 !LPB[5]
18262
18263 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.             config_flags%nested ) THEN
18264 !  j_start =max(jds+1, jts)
18265 !  END IF
18266
18267 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
18268 !            config_flags%nested ) THEN
18269
18270 !  END IF
18271
18272 !LPB[4]
18273
18274 !LPB[3]
18275
18276 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.             config_flags%nested ) THEN
18277 !  i_end =min(ide-1, ite)
18278 !  END IF
18279
18280 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
18281 !            config_flags%nested ) THEN
18282
18283 !  END IF
18284
18285 !LPB[2]
18286
18287 !LPB[1]
18288
18289 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.             config_flags%nested ) THEN
18290 !  i_start =max(ids+1, its)
18291 !  END IF
18292
18293 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
18294 !            config_flags%nested ) THEN
18295
18296 !  END IF
18297
18298 !LPB[0]
18299 !  ktf =min(kte, kde-1)
18300 !  i_start =its
18301 !  i_end =ite
18302 !  j_start =jts
18303 !  j_end =jte
18304
18305    END SUBROUTINE a_cal_titau_12_21
18306
18307    SUBROUTINE a_cal_titau_13_31(config_flags,titau,a_titau,defor,a_defor,mtau, &
18308    a_mtau,mu,a_mu,xkx,a_xkx,fnm,fnp,rho,a_rho,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde, &
18309    kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
18310
18311 !PART I: DECLARATION OF VARIABLES
18312
18313    IMPLICIT NONE
18314
18315    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
18316    TYPE(grid_config_rec_type) :: config_flags
18317    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
18318    INTEGER :: is_ext,ie_ext,js_ext,je_ext
18319    REAL,DIMENSION(kms:kme) :: fnm,fnp
18320    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau,a_titau
18321    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor,a_defor,xkx,a_xkx
18322    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rho, a_rho
18323    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: mtau,a_mtau
18324    REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
18325    INTEGER :: i,j,k,ktf,i_start,i_end,j_start,j_end
18326    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: xkxavg,a_xkxavg
18327    REAL,DIMENSION(its-1:ite+1,jts-1:jte+1) :: muavg,a_muavg
18328
18329 !  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb16_mtau
18330    INTEGER :: IX1,IX2,IX3
18331
18332    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
18333    a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006
18334 ! Revised by Ning Pan, 2010-08-10
18335 !   REAL,DIMENSION(i_start-is_ext:i_end+ie_ext,kts+1:min(kte,kde-1),j_start-js_ext:j_end+ &
18336 !   je_ext) :: Tmpv400
18337 !   REAL,DIMENSION(i_start-is_ext:i_end+ie_ext,kts+1:min(kte,kde-1),j_start-js_ext:j_end+ &
18338 !   je_ext) :: Tmpv401
18339 !   REAL,DIMENSION(i_start-is_ext:i_end+ie_ext,kts+1:min(kte,kde-1),j_start-js_ext:j_end+ &
18340 !   je_ext) :: Tmpv402
18341    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: Tmpv400, Tmpv401, Tmpv402
18342
18343 !PART II: CALCULATIONS OF B. S. TRAJECTORY
18344
18345 !LPB[0]
18346
18347        ktf = MIN( kte, kde-1 )
18348        i_start = its
18349        i_end   = ite
18350        j_start = jts
18351        j_end   = MIN( jte, jde-1 )
18352
18353 !LPB[1]
18354     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
18355          config_flags%nested) i_start = MAX( ids+1, its )
18356
18357 !LPB[2]
18358
18359 !LPB[3]
18360     IF ( config_flags%open_xe .OR. config_flags%specified .OR.   &
18361          config_flags%nested) i_end   = MIN( ide-1, ite )
18362
18363 !LPB[4]
18364
18365 !LPB[5]
18366     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
18367          config_flags%nested) j_start = MAX( jds+1, jts )
18368
18369 !LPB[6]
18370
18371 !LPB[7]
18372     IF ( config_flags%open_ye .OR. config_flags%specified .OR.   &
18373          config_flags%nested) j_end   = MIN( jde-2, jte )
18374
18375 !LPB[8]
18376
18377 !LPB[9]
18378       IF ( config_flags%periodic_x ) i_start = its
18379
18380 !LPB[10]
18381
18382 !LPB[11]
18383       IF ( config_flags%periodic_x ) i_end = ite
18384
18385 !LPB[12]
18386        i_start = i_start - is_ext
18387        i_end   = i_end   + ie_ext
18388        j_start = j_start - js_ext
18389        j_end   = j_end   + je_ext
18390
18391 !LPB[13]
18392        DO j = j_start, j_end
18393
18394        DO k = kts+1, ktf
18395        DO i = i_start, i_end
18396          xkxavg(i,k,j) = 0.5 * ( fnm(k) * ( xkx(i,k  ,j) + xkx(i-1,k  ,j) ) +    &
18397                                  fnp(k) * ( xkx(i,k-1,j) + xkx(i-1,k-1,j) ) )
18398        END DO
18399        END DO
18400
18401        END DO
18402
18403 !LPB[14]
18404        DO j = j_start, j_end
18405
18406        DO i = i_start, i_end
18407          muavg(i,j) = 0.5 * ( mu(i,j) + mu(i-1,j) )
18408        END DO
18409
18410        END DO
18411
18412 !LPB[15]
18413
18414 !!LPB[16]
18415 !!  DO IX3=jms,jme
18416 !!  DO IX2=kms,kme
18417 !!  DO IX1=ims,ime
18418 !    !  Keep_Lpb16_mtau(IX1,IX2,IX3) =mtau(IX1,IX2,IX3)
18419 !!  END DO
18420 !!  END DO
18421 !!  END DO
18422
18423 !    IF ( config_flags%sfs_opt .GT. 0 ) THEN
18424
18425 !         DO j = j_start, j_end
18426 !         DO k = kts+1, ktf
18427 !         DO i = i_start, i_end
18428 !            titau(i,k,j) = muavg(i,j) * mtau(i,k,j)
18429 !         ENDDO
18430 !         ENDDO
18431 !         ENDDO
18432 !       ELSE
18433 !      IF ( config_flags%m_opt .EQ. 1 ) THEN
18434
18435 !           DO j = j_start, j_end
18436 !           DO k = kts+1, ktf
18437 !           DO i = i_start, i_end
18438 !             titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j)
18439 !             mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j)
18440 !           ENDDO
18441 !           ENDDO
18442 !           ENDDO
18443 !         ELSE
18444
18445 !           DO j = j_start, j_end
18446 !           DO k = kts+1, ktf
18447 !           DO i = i_start, i_end
18448 !             titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j)
18449 !           ENDDO
18450 !           ENDDO
18451 !           ENDDO
18452 !         ENDIF
18453
18454 !   ENDIF
18455
18456 !!LPB[17]
18457 !       DO j = j_start, j_end
18458
18459 !
18460 !       DO i = i_start, i_end
18461 !         titau(i,kts  ,j) = 0.0
18462 !         titau(i,ktf+1,j) = 0.0
18463 !       ENDDO
18464
18465 !       ENDDO
18466
18467 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
18468
18469    Do K2_ADJ =jts-1, jte+1
18470    Do K1_ADJ =kts, kte
18471    Do K0_ADJ =its-1, ite+1
18472    a_xkxavg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
18473    End Do
18474    End Do
18475    End Do
18476
18477    Do K1_ADJ =jts-1, jte+1
18478    Do K0_ADJ =its-1, ite+1
18479    a_muavg(K0_ADJ,K1_ADJ) =0.0
18480    End Do
18481    End Do
18482
18483 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
18484
18485 !LPB[17]
18486    DO j =j_end, j_start, -1
18487
18488 !  DO i =i_start, i_end
18489 !  titau(i,kts,j) =0.0
18490
18491 !  titau(i,ktf+1,j) =0.0
18492
18493 !  ENDDO
18494
18495    DO i =i_end, i_start, -1
18496    a_titau(i,ktf+1,j) =0.0
18497    a_titau(i,kts,j) =0.0
18498    ENDDO
18499
18500    ENDDO
18501
18502 !LPB[16]
18503 !  DO IX3=jms,jme
18504 !  DO IX2=kms,kme
18505 !  DO IX1=ims,ime
18506 !  mtau(IX1,IX2,IX3) =Keep_Lpb16_mtau(IX1,IX2,IX3)
18507 !  END DO
18508 !  END DO
18509 !  END DO
18510
18511    IF( config_flags%sfs_opt .GT. 0 ) THEN
18512 ! Remarked by Ning Pan, 2010-08-10
18513 !   DO j =j_start, j_end
18514 !   DO k =kts+1, ktf
18515 !   DO i =i_start, i_end
18516 !   Tmpv001 =muavg(i,j)*mtau(i,k,j)
18517 !   titau(i,k,j) =Tmpv001
18518
18519 !   ENDDO
18520 !   ENDDO
18521 !   ENDDO
18522    ELSE
18523    IF( config_flags%m_opt .EQ. 1 ) THEN
18524    DO j =j_start, j_end
18525    DO k =kts+1, ktf
18526    DO i =i_start, i_end
18527    Tmpv001 =-muavg(i,j)*xkxavg(i,k,j)
18528    Tmpv400(i,k,j) =Tmpv001
18529 ! Remarked by Ning Pan, 2010-08-10
18530 !   Tmpv002 =Tmpv400(i,k,j)*defor(i,k,j)
18531 !   titau(i,k,j) =Tmpv002
18532
18533 ! Remarked by Ning Pan, 2010-08-10
18534 !   Tmpv001 =-xkxavg(i,k,j)*defor(i,k,j)
18535 !   Tmpv401(i,k,j) =mtau(i,k,j)
18536 !   mtau(i,k,j) =Tmpv001
18537
18538    ENDDO
18539    ENDDO
18540    ENDDO
18541    ELSE
18542    DO j =j_start, j_end
18543    DO k =kts+1, ktf
18544    DO i =i_start, i_end
18545    Tmpv001 =-muavg(i,j)*xkxavg(i,k,j)
18546    Tmpv402(i,k,j) =Tmpv001
18547 ! Remarked by Ning Pan, 2010-08-10
18548 !   Tmpv002 =Tmpv402(i,k,j)*defor(i,k,j)
18549 !   titau(i,k,j) =Tmpv002
18550
18551    ENDDO
18552    ENDDO
18553    ENDDO
18554    ENDIF
18555    ENDIF
18556
18557    IF( config_flags%sfs_opt .GT. 0 ) THEN
18558
18559    DO j =j_end, j_start, -1
18560    DO k =ktf, kts+1, -1
18561    DO i =i_end, i_start, -1
18562    a_Tmpv1 =a_titau(i,k,j)
18563    a_titau(i,k,j) =0.0
18564    a_muavg(i,j) =a_muavg(i,j) +mtau(i,k,j)*a_Tmpv1
18565    a_mtau(i,k,j) =a_mtau(i,k,j) +muavg(i,j)*a_Tmpv1
18566    ENDDO
18567    ENDDO
18568    ENDDO
18569
18570    ELSE
18571
18572    IF( config_flags%m_opt .EQ. 1 ) THEN
18573
18574    DO j =j_end, j_start, -1
18575    DO k =ktf, kts+1, -1
18576    DO i =i_end, i_start, -1
18577
18578 !   mtau(i,k,j) =Tmpv401(i,k,j)  ! Remarked by Ning Pan, 2010-08-10
18579
18580    a_Tmpv1 =a_mtau(i,k,j)
18581    a_mtau(i,k,j) =0.0
18582    a_xkxavg(i,k,j) =a_xkxavg(i,k,j) -defor(i,k,j)*a_Tmpv1
18583    a_defor(i,k,j) =a_defor(i,k,j) -xkxavg(i,k,j)*a_Tmpv1
18584    a_Tmpv2 =a_titau(i,k,j)
18585    a_titau(i,k,j) =0.0
18586    a_Tmpv1 =defor(i,k,j)*a_Tmpv2
18587    a_defor(i,k,j) =a_defor(i,k,j) +Tmpv400(i,k,j)*a_Tmpv2
18588    a_muavg(i,j) =a_muavg(i,j) -xkxavg(i,k,j)*a_Tmpv1
18589    a_xkxavg(i,k,j) =a_xkxavg(i,k,j) -muavg(i,j)*a_Tmpv1
18590    ENDDO
18591    ENDDO
18592    ENDDO
18593
18594    ELSE
18595
18596    DO j =j_end, j_start, -1
18597    DO k =ktf, kts+1, -1
18598    DO i =i_end, i_start, -1
18599    a_Tmpv2 =a_titau(i,k,j)
18600    a_titau(i,k,j) =0.0
18601    a_Tmpv1 =defor(i,k,j)*a_Tmpv2
18602    a_defor(i,k,j) =a_defor(i,k,j) +Tmpv402(i,k,j)*a_Tmpv2
18603    a_muavg(i,j) =a_muavg(i,j) -xkxavg(i,k,j)*a_Tmpv1
18604    a_xkxavg(i,k,j) =a_xkxavg(i,k,j) -muavg(i,j)*a_Tmpv1
18605    ENDDO
18606    ENDDO
18607    ENDDO
18608
18609    ENDIF
18610
18611    ENDIF
18612
18613 !LPB[15]
18614
18615 !LPB[14]
18616    DO j =j_end, j_start, -1
18617
18618 !  DO i =i_start, i_end
18619 !  Tmpv001 =mu(i,j) +mu(i-1,j)
18620 !  Tmpv002 =0.5*Tmpv001
18621 !  muavg(i,j) =Tmpv002
18622
18623 !  ENDDO
18624
18625    DO i =i_end, i_start, -1
18626    a_Tmpv2 =a_muavg(i,j)
18627    a_muavg(i,j) =0.0
18628    a_Tmpv1 =0.5*a_Tmpv2
18629    a_mu(i,j) =a_mu(i,j) +a_Tmpv1
18630    a_mu(i-1,j) =a_mu(i-1,j) +a_Tmpv1
18631    ENDDO
18632
18633    ENDDO
18634
18635 !LPB[13]
18636    DO j =j_end, j_start, -1
18637
18638 !  DO k =kts+1, ktf
18639 !  DO i =i_start, i_end
18640 !  Tmpv001 =xkx(i,k,j) +xkx(i-1,k,j)
18641 !  Tmpv002 =fnm(k)*Tmpv001
18642 !  Tmpv003 =xkx(i,k-1,j) +xkx(i-1,k-1,j)
18643 !  Tmpv004 =fnp(k)*Tmpv003
18644 !  Tmpv005 =Tmpv002 +Tmpv004
18645 !  Tmpv006 =0.5*Tmpv005
18646 !  xkxavg(i,k,j) =Tmpv006
18647
18648 !  ENDDO
18649 !  ENDDO
18650
18651    DO k =ktf, kts+1, -1
18652    DO i =i_end, i_start, -1
18653    a_Tmpv6 =a_xkxavg(i,k,j)
18654    a_xkxavg(i,k,j) =0.0
18655    a_Tmpv5 =0.5*a_Tmpv6
18656    a_Tmpv2 =a_Tmpv5
18657    a_Tmpv4 =a_Tmpv5
18658    a_Tmpv3 =fnp(k)*a_Tmpv4
18659    a_xkx(i,k-1,j) =a_xkx(i,k-1,j) +a_Tmpv3
18660    a_xkx(i-1,k-1,j) =a_xkx(i-1,k-1,j) +a_Tmpv3
18661    a_Tmpv1 =fnm(k)*a_Tmpv2
18662    a_xkx(i,k,j) =a_xkx(i,k,j) +a_Tmpv1
18663    a_xkx(i-1,k,j) =a_xkx(i-1,k,j) +a_Tmpv1
18664    ENDDO
18665    ENDDO
18666
18667    ENDDO
18668
18669 !LPB[12]
18670 !  i_start =i_start-is_ext
18671 !  i_end =i_end+ie_ext
18672 !  j_start =j_start-js_ext
18673 !  j_end =j_end+je_ext
18674
18675 !LPB[11]
18676
18677 !  IF( config_flags%periodic_x ) THEN
18678 !  i_end =ite
18679 !  END IF
18680
18681 !  IF( config_flags%periodic_x ) THEN
18682
18683 !  END IF
18684
18685 !LPB[10]
18686
18687 !LPB[9]
18688
18689 !  IF( config_flags%periodic_x ) THEN
18690 !  i_start =its
18691 !  END IF
18692
18693 !  IF( config_flags%periodic_x ) THEN
18694
18695 !  END IF
18696
18697 !LPB[8]
18698
18699 !LPB[7]
18700
18701 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.             config_flags%nested) THEN
18702 !  j_end =min(jde-2, jte)
18703 !  END IF
18704
18705 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
18706 !            config_flags%nested) THEN
18707
18708 !  END IF
18709
18710 !LPB[6]
18711
18712 !LPB[5]
18713
18714 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.             config_flags%nested) THEN
18715 !  j_start =max(jds+1, jts)
18716 !  END IF
18717
18718 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
18719 !            config_flags%nested) THEN
18720
18721 !  END IF
18722
18723 !LPB[4]
18724
18725 !LPB[3]
18726
18727 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.             config_flags%nested) THEN
18728 !  i_end =min(ide-1, ite)
18729 !  END IF
18730
18731 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
18732 !            config_flags%nested) THEN
18733
18734 !  END IF
18735
18736 !LPB[2]
18737
18738 !LPB[1]
18739
18740 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.             config_flags%nested) THEN
18741 !  i_start =max(ids+1, its)
18742 !  END IF
18743
18744 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
18745 !            config_flags%nested) THEN
18746
18747 !  END IF
18748
18749 !LPB[0]
18750 !  ktf =min(kte, kde-1)
18751 !  i_start =its
18752 !  i_end =ite
18753 !  j_start =jts
18754 !  j_end =min(jte, jde-1)
18755
18756    END SUBROUTINE a_cal_titau_13_31
18757
18758    SUBROUTINE a_cal_titau_23_32(config_flags,titau,a_titau,defor,a_defor,mtau, &
18759    a_mtau,mu,a_mu,xkx,a_xkx,fnm,fnp,rho,a_rho,is_ext,ie_ext,js_ext,je_ext,ids,ide,jds,jde, &
18760    kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte)
18761
18762 !PART I: DECLARATION OF VARIABLES
18763
18764    IMPLICIT NONE
18765
18766    INTEGER :: K0_ADJ,K1_ADJ,K2_ADJ,K3_ADJ
18767    TYPE(grid_config_rec_type) :: config_flags
18768    INTEGER :: ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte
18769    INTEGER :: is_ext,ie_ext,js_ext,je_ext
18770    REAL,DIMENSION(kms:kme) :: fnm,fnp
18771    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: titau,a_titau
18772    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: defor,a_defor,xkx,a_xkx
18773    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: rho, a_rho
18774    REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: mtau,a_mtau
18775    REAL,DIMENSION(ims:ime,jms:jme) :: mu,a_mu
18776    INTEGER :: i,j,k,ktf,i_start,i_end,j_start,j_end
18777    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: xkxavg,a_xkxavg
18778    REAL,DIMENSION(its-1:ite+1,jts-1:jte+1) :: muavg,a_muavg
18779
18780 !  REAL,DIMENSION(ims:ime,kms:kme,jms:jme) :: Keep_Lpb16_mtau
18781    INTEGER :: IX1,IX2,IX3
18782
18783    REAL :: a_Tmpv1,Tmpv001,a_Tmpv2,Tmpv002,a_Tmpv3,Tmpv003,a_Tmpv4,Tmpv004, &
18784    a_Tmpv5,Tmpv005,a_Tmpv6,Tmpv006
18785 ! Revised by Ning Pan, 2010-08-10
18786 !   REAL,DIMENSION(i_start-is_ext:i_end+ie_ext,kts+1:min(kte,kde-1),j_start-js_ext:j_end+ &
18787 !   je_ext) :: Tmpv400
18788 !   REAL,DIMENSION(i_start-is_ext:i_end+ie_ext,kts+1:min(kte,kde-1),j_start-js_ext:j_end+ &
18789 !   je_ext) :: Tmpv401
18790 !   REAL,DIMENSION(i_start-is_ext:i_end+ie_ext,kts+1:min(kte,kde-1),j_start-js_ext:j_end+ &
18791 !   je_ext) :: Tmpv402
18792    REAL,DIMENSION(its-1:ite+1,kts:kte,jts-1:jte+1) :: Tmpv400, Tmpv401, Tmpv402
18793
18794 !PART II: CALCULATIONS OF B. S. TRAJECTORY
18795
18796 !LPB[0]
18797         ktf = MIN( kte, kde-1 )
18798        i_start = its
18799        i_end   = MIN( ite, ide-1 )
18800        j_start = jts
18801        j_end   = jte
18802
18803 !LPB[1]
18804     IF ( config_flags%open_xs .OR. config_flags%specified .OR.   &
18805          config_flags%nested) i_start = MAX( ids+1, its )
18806
18807 !LPB[2]
18808
18809 !LPB[3]
18810     IF ( config_flags%open_xe .OR. config_flags%specified .OR.   &
18811          config_flags%nested) i_end   = MIN( ide-2, ite )
18812
18813 !LPB[4]
18814
18815 !LPB[5]
18816     IF ( config_flags%open_ys .OR. config_flags%specified .OR.   &
18817          config_flags%nested) j_start = MAX( jds+1, jts )
18818
18819 !LPB[6]
18820
18821 !LPB[7]
18822     IF ( config_flags%open_ye .OR. config_flags%specified .OR.   &
18823          config_flags%nested) j_end   = MIN( jde-1, jte )
18824
18825 !LPB[8]
18826
18827 !LPB[9]
18828       IF ( config_flags%periodic_x ) i_start = its
18829
18830 !LPB[10]
18831
18832 !LPB[11]
18833       IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
18834
18835 !LPB[12]
18836        i_start = i_start - is_ext
18837        i_end   = i_end   + ie_ext
18838        j_start = j_start - js_ext
18839        j_end   = j_end   + je_ext
18840
18841 !LPB[13]
18842        DO j = j_start, j_end
18843
18844        DO k = kts+1, ktf
18845        DO i = i_start, i_end
18846          xkxavg(i,k,j) = 0.5 * ( fnm(k) * ( xkx(i,k  ,j) + xkx(i,k  ,j-1) ) +    &
18847                                  fnp(k) * ( xkx(i,k-1,j) + xkx(i,k-1,j-1) ) )
18848        END DO
18849        END DO
18850
18851        END DO
18852
18853 !LPB[14]
18854        DO j = j_start, j_end
18855
18856        DO i = i_start, i_end
18857          muavg(i,j) = 0.5 * ( mu(i,j) + mu(i,j-1) )
18858        END DO
18859
18860        END DO
18861
18862 !LPB[15]
18863
18864 !!LPB[16]
18865 !!  DO IX3=jms,jme
18866 !!  DO IX2=kms,kme
18867 !!  DO IX1=ims,ime
18868 !    !  Keep_Lpb16_mtau(IX1,IX2,IX3) =mtau(IX1,IX2,IX3)
18869 !!  END DO
18870 !!  END DO
18871 !!  END DO
18872
18873 !    IF ( config_flags%sfs_opt .EQ. 1 ) THEN
18874
18875 !         DO j = j_start, j_end
18876 !         DO k = kts+1, ktf
18877 !         DO i = i_start, i_end
18878 !           titau(i,k,j) = muavg(i,j) * mtau(i,k,j)
18879 !         END DO
18880 !         END DO
18881 !         END DO
18882 !       ELSE
18883 !      IF ( config_flags%m_opt .EQ. 1 ) THEN
18884
18885 !           DO j = j_start, j_end
18886 !           DO k = kts+1, ktf
18887 !           DO i = i_start, i_end
18888 !             titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j)
18889 !             mtau(i,k,j) = - xkxavg(i,k,j) * defor(i,k,j)
18890 !           END DO
18891 !           END DO
18892 !           END DO
18893 !         ELSE
18894
18895 !           DO j = j_start, j_end
18896 !           DO k = kts+1, ktf
18897 !           DO i = i_start, i_end
18898 !             titau(i,k,j) = - muavg(i,j) * xkxavg(i,k,j) * defor(i,k,j)
18899 !           END DO
18900 !           END DO
18901 !           END DO
18902 !         ENDIF
18903
18904 !   ENDIF
18905
18906 !!LPB[17]
18907 !       DO j = j_start, j_end
18908
18909 !
18910 !       DO i = i_start, i_end
18911 !         titau(i,kts  ,j) = 0.0
18912 !         titau(i,ktf+1,j) = 0.0
18913 !       END DO
18914
18915 !       END DO
18916
18917 !PART III: INITIALIZATION OF LOCAL ADJOINT PERTURBATIONS
18918
18919    Do K2_ADJ =jts-1, jte+1
18920    Do K1_ADJ =kts, kte
18921    Do K0_ADJ =its-1, ite+1
18922    a_xkxavg(K0_ADJ,K1_ADJ,K2_ADJ) =0.0
18923    End Do
18924    End Do
18925    End Do
18926
18927    Do K1_ADJ =jts-1, jte+1
18928    Do K0_ADJ =its-1, ite+1
18929    a_muavg(K0_ADJ,K1_ADJ) =0.0
18930    End Do
18931    End Do
18932
18933 !PART IV: REVERSE/BACKWARD ACCUMULATIONS
18934
18935 !LPB[17]
18936    DO j =j_end, j_start, -1
18937
18938 !  DO i =i_start, i_end
18939 !  titau(i,kts,j) =0.0
18940
18941 !  titau(i,ktf+1,j) =0.0
18942
18943 !  ENDDO
18944
18945    DO i =i_end, i_start, -1
18946    a_titau(i,ktf+1,j) =0.0
18947    a_titau(i,kts,j) =0.0
18948    ENDDO
18949
18950    ENDDO
18951
18952 !LPB[16]
18953 !  DO IX3=jms,jme
18954 !  DO IX2=kms,kme
18955 !  DO IX1=ims,ime
18956 !  mtau(IX1,IX2,IX3) =Keep_Lpb16_mtau(IX1,IX2,IX3)
18957 !  END DO
18958 !  END DO
18959 !  END DO
18960
18961    IF( config_flags%sfs_opt .EQ. 1 ) THEN
18962 ! Remarked by Ning Pan, 2010-08-10
18963 !   DO j =j_start, j_end
18964 !   DO k =kts+1, ktf
18965 !   DO i =i_start, i_end
18966 !   Tmpv001 =muavg(i,j)*mtau(i,k,j)
18967 !   titau(i,k,j) =Tmpv001
18968
18969 !   ENDDO
18970 !   ENDDO
18971 !   ENDDO
18972    ELSE
18973    IF( config_flags%m_opt .EQ. 1 ) THEN
18974    DO j =j_start, j_end
18975    DO k =kts+1, ktf
18976    DO i =i_start, i_end
18977    Tmpv001 =-muavg(i,j)*xkxavg(i,k,j)
18978    Tmpv400(i,k,j) =Tmpv001
18979 ! Remarked by Ning Pan, 2010-08-10
18980 !   Tmpv002 =Tmpv400(i,k,j)*defor(i,k,j)
18981 !   titau(i,k,j) =Tmpv002
18982
18983 ! Remarked by Ning Pan, 2010-08-10
18984 !   Tmpv001 =-xkxavg(i,k,j)*defor(i,k,j)
18985 !   Tmpv401(i,k,j) =mtau(i,k,j)
18986 !   mtau(i,k,j) =Tmpv001
18987
18988    ENDDO
18989    ENDDO
18990    ENDDO
18991    ELSE
18992    DO j =j_start, j_end
18993    DO k =kts+1, ktf
18994    DO i =i_start, i_end
18995    Tmpv001 =-muavg(i,j)*xkxavg(i,k,j)
18996    Tmpv402(i,k,j) =Tmpv001
18997 ! Remarked by Ning Pan, 2010-08-10
18998 !   Tmpv002 =Tmpv402(i,k,j)*defor(i,k,j)
18999 !   titau(i,k,j) =Tmpv002
19000
19001    ENDDO
19002    ENDDO
19003    ENDDO
19004    ENDIF
19005    ENDIF
19006
19007    IF( config_flags%sfs_opt .EQ. 1 ) THEN
19008
19009    DO j =j_end, j_start, -1
19010    DO k =ktf, kts+1, -1
19011    DO i =i_end, i_start, -1
19012    a_Tmpv1 =a_titau(i,k,j)
19013    a_titau(i,k,j) =0.0
19014    a_muavg(i,j) =a_muavg(i,j) +mtau(i,k,j)*a_Tmpv1
19015    a_mtau(i,k,j) =a_mtau(i,k,j) +muavg(i,j)*a_Tmpv1
19016    ENDDO
19017    ENDDO
19018    ENDDO
19019
19020    ELSE
19021
19022    IF( config_flags%m_opt .EQ. 1 ) THEN
19023
19024    DO j =j_end, j_start, -1
19025    DO k =ktf, kts+1, -1
19026    DO i =i_end, i_start, -1
19027
19028 !   mtau(i,k,j) =Tmpv401(i,k,j)  ! Remarked by Ning Pan, 2010-08-10
19029
19030    a_Tmpv1 =a_mtau(i,k,j)
19031    a_mtau(i,k,j) =0.0
19032    a_xkxavg(i,k,j) =a_xkxavg(i,k,j) -defor(i,k,j)*a_Tmpv1
19033    a_defor(i,k,j) =a_defor(i,k,j) -xkxavg(i,k,j)*a_Tmpv1
19034    a_Tmpv2 =a_titau(i,k,j)
19035    a_titau(i,k,j) =0.0
19036    a_Tmpv1 =defor(i,k,j)*a_Tmpv2
19037    a_defor(i,k,j) =a_defor(i,k,j) +Tmpv400(i,k,j)*a_Tmpv2
19038    a_muavg(i,j) =a_muavg(i,j) -xkxavg(i,k,j)*a_Tmpv1
19039    a_xkxavg(i,k,j) =a_xkxavg(i,k,j) -muavg(i,j)*a_Tmpv1
19040    ENDDO
19041    ENDDO
19042    ENDDO
19043
19044    ELSE
19045
19046    DO j =j_end, j_start, -1
19047    DO k =ktf, kts+1, -1
19048    DO i =i_end, i_start, -1
19049    a_Tmpv2 =a_titau(i,k,j)
19050    a_titau(i,k,j) =0.0
19051    a_Tmpv1 =defor(i,k,j)*a_Tmpv2
19052    a_defor(i,k,j) =a_defor(i,k,j) +Tmpv402(i,k,j)*a_Tmpv2
19053    a_muavg(i,j) =a_muavg(i,j) -xkxavg(i,k,j)*a_Tmpv1
19054    a_xkxavg(i,k,j) =a_xkxavg(i,k,j) -muavg(i,j)*a_Tmpv1
19055    ENDDO
19056    ENDDO
19057    ENDDO
19058
19059    ENDIF
19060
19061    ENDIF
19062
19063 !LPB[15]
19064
19065 !LPB[14]
19066    DO j =j_end, j_start, -1
19067
19068 !  DO i =i_start, i_end
19069 !  Tmpv001 =mu(i,j) +mu(i,j-1)
19070 !  Tmpv002 =0.5*Tmpv001
19071 !  muavg(i,j) =Tmpv002
19072
19073 !  ENDDO
19074
19075    DO i =i_end, i_start, -1
19076    a_Tmpv2 =a_muavg(i,j)
19077    a_muavg(i,j) =0.0
19078    a_Tmpv1 =0.5*a_Tmpv2
19079    a_mu(i,j) =a_mu(i,j) +a_Tmpv1
19080    a_mu(i,j-1) =a_mu(i,j-1) +a_Tmpv1
19081    ENDDO
19082
19083    ENDDO
19084
19085 !LPB[13]
19086    DO j =j_end, j_start, -1
19087
19088 !  DO k =kts+1, ktf
19089 !  DO i =i_start, i_end
19090 !  Tmpv001 =xkx(i,k,j) +xkx(i,k,j-1)
19091 !  Tmpv002 =fnm(k)*Tmpv001
19092 !  Tmpv003 =xkx(i,k-1,j) +xkx(i,k-1,j-1)
19093 !  Tmpv004 =fnp(k)*Tmpv003
19094 !  Tmpv005 =Tmpv002 +Tmpv004
19095 !  Tmpv006 =0.5*Tmpv005
19096 !  xkxavg(i,k,j) =Tmpv006
19097
19098 !  ENDDO
19099 !  ENDDO
19100
19101    DO k =ktf, kts+1, -1
19102    DO i =i_end, i_start, -1
19103    a_Tmpv6 =a_xkxavg(i,k,j)
19104    a_xkxavg(i,k,j) =0.0
19105    a_Tmpv5 =0.5*a_Tmpv6
19106    a_Tmpv2 =a_Tmpv5
19107    a_Tmpv4 =a_Tmpv5
19108    a_Tmpv3 =fnp(k)*a_Tmpv4
19109    a_xkx(i,k-1,j) =a_xkx(i,k-1,j) +a_Tmpv3
19110    a_xkx(i,k-1,j-1) =a_xkx(i,k-1,j-1) +a_Tmpv3
19111    a_Tmpv1 =fnm(k)*a_Tmpv2
19112    a_xkx(i,k,j) =a_xkx(i,k,j) +a_Tmpv1
19113    a_xkx(i,k,j-1) =a_xkx(i,k,j-1) +a_Tmpv1
19114    ENDDO
19115    ENDDO
19116
19117    ENDDO
19118
19119 !LPB[12]
19120 !  i_start =i_start-is_ext
19121 !  i_end =i_end+ie_ext
19122 !  j_start =j_start-js_ext
19123 !  j_end =j_end+je_ext
19124
19125 !LPB[11]
19126
19127 !  IF( config_flags%periodic_x ) THEN
19128 !  i_end =min(ite, ide-1)
19129 !  END IF
19130
19131 !  IF( config_flags%periodic_x ) THEN
19132
19133 !  END IF
19134
19135 !LPB[10]
19136
19137 !LPB[9]
19138
19139 !  IF( config_flags%periodic_x ) THEN
19140 !  i_start =its
19141 !  END IF
19142
19143 !  IF( config_flags%periodic_x ) THEN
19144
19145 !  END IF
19146
19147 !LPB[8]
19148
19149 !LPB[7]
19150
19151 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.             config_flags%nested) THEN
19152 !  j_end =min(jde-1, jte)
19153 !  END IF
19154
19155 !  IF( config_flags%open_ye .OR. config_flags%specified .OR.   &
19156 !            config_flags%nested) THEN
19157
19158 !  END IF
19159
19160 !LPB[6]
19161
19162 !LPB[5]
19163
19164 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.             config_flags%nested) THEN
19165 !  j_start =max(jds+1, jts)
19166 !  END IF
19167
19168 !  IF( config_flags%open_ys .OR. config_flags%specified .OR.   &
19169 !            config_flags%nested) THEN
19170
19171 !  END IF
19172
19173 !LPB[4]
19174
19175 !LPB[3]
19176
19177 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.             config_flags%nested) THEN
19178 !  i_end =min(ide-2, ite)
19179 !  END IF
19180
19181 !  IF( config_flags%open_xe .OR. config_flags%specified .OR.   &
19182 !            config_flags%nested) THEN
19183
19184 !  END IF
19185
19186 !LPB[2]
19187
19188 !LPB[1]
19189
19190 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.             config_flags%nested) THEN
19191 !  i_start =max(ids+1, its)
19192 !  END IF
19193
19194 !  IF( config_flags%open_xs .OR. config_flags%specified .OR.   &
19195 !            config_flags%nested) THEN
19196
19197 !  END IF
19198
19199 !LPB[0]
19200 !  ktf =min(kte, kde-1)
19201 !  i_start =its
19202 !  i_end =min(ite, ide-1)
19203 !  j_start =jts
19204 !  j_end =jte
19205
19206    END SUBROUTINE a_cal_titau_23_32
19207
19208 END MODULE a_module_diffusion_em
19209