wrfv2_fire/phys/module_physics_addtendc.F

   1 !WRF:MODEL_LAYER: PHYSICS
   2 !
   3 ! note: this module really belongs in the dyn_em directory since it is
   4 !       specific only to the EM core. Leaving here for now, with an
   5 !       #if ( EM_CORE == 1 ) directive. JM 20031201
   6 !
   7
   8 !  This MODULE holds the routines which are used to perform updates of the
   9 !  model C-grid tendencies with physics A-grid tendencies
  10 !  The module consolidates code that was (up to v1.2) duplicated in
  11 !  module_em and module_rk and in
  12 !  module_big_step_utilities.F and module_big_step_utilities_em.F
  13
  14 !  This MODULE CONTAINS the following routines:
  15 !  update_phy_ten, phy_ra_ten, phy_bl_ten, phy_cu_ten, advance_ppt,
  16 !  add_a2a, add_a2c_u, and add_a2c_v
  17
  18
  19 MODULE module_physics_addtendc
  20
  21 #if ( EM_CORE == 1 )
  22
  23    USE module_state_description
  24    USE module_configure
  25
  26 CONTAINS
  27
  28 SUBROUTINE update_phy_ten(rt_tendf,ru_tendf,rv_tendf,moist_tendf,  &
  29                       scalar_tendf,mu_tendf,                       &
  30                       RTHRATEN,RTHBLTEN,RTHCUTEN,RUBLTEN,RVBLTEN,  &
  31                       RQVBLTEN,RQCBLTEN,RQIBLTEN,                  &
  32                       RQVCUTEN,RQCCUTEN,RQRCUTEN,RQICUTEN,RQSCUTEN,&
  33                       RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RQVNDGDTEN,   &
  34                       RMUNDGDTEN,                                  &
  35                       rthfrten,rqvfrten,                           &    ! fire
  36                       n_moist,n_scalar,config_flags,rk_step,adv_moist_cond, &
  37                       ids, ide, jds, jde, kds, kde,                &
  38                       ims, ime, jms, jme, kms, kme,                &
  39                       its, ite, jts, jte, kts, kte                 )
  40 !-------------------------------------------------------------------
  41    IMPLICIT NONE
  42 !-------------------------------------------------------------------
  43
  44    TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
  45
  46    INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde,   &
  47                                    ims, ime, jms, jme, kms, kme,   &
  48                                    its, ite, jts, jte, kts, kte,   &
  49                                    n_moist,n_scalar,rk_step
  50
  51    LOGICAL , INTENT(IN)        :: adv_moist_cond
  52
  53    REAL , DIMENSION(ims:ime , kms:kme, jms:jme),INTENT(INOUT) ::   &
  54                                                          ru_tendf, &
  55                                                          rv_tendf, &
  56                                                          rt_tendf
  57
  58    REAL , DIMENSION(ims:ime , jms:jme),INTENT(INOUT) ::  mu_tendf
  59
  60    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),           &
  61           INTENT(INOUT)     ::                        moist_tendf
  62
  63    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar),           &
  64           INTENT(INOUT)     ::                        scalar_tendf
  65
  66    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
  67                                                        RTHRATEN, &
  68                                                        RTHBLTEN, &
  69                                                        RTHCUTEN, &
  70                                                         RUBLTEN, &
  71                                                         RVBLTEN, &
  72                                                        RQVBLTEN, &
  73                                                        RQCBLTEN, &
  74                                                        RQIBLTEN, &
  75                                                        RQVCUTEN, &
  76                                                        RQCCUTEN, &
  77                                                        RQRCUTEN, &
  78                                                        RQICUTEN, &
  79                                                        RQSCUTEN, &
  80                                                      RTHNDGDTEN, &
  81                                                      RQVNDGDTEN, &
  82                                                       RUNDGDTEN, &
  83                                                       RVNDGDTEN
  84
  85    REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN  ) :: RMUNDGDTEN
  86
  87    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   & ! fire
  88                                                        rthfrten, &
  89                                                        rqvfrten
  90 !------------------------------------------------------------------
  91
  92 !  set up loop bounds for this grid's boundary conditions
  93
  94    if (config_flags%ra_lw_physics .gt. 0 .or.                  &
  95        config_flags%ra_sw_physics .gt. 0)                      &
  96       CALL phy_ra_ten(config_flags,rt_tendf,RTHRATEN,          &
  97                       ids, ide, jds, jde, kds, kde,            &
  98                       ims, ime, jms, jme, kms, kme,            &
  99                       its, ite, jts, jte, kts, kte             )
 100
 101    if (config_flags%bl_pbl_physics .gt. 0)                     &
 102       CALL phy_bl_ten(config_flags,rk_step,n_moist,n_scalar,   &
 103                       rt_tendf,ru_tendf,rv_tendf,moist_tendf,  &
 104                       scalar_tendf,adv_moist_cond,             &
 105                       RTHBLTEN,RUBLTEN,RVBLTEN,                &
 106                       RQVBLTEN,RQCBLTEN,RQIBLTEN,              &
 107                       ids, ide, jds, jde, kds, kde,            &
 108                       ims, ime, jms, jme, kms, kme,            &
 109                       its, ite, jts, jte, kts, kte             )
 110
 111    if (config_flags%cu_physics .gt. 0)                         &
 112       CALL phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf,  &
 113                       RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,     &
 114                       RQICUTEN,RQSCUTEN,moist_tendf,           &
 115                       ids, ide, jds, jde, kds, kde,            &
 116                       ims, ime, jms, jme, kms, kme,            &
 117                       its, ite, jts, jte, kts, kte             )
 118
 119    if (config_flags%grid_fdda .gt. 0)                     &
 120       CALL phy_fg_ten(config_flags,rk_step,n_moist,            &
 121                       rt_tendf,ru_tendf,rv_tendf,              &
 122                       mu_tendf, moist_tendf,                   &
 123                       RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,          &
 124                       RQVNDGDTEN,RMUNDGDTEN,                   &
 125                       ids, ide, jds, jde, kds, kde,            &
 126                       ims, ime, jms, jme, kms, kme,            &
 127                       its, ite, jts, jte, kts, kte             )
 128
 129    if (config_flags%ifire .gt. 0)                              & ! fire
 130       CALL phy_fr_ten(config_flags,rk_step,n_moist,            &
 131                       rt_tendf,ru_tendf,rv_tendf,              &
 132                       mu_tendf, moist_tendf,                   &
 133                       rthfrten,rqvfrten,                       &
 134                       ids, ide, jds, jde, kds, kde,            &
 135                       ims, ime, jms, jme, kms, kme,            &
 136                       its, ite, jts, jte, kts, kte             )
 137
 138 END SUBROUTINE update_phy_ten
 139
 140 !=================================================================
 141 SUBROUTINE phy_ra_ten(config_flags,rt_tendf,RTHRATEN,            &
 142                       ids, ide, jds, jde, kds, kde,              &
 143                       ims, ime, jms, jme, kms, kme,              &
 144                       its, ite, jts, jte, kts, kte               )
 145 !-----------------------------------------------------------------
 146    IMPLICIT NONE
 147 !-----------------------------------------------------------------
 148    TYPE(grid_config_rec_type  ) , INTENT(IN   ) :: config_flags
 149
 150    INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
 151                                    ims, ime, jms, jme, kms, kme, &
 152                                    its, ite, jts, jte, kts, kte
 153
 154    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
 155                                                        RTHRATEN
 156
 157    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::  &
 158                                                        rt_tendf
 159
 160 ! LOCAL VARS
 161
 162    INTEGER :: i,j,k
 163
 164    CALL add_a2a(rt_tendf,RTHRATEN,config_flags,                  &
 165                 ids,ide, jds, jde, kds, kde,                     &
 166                 ims, ime, jms, jme, kms, kme,                    &
 167                 its, ite, jts, jte, kts, kte                     )
 168
 169 END SUBROUTINE phy_ra_ten
 170
 171 !=================================================================
 172 SUBROUTINE phy_bl_ten(config_flags,rk_step,n_moist,n_scalar,     &
 173                       rt_tendf,ru_tendf,rv_tendf,moist_tendf,    &
 174                       scalar_tendf,adv_moist_cond,               &
 175                       RTHBLTEN,RUBLTEN,RVBLTEN,                  &
 176                       RQVBLTEN,RQCBLTEN,RQIBLTEN,                &
 177                       ids, ide, jds, jde, kds, kde,              &
 178                       ims, ime, jms, jme, kms, kme,              &
 179                       its, ite, jts, jte, kts, kte               )
 180 !-----------------------------------------------------------------
 181    IMPLICIT NONE
 182 !-----------------------------------------------------------------
 183    TYPE(grid_config_rec_type) ,     INTENT(IN   ) :: config_flags
 184
 185    INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
 186                                    ims, ime, jms, jme, kms, kme, &
 187                                    its, ite, jts, jte, kts, kte, &
 188                                    n_moist, n_scalar, rk_step
 189
 190    LOGICAL , INTENT(IN)     :: adv_moist_cond
 191
 192    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
 193           INTENT(INOUT)     ::                      moist_tendf
 194
 195    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar),         &
 196           INTENT(INOUT)     ::                      scalar_tendf
 197
 198    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
 199                                                        RTHBLTEN, &
 200                                                         RUBLTEN, &
 201                                                         RVBLTEN, &
 202                                                        RQVBLTEN, &
 203                                                        RQCBLTEN, &
 204                                                        RQIBLTEN
 205
 206    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT)::   &
 207                                                        rt_tendf, &
 208                                                        ru_tendf, &
 209                                                        rv_tendf
 210 ! LOCAL VARS
 211
 212    INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
 213
 214 !-----------------------------------------------------------------
 215
 216    SELECT CASE(config_flags%bl_pbl_physics)
 217
 218       CASE (YSUSCHEME)
 219
 220            CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
 221                 ids,ide, jds, jde, kds, kde,                     &
 222                 ims, ime, jms, jme, kms, kme,                    &
 223                 its, ite, jts, jte, kts, kte                     )
 224
 225            CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
 226                 ids,ide, jds, jde, kds, kde,                     &
 227                 ims, ime, jms, jme, kms, kme,                    &
 228                 its, ite, jts, jte, kts, kte                     )
 229
 230            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
 231                 ids,ide, jds, jde, kds, kde,                     &
 232                 ims, ime, jms, jme, kms, kme,                    &
 233                 its, ite, jts, jte, kts, kte                     )
 234
 235         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 236            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
 237                 config_flags,                                    &
 238                 ids,ide, jds, jde, kds, kde,                     &
 239                 ims, ime, jms, jme, kms, kme,                    &
 240                 its, ite, jts, jte, kts, kte                     )
 241
 242         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 243            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
 244                 config_flags,                                    &
 245                 ids,ide, jds, jde, kds, kde,                     &
 246                 ims, ime, jms, jme, kms, kme,                    &
 247                 its, ite, jts, jte, kts, kte                     )
 248
 249         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
 250            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
 251                 config_flags,                                    &
 252                 ids,ide, jds, jde, kds, kde,                     &
 253                 ims, ime, jms, jme, kms, kme,                    &
 254                 its, ite, jts, jte, kts, kte                     )
 255
 256        IF(.not. adv_moist_cond)THEN
 257
 258         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 259            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
 260                 config_flags,                                    &
 261                 ids,ide, jds, jde, kds, kde,                     &
 262                 ims, ime, jms, jme, kms, kme,                    &
 263                 its, ite, jts, jte, kts, kte                     )
 264
 265         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 266            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
 267                 config_flags,                                    &
 268                 ids,ide, jds, jde, kds, kde,                     &
 269                 ims, ime, jms, jme, kms, kme,                    &
 270                 its, ite, jts, jte, kts, kte                     )
 271        ENDIF
 272
 273       CASE (MRFSCHEME)
 274
 275            CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
 276                 ids,ide, jds, jde, kds, kde,                     &
 277                 ims, ime, jms, jme, kms, kme,                    &
 278                 its, ite, jts, jte, kts, kte                     )
 279
 280            CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
 281                 ids,ide, jds, jde, kds, kde,                     &
 282                 ims, ime, jms, jme, kms, kme,                    &
 283                 its, ite, jts, jte, kts, kte                     )
 284
 285            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
 286                 ids,ide, jds, jde, kds, kde,                     &
 287                 ims, ime, jms, jme, kms, kme,                    &
 288                 its, ite, jts, jte, kts, kte                     )
 289
 290         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 291            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
 292                 config_flags,                                    &
 293                 ids,ide, jds, jde, kds, kde,                     &
 294                 ims, ime, jms, jme, kms, kme,                    &
 295                 its, ite, jts, jte, kts, kte                     )
 296
 297         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 298            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
 299                 config_flags,                                    &
 300                 ids,ide, jds, jde, kds, kde,                     &
 301                 ims, ime, jms, jme, kms, kme,                    &
 302                 its, ite, jts, jte, kts, kte                     )
 303
 304         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
 305            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
 306                 config_flags,                                    &
 307                 ids,ide, jds, jde, kds, kde,                     &
 308                 ims, ime, jms, jme, kms, kme,                    &
 309                 its, ite, jts, jte, kts, kte                     )
 310
 311        IF(.not. adv_moist_cond)THEN
 312
 313         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 314            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
 315                 config_flags,                                    &
 316                 ids,ide, jds, jde, kds, kde,                     &
 317                 ims, ime, jms, jme, kms, kme,                    &
 318                 its, ite, jts, jte, kts, kte                     )
 319
 320         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 321            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
 322                 config_flags,                                    &
 323                 ids,ide, jds, jde, kds, kde,                     &
 324                 ims, ime, jms, jme, kms, kme,                    &
 325                 its, ite, jts, jte, kts, kte                     )
 326        ENDIF
 327
 328       CASE (ACMPBLSCHEME)
 329
 330            CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
 331                 ids,ide, jds, jde, kds, kde,                     &
 332                 ims, ime, jms, jme, kms, kme,                    &
 333                 its, ite, jts, jte, kts, kte                     )
 334
 335            CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
 336                 ids,ide, jds, jde, kds, kde,                     &
 337                 ims, ime, jms, jme, kms, kme,                    &
 338                 its, ite, jts, jte, kts, kte                     )
 339
 340            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
 341                 ids,ide, jds, jde, kds, kde,                     &
 342                 ims, ime, jms, jme, kms, kme,                    &
 343                 its, ite, jts, jte, kts, kte                     )
 344
 345         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 346            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
 347                 config_flags,                                    &
 348                 ids,ide, jds, jde, kds, kde,                     &
 349                 ims, ime, jms, jme, kms, kme,                    &
 350                 its, ite, jts, jte, kts, kte                     )
 351
 352         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 353            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
 354                 config_flags,                                    &
 355                 ids,ide, jds, jde, kds, kde,                     &
 356                 ims, ime, jms, jme, kms, kme,                    &
 357                 its, ite, jts, jte, kts, kte                     )
 358
 359         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
 360            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
 361                 config_flags,                                    &
 362                 ids,ide, jds, jde, kds, kde,                     &
 363                 ims, ime, jms, jme, kms, kme,                    &
 364                 its, ite, jts, jte, kts, kte                     )
 365
 366        IF(.not. adv_moist_cond)THEN
 367
 368         if (P_QT .ge. PARAM_FIRST_SCALAR)THEN
 369            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
 370                 config_flags,                                    &
 371                 ids,ide, jds, jde, kds, kde,                     &
 372                 ims, ime, jms, jme, kms, kme,                    &
 373                 its, ite, jts, jte, kts, kte                     )
 374
 375            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
 376                 config_flags,                                    &
 377                 ids,ide, jds, jde, kds, kde,                     &
 378                 ims, ime, jms, jme, kms, kme,                    &
 379                 its, ite, jts, jte, kts, kte                     )
 380         ENDIF
 381
 382        ENDIF
 383
 384       CASE (MYJPBLSCHEME)
 385
 386            CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
 387                 ids,ide, jds, jde, kds, kde,                     &
 388                 ims, ime, jms, jme, kms, kme,                    &
 389                 its, ite, jts, jte, kts, kte                     )
 390
 391            CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
 392                 ids,ide, jds, jde, kds, kde,                     &
 393                 ims, ime, jms, jme, kms, kme,                    &
 394                 its, ite, jts, jte, kts, kte                     )
 395
 396            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
 397                 ids,ide, jds, jde, kds, kde,                     &
 398                 ims, ime, jms, jme, kms, kme,                    &
 399                 its, ite, jts, jte, kts, kte                     )
 400
 401         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 402            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
 403                 config_flags,                                    &
 404                 ids,ide, jds, jde, kds, kde,                     &
 405                 ims, ime, jms, jme, kms, kme,                    &
 406                 its, ite, jts, jte, kts, kte                     )
 407
 408        IF(.not. adv_moist_cond)THEN
 409
 410         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 411            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
 412                 config_flags,                                    &
 413                 ids,ide, jds, jde, kds, kde,                     &
 414                 ims, ime, jms, jme, kms, kme,                    &
 415                 its, ite, jts, jte, kts, kte                     )
 416
 417        ELSE
 418
 419         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 420            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
 421                 config_flags,                                    &
 422                 ids,ide, jds, jde, kds, kde,                     &
 423                 ims, ime, jms, jme, kms, kme,                    &
 424                 its, ite, jts, jte, kts, kte                     )
 425
 426        ENDIF
 427
 428       CASE (GFSSCHEME)
 429
 430            CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
 431                 ids,ide, jds, jde, kds, kde,                     &
 432                 ims, ime, jms, jme, kms, kme,                    &
 433                 its, ite, jts, jte, kts, kte                     )
 434
 435            CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
 436                 ids,ide, jds, jde, kds, kde,                     &
 437                 ims, ime, jms, jme, kms, kme,                    &
 438                 its, ite, jts, jte, kts, kte                     )
 439
 440            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
 441                 ids,ide, jds, jde, kds, kde,                     &
 442                 ims, ime, jms, jme, kms, kme,                    &
 443                 its, ite, jts, jte, kts, kte                     )
 444
 445         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 446            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
 447                 config_flags,                                    &
 448                 ids,ide, jds, jde, kds, kde,                     &
 449                 ims, ime, jms, jme, kms, kme,                    &
 450                 its, ite, jts, jte, kts, kte                     )
 451
 452         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 453            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
 454                 config_flags,                                    &
 455                 ids,ide, jds, jde, kds, kde,                     &
 456                 ims, ime, jms, jme, kms, kme,                    &
 457                 its, ite, jts, jte, kts, kte                     )
 458
 459         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
 460            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
 461                 config_flags,                                    &
 462                 ids,ide, jds, jde, kds, kde,                     &
 463                 ims, ime, jms, jme, kms, kme,                    &
 464                 its, ite, jts, jte, kts, kte                     )
 465
 466        IF(.not. adv_moist_cond)THEN
 467
 468         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 469            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
 470                 config_flags,                                    &
 471                 ids,ide, jds, jde, kds, kde,                     &
 472                 ims, ime, jms, jme, kms, kme,                    &
 473                 its, ite, jts, jte, kts, kte                     )
 474
 475         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 476            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
 477                 config_flags,                                    &
 478                 ids,ide, jds, jde, kds, kde,                     &
 479                 ims, ime, jms, jme, kms, kme,                    &
 480                 its, ite, jts, jte, kts, kte                     )
 481        ENDIF
 482
 483       CASE DEFAULT
 484
 485        print*,'phy_bl_ten: The pbl scheme does not exist'
 486
 487    END SELECT
 488
 489 END SUBROUTINE phy_bl_ten
 490
 491 !=================================================================
 492 SUBROUTINE phy_cu_ten(config_flags,rk_step,n_moist,rt_tendf,    &
 493                       RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,       &
 494                       RQICUTEN,RQSCUTEN,moist_tendf,             &
 495                       ids, ide, jds, jde, kds, kde,              &
 496                       ims, ime, jms, jme, kms, kme,              &
 497                       its, ite, jts, jte, kts, kte               )
 498 !-----------------------------------------------------------------
 499    IMPLICIT NONE
 500 !-----------------------------------------------------------------
 501    TYPE(grid_config_rec_type  ) , INTENT(IN   ) :: config_flags
 502
 503    INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
 504                                    ims, ime, jms, jme, kms, kme, &
 505                                    its, ite, jts, jte, kts, kte, &
 506                                    n_moist, rk_step
 507
 508    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
 509           INTENT(INOUT)     ::                      moist_tendf
 510
 511    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
 512                                                        RTHCUTEN, &
 513                                                        RQVCUTEN, &
 514                                                        RQCCUTEN, &
 515                                                        RQRCUTEN, &
 516                                                        RQICUTEN, &
 517                                                        RQSCUTEN
 518
 519    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::  &
 520                                                        rt_tendf
 521
 522 ! LOCAL VARS
 523
 524    INTEGER :: i,j,k
 525
 526    SELECT CASE (config_flags%cu_physics)
 527
 528    CASE (KFSCHEME)
 529         CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
 530                 ids,ide, jds, jde, kds, kde,                     &
 531                 ims, ime, jms, jme, kms, kme,                    &
 532                 its, ite, jts, jte, kts, kte                     )
 533
 534         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 535         CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
 536                 config_flags,                                    &
 537                 ids,ide, jds, jde, kds, kde,                     &
 538                 ims, ime, jms, jme, kms, kme,                    &
 539                 its, ite, jts, jte, kts, kte                     )
 540
 541         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 542         CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
 543                 config_flags,                                    &
 544                 ids,ide, jds, jde, kds, kde,                     &
 545                 ims, ime, jms, jme, kms, kme,                    &
 546                 its, ite, jts, jte, kts, kte                     )
 547
 548         if (P_QR .ge. PARAM_FIRST_SCALAR)                                         &
 549         CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN,     &
 550                 config_flags,                                    &
 551                 ids,ide, jds, jde, kds, kde,                     &
 552                 ims, ime, jms, jme, kms, kme,                    &
 553                 its, ite, jts, jte, kts, kte                     )
 554
 555         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
 556         CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
 557                 config_flags,                                    &
 558                 ids,ide, jds, jde, kds, kde,                     &
 559                 ims, ime, jms, jme, kms, kme,                    &
 560                 its, ite, jts, jte, kts, kte                     )
 561
 562         if (P_QS .ge. PARAM_FIRST_SCALAR)                                         &
 563         CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN,     &
 564                 config_flags,                                    &
 565                 ids,ide, jds, jde, kds, kde,                     &
 566                 ims, ime, jms, jme, kms, kme,                    &
 567                 its, ite, jts, jte, kts, kte                     )
 568
 569    CASE (BMJSCHEME)
 570         CALL add_a2a(rt_tendf,RTHCUTEN,                          &
 571                 config_flags,                                    &
 572                 ids,ide, jds, jde, kds, kde,                     &
 573                 ims, ime, jms, jme, kms, kme,                    &
 574                 its, ite, jts, jte, kts, kte                     )
 575
 576         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 577         CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
 578                 config_flags,                                    &
 579                 ids,ide, jds, jde, kds, kde,                     &
 580                 ims, ime, jms, jme, kms, kme,                    &
 581                 its, ite, jts, jte, kts, kte                     )
 582
 583    CASE (KFETASCHEME)
 584         CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
 585                 ids,ide, jds, jde, kds, kde,                     &
 586                 ims, ime, jms, jme, kms, kme,                    &
 587                 its, ite, jts, jte, kts, kte                     )
 588
 589         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 590         CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
 591                 config_flags,                                    &
 592                 ids,ide, jds, jde, kds, kde,                     &
 593                 ims, ime, jms, jme, kms, kme,                    &
 594                 its, ite, jts, jte, kts, kte                     )
 595
 596         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 597         CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
 598                 config_flags,                                    &
 599                 ids,ide, jds, jde, kds, kde,                     &
 600                 ims, ime, jms, jme, kms, kme,                    &
 601                 its, ite, jts, jte, kts, kte                     )
 602
 603         if (P_QR .ge. PARAM_FIRST_SCALAR)                                         &
 604         CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN,     &
 605                 config_flags,                                    &
 606                 ids,ide, jds, jde, kds, kde,                     &
 607                 ims, ime, jms, jme, kms, kme,                    &
 608                 its, ite, jts, jte, kts, kte                     )
 609
 610         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
 611         CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
 612                 config_flags,                                    &
 613                 ids,ide, jds, jde, kds, kde,                     &
 614                 ims, ime, jms, jme, kms, kme,                    &
 615                 its, ite, jts, jte, kts, kte                     )
 616
 617         if (P_QS .ge. PARAM_FIRST_SCALAR)                                         &
 618         CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN,     &
 619                 config_flags,                                    &
 620                 ids,ide, jds, jde, kds, kde,                     &
 621                 ims, ime, jms, jme, kms, kme,                    &
 622                 its, ite, jts, jte, kts, kte                     )
 623
 624    CASE (GDSCHEME, G3SCHEME)
 625         CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
 626                 ids,ide, jds, jde, kds, kde,                     &
 627                 ims, ime, jms, jme, kms, kme,                    &
 628                 its, ite, jts, jte, kts, kte                     )
 629
 630         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 631         CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
 632                 config_flags,                                    &
 633                 ids,ide, jds, jde, kds, kde,                     &
 634                 ims, ime, jms, jme, kms, kme,                    &
 635                 its, ite, jts, jte, kts, kte                     )
 636
 637         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 638         CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
 639                 config_flags,                                    &
 640                 ids,ide, jds, jde, kds, kde,                     &
 641                 ims, ime, jms, jme, kms, kme,                    &
 642                 its, ite, jts, jte, kts, kte                     )
 643
 644         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
 645         CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
 646                 config_flags,                                    &
 647                 ids,ide, jds, jde, kds, kde,                     &
 648                 ims, ime, jms, jme, kms, kme,                    &
 649                 its, ite, jts, jte, kts, kte                     )
 650
 651    CASE (SASSCHEME)
 652         CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
 653                 ids,ide, jds, jde, kds, kde,                     &
 654                 ims, ime, jms, jme, kms, kme,                    &
 655                 its, ite, jts, jte, kts, kte                     )
 656
 657         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 658         CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
 659                 config_flags,                                    &
 660                 ids,ide, jds, jde, kds, kde,                     &
 661                 ims, ime, jms, jme, kms, kme,                    &
 662                 its, ite, jts, jte, kts, kte                     )
 663
 664         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 665         CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
 666                 config_flags,                                    &
 667                 ids,ide, jds, jde, kds, kde,                     &
 668                 ims, ime, jms, jme, kms, kme,                    &
 669                 its, ite, jts, jte, kts, kte                     )
 670
 671         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
 672         CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
 673                 config_flags,                                    &
 674                 ids,ide, jds, jde, kds, kde,                     &
 675                 ims, ime, jms, jme, kms, kme,                    &
 676                 its, ite, jts, jte, kts, kte                     )
 677
 678    CASE DEFAULT
 679
 680    END SELECT
 681
 682 END SUBROUTINE phy_cu_ten
 683
 684 !=================================================================
 685 SUBROUTINE phy_fg_ten(config_flags,rk_step,n_moist,            &
 686                       rt_tendf,ru_tendf,rv_tendf,              &
 687                       mu_tendf, moist_tendf,                   &
 688                       RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,          &
 689                       RQVNDGDTEN,RMUNDGDTEN,                   &
 690                       ids, ide, jds, jde, kds, kde,              &
 691                       ims, ime, jms, jme, kms, kme,              &
 692                       its, ite, jts, jte, kts, kte               )
 693 !-----------------------------------------------------------------
 694    IMPLICIT NONE
 695 !-----------------------------------------------------------------
 696    TYPE(grid_config_rec_type) ,     INTENT(IN   ) :: config_flags
 697
 698    INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
 699                                    ims, ime, jms, jme, kms, kme, &
 700                                    its, ite, jts, jte, kts, kte, &
 701                                    n_moist, rk_step
 702
 703    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
 704           INTENT(INOUT)     ::                      moist_tendf
 705
 706    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
 707                                                        RTHNDGDTEN, &
 708                                                         RUNDGDTEN, &
 709                                                         RVNDGDTEN, &
 710                                                        RQVNDGDTEN
 711
 712    REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN  ) ::  RMUNDGDTEN
 713
 714    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT)::   &
 715                                                        rt_tendf, &
 716                                                        ru_tendf, &
 717                                                        rv_tendf
 718
 719    REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT)::  mu_tendf
 720
 721 ! LOCAL VARS
 722
 723    INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
 724
 725 !-----------------------------------------------------------------
 726
 727    SELECT CASE(config_flags%grid_fdda)
 728
 729       CASE (PSUFDDAGD)
 730
 731            CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags,        &
 732                 ids,ide, jds, jde, kds, kde,                     &
 733                 ims, ime, jms, jme, kms, kme,                    &
 734                 its, ite, jts, jte, kts, kte                     )
 735
 736 ! note fdda u and v tendencies are staggered
 737            CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags,       &
 738                 ids,ide, jds, jde, kds, kde,                     &
 739                 ims, ime, jms, jme, kms, kme,                    &
 740                 its, ite, jts, jte, kts, kte                     )
 741
 742            CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags,       &
 743                 ids,ide, jds, jde, kds, kde,                     &
 744                 ims, ime, jms, jme, kms, kme,                    &
 745                 its, ite, jts, jte, kts, kte                     )
 746
 747            CALL add_a2a(mu_tendf,RMUNDGDTEN,config_flags,      &
 748                 ids,ide, jds, jde, kds, kds,                     &
 749                 ims, ime, jms, jme, kms, kms,                    &
 750                 its, ite, jts, jte, kts, kts                     )
 751
 752         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 753            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVNDGDTEN,  &
 754                 config_flags,                                    &
 755                 ids,ide, jds, jde, kds, kde,                     &
 756                 ims, ime, jms, jme, kms, kme,                    &
 757                 its, ite, jts, jte, kts, kte                     )
 758
 759
 760       CASE DEFAULT
 761
 762    END SELECT
 763
 764 END SUBROUTINE phy_fg_ten
 765
 766 !=================================================================
 767 SUBROUTINE phy_fr_ten(config_flags,rk_step,n_moist,            &
 768                       rt_tendf,ru_tendf,rv_tendf,              &
 769                       mu_tendf, moist_tendf,                   &
 770                       rthfrten,rqvfrten,                       &
 771                       ids, ide, jds, jde, kds, kde,              &
 772                       ims, ime, jms, jme, kms, kme,              &
 773                       its, ite, jts, jte, kts, kte               )
 774 !-----------------------------------------------------------------
 775    USE module_state_description, ONLY :                         &
 776                    FIRE_CAWFE
 777 !-----------------------------------------------------------------
 778    IMPLICIT NONE
 779 !-----------------------------------------------------------------
 780    TYPE(grid_config_rec_type) ,     INTENT(IN   ) :: config_flags
 781
 782    INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
 783                                    ims, ime, jms, jme, kms, kme, &
 784                                    its, ite, jts, jte, kts, kte, &
 785                                    n_moist, rk_step
 786
 787    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
 788           INTENT(INOUT)     ::                      moist_tendf
 789
 790    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
 791                                                        rthfrten, &
 792                                                        rqvfrten
 793
 794    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT)::   &
 795                                                        rt_tendf, &
 796                                                        ru_tendf, &
 797                                                        rv_tendf
 798
 799    REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT)::  mu_tendf
 800
 801 ! LOCAL VARS
 802
 803    INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
 804
 805 !-----------------------------------------------------------------
 806
 807    SELECT CASE(config_flags%ifire)
 808
 809       CASE (FIRE_CAWFE,FIRE_SFIRE,FIRE_SFIRED)
 810 ! Jan Mandel added FIRE_SFIRE Nov 17 2007
 811 ! Jan Mandel added FIRE_SFIRED Nov 17 2007
 812
 813            CALL add_a2a(rt_tendf,rthfrten,                       &
 814                 config_flags,                                    &
 815                 ids,ide, jds, jde, kds, kde,                     &
 816                 ims, ime, jms, jme, kms, kme,                    &
 817                 its, ite, jts, jte, kts, kte                     )
 818
 819            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),rqvfrten,  &
 820                 config_flags,                                    &
 821                 ids,ide, jds, jde, kds, kde,                     &
 822                 ims, ime, jms, jme, kms, kme,                    &
 823                 its, ite, jts, jte, kts, kte                     )
 824
 825       CASE DEFAULT
 826
 827    END SELECT
 828
 829 END SUBROUTINE phy_fr_ten
 830
 831 !----------------------------------------------------------------------
 832 SUBROUTINE advance_ppt(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,           &
 833                      RQICUTEN,RQSCUTEN,RAINC,RAINCV,PRATEC,NCA,       &
 834                      HTOP,HBOT,CUTOP,CUBOT,                           &
 835                      CUPPT, DT, config_flags,                         &
 836                      ids,ide, jds,jde, kds,kde,                       &
 837                      ims,ime, jms,jme, kms,kme,                       &
 838                      its,ite, jts,jte, kts,kte                        )
 839 !----------------------------------------------------------------------
 840    USE module_state_description
 841    USE module_cu_kf
 842    USE module_cu_kfeta
 843 !----------------------------------------------------------------------
 844    IMPLICIT NONE
 845 !----------------------------------------------------------------------
 846    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
 847
 848    INTEGER,      INTENT(IN   )    ::                             &
 849                                       ids,ide, jds,jde, kds,kde, &
 850                                       ims,ime, jms,jme, kms,kme, &
 851                                       its,ite, jts,jte, kts,kte
 852
 853
 854    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                 &
 855          INTENT(INOUT)  ::                             RTHCUTEN, &
 856                                                        RQVCUTEN, &
 857                                                        RQCCUTEN, &
 858                                                        RQRCUTEN, &
 859                                                        RQICUTEN, &
 860                                                        RQSCUTEN
 861
 862    REAL, DIMENSION( ims:ime , jms:jme ),                         &
 863           INTENT(INOUT) ::                                RAINC, &
 864                                                          RAINCV, &
 865                                                          PRATEC, &
 866                                                             NCA, &
 867                                                            HTOP, &
 868                                                            HBOT, &
 869                                                           CUTOP, &
 870                                                           CUBOT, &
 871                                                           CUPPT
 872    REAL, INTENT(IN) ::                                       DT
 873
 874 ! LOCAL  VAR
 875
 876    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,k_start,k_end
 877    INTEGER :: NCUTOP, NCUBOT
 878
 879 !-----------------------------------------------------------------
 880
 881    IF (config_flags%cu_physics .eq. 0) return
 882
 883 ! SET START AND END POINTS FOR TILES
 884
 885    i_start = its
 886    i_end   = min( ite,ide-1 )
 887    j_start = jts
 888    j_end   = min( jte,jde-1 )
 889 !
 890 !  IF( config_flags%nested .or. config_flags%specified ) THEN
 891 !    i_start = max( its,ids+1 )
 892 !    i_end   = min( ite,ide-2 )
 893 !    j_start = max( jts,jds+1 )
 894 !    j_end   = min( jte,jde-2 )
 895 !  ENDIF
 896 !
 897    k_start = kts
 898    k_end = min( kte, kde-1 )
 899
 900 ! Update total cumulus scheme precipitation
 901
 902 ! in mm
 903
 904    DO J = j_start,j_end
 905    DO i = i_start,i_end
 906       RAINC(I,J)=RAINC(I,J)+PRATEC(I,J)*DT
 907       CUPPT(I,J)=CUPPT(I,J)+PRATEC(I,J)*DT/1000.
 908    ENDDO
 909    ENDDO
 910
 911    SELECT CASE (config_flags%cu_physics)
 912
 913    CASE (KFSCHEME)
 914
 915         DO J = j_start,j_end
 916         DO i = i_start,i_end
 917
 918            IF ( NCA(I,J) .GT. 0 ) THEN
 919
 920               IF ( NINT(NCA(I,J) / DT) .le. 0 ) THEN
 921
 922               ! set tendency to zero
 923                  PRATEC(I,J)=0.
 924                  RAINCV(I,J)=0.
 925                  DO k = k_start,k_end
 926                     RTHCUTEN(i,k,j)=0.
 927                     RQVCUTEN(i,k,j)=0.
 928                     RQCCUTEN(i,k,j)=0.
 929                     RQRCUTEN(i,k,j)=0.
 930                     if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
 931                     if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
 932                  ENDDO
 933               ENDIF
 934
 935               NCA(I,J)=NCA(I,J)-DT ! Decrease NCA
 936
 937            ENDIF
 938 !
 939         ENDDO
 940         ENDDO
 941
 942    CASE (BMJSCHEME)
 943
 944         DO J = j_start,j_end
 945         DO i = i_start,i_end
 946
 947 ! HTOP, HBOT FOR GFDL RADIATION
 948            NCUTOP=NINT(CUTOP(I,J))
 949            NCUBOT=NINT(CUBOT(I,J))
 950            IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
 951              HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
 952            ENDIF
 953            IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
 954              HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
 955            ENDIF
 956
 957         ENDDO
 958         ENDDO
 959
 960    CASE (KFETASCHEME)
 961
 962         DO J = j_start,j_end
 963         DO i = i_start,i_end
 964
 965 ! HTOP, HBOT FOR GFDL RADIATION
 966            NCUTOP=NINT(CUTOP(I,J))
 967            NCUBOT=NINT(CUBOT(I,J))
 968            IF(NCUTOP>1.AND.NCUTOP<KDE)THEN
 969              HTOP(I,J)=MAX(CUTOP(I,J),HTOP(I,J))
 970            ENDIF
 971            IF(NCUBOT>0.AND.NCUBOT<KDE)THEN
 972              HBOT(I,J)=MIN(CUBOT(I,J),HBOT(I,J))
 973            ENDIF
 974
 975            IF ( NCA(I,J) .GT. 0 ) THEN
 976
 977
 978               IF ( NINT(NCA(I,J) / DT) .LE. 1 ) THEN
 979
 980               ! set tendency to zero
 981                  PRATEC(I,J)=0.
 982                  RAINCV(I,J)=0.
 983                  DO k = k_start,k_end
 984                     RTHCUTEN(i,k,j)=0.
 985                     RQVCUTEN(i,k,j)=0.
 986                     RQCCUTEN(i,k,j)=0.
 987                     RQRCUTEN(i,k,j)=0.
 988                     if (P_QI .ge. PARAM_FIRST_SCALAR) RQICUTEN(i,k,j)=0.
 989                     if (P_QS .ge. PARAM_FIRST_SCALAR) RQSCUTEN(i,k,j)=0.
 990                  ENDDO
 991               ENDIF
 992
 993               NCA(I,J)=NCA(I,J)-DT ! Decrease NCA
 994 !              NCA(I,J)=NCA(I,J)-1. ! Decrease NCA
 995
 996            ENDIF
 997 !
 998         ENDDO
 999         ENDDO
1000
1001    CASE DEFAULT
1002
1003    END SELECT
1004
1005 END SUBROUTINE advance_ppt
1006
1007 SUBROUTINE add_a2a(lvar,rvar,config_flags,                  &
1008                    ids,ide, jds, jde, kds, kde,             &
1009                    ims, ime, jms, jme, kms, kme,            &
1010                    its, ite, jts, jte, kts, kte             )
1011 !------------------------------------------------------------
1012    IMPLICIT NONE
1013 !------------------------------------------------------------
1014    TYPE(grid_config_rec_type),  INTENT(IN) :: config_flags
1015
1016    INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
1017                               ims, ime, jms, jme, kms, kme, &
1018                               its, ite, jts, jte, kts, kte
1019
1020    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
1021                                                       rvar
1022    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1023                                                       lvar
1024
1025 ! LOCAL VARS
1026    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1027
1028    i_start = its
1029    i_end   = MIN(ite,ide-1)
1030    j_start = jts
1031    j_end   = MIN(jte,jde-1)
1032    ktf = min(kte,kde-1)
1033
1034    IF ( config_flags%specified .or. &
1035         config_flags%nested) i_start = MAX(ids+1,its)
1036    IF ( config_flags%specified .or. &
1037         config_flags%nested) i_end   = MIN(ide-2,ite)
1038    IF ( config_flags%specified .or. &
1039         config_flags%nested) j_start = MAX(jds+1,jts)
1040    IF ( config_flags%specified .or. &
1041         config_flags%nested) j_end   = MIN(jde-2,jte)
1042       IF ( config_flags%periodic_x ) i_start = its
1043       IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
1044
1045    DO j = j_start,j_end
1046    DO k = kts,ktf
1047    DO i = i_start,i_end
1048       lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1049    ENDDO
1050    ENDDO
1051    ENDDO
1052
1053 END SUBROUTINE add_a2a
1054
1055 !------------------------------------------------------------
1056 SUBROUTINE add_a2c_u(lvar,rvar,config_flags,                &
1057                    ids,ide, jds, jde, kds, kde,             &
1058                    ims, ime, jms, jme, kms, kme,            &
1059                    its, ite, jts, jte, kts, kte             )
1060 !------------------------------------------------------------
1061 !------------------------------------------------------------
1062    IMPLICIT NONE
1063 !------------------------------------------------------------
1064
1065    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
1066
1067    INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
1068                               ims, ime, jms, jme, kms, kme, &
1069                               its, ite, jts, jte, kts, kte
1070
1071    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
1072                                                       rvar
1073    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1074                                                       lvar
1075
1076 ! LOCAL VARS
1077
1078    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1079
1080    ktf=min(kte,kde-1)
1081
1082    i_start = its
1083    i_end   = ite
1084    j_start = jts
1085    j_end   = MIN(jte,jde-1)
1086
1087    IF ( config_flags%specified .or. &
1088         config_flags%nested) i_start = MAX(ids+1,its)
1089    IF ( config_flags%specified .or. &
1090         config_flags%nested) i_end   = MIN(ide-1,ite)
1091    IF ( config_flags%specified .or. &
1092         config_flags%nested) j_start = MAX(jds+1,jts)
1093    IF ( config_flags%specified .or. &
1094         config_flags%nested) j_end   = MIN(jde-2,jte)
1095       IF ( config_flags%periodic_x ) i_start = its
1096       IF ( config_flags%periodic_x ) i_end = ite
1097
1098    DO j = j_start,j_end
1099    DO k = kts,ktf
1100    DO i = i_start,i_end
1101       lvar(i,k,j) = lvar(i,k,j) + &
1102                        0.5*(rvar(i,k,j)+rvar(i-1,k,j))
1103    ENDDO
1104    ENDDO
1105    ENDDO
1106
1107 END SUBROUTINE add_a2c_u
1108
1109 !------------------------------------------------------------
1110 SUBROUTINE add_a2c_v(lvar,rvar,config_flags,                &
1111                    ids,ide, jds, jde, kds, kde,             &
1112                    ims, ime, jms, jme, kms, kme,            &
1113                    its, ite, jts, jte, kts, kte             )
1114 !------------------------------------------------------------
1115 !------------------------------------------------------------
1116    IMPLICIT NONE
1117 !------------------------------------------------------------
1118
1119    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
1120
1121    INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
1122                               ims, ime, jms, jme, kms, kme, &
1123                               its, ite, jts, jte, kts, kte
1124
1125    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
1126                                                       rvar
1127    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1128                                                       lvar
1129
1130 ! LOCAL VARS
1131
1132    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1133
1134    ktf=min(kte,kde-1)
1135
1136    i_start = its
1137    i_end   = MIN(ite,ide-1)
1138    j_start = jts
1139    j_end   = jte
1140
1141    IF ( config_flags%specified .or. &
1142         config_flags%nested) i_start = MAX(ids+1,its)
1143    IF ( config_flags%specified .or. &
1144         config_flags%nested) i_end   = MIN(ide-2,ite)
1145    IF ( config_flags%specified .or. &
1146         config_flags%nested) j_start = MAX(jds+1,jts)
1147    IF ( config_flags%specified .or. &
1148         config_flags%nested) j_end   = MIN(jde-1,jte)
1149       IF ( config_flags%periodic_x ) i_start = its
1150       IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
1151
1152    DO j = j_start,j_end
1153    DO k = kts,kte
1154    DO i = i_start,i_end
1155       lvar(i,k,j) = lvar(i,k,j) + &
1156                      0.5*(rvar(i,k,j)+rvar(i,k,j-1))
1157    ENDDO
1158    ENDDO
1159    ENDDO
1160
1161 END SUBROUTINE add_a2c_v
1162
1163 !------------------------------------------------------------
1164 SUBROUTINE add_c2c_u(lvar,rvar,config_flags,                &
1165                    ids,ide, jds, jde, kds, kde,             &
1166                    ims, ime, jms, jme, kms, kme,            &
1167                    its, ite, jts, jte, kts, kte             )
1168 !------------------------------------------------------------
1169 !------------------------------------------------------------
1170    IMPLICIT NONE
1171 !------------------------------------------------------------
1172
1173    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
1174
1175    INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
1176                               ims, ime, jms, jme, kms, kme, &
1177                               its, ite, jts, jte, kts, kte
1178
1179    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
1180                                                       rvar
1181    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1182                                                       lvar
1183
1184 ! LOCAL VARS
1185
1186    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1187
1188    ktf=min(kte,kde-1)
1189
1190    i_start = its
1191    i_end   = ite
1192    j_start = jts
1193    j_end   = MIN(jte,jde-1)
1194
1195
1196    IF ( config_flags%specified .or. &
1197         config_flags%nested) i_start = MAX(ids+1,its)
1198    IF ( config_flags%specified .or. &
1199         config_flags%nested) i_end   = MIN(ide-1,ite)
1200    IF ( config_flags%specified .or. &
1201         config_flags%nested) j_start = MAX(jds+1,jts)
1202    IF ( config_flags%specified .or. &
1203         config_flags%nested) j_end   = MIN(jde-2,jte)
1204
1205 !  write(*,'(a,6i4)') 'call c2cu, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
1206
1207    DO j = j_start,j_end
1208    DO k = kts,ktf
1209    DO i = i_start,i_end
1210       lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1211    ENDDO
1212    ENDDO
1213    ENDDO
1214
1215 END SUBROUTINE add_c2c_u
1216
1217 SUBROUTINE add_c2c_v(lvar,rvar,config_flags,                &
1218                    ids,ide, jds, jde, kds, kde,             &
1219                    ims, ime, jms, jme, kms, kme,            &
1220                    its, ite, jts, jte, kts, kte             )
1221 !------------------------------------------------------------
1222 !------------------------------------------------------------
1223    IMPLICIT NONE
1224 !------------------------------------------------------------
1225
1226    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
1227
1228    INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
1229                               ims, ime, jms, jme, kms, kme, &
1230                               its, ite, jts, jte, kts, kte
1231
1232    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
1233                                                       rvar
1234    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1235                                                       lvar
1236
1237 ! LOCAL VARS
1238
1239    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1240
1241    ktf=min(kte,kde-1)
1242
1243    i_start = its
1244    i_end   = MIN(ite,ide-1)
1245    j_start = jts
1246    j_end   = jte
1247
1248    IF ( config_flags%specified .or. &
1249         config_flags%nested) i_start = MAX(ids+1,its)
1250    IF ( config_flags%specified .or. &
1251         config_flags%nested) i_end   = MIN(ide-2,ite)
1252    IF ( config_flags%specified .or. &
1253         config_flags%nested) j_start = MAX(jds+1,jts)
1254    IF ( config_flags%specified .or. &
1255         config_flags%nested) j_end   = MIN(jde-1,jte)
1256
1257 !  write(*,'(a,6i4)') 'call c2cv, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
1258
1259    DO j = j_start,j_end
1260    DO k = kts,kte
1261    DO i = i_start,i_end
1262       lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1263    ENDDO
1264    ENDDO
1265    ENDDO
1266
1267 END SUBROUTINE add_c2c_v
1268
1269 #endif
1270
1271 END MODULE module_physics_addtendc