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