wrftladj/module_physics_addtendc_tl.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 g_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 g_update_phy_ten(rph_tendf,rt_tendf,g_rt_tendf,ru_tendf,g_ru_tendf,         &
  29                       rv_tendf,g_rv_tendf,moist_tendf,g_moist_tendf,        &
  30                       scalar_tendf,mu_tendf,                                &
  31                       RTHRATEN,RTHBLTEN,g_RTHBLTEN,RTHCUTEN,g_RTHCUTEN,RTHSHTEN,       &
  32                       RUBLTEN,g_RUBLTEN,RUCUTEN,RUSHTEN,                    &
  33                       RVBLTEN,g_RVBLTEN,RVCUTEN,RVSHTEN,                    &
  34                       RQVBLTEN,g_RQVBLTEN,RQCBLTEN,RQIBLTEN,                &
  35                       RQVCUTEN,g_RQVCUTEN,RQCCUTEN,RQRCUTEN,RQICUTEN,RQSCUTEN,         &
  36                       RQVSHTEN,RQCSHTEN,RQRSHTEN,RQISHTEN,RQSSHTEN,RQGSHTEN,&
  37                       RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,RPHNDGDTEN,            &
  38                       RQVNDGDTEN,RMUNDGDTEN,                                &
  39                       rthfrten,rqvfrten,                                    & !fire
  40                       n_moist,n_scalar,config_flags,rk_step,adv_moist_cond, &
  41                       ids, ide, jds, jde, kds, kde,                         &
  42                       ims, ime, jms, jme, kms, kme,                         &
  43                       its, ite, jts, jte, kts, kte                          )
  44 !-------------------------------------------------------------------
  45    IMPLICIT NONE
  46 !-------------------------------------------------------------------
  47
  48    TYPE(grid_config_rec_type   ) ,   INTENT(IN   ) :: config_flags
  49
  50    INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde,   &
  51                                    ims, ime, jms, jme, kms, kme,   &
  52                                    its, ite, jts, jte, kts, kte,   &
  53                                    n_moist,n_scalar,rk_step
  54
  55    LOGICAL , INTENT(IN)        :: adv_moist_cond
  56
  57    REAL , DIMENSION(ims:ime , kms:kme, jms:jme),INTENT(INOUT) ::   &
  58                                                          ru_tendf, &
  59                                                        g_ru_tendf, &
  60                                                          rv_tendf, &
  61                                                        g_rv_tendf, &
  62                                                          rt_tendf, &
  63                                                        g_rt_tendf, &
  64                                                          rph_tendf
  65
  66    REAL , DIMENSION(ims:ime , jms:jme),INTENT(INOUT) ::  mu_tendf
  67
  68    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),           &
  69           INTENT(INOUT)     ::                        moist_tendf, &
  70                                                     g_moist_tendf
  71
  72    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar),           &
  73           INTENT(INOUT)     ::                        scalar_tendf
  74
  75    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
  76                                                        RTHRATEN, &
  77                                                        RTHBLTEN, &
  78                                                      g_RTHBLTEN, &
  79                                                        RTHCUTEN, &
  80                                                      g_RTHCUTEN, &
  81                                                        RTHSHTEN, &
  82                                                         RUBLTEN, &
  83                                                       g_RUBLTEN, &
  84                                                         RUCUTEN, &
  85                                                         RUSHTEN, &
  86                                                         RVBLTEN, &
  87                                                       g_RVBLTEN, &
  88                                                         RVCUTEN, &
  89                                                         RVSHTEN, &
  90                                                        RQVBLTEN, &
  91                                                      g_RQVBLTEN, &
  92                                                        RQCBLTEN, &
  93                                                        RQIBLTEN, &
  94                                                        RQVCUTEN, &
  95                                                      g_RQVCUTEN, &
  96                                                        RQCCUTEN, &
  97                                                        RQRCUTEN, &
  98                                                        RQICUTEN, &
  99                                                        RQSCUTEN, &
 100                                                        RQVSHTEN, &
 101                                                        RQCSHTEN, &
 102                                                        RQRSHTEN, &
 103                                                        RQISHTEN, &
 104                                                        RQSSHTEN, &
 105                                                        RQGSHTEN, &
 106                                                      RTHNDGDTEN, &
 107                                                      RPHNDGDTEN, &
 108                                                      RQVNDGDTEN, &
 109                                                       RUNDGDTEN, &
 110                                                       RVNDGDTEN
 111
 112    REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN  ) :: RMUNDGDTEN
 113
 114    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   & ! fire
 115                                                        rthfrten, &
 116                                                        rqvfrten
 117 !------------------------------------------------------------------
 118 !  set up loop bounds for this grid's boundary conditions
 119
 120    if (config_flags%ra_lw_physics .gt. 0 .or.                  &
 121        config_flags%ra_sw_physics .gt. 0)                      &
 122       CALL phy_ra_ten(config_flags,rt_tendf,RTHRATEN,          &
 123                       ids, ide, jds, jde, kds, kde,            &
 124                       ims, ime, jms, jme, kms, kme,            &
 125                       its, ite, jts, jte, kts, kte             )
 126
 127    if (config_flags%bl_pbl_physics .gt. 0)                     &
 128       CALL g_phy_bl_ten(config_flags,rk_step,n_moist,n_scalar,   &
 129                       rt_tendf,g_rt_tendf,ru_tendf,g_ru_tendf,   &
 130                       rv_tendf,g_rv_tendf,                     &
 131                       moist_tendf, g_moist_tendf,              &
 132                       scalar_tendf,adv_moist_cond,             &
 133                       RTHBLTEN,g_RTHBLTEN,                     &
 134                       RUBLTEN,g_RUBLTEN,                       &
 135                       RVBLTEN,g_RVBLTEN,                       &
 136                       RQVBLTEN,g_RQVBLTEN,                     &
 137                       RQCBLTEN,RQIBLTEN,                       &
 138                       ids, ide, jds, jde, kds, kde,            &
 139                       ims, ime, jms, jme, kms, kme,            &
 140                       its, ite, jts, jte, kts, kte             )
 141
 142    if (config_flags%cu_physics .gt. 0)                         &
 143       CALL g_phy_cu_ten(config_flags,rk_step,n_moist,n_scalar,   &
 144                       rt_tendf,g_rt_tendf,ru_tendf,rv_tendf,   &
 145                       RUCUTEN,RVCUTEN,RTHCUTEN,g_RTHCUTEN,     &
 146                       RQVCUTEN,g_RQVCUTEN,RQCCUTEN,RQRCUTEN,   &
 147                       RQICUTEN,RQSCUTEN,moist_tendf,g_moist_tendf,&
 148                       scalar_tendf,adv_moist_cond,             &
 149                       ids, ide, jds, jde, kds, kde,            &
 150                       ims, ime, jms, jme, kms, kme,            &
 151                       its, ite, jts, jte, kts, kte             )
 152
 153    if (config_flags%shcu_physics .gt. 0)                       &
 154       CALL phy_shcu_ten(config_flags,rk_step,n_moist,          &
 155                       rt_tendf,ru_tendf,rv_tendf,              &
 156                       RUSHTEN,RVSHTEN,RTHSHTEN,                &
 157                       RQVSHTEN,RQCSHTEN,RQRSHTEN,              &
 158                       RQISHTEN,RQSSHTEN,RQGSHTEN,moist_tendf,  &
 159                       ids, ide, jds, jde, kds, kde,            &
 160                       ims, ime, jms, jme, kms, kme,            &
 161                       its, ite, jts, jte, kts, kte             )
 162
 163    if (config_flags%grid_fdda .gt. 0)                          &
 164       CALL phy_fg_ten(config_flags,rk_step,n_moist,            &
 165                       rph_tendf,rt_tendf,ru_tendf,rv_tendf,    &
 166                       mu_tendf, moist_tendf,                   &
 167                       RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,          &
 168                       RPHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,        &
 169                       ids, ide, jds, jde, kds, kde,            &
 170                       ims, ime, jms, jme, kms, kme,            &
 171                       its, ite, jts, jte, kts, kte             )
 172
 173    if (config_flags%ifire .gt. 0)                              & ! fire
 174       CALL phy_fr_ten(config_flags,rk_step,n_moist,            &
 175                       rt_tendf,ru_tendf,rv_tendf,              &
 176                       mu_tendf, moist_tendf,                   &
 177                       rthfrten,rqvfrten,                       &
 178                       ids, ide, jds, jde, kds, kde,            &
 179                       ims, ime, jms, jme, kms, kme,            &
 180                       its, ite, jts, jte, kts, kte             )
 181
 182 END SUBROUTINE g_update_phy_ten
 183
 184 !=================================================================
 185 SUBROUTINE phy_ra_ten(config_flags,rt_tendf,RTHRATEN,            &
 186                       ids, ide, jds, jde, kds, kde,              &
 187                       ims, ime, jms, jme, kms, kme,              &
 188                       its, ite, jts, jte, kts, kte               )
 189 !-----------------------------------------------------------------
 190    IMPLICIT NONE
 191 !-----------------------------------------------------------------
 192    TYPE(grid_config_rec_type  ) , INTENT(IN   ) :: config_flags
 193
 194    INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
 195                                    ims, ime, jms, jme, kms, kme, &
 196                                    its, ite, jts, jte, kts, kte
 197
 198    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
 199                                                        RTHRATEN
 200
 201    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::  &
 202                                                        rt_tendf
 203
 204 ! LOCAL VARS
 205
 206    INTEGER :: i,j,k
 207
 208    CALL add_a2a(rt_tendf,RTHRATEN,config_flags,                  &
 209                 ids,ide, jds, jde, kds, kde,                     &
 210                 ims, ime, jms, jme, kms, kme,                    &
 211                 its, ite, jts, jte, kts, kte                     )
 212
 213 END SUBROUTINE phy_ra_ten
 214
 215 !=================================================================
 216 SUBROUTINE g_phy_bl_ten(config_flags,rk_step,n_moist,n_scalar,   &
 217                       rt_tendf,g_rt_tendf,ru_tendf,g_ru_tendf,   &
 218                       rv_tendf,g_rv_tendf,moist_tendf,g_moist_tendf, &
 219                       scalar_tendf,adv_moist_cond,               &
 220                       RTHBLTEN,g_RTHBLTEN,                       &
 221                       RUBLTEN,g_RUBLTEN,                         &
 222                       RVBLTEN,g_RVBLTEN,                         &
 223                       RQVBLTEN,g_RQVBLTEN,                       &
 224                       RQCBLTEN,RQIBLTEN,                         &
 225                       ids, ide, jds, jde, kds, kde,              &
 226                       ims, ime, jms, jme, kms, kme,              &
 227                       its, ite, jts, jte, kts, kte               )
 228 !-----------------------------------------------------------------
 229    IMPLICIT NONE
 230 !-----------------------------------------------------------------
 231    TYPE(grid_config_rec_type) ,     INTENT(IN   ) :: config_flags
 232
 233    INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
 234                                    ims, ime, jms, jme, kms, kme, &
 235                                    its, ite, jts, jte, kts, kte, &
 236                                    n_moist, n_scalar, rk_step
 237
 238    LOGICAL , INTENT(IN)     :: adv_moist_cond
 239
 240    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
 241           INTENT(INOUT)     ::                      moist_tendf, &
 242                                                   g_moist_tendf
 243
 244    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar),         &
 245           INTENT(INOUT)     ::                      scalar_tendf
 246
 247    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
 248                                                        RTHBLTEN, &
 249                                                      g_RTHBLTEN, &
 250                                                         RUBLTEN, &
 251                                                       g_RUBLTEN, &
 252                                                         RVBLTEN, &
 253                                                       g_RVBLTEN, &
 254                                                        RQVBLTEN, &
 255                                                      g_RQVBLTEN, &
 256                                                        RQCBLTEN, &
 257                                                        RQIBLTEN
 258
 259    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT)::   &
 260                                                        rt_tendf, &
 261                                                      g_rt_tendf, &
 262                                                        ru_tendf, &
 263                                                      g_ru_tendf, &
 264                                                        rv_tendf, &
 265                                                      g_rv_tendf
 266 ! LOCAL VARS
 267
 268    INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
 269
 270 !-----------------------------------------------------------------
 271
 272    SELECT CASE(config_flags%bl_pbl_physics)
 273
 274       CASE (YSUSCHEME)
 275
 276            CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
 277                 ids,ide, jds, jde, kds, kde,                     &
 278                 ims, ime, jms, jme, kms, kme,                    &
 279                 its, ite, jts, jte, kts, kte                     )
 280
 281            CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
 282                 ids,ide, jds, jde, kds, kde,                     &
 283                 ims, ime, jms, jme, kms, kme,                    &
 284                 its, ite, jts, jte, kts, kte                     )
 285
 286            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
 287                 ids,ide, jds, jde, kds, kde,                     &
 288                 ims, ime, jms, jme, kms, kme,                    &
 289                 its, ite, jts, jte, kts, kte                     )
 290
 291         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 292            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
 293                 config_flags,                                    &
 294                 ids,ide, jds, jde, kds, kde,                     &
 295                 ims, ime, jms, jme, kms, kme,                    &
 296                 its, ite, jts, jte, kts, kte                     )
 297
 298         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 299            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
 300                 config_flags,                                    &
 301                 ids,ide, jds, jde, kds, kde,                     &
 302                 ims, ime, jms, jme, kms, kme,                    &
 303                 its, ite, jts, jte, kts, kte                     )
 304
 305         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
 306            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
 307                 config_flags,                                    &
 308                 ids,ide, jds, jde, kds, kde,                     &
 309                 ims, ime, jms, jme, kms, kme,                    &
 310                 its, ite, jts, jte, kts, kte                     )
 311
 312        IF(.not. adv_moist_cond)THEN
 313
 314         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 315            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
 316                 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         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 322            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
 323                 config_flags,                                    &
 324                 ids,ide, jds, jde, kds, kde,                     &
 325                 ims, ime, jms, jme, kms, kme,                    &
 326                 its, ite, jts, jte, kts, kte                     )
 327        ENDIF
 328
 329       CASE (MRFSCHEME)
 330
 331            CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
 332                 ids,ide, jds, jde, kds, kde,                     &
 333                 ims, ime, jms, jme, kms, kme,                    &
 334                 its, ite, jts, jte, kts, kte                     )
 335
 336            CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
 337                 ids,ide, jds, jde, kds, kde,                     &
 338                 ims, ime, jms, jme, kms, kme,                    &
 339                 its, ite, jts, jte, kts, kte                     )
 340
 341            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
 342                 ids,ide, jds, jde, kds, kde,                     &
 343                 ims, ime, jms, jme, kms, kme,                    &
 344                 its, ite, jts, jte, kts, kte                     )
 345
 346         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 347            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
 348                 config_flags,                                    &
 349                 ids,ide, jds, jde, kds, kde,                     &
 350                 ims, ime, jms, jme, kms, kme,                    &
 351                 its, ite, jts, jte, kts, kte                     )
 352
 353         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 354            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
 355                 config_flags,                                    &
 356                 ids,ide, jds, jde, kds, kde,                     &
 357                 ims, ime, jms, jme, kms, kme,                    &
 358                 its, ite, jts, jte, kts, kte                     )
 359
 360         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
 361            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),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
 367        IF(.not. adv_moist_cond)THEN
 368
 369         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 370            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
 371                 config_flags,                                    &
 372                 ids,ide, jds, jde, kds, kde,                     &
 373                 ims, ime, jms, jme, kms, kme,                    &
 374                 its, ite, jts, jte, kts, kte                     )
 375
 376         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 377            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
 378                 config_flags,                                    &
 379                 ids,ide, jds, jde, kds, kde,                     &
 380                 ims, ime, jms, jme, kms, kme,                    &
 381                 its, ite, jts, jte, kts, kte                     )
 382        ENDIF
 383
 384       CASE (ACMPBLSCHEME)
 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 (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 409            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
 410                 config_flags,                                    &
 411                 ids,ide, jds, jde, kds, kde,                     &
 412                 ims, ime, jms, jme, kms, kme,                    &
 413                 its, ite, jts, jte, kts, kte                     )
 414
 415         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
 416            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
 417                 config_flags,                                    &
 418                 ids,ide, jds, jde, kds, kde,                     &
 419                 ims, ime, jms, jme, kms, kme,                    &
 420                 its, ite, jts, jte, kts, kte                     )
 421
 422        IF(.not. adv_moist_cond)THEN
 423
 424         if (P_QT .ge. PARAM_FIRST_SCALAR)THEN
 425            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
 426                 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            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
 432                 config_flags,                                    &
 433                 ids,ide, jds, jde, kds, kde,                     &
 434                 ims, ime, jms, jme, kms, kme,                    &
 435                 its, ite, jts, jte, kts, kte                     )
 436         ENDIF
 437
 438        ENDIF
 439
 440       CASE (MYJPBLSCHEME)
 441
 442            CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
 443                 ids,ide, jds, jde, kds, kde,                     &
 444                 ims, ime, jms, jme, kms, kme,                    &
 445                 its, ite, jts, jte, kts, kte                     )
 446
 447            CALL add_a2c_u(ru_tendf,RUBLTEN,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            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
 453                 ids,ide, jds, jde, kds, kde,                     &
 454                 ims, ime, jms, jme, kms, kme,                    &
 455                 its, ite, jts, jte, kts, kte                     )
 456
 457         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 458            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
 459                 config_flags,                                    &
 460                 ids,ide, jds, jde, kds, kde,                     &
 461                 ims, ime, jms, jme, kms, kme,                    &
 462                 its, ite, jts, jte, kts, kte                     )
 463
 464        IF(.not. adv_moist_cond)THEN
 465
 466         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 467            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
 468                 config_flags,                                    &
 469                 ids,ide, jds, jde, kds, kde,                     &
 470                 ims, ime, jms, jme, kms, kme,                    &
 471                 its, ite, jts, jte, kts, kte                     )
 472
 473         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 474            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
 475                 config_flags,                                    &
 476                 ids,ide, jds, jde, kds, kde,                     &
 477                 ims, ime, jms, jme, kms, kme,                    &
 478                 its, ite, jts, jte, kts, kte                     )
 479
 480 !       if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 481 !          CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQSBLTEN,  &
 482 !               config_flags,                                    &
 483 !               ids,ide, jds, jde, kds, kde,                     &
 484 !               ims, ime, jms, jme, kms, kme,                    &
 485 !               its, ite, jts, jte, kts, kte                     )
 486 !
 487 !       if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 488 !          CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQRBLTEN,  &
 489 !               config_flags,                                    &
 490 !               ids,ide, jds, jde, kds, kde,                     &
 491 !               ims, ime, jms, jme, kms, kme,                    &
 492 !               its, ite, jts, jte, kts, kte                     )
 493 !
 494 !       if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 495 !          CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQGBLTEN,  &
 496 !               config_flags,                                    &
 497 !               ids,ide, jds, jde, kds, kde,                     &
 498 !               ims, ime, jms, jme, kms, kme,                    &
 499 !               its, ite, jts, jte, kts, kte                     )
 500
 501        ELSE
 502
 503         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 504            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
 505                 config_flags,                                    &
 506                 ids,ide, jds, jde, kds, kde,                     &
 507                 ims, ime, jms, jme, kms, kme,                    &
 508                 its, ite, jts, jte, kts, kte                     )
 509
 510         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
 511            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
 512                 config_flags,                                    &
 513                 ids,ide, jds, jde, kds, kde,                     &
 514                 ims, ime, jms, jme, kms, kme,                    &
 515                 its, ite, jts, jte, kts, kte                     )
 516
 517 !       if (P_QS .ge. PARAM_FIRST_SCALAR)                                         &
 518 !          CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSBLTEN,  &
 519 !               config_flags,                                    &
 520 !               ids,ide, jds, jde, kds, kde,                     &
 521 !               ims, ime, jms, jme, kms, kme,                    &
 522 !               its, ite, jts, jte, kts, kte                     )
 523 !
 524 !       if (P_QR .ge. PARAM_FIRST_SCALAR)                                         &
 525 !          CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRBLTEN,  &
 526 !               config_flags,                                    &
 527 !               ids,ide, jds, jde, kds, kde,                     &
 528 !               ims, ime, jms, jme, kms, kme,                    &
 529 !               its, ite, jts, jte, kts, kte                     )
 530 !
 531 !       if (P_QG .ge. PARAM_FIRST_SCALAR)                                         &
 532 !          CALL add_a2a(moist_tendf(ims,kms,jms,P_QG),RQGBLTEN,  &
 533 !               config_flags,                                    &
 534 !               ids,ide, jds, jde, kds, kde,                     &
 535 !               ims, ime, jms, jme, kms, kme,                    &
 536 !               its, ite, jts, jte, kts, kte                     )
 537
 538        ENDIF
 539
 540       CASE (QNSEPBLSCHEME)
 541
 542            CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
 543                 ids,ide, jds, jde, kds, kde,                     &
 544                 ims, ime, jms, jme, kms, kme,                    &
 545                 its, ite, jts, jte, kts, kte                     )
 546
 547            CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
 548                 ids,ide, jds, jde, kds, kde,                     &
 549                 ims, ime, jms, jme, kms, kme,                    &
 550                 its, ite, jts, jte, kts, kte                     )
 551
 552            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
 553                 ids,ide, jds, jde, kds, kde,                     &
 554                 ims, ime, jms, jme, kms, kme,                    &
 555                 its, ite, jts, jte, kts, kte                     )
 556
 557         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 558            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
 559                 config_flags,                                    &
 560                 ids,ide, jds, jde, kds, kde,                     &
 561                 ims, ime, jms, jme, kms, kme,                    &
 562                 its, ite, jts, jte, kts, kte                     )
 563
 564        IF(.not. adv_moist_cond)THEN
 565
 566         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 567            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
 568                 config_flags,                                    &
 569                 ids,ide, jds, jde, kds, kde,                     &
 570                 ims, ime, jms, jme, kms, kme,                    &
 571                 its, ite, jts, jte, kts, kte                     )
 572
 573        ELSE
 574
 575         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 576            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
 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        ENDIF
 583
 584       CASE (GFSSCHEME)
 585
 586            CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
 587                 ids,ide, jds, jde, kds, kde,                     &
 588                 ims, ime, jms, jme, kms, kme,                    &
 589                 its, ite, jts, jte, kts, kte                     )
 590
 591            CALL add_a2c_u(ru_tendf,RUBLTEN,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            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
 597                 ids,ide, jds, jde, kds, kde,                     &
 598                 ims, ime, jms, jme, kms, kme,                    &
 599                 its, ite, jts, jte, kts, kte                     )
 600
 601         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 602            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
 603                 config_flags,                                    &
 604                 ids,ide, jds, jde, kds, kde,                     &
 605                 ims, ime, jms, jme, kms, kme,                    &
 606                 its, ite, jts, jte, kts, kte                     )
 607
 608         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 609            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
 610                 config_flags,                                    &
 611                 ids,ide, jds, jde, kds, kde,                     &
 612                 ims, ime, jms, jme, kms, kme,                    &
 613                 its, ite, jts, jte, kts, kte                     )
 614
 615         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
 616            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
 617                 config_flags,                                    &
 618                 ids,ide, jds, jde, kds, kde,                     &
 619                 ims, ime, jms, jme, kms, kme,                    &
 620                 its, ite, jts, jte, kts, kte                     )
 621
 622        IF(.not. adv_moist_cond)THEN
 623
 624         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 625            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
 626                 config_flags,                                    &
 627                 ids,ide, jds, jde, kds, kde,                     &
 628                 ims, ime, jms, jme, kms, kme,                    &
 629                 its, ite, jts, jte, kts, kte                     )
 630
 631         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 632            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQIBLTEN,  &
 633                 config_flags,                                    &
 634                 ids,ide, jds, jde, kds, kde,                     &
 635                 ims, ime, jms, jme, kms, kme,                    &
 636                 its, ite, jts, jte, kts, kte                     )
 637        ENDIF
 638
 639       CASE (MYNNPBLSCHEME2,MYNNPBLSCHEME3)
 640
 641            CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
 642                 ids,ide, jds, jde, kds, kde,                     &
 643                 ims, ime, jms, jme, kms, kme,                    &
 644                 its, ite, jts, jte, kts, kte                     )
 645
 646            CALL add_a2c_u(ru_tendf,RUBLTEN,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            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
 652                 ids,ide, jds, jde, kds, kde,                     &
 653                 ims, ime, jms, jme, kms, kme,                    &
 654                 its, ite, jts, jte, kts, kte                     )
 655
 656         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 657            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
 658                 config_flags,                                    &
 659                 ids,ide, jds, jde, kds, kde,                     &
 660                 ims, ime, jms, jme, kms, kme,                    &
 661                 its, ite, jts, jte, kts, kte                     )
 662
 663         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 664            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
 665                 config_flags,                                    &
 666                 ids,ide, jds, jde, kds, kde,                     &
 667                 ims, ime, jms, jme, kms, kme,                    &
 668                 its, ite, jts, jte, kts, kte                     )
 669
 670        IF(.not. adv_moist_cond)THEN
 671
 672         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 673            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
 674                 config_flags,                                    &
 675                 ids,ide, jds, jde, kds, kde,                     &
 676                 ims, ime, jms, jme, kms, kme,                    &
 677                 its, ite, jts, jte, kts, kte                     )
 678
 679        ENDIF
 680
 681        CASE (BOULACSCHEME)
 682
 683            CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
 684                 ids,ide, jds, jde, kds, kde,                     &
 685                 ims, ime, jms, jme, kms, kme,                    &
 686                 its, ite, jts, jte, kts, kte                     )
 687
 688            CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
 689                 ids,ide, jds, jde, kds, kde,                     &
 690                 ims, ime, jms, jme, kms, kme,                    &
 691                 its, ite, jts, jte, kts, kte                     )
 692
 693            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
 694                 ids,ide, jds, jde, kds, kde,                     &
 695                 ims, ime, jms, jme, kms, kme,                    &
 696                 its, ite, jts, jte, kts, kte                     )
 697
 698         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 699            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
 700                 config_flags,                                    &
 701                 ids,ide, jds, jde, kds, kde,                     &
 702                 ims, ime, jms, jme, kms, kme,                    &
 703                 its, ite, jts, jte, kts, kte                     )
 704
 705        IF(.not. adv_moist_cond)THEN
 706
 707         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 708            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
 709                 config_flags,                                    &
 710                 ids,ide, jds, jde, kds, kde,                     &
 711                 ims, ime, jms, jme, kms, kme,                    &
 712                 its, ite, jts, jte, kts, kte                     )
 713
 714        ELSE
 715
 716         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 717            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
 718                 config_flags,                                    &
 719                 ids,ide, jds, jde, kds, kde,                     &
 720                 ims, ime, jms, jme, kms, kme,                    &
 721                 its, ite, jts, jte, kts, kte                     )
 722        ENDIF
 723
 724       CASE (SURFDRAGSCHEME)
 725
 726            CALL g_add_a2a(rt_tendf,g_rt_tendf,                   &
 727                 RTHBLTEN,g_RTHBLTEN,config_flags,                &
 728                 ids,ide, jds, jde, kds, kde,                     &
 729                 ims, ime, jms, jme, kms, kme,                    &
 730                 its, ite, jts, jte, kts, kte                     )
 731
 732            CALL g_add_a2c_u(ru_tendf,g_ru_tendf,                 &
 733                 RUBLTEN,g_RUBLTEN,config_flags,                  &
 734                 ids,ide, jds, jde, kds, kde,                     &
 735                 ims, ime, jms, jme, kms, kme,                    &
 736                 its, ite, jts, jte, kts, kte                     )
 737
 738            CALL g_add_a2c_v(rv_tendf,g_rv_tendf,                 &
 739                 RVBLTEN,g_RVBLTEN,config_flags,                  &
 740                 ids,ide, jds, jde, kds, kde,                     &
 741                 ims, ime, jms, jme, kms, kme,                    &
 742                 its, ite, jts, jte, kts, kte                     )
 743
 744            if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 745               CALL g_add_a2a(moist_tendf(ims,kms,jms,P_QV),      &
 746                    g_moist_tendf(ims,kms,jms,P_QV),              &
 747                    RQVBLTEN, g_RQVBLTEN,                         &
 748                    config_flags,                                 &
 749                    ids,ide, jds, jde, kds, kde,                  &
 750                    ims, ime, jms, jme, kms, kme,                 &
 751                    its, ite, jts, jte, kts, kte                  )
 752
 753        CASE (CAMUWPBLSCHEME)
 754            CALL add_a2a(rt_tendf,RTHBLTEN,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            CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
 760                 ids,ide, jds, jde, kds, kde,                     &
 761                 ims, ime, jms, jme, kms, kme,                    &
 762                 its, ite, jts, jte, kts, kte                     )
 763
 764            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
 765                 ids,ide, jds, jde, kds, kde,                     &
 766                 ims, ime, jms, jme, kms, kme,                    &
 767                 its, ite, jts, jte, kts, kte                     )
 768
 769         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 770            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
 771                 config_flags,                                    &
 772                 ids,ide, jds, jde, kds, kde,                     &
 773                 ims, ime, jms, jme, kms, kme,                    &
 774                 its, ite, jts, jte, kts, kte                     )
 775
 776        IF(.not. adv_moist_cond)THEN
 777
 778         if (P_QT .ge. PARAM_FIRST_SCALAR)                                         &
 779            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCBLTEN,  &
 780                 config_flags,                                    &
 781                 ids,ide, jds, jde, kds, kde,                     &
 782                 ims, ime, jms, jme, kms, kme,                    &
 783                 its, ite, jts, jte, kts, kte                     )
 784
 785        ELSE
 786
 787         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 788            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
 789                 config_flags,                                    &
 790                 ids,ide, jds, jde, kds, kde,                     &
 791                 ims, ime, jms, jme, kms, kme,                    &
 792                 its, ite, jts, jte, kts, kte                     )
 793        ENDIF
 794
 795
 796       CASE (TEMFPBLSCHEME)
 797            CALL add_a2a(rt_tendf,RTHBLTEN,config_flags,          &
 798                 ids,ide, jds, jde, kds, kde,                     &
 799                 ims, ime, jms, jme, kms, kme,                    &
 800                 its, ite, jts, jte, kts, kte                     )
 801
 802            CALL add_a2c_u(ru_tendf,RUBLTEN,config_flags,         &
 803                 ids,ide, jds, jde, kds, kde,                     &
 804                 ims, ime, jms, jme, kms, kme,                    &
 805                 its, ite, jts, jte, kts, kte                     )
 806
 807            CALL add_a2c_v(rv_tendf,RVBLTEN,config_flags,         &
 808                 ids,ide, jds, jde, kds, kde,                     &
 809                 ims, ime, jms, jme, kms, kme,                    &
 810                 its, ite, jts, jte, kts, kte                     )
 811
 812         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 813            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVBLTEN,  &
 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         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 820            CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCBLTEN,  &
 821                 config_flags,                                    &
 822                 ids,ide, jds, jde, kds, kde,                     &
 823                 ims, ime, jms, jme, kms, kme,                    &
 824                 its, ite, jts, jte, kts, kte                     )
 825
 826         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
 827            CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQIBLTEN,  &
 828                 config_flags,                                    &
 829                 ids,ide, jds, jde, kds, kde,                     &
 830                 ims, ime, jms, jme, kms, kme,                    &
 831                 its, ite, jts, jte, kts, kte                     )
 832
 833       CASE DEFAULT
 834
 835        print*,'g_phy_bl_ten: The pbl scheme does not exist'
 836
 837    END SELECT
 838
 839 END SUBROUTINE g_phy_bl_ten
 840
 841 !=================================================================
 842 SUBROUTINE g_phy_cu_ten(config_flags,rk_step,n_moist,n_scalar,     &
 843                       rt_tendf,g_rt_tendf,ru_tendf,rv_tendf,     &
 844                       RUCUTEN,RVCUTEN,RTHCUTEN,g_RTHCUTEN,       &
 845                       RQVCUTEN,g_RQVCUTEN,RQCCUTEN,RQRCUTEN,     &
 846                       RQICUTEN,RQSCUTEN,moist_tendf,g_moist_tendf,&
 847                       scalar_tendf,adv_moist_cond,               &
 848                       ids, ide, jds, jde, kds, kde,              &
 849                       ims, ime, jms, jme, kms, kme,              &
 850                       its, ite, jts, jte, kts, kte               )
 851 !-----------------------------------------------------------------
 852    IMPLICIT NONE
 853 !-----------------------------------------------------------------
 854    TYPE(grid_config_rec_type  ) , INTENT(IN   ) :: config_flags
 855
 856    INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
 857                                    ims, ime, jms, jme, kms, kme, &
 858                                    its, ite, jts, jte, kts, kte, &
 859                                    n_moist, n_scalar, rk_step
 860
 861    LOGICAL , INTENT(IN)     :: adv_moist_cond
 862
 863    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
 864           INTENT(INOUT)     ::                      moist_tendf, g_moist_tendf
 865
 866    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_scalar),         &
 867           INTENT(INOUT)     ::                      scalar_tendf
 868
 869    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
 870                                                         RUCUTEN, &
 871                                                         RVCUTEN, &
 872                                                        RTHCUTEN, &
 873                                                      g_RTHCUTEN, &
 874                                                        RQVCUTEN, &
 875                                                      g_RQVCUTEN, &
 876                                                        RQCCUTEN, &
 877                                                        RQRCUTEN, &
 878                                                        RQICUTEN, &
 879                                                        RQSCUTEN
 880
 881    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::  &
 882                                                        rt_tendf, &
 883                                                      g_rt_tendf, &
 884                                                        ru_tendf, &
 885                                                        rv_tendf
 886
 887
 888 ! LOCAL VARS
 889
 890    INTEGER :: i,j,k
 891
 892    SELECT CASE (config_flags%cu_physics)
 893
 894    CASE (KFSCHEME)
 895         CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
 896                 ids,ide, jds, jde, kds, kde,                     &
 897                 ims, ime, jms, jme, kms, kme,                    &
 898                 its, ite, jts, jte, kts, kte                     )
 899
 900         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 901         CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
 902                 config_flags,                                    &
 903                 ids,ide, jds, jde, kds, kde,                     &
 904                 ims, ime, jms, jme, kms, kme,                    &
 905                 its, ite, jts, jte, kts, kte                     )
 906
 907         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 908         CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
 909                 config_flags,                                    &
 910                 ids,ide, jds, jde, kds, kde,                     &
 911                 ims, ime, jms, jme, kms, kme,                    &
 912                 its, ite, jts, jte, kts, kte                     )
 913
 914         if (P_QR .ge. PARAM_FIRST_SCALAR)                                         &
 915         CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN,     &
 916                 config_flags,                                    &
 917                 ids,ide, jds, jde, kds, kde,                     &
 918                 ims, ime, jms, jme, kms, kme,                    &
 919                 its, ite, jts, jte, kts, kte                     )
 920
 921         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
 922         CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
 923                 config_flags,                                    &
 924                 ids,ide, jds, jde, kds, kde,                     &
 925                 ims, ime, jms, jme, kms, kme,                    &
 926                 its, ite, jts, jte, kts, kte                     )
 927
 928         if (P_QS .ge. PARAM_FIRST_SCALAR)                                         &
 929         CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN,     &
 930                 config_flags,                                    &
 931                 ids,ide, jds, jde, kds, kde,                     &
 932                 ims, ime, jms, jme, kms, kme,                    &
 933                 its, ite, jts, jte, kts, kte                     )
 934
 935        IF(.not. adv_moist_cond)THEN
 936
 937         if (P_QT .ge. PARAM_FIRST_SCALAR)                        &
 938            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
 939                 config_flags,                                    &
 940                 ids,ide, jds, jde, kds, kde,                     &
 941                 ims, ime, jms, jme, kms, kme,                    &
 942                 its, ite, jts, jte, kts, kte                     )
 943
 944         if (P_QT .ge. PARAM_FIRST_SCALAR)                        &
 945            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQRCUTEN, &
 946                 config_flags,                                    &
 947                 ids,ide, jds, jde, kds, kde,                     &
 948                 ims, ime, jms, jme, kms, kme,                    &
 949                 its, ite, jts, jte, kts, kte                     )
 950
 951         if (P_QT .ge. PARAM_FIRST_SCALAR)                        &
 952            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
 953                 config_flags,                                    &
 954                 ids,ide, jds, jde, kds, kde,                     &
 955                 ims, ime, jms, jme, kms, kme,                    &
 956                 its, ite, jts, jte, kts, kte                     )
 957
 958         if (P_QT .ge. PARAM_FIRST_SCALAR)                        &
 959            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQSCUTEN, &
 960                 config_flags,                                    &
 961                 ids,ide, jds, jde, kds, kde,                     &
 962                 ims, ime, jms, jme, kms, kme,                    &
 963                 its, ite, jts, jte, kts, kte                     )
 964
 965        ENDIF
 966
 967    CASE (BMJSCHEME)
 968         CALL add_a2a(rt_tendf,RTHCUTEN,                          &
 969                 config_flags,                                    &
 970                 ids,ide, jds, jde, kds, kde,                     &
 971                 ims, ime, jms, jme, kms, kme,                    &
 972                 its, ite, jts, jte, kts, kte                     )
 973
 974         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 975         CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
 976                 config_flags,                                    &
 977                 ids,ide, jds, jde, kds, kde,                     &
 978                 ims, ime, jms, jme, kms, kme,                    &
 979                 its, ite, jts, jte, kts, kte                     )
 980
 981    CASE (KFETASCHEME, MSKFSCHEME)
 982         CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
 983                 ids,ide, jds, jde, kds, kde,                     &
 984                 ims, ime, jms, jme, kms, kme,                    &
 985                 its, ite, jts, jte, kts, kte                     )
 986
 987         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
 988         CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
 989                 config_flags,                                    &
 990                 ids,ide, jds, jde, kds, kde,                     &
 991                 ims, ime, jms, jme, kms, kme,                    &
 992                 its, ite, jts, jte, kts, kte                     )
 993
 994         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
 995         CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
 996                 config_flags,                                    &
 997                 ids,ide, jds, jde, kds, kde,                     &
 998                 ims, ime, jms, jme, kms, kme,                    &
 999                 its, ite, jts, jte, kts, kte                     )
1000
1001         if (P_QR .ge. PARAM_FIRST_SCALAR)                                         &
1002         CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRCUTEN,     &
1003                 config_flags,                                    &
1004                 ids,ide, jds, jde, kds, kde,                     &
1005                 ims, ime, jms, jme, kms, kme,                    &
1006                 its, ite, jts, jte, kts, kte                     )
1007
1008         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
1009         CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
1010                 config_flags,                                    &
1011                 ids,ide, jds, jde, kds, kde,                     &
1012                 ims, ime, jms, jme, kms, kme,                    &
1013                 its, ite, jts, jte, kts, kte                     )
1014
1015         if (P_QS .ge. PARAM_FIRST_SCALAR)                                         &
1016         CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSCUTEN,     &
1017                 config_flags,                                    &
1018                 ids,ide, jds, jde, kds, kde,                     &
1019                 ims, ime, jms, jme, kms, kme,                    &
1020                 its, ite, jts, jte, kts, kte                     )
1021
1022        IF(.not. adv_moist_cond)THEN
1023
1024         if (P_QT .ge. PARAM_FIRST_SCALAR)                        &
1025            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
1026                 config_flags,                                    &
1027                 ids,ide, jds, jde, kds, kde,                     &
1028                 ims, ime, jms, jme, kms, kme,                    &
1029                 its, ite, jts, jte, kts, kte                     )
1030
1031         if (P_QT .ge. PARAM_FIRST_SCALAR)                        &
1032            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQRCUTEN, &
1033                 config_flags,                                    &
1034                 ids,ide, jds, jde, kds, kde,                     &
1035                 ims, ime, jms, jme, kms, kme,                    &
1036                 its, ite, jts, jte, kts, kte                     )
1037
1038         if (P_QT .ge. PARAM_FIRST_SCALAR)                        &
1039            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
1040                 config_flags,                                    &
1041                 ids,ide, jds, jde, kds, kde,                     &
1042                 ims, ime, jms, jme, kms, kme,                    &
1043                 its, ite, jts, jte, kts, kte                     )
1044
1045         if (P_QT .ge. PARAM_FIRST_SCALAR)                        &
1046            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQSCUTEN, &
1047                 config_flags,                                    &
1048                 ids,ide, jds, jde, kds, kde,                     &
1049                 ims, ime, jms, jme, kms, kme,                    &
1050                 its, ite, jts, jte, kts, kte                     )
1051
1052        ENDIF
1053    CASE (GDSCHEME, G3SCHEME)
1054         CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
1055                 ids,ide, jds, jde, kds, kde,                     &
1056                 ims, ime, jms, jme, kms, kme,                    &
1057                 its, ite, jts, jte, kts, kte                     )
1058
1059         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
1060         CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
1061                 config_flags,                                    &
1062                 ids,ide, jds, jde, kds, kde,                     &
1063                 ims, ime, jms, jme, kms, kme,                    &
1064                 its, ite, jts, jte, kts, kte                     )
1065
1066         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
1067         CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
1068                 config_flags,                                    &
1069                 ids,ide, jds, jde, kds, kde,                     &
1070                 ims, ime, jms, jme, kms, kme,                    &
1071                 its, ite, jts, jte, kts, kte                     )
1072
1073         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
1074         CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
1075                 config_flags,                                    &
1076                 ids,ide, jds, jde, kds, kde,                     &
1077                 ims, ime, jms, jme, kms, kme,                    &
1078                 its, ite, jts, jte, kts, kte                     )
1079
1080        IF(.not. adv_moist_cond)THEN
1081
1082         if (P_QT .ge. PARAM_FIRST_SCALAR)                        &
1083            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
1084                 config_flags,                                    &
1085                 ids,ide, jds, jde, kds, kde,                     &
1086                 ims, ime, jms, jme, kms, kme,                    &
1087                 its, ite, jts, jte, kts, kte                     )
1088
1089         if (P_QT .ge. PARAM_FIRST_SCALAR)                        &
1090            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
1091                 config_flags,                                    &
1092                 ids,ide, jds, jde, kds, kde,                     &
1093                 ims, ime, jms, jme, kms, kme,                    &
1094                 its, ite, jts, jte, kts, kte                     )
1095
1096        ENDIF
1097
1098    CASE (NSASSCHEME)
1099         CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
1100                 ids,ide, jds, jde, kds, kde,                     &
1101                 ims, ime, jms, jme, kms, kme,                    &
1102                 its, ite, jts, jte, kts, kte                     )
1103
1104         CALL add_a2c_u(ru_tendf,RUCUTEN,config_flags,            &
1105                 ids,ide, jds, jde, kds, kde,                     &
1106                 ims, ime, jms, jme, kms, kme,                    &
1107                 its, ite, jts, jte, kts, kte                     )
1108
1109         CALL add_a2c_v(rv_tendf,RVCUTEN,config_flags,            &
1110                 ids,ide, jds, jde, kds, kde,                     &
1111                 ims, ime, jms, jme, kms, kme,                    &
1112                 its, ite, jts, jte, kts, kte                     )
1113
1114         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
1115         CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
1116                 config_flags,                                    &
1117                 ids,ide, jds, jde, kds, kde,                     &
1118                 ims, ime, jms, jme, kms, kme,                    &
1119                 its, ite, jts, jte, kts, kte                     )
1120
1121         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
1122         CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
1123                 config_flags,                                    &
1124                 ids,ide, jds, jde, kds, kde,                     &
1125                 ims, ime, jms, jme, kms, kme,                    &
1126                 its, ite, jts, jte, kts, kte                     )
1127
1128         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
1129         CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
1130                 config_flags,                                    &
1131                 ids,ide, jds, jde, kds, kde,                     &
1132                 ims, ime, jms, jme, kms, kme,                    &
1133                 its, ite, jts, jte, kts, kte                     )
1134
1135        IF(.not. adv_moist_cond)THEN
1136
1137         if (P_QT .ge. PARAM_FIRST_SCALAR)                        &
1138            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
1139                 config_flags,                                    &
1140                 ids,ide, jds, jde, kds, kde,                     &
1141                 ims, ime, jms, jme, kms, kme,                    &
1142                 its, ite, jts, jte, kts, kte                     )
1143
1144         if (P_QT .ge. PARAM_FIRST_SCALAR)                        &
1145            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
1146                 config_flags,                                    &
1147                 ids,ide, jds, jde, kds, kde,                     &
1148                 ims, ime, jms, jme, kms, kme,                    &
1149                 its, ite, jts, jte, kts, kte                     )
1150
1151        ENDIF
1152
1153    CASE (SASSCHEME,OSASSCHEME)
1154         CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
1155                 ids,ide, jds, jde, kds, kde,                     &
1156                 ims, ime, jms, jme, kms, kme,                    &
1157                 its, ite, jts, jte, kts, kte                     )
1158
1159         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
1160         CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
1161                 config_flags,                                    &
1162                 ids,ide, jds, jde, kds, kde,                     &
1163                 ims, ime, jms, jme, kms, kme,                    &
1164                 its, ite, jts, jte, kts, kte                     )
1165
1166         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
1167         CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
1168                 config_flags,                                    &
1169                 ids,ide, jds, jde, kds, kde,                     &
1170                 ims, ime, jms, jme, kms, kme,                    &
1171                 its, ite, jts, jte, kts, kte                     )
1172
1173         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
1174         CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
1175                 config_flags,                                    &
1176                 ids,ide, jds, jde, kds, kde,                     &
1177                 ims, ime, jms, jme, kms, kme,                    &
1178                 its, ite, jts, jte, kts, kte                     )
1179
1180    CASE (DUCUSCHEME)
1181         CALL g_add_a2a(rt_tendf, g_rt_tendf,                     &
1182                 RTHCUTEN, g_RTHCUTEN, config_flags,              &
1183                 ids,ide, jds, jde, kds, kde,                     &
1184                 ims, ime, jms, jme, kms, kme,                    &
1185                 its, ite, jts, jte, kts, kte                     )
1186
1187         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
1188         CALL g_add_a2a(moist_tendf(ims,kms,jms,P_QV),            &
1189                 g_moist_tendf(ims,kms,jms,P_QV), RQVCUTEN,       &
1190                 g_RQVCUTEN,                                      &
1191                 config_flags,                                    &
1192                 ids,ide, jds, jde, kds, kde,                     &
1193                 ims, ime, jms, jme, kms, kme,                    &
1194                 its, ite, jts, jte, kts, kte                     )
1195
1196    CASE (CAMZMSCHEME)
1197         CALL add_a2c_u(ru_tendf,RUCUTEN,config_flags,            &
1198                 ids,ide, jds, jde, kds, kde,                     &
1199                 ims, ime, jms, jme, kms, kme,                    &
1200                 its, ite, jts, jte, kts, kte                     )
1201
1202         CALL add_a2c_v(rv_tendf,RVCUTEN,config_flags,            &
1203                 ids,ide, jds, jde, kds, kde,                     &
1204                 ims, ime, jms, jme, kms, kme,                    &
1205                 its, ite, jts, jte, kts, kte                     )
1206
1207         CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
1208                 ids,ide, jds, jde, kds, kde,                     &
1209                 ims, ime, jms, jme, kms, kme,                    &
1210                 its, ite, jts, jte, kts, kte                     )
1211
1212         if (P_QV .ge. PARAM_FIRST_SCALAR)                        &
1213         CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
1214                 config_flags,                                    &
1215                 ids,ide, jds, jde, kds, kde,                     &
1216                 ims, ime, jms, jme, kms, kme,                    &
1217                 its, ite, jts, jte, kts, kte                     )
1218
1219         if (P_QC .ge. PARAM_FIRST_SCALAR)                        &
1220         CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
1221                 config_flags,                                    &
1222                 ids,ide, jds, jde, kds, kde,                     &
1223                 ims, ime, jms, jme, kms, kme,                    &
1224                 its, ite, jts, jte, kts, kte                     )
1225
1226         if (P_QI .ge. PARAM_FIRST_SCALAR)                        &
1227         CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
1228                 config_flags,                                    &
1229                 ids,ide, jds, jde, kds, kde,                     &
1230                 ims, ime, jms, jme, kms, kme,                    &
1231                 its, ite, jts, jte, kts, kte                     )
1232        IF(.not. adv_moist_cond)THEN
1233
1234         if (P_QT .ge. PARAM_FIRST_SCALAR)                        &
1235            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
1236                 config_flags,                                    &
1237                 ids,ide, jds, jde, kds, kde,                     &
1238                 ims, ime, jms, jme, kms, kme,                    &
1239                 its, ite, jts, jte, kts, kte                     )
1240
1241         if (P_QT .ge. PARAM_FIRST_SCALAR)                        &
1242            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
1243                 config_flags,                                    &
1244                 ids,ide, jds, jde, kds, kde,                     &
1245                 ims, ime, jms, jme, kms, kme,                    &
1246                 its, ite, jts, jte, kts, kte                     )
1247
1248        ENDIF
1249
1250    CASE (TIEDTKESCHEME, NTIEDTKESCHEME)
1251         CALL add_a2a(rt_tendf,RTHCUTEN,config_flags,             &
1252                 ids,ide, jds, jde, kds, kde,                     &
1253                 ims, ime, jms, jme, kms, kme,                    &
1254                 its, ite, jts, jte, kts, kte                     )
1255
1256         CALL add_a2c_u(ru_tendf,RUCUTEN,config_flags,            &
1257                 ids,ide, jds, jde, kds, kde,                     &
1258                 ims, ime, jms, jme, kms, kme,                    &
1259                 its, ite, jts, jte, kts, kte                     )
1260
1261         CALL add_a2c_v(rv_tendf,RVCUTEN,config_flags,            &
1262                 ids,ide, jds, jde, kds, kde,                     &
1263                 ims, ime, jms, jme, kms, kme,                    &
1264                 its, ite, jts, jte, kts, kte                     )
1265
1266         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
1267         CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVCUTEN,     &
1268                 config_flags,                                    &
1269                 ids,ide, jds, jde, kds, kde,                     &
1270                 ims, ime, jms, jme, kms, kme,                    &
1271                 its, ite, jts, jte, kts, kte                     )
1272
1273         if (P_QC .ge. PARAM_FIRST_SCALAR)                                         &
1274         CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCCUTEN,     &
1275                 config_flags,                                    &
1276                 ids,ide, jds, jde, kds, kde,                     &
1277                 ims, ime, jms, jme, kms, kme,                    &
1278                 its, ite, jts, jte, kts, kte                     )
1279
1280         if (P_QI .ge. PARAM_FIRST_SCALAR)                                         &
1281         CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQICUTEN,     &
1282                 config_flags,                                    &
1283                 ids,ide, jds, jde, kds, kde,                     &
1284                 ims, ime, jms, jme, kms, kme,                    &
1285                 its, ite, jts, jte, kts, kte                     )
1286
1287        IF(.not. adv_moist_cond)THEN
1288
1289         if (P_QT .ge. PARAM_FIRST_SCALAR)                        &
1290            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQCCUTEN, &
1291                 config_flags,                                    &
1292                 ids,ide, jds, jde, kds, kde,                     &
1293                 ims, ime, jms, jme, kms, kme,                    &
1294                 its, ite, jts, jte, kts, kte                     )
1295
1296         if (P_QT .ge. PARAM_FIRST_SCALAR)                        &
1297            CALL add_a2a(scalar_tendf(ims,kms,jms,P_QT),RQICUTEN, &
1298                 config_flags,                                    &
1299                 ids,ide, jds, jde, kds, kde,                     &
1300                 ims, ime, jms, jme, kms, kme,                    &
1301                 its, ite, jts, jte, kts, kte                     )
1302
1303        ENDIF
1304
1305    CASE DEFAULT
1306
1307    END SELECT
1308
1309 END SUBROUTINE g_phy_cu_ten
1310
1311 !=================================================================
1312 SUBROUTINE phy_shcu_ten(config_flags,rk_step,n_moist,            &
1313                       rt_tendf,ru_tendf,rv_tendf,                &
1314                       RUSHTEN,RVSHTEN,RTHSHTEN,                  &
1315                       RQVSHTEN,RQCSHTEN,RQRSHTEN,                &
1316                       RQISHTEN,RQSSHTEN,RQGSHTEN,moist_tendf,    &
1317                       ids, ide, jds, jde, kds, kde,              &
1318                       ims, ime, jms, jme, kms, kme,              &
1319                       its, ite, jts, jte, kts, kte               )
1320 !-----------------------------------------------------------------
1321    IMPLICIT NONE
1322 !-----------------------------------------------------------------
1323    TYPE(grid_config_rec_type  ) , INTENT(IN   ) :: config_flags
1324
1325    INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
1326                                    ims, ime, jms, jme, kms, kme, &
1327                                    its, ite, jts, jte, kts, kte, &
1328                                    n_moist, rk_step
1329
1330    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
1331           INTENT(INOUT)     ::                      moist_tendf
1332
1333    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
1334                                                         RUSHTEN, &
1335                                                         RVSHTEN, &
1336                                                        RTHSHTEN, &
1337                                                        RQVSHTEN, &
1338                                                        RQCSHTEN, &
1339                                                        RQRSHTEN, &
1340                                                        RQISHTEN, &
1341                                                        RQSSHTEN, &
1342                                                        RQGSHTEN
1343
1344    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) ::  &
1345                                                        rt_tendf, &
1346                                                        ru_tendf, &
1347                                                        rv_tendf
1348
1349 ! LOCAL VARS
1350
1351    INTEGER :: i,j,k
1352
1353    SELECT CASE (config_flags%shcu_physics)
1354
1355    CASE (CAMUWSHCUSCHEME)
1356         CALL add_a2c_u(ru_tendf,RUSHTEN,config_flags,            &
1357                 ids,ide, jds, jde, kds, kde,                     &
1358                 ims, ime, jms, jme, kms, kme,                    &
1359                 its, ite, jts, jte, kts, kte                     )
1360
1361         CALL add_a2c_v(rv_tendf,RVSHTEN,config_flags,            &
1362                 ids,ide, jds, jde, kds, kde,                     &
1363                 ims, ime, jms, jme, kms, kme,                    &
1364                 its, ite, jts, jte, kts, kte                     )
1365
1366         CALL add_a2a(rt_tendf,RTHSHTEN,config_flags,             &
1367                 ids,ide, jds, jde, kds, kde,                     &
1368                 ims, ime, jms, jme, kms, kme,                    &
1369                 its, ite, jts, jte, kts, kte                     )
1370
1371         if (P_QV .ge. PARAM_FIRST_SCALAR)                        &
1372         CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVSHTEN,     &
1373                 config_flags,                                    &
1374                 ids,ide, jds, jde, kds, kde,                     &
1375                 ims, ime, jms, jme, kms, kme,                    &
1376                 its, ite, jts, jte, kts, kte                     )
1377
1378         if (P_QC .ge. PARAM_FIRST_SCALAR)                        &
1379         CALL add_a2a(moist_tendf(ims,kms,jms,P_QC),RQCSHTEN,     &
1380                 config_flags,                                    &
1381                 ids,ide, jds, jde, kds, kde,                     &
1382                 ims, ime, jms, jme, kms, kme,                    &
1383                 its, ite, jts, jte, kts, kte                     )
1384
1385         if (P_QR .ge. PARAM_FIRST_SCALAR)                        &
1386         CALL add_a2a(moist_tendf(ims,kms,jms,P_QR),RQRSHTEN,     &
1387                 config_flags,                                    &
1388                 ids,ide, jds, jde, kds, kde,                     &
1389                 ims, ime, jms, jme, kms, kme,                    &
1390                 its, ite, jts, jte, kts, kte                     )
1391
1392         if (P_QI .ge. PARAM_FIRST_SCALAR)                        &
1393         CALL add_a2a(moist_tendf(ims,kms,jms,P_QI),RQISHTEN,     &
1394                 config_flags,                                    &
1395                 ids,ide, jds, jde, kds, kde,                     &
1396                 ims, ime, jms, jme, kms, kme,                    &
1397                 its, ite, jts, jte, kts, kte                     )
1398
1399         if (P_QS .ge. PARAM_FIRST_SCALAR)                        &
1400         CALL add_a2a(moist_tendf(ims,kms,jms,P_QS),RQSSHTEN,     &
1401                 config_flags,                                    &
1402                 ids,ide, jds, jde, kds, kde,                     &
1403                 ims, ime, jms, jme, kms, kme,                    &
1404                 its, ite, jts, jte, kts, kte                     )
1405
1406         if (P_QG .ge. PARAM_FIRST_SCALAR)                        &
1407         CALL add_a2a(moist_tendf(ims,kms,jms,P_QG),RQGSHTEN,     &
1408                 config_flags,                                    &
1409                 ids,ide, jds, jde, kds, kde,                     &
1410                 ims, ime, jms, jme, kms, kme,                    &
1411                 its, ite, jts, jte, kts, kte                     )
1412
1413    CASE DEFAULT
1414
1415    END SELECT
1416
1417
1418 END SUBROUTINE phy_shcu_ten
1419
1420 !=================================================================
1421 SUBROUTINE phy_fg_ten(config_flags,rk_step,n_moist,            &
1422                       rph_tendf,rt_tendf,ru_tendf,rv_tendf,    &
1423                       mu_tendf, moist_tendf,                   &
1424                       RUNDGDTEN,RVNDGDTEN,RTHNDGDTEN,          &
1425                       RPHNDGDTEN,RQVNDGDTEN,RMUNDGDTEN,        &
1426                       ids, ide, jds, jde, kds, kde,              &
1427                       ims, ime, jms, jme, kms, kme,              &
1428                       its, ite, jts, jte, kts, kte               )
1429 !-----------------------------------------------------------------
1430    IMPLICIT NONE
1431 !-----------------------------------------------------------------
1432    TYPE(grid_config_rec_type) ,     INTENT(IN   ) :: config_flags
1433
1434    INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
1435                                    ims, ime, jms, jme, kms, kme, &
1436                                    its, ite, jts, jte, kts, kte, &
1437                                    n_moist, rk_step
1438
1439    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
1440           INTENT(INOUT)     ::                      moist_tendf
1441
1442    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
1443                                                        RTHNDGDTEN, &
1444                                                        RPHNDGDTEN, &
1445                                                         RUNDGDTEN, &
1446                                                         RVNDGDTEN, &
1447                                                        RQVNDGDTEN
1448
1449    REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN  ) ::  RMUNDGDTEN
1450
1451    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT)::   &
1452                                                        rph_tendf,&
1453                                                        rt_tendf, &
1454                                                        ru_tendf, &
1455                                                        rv_tendf
1456
1457    REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT)::  mu_tendf
1458
1459 ! LOCAL VARS
1460
1461    INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
1462
1463 !-----------------------------------------------------------------
1464
1465    SELECT CASE(config_flags%grid_fdda)
1466
1467       CASE (PSUFDDAGD)
1468
1469            CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags,        &
1470                 ids,ide, jds, jde, kds, kde,                     &
1471                 ims, ime, jms, jme, kms, kme,                    &
1472                 its, ite, jts, jte, kts, kte                     )
1473
1474 ! note fdda u and v tendencies are staggered
1475            CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags,       &
1476                 ids,ide, jds, jde, kds, kde,                     &
1477                 ims, ime, jms, jme, kms, kme,                    &
1478                 its, ite, jts, jte, kts, kte                     )
1479
1480            CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags,       &
1481                 ids,ide, jds, jde, kds, kde,                     &
1482                 ims, ime, jms, jme, kms, kme,                    &
1483                 its, ite, jts, jte, kts, kte                     )
1484
1485            CALL add_a2a(mu_tendf,RMUNDGDTEN,config_flags,      &
1486                 ids,ide, jds, jde, kds, kds,                     &
1487                 ims, ime, jms, jme, kms, kms,                    &
1488                 its, ite, jts, jte, kts, kts                     )
1489
1490         if (P_QV .ge. PARAM_FIRST_SCALAR)                                         &
1491            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),RQVNDGDTEN,  &
1492                 config_flags,                                    &
1493                 ids,ide, jds, jde, kds, kde,                     &
1494                 ims, ime, jms, jme, kms, kme,                    &
1495                 its, ite, jts, jte, kts, kte                     )
1496
1497       CASE (SPNUDGING)
1498
1499 ! note fdda u and v tendencies are staggered
1500            CALL add_c2c_u(ru_tendf,RUNDGDTEN,config_flags,       &
1501                 ids,ide, jds, jde, kds, kde,                     &
1502                 ims, ime, jms, jme, kms, kme,                    &
1503                 its, ite, jts, jte, kts, kte                     )
1504
1505            CALL add_c2c_v(rv_tendf,RVNDGDTEN,config_flags,       &
1506                 ids,ide, jds, jde, kds, kde,                     &
1507                 ims, ime, jms, jme, kms, kme,                    &
1508                 its, ite, jts, jte, kts, kte                     )
1509
1510            CALL add_a2a(rt_tendf,RTHNDGDTEN,config_flags,        &
1511                 ids,ide, jds, jde, kds, kde,                     &
1512                 ims, ime, jms, jme, kms, kme,                    &
1513                 its, ite, jts, jte, kts, kte                     )
1514
1515            CALL add_a2a_ph(rph_tendf,RPHNDGDTEN,config_flags,        &
1516                 ids,ide, jds, jde, kds, kde,                     &
1517                 ims, ime, jms, jme, kms, kme,                    &
1518                 its, ite, jts, jte, kts, kte                     )
1519
1520       CASE DEFAULT
1521
1522    END SELECT
1523
1524 END SUBROUTINE phy_fg_ten
1525
1526 !=================================================================
1527 SUBROUTINE phy_fr_ten(config_flags,rk_step,n_moist,            &
1528                       rt_tendf,ru_tendf,rv_tendf,              &
1529                       mu_tendf, moist_tendf,                   &
1530                       rthfrten,rqvfrten,                       &
1531                       ids, ide, jds, jde, kds, kde,              &
1532                       ims, ime, jms, jme, kms, kme,              &
1533                       its, ite, jts, jte, kts, kte               )
1534 !-----------------------------------------------------------------
1535    USE module_state_description, ONLY :                         &
1536                    FIRE_SFIRE1, FIRE_SFIRE
1537 !-----------------------------------------------------------------
1538    IMPLICIT NONE
1539 !-----------------------------------------------------------------
1540    TYPE(grid_config_rec_type) ,     INTENT(IN   ) :: config_flags
1541
1542    INTEGER , INTENT(IN)        ::  ids, ide, jds, jde, kds, kde, &
1543                                    ims, ime, jms, jme, kms, kme, &
1544                                    its, ite, jts, jte, kts, kte, &
1545                                    n_moist, rk_step
1546
1547    REAL , DIMENSION(ims:ime, kms:kme, jms:jme, n_moist),         &
1548           INTENT(INOUT)     ::                      moist_tendf
1549
1550    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN  ) ::   &
1551                                                        rthfrten, &
1552                                                        rqvfrten
1553
1554    REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT)::   &
1555                                                        rt_tendf, &
1556                                                        ru_tendf, &
1557                                                        rv_tendf
1558
1559    REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT)::  mu_tendf
1560
1561 ! LOCAL VARS
1562
1563    INTEGER :: i,j,k,IBGN,IEND,JBGN,JEND
1564
1565 !-----------------------------------------------------------------
1566
1567    SELECT CASE(config_flags%ifire)
1568
1569       CASE (FIRE_SFIRE1, FIRE_SFIRE)
1570
1571            CALL add_a2a(rt_tendf,rthfrten,                       &
1572                 config_flags,                                    &
1573                 ids,ide, jds, jde, kds, kde,                     &
1574                 ims, ime, jms, jme, kms, kme,                    &
1575                 its, ite, jts, jte, kts, kte                     )
1576
1577            CALL add_a2a(moist_tendf(ims,kms,jms,P_QV),rqvfrten,  &
1578                 config_flags,                                    &
1579                 ids,ide, jds, jde, kds, kde,                     &
1580                 ims, ime, jms, jme, kms, kme,                    &
1581                 its, ite, jts, jte, kts, kte                     )
1582
1583       CASE DEFAULT
1584
1585    END SELECT
1586
1587 END SUBROUTINE phy_fr_ten
1588
1589 !--------------------------------------------------- -------------------
1590
1591 !        Generated by TAPENADE     (INRIA, Tropics team)
1592 !  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
1593 !
1594 !  Differentiation of advance_ppt in forward (tangent) mode:
1595 !   variations   of useful results: rqccuten rthcuten rqicuten
1596 !                rqscuten rainc cuppt nca rqrcuten rqvcuten rainsh
1597 !                htop hbot
1598 !   with respect to varying inputs: pratesh rqccuten rthcuten rqicuten
1599 !                rqscuten rainc pratec cuppt cutop cubot nca rqrcuten
1600 !                rqvcuten rainsh htop hbot
1601 !   RW status of diff variables: pratesh:in rqccuten:in-out rthcuten:in-out
1602 !                rqicuten:in-out rqscuten:in-out rainc:in-out pratec:in
1603 !                cuppt:in-out cutop:in cubot:in nca:in-out rqrcuten:in-out
1604 !                rqvcuten:in-out rainsh:in-out htop:in-out hbot:in-out
1605 SUBROUTINE G_ADVANCE_PPT(rthcuten, rthcutend, rqvcuten, rqvcutend, &
1606 &  rqccuten, rqccutend, rqrcuten, rqrcutend, rqicuten, rqicutend, &
1607 &  rqscuten, rqscutend, rainc, raincd, raincv, rainsh, rainshd, pratec, &
1608 &  pratecd, pratesh, prateshd, nca, ncad, htop, htopd, hbot, hbotd, cutop&
1609 &  , cutopd, cubot, cubotd, cuppt, cupptd, dt, config_flags, ids, ide, &
1610 &  jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, &
1611 &  kts, kte)
1612   IMPLICIT NONE
1613 !
1614   TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
1615   INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
1616 &  jme, kms, kme, its, ite, jts, jte, kts, kte
1617   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rthcuten&
1618 &  , rqvcuten, rqccuten, rqrcuten, rqicuten, rqscuten
1619   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: rthcutend&
1620 &  , rqvcutend, rqccutend, rqrcutend, rqicutend, rqscutend
1621   REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: rainc, rainsh, &
1622 &  raincv, pratec, pratesh, nca, htop, hbot, cutop, cubot, cuppt
1623   REAL, DIMENSION(ims:ime, jms:jme), INTENT(INOUT) :: raincd, rainshd, &
1624 &  pratecd, prateshd, ncad, htopd, hbotd, cutopd, cubotd, cupptd
1625   REAL, INTENT(IN) :: dt
1626 ! LOCAL  VAR
1627   INTEGER :: i, j, k, i_start, i_end, j_start, j_end, k_start, k_end
1628   INTEGER :: ncutop, ncubot
1629 !-----------------------------------------------------------------
1630   IF (config_flags%cu_physics .EQ. 0) THEN
1631     RETURN
1632   ELSE
1633 ! SET START AND END POINTS FOR TILES
1634     i_start = its
1635     IF (ite .GT. ide - 1) THEN
1636       i_end = ide - 1
1637     ELSE
1638       i_end = ite
1639     END IF
1640     j_start = jts
1641     IF (jte .GT. jde - 1) THEN
1642       j_end = jde - 1
1643     ELSE
1644       j_end = jte
1645     END IF
1646 !
1647 !  IF( config_flags%nested .or. config_flags%specified ) THEN
1648 !    i_start = max( its,ids+1 )
1649 !    i_end   = min( ite,ide-2 )
1650 !    j_start = max( jts,jds+1 )
1651 !    j_end   = min( jte,jde-2 )
1652 !  ENDIF
1653 !
1654     k_start = kts
1655     IF (kte .GT. kde - 1) THEN
1656       k_end = kde - 1
1657     ELSE
1658       k_end = kte
1659     END IF
1660 ! Update total cumulus scheme precipitation
1661 ! in mm
1662     DO j=j_start,j_end
1663       DO i=i_start,i_end
1664         raincd(i, j) = raincd(i, j) + dt*pratecd(i, j)
1665         rainc(i, j) = rainc(i, j) + pratec(i, j)*dt
1666         rainshd(i, j) = rainshd(i, j) + dt*prateshd(i, j)
1667         rainsh(i, j) = rainsh(i, j) + pratesh(i, j)*dt
1668         cupptd(i, j) = cupptd(i, j) + dt*(pratecd(i, j)+prateshd(i, j))/&
1669 &          1000.
1670         cuppt(i, j) = cuppt(i, j) + (pratec(i, j)+pratesh(i, j))*dt/&
1671 &          1000.
1672       END DO
1673     END DO
1674     SELECT CASE  (config_flags%cu_physics)
1675     CASE (kfscheme)
1676       DO j=j_start,j_end
1677         DO i=i_start,i_end
1678           IF (nca(i, j) .GT. 0) THEN
1679             IF (NINT(nca(i, j)/dt) .LE. 0) THEN
1680 ! set tendency to zero
1681 !                PRATEC(I,J)=0.
1682 !                RAINCV(I,J)=0.
1683               DO k=k_start,k_end
1684                 rthcutend(i, k, j) = 0.0
1685                 rthcuten(i, k, j) = 0.
1686                 rqvcutend(i, k, j) = 0.0
1687                 rqvcuten(i, k, j) = 0.
1688                 rqccutend(i, k, j) = 0.0
1689                 rqccuten(i, k, j) = 0.
1690                 rqrcutend(i, k, j) = 0.0
1691                 rqrcuten(i, k, j) = 0.
1692                 IF (p_qi .GE. param_first_scalar) THEN
1693                   rqicutend(i, k, j) = 0.0
1694                   rqicuten(i, k, j) = 0.
1695                 END IF
1696                 IF (p_qs .GE. param_first_scalar) THEN
1697                   rqscutend(i, k, j) = 0.0
1698                   rqscuten(i, k, j) = 0.
1699                 END IF
1700               END DO
1701             END IF
1702 ! Decrease NCA
1703             nca(i, j) = nca(i, j) - dt
1704           END IF
1705         END DO
1706       END DO
1707     CASE (ducuscheme)
1708 !
1709       DO j=j_start,j_end
1710         DO i=i_start,i_end
1711           IF (nca(i, j) .GT. 0) THEN
1712             IF (NINT(nca(i, j)/dt) .LE. 0) THEN
1713 ! set tendency to zero
1714 !!                PRATEC(I,J)=0.
1715 !!                RAINCV(I,J)=0.
1716               DO k=k_start,k_end
1717                 rthcutend(i, k, j) = 0.0
1718                 rthcuten(i, k, j) = 0.
1719                 rqvcutend(i, k, j) = 0.0
1720                 rqvcuten(i, k, j) = 0.
1721               END DO
1722             END IF
1723 ! Decrease NCA
1724             nca(i, j) = nca(i, j) - dt
1725           END IF
1726         END DO
1727       END DO
1728     CASE (bmjscheme, camzmscheme)
1729 !
1730       DO j=j_start,j_end
1731         DO i=i_start,i_end
1732 ! HTOP, HBOT FOR GFDL RADIATION
1733           ncutop = NINT(cutop(i, j))
1734           ncubot = NINT(cubot(i, j))
1735           IF (ncutop .GT. 1 .AND. ncutop .LT. kde) THEN
1736             IF (cutop(i, j) .LT. htop(i, j)) THEN
1737               htop(i, j) = htop(i, j)
1738             ELSE
1739               htopd(i, j) = cutopd(i, j)
1740               htop(i, j) = cutop(i, j)
1741             END IF
1742           END IF
1743           IF (ncubot .GT. 0 .AND. ncubot .LT. kde) THEN
1744             IF (cubot(i, j) .GT. hbot(i, j)) THEN
1745               hbot(i, j) = hbot(i, j)
1746             ELSE
1747               hbotd(i, j) = cubotd(i, j)
1748               hbot(i, j) = cubot(i, j)
1749             END IF
1750           END IF
1751         END DO
1752       END DO
1753     CASE (kfetascheme, MSKFSCHEME)
1754       DO j=j_start,j_end
1755         DO i=i_start,i_end
1756 ! HTOP, HBOT FOR GFDL RADIATION
1757           ncutop = NINT(cutop(i, j))
1758           ncubot = NINT(cubot(i, j))
1759           IF (ncutop .GT. 1 .AND. ncutop .LT. kde) THEN
1760             IF (cutop(i, j) .LT. htop(i, j)) THEN
1761               htop(i, j) = htop(i, j)
1762             ELSE
1763               htopd(i, j) = cutopd(i, j)
1764               htop(i, j) = cutop(i, j)
1765             END IF
1766           END IF
1767           IF (ncubot .GT. 0 .AND. ncubot .LT. kde) THEN
1768             IF (cubot(i, j) .GT. hbot(i, j)) THEN
1769               hbot(i, j) = hbot(i, j)
1770             ELSE
1771               hbotd(i, j) = cubotd(i, j)
1772               hbot(i, j) = cubot(i, j)
1773             END IF
1774           END IF
1775           IF (nca(i, j) .GT. 0) THEN
1776             IF (NINT(nca(i, j)/dt) .LE. 1) THEN
1777 ! set tendency to zero
1778 !                PRATEC(I,J)=0.
1779 !                RAINCV(I,J)=0.
1780               DO k=k_start,k_end
1781                 rthcutend(i, k, j) = 0.0
1782                 rthcuten(i, k, j) = 0.
1783                 rqvcutend(i, k, j) = 0.0
1784                 rqvcuten(i, k, j) = 0.
1785                 rqccutend(i, k, j) = 0.0
1786                 rqccuten(i, k, j) = 0.
1787                 rqrcutend(i, k, j) = 0.0
1788                 rqrcuten(i, k, j) = 0.
1789                 IF (p_qi .GE. param_first_scalar) THEN
1790                   rqicutend(i, k, j) = 0.0
1791                   rqicuten(i, k, j) = 0.
1792                 END IF
1793                 IF (p_qs .GE. param_first_scalar) THEN
1794                   rqscutend(i, k, j) = 0.0
1795                   rqscuten(i, k, j) = 0.
1796                 END IF
1797               END DO
1798             END IF
1799 ! Decrease NCA
1800             nca(i, j) = nca(i, j) - dt
1801 !              NCA(I,J)=NCA(I,J)-1. ! Decrease NCA
1802           END IF
1803         END DO
1804       END DO
1805     END SELECT
1806   END IF
1807 END SUBROUTINE G_ADVANCE_PPT
1808
1809 SUBROUTINE add_a2a(lvar,rvar,config_flags,                  &
1810                    ids,ide, jds, jde, kds, kde,             &
1811                    ims, ime, jms, jme, kms, kme,            &
1812                    its, ite, jts, jte, kts, kte             )
1813 !------------------------------------------------------------
1814    IMPLICIT NONE
1815 !------------------------------------------------------------
1816    TYPE(grid_config_rec_type),  INTENT(IN) :: config_flags
1817
1818    INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
1819                               ims, ime, jms, jme, kms, kme, &
1820                               its, ite, jts, jte, kts, kte
1821
1822    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
1823                                                       rvar
1824    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1825                                                       lvar
1826
1827 ! LOCAL VARS
1828    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1829
1830    i_start = its
1831    i_end   = MIN(ite,ide-1)
1832    j_start = jts
1833    j_end   = MIN(jte,jde-1)
1834    ktf = min(kte,kde-1)
1835
1836    IF ( config_flags%specified .or. &
1837         config_flags%nested) i_start = MAX(ids+1,its)
1838    IF ( config_flags%specified .or. &
1839         config_flags%nested) i_end   = MIN(ide-2,ite)
1840    IF ( config_flags%specified .or. &
1841         config_flags%nested) j_start = MAX(jds+1,jts)
1842    IF ( config_flags%specified .or. &
1843         config_flags%nested) j_end   = MIN(jde-2,jte)
1844       IF ( config_flags%periodic_x ) i_start = its
1845       IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
1846
1847    DO j = j_start,j_end
1848    DO k = kts,ktf
1849    DO i = i_start,i_end
1850       lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1851    ENDDO
1852    ENDDO
1853    ENDDO
1854
1855 END SUBROUTINE add_a2a
1856
1857 SUBROUTINE add_a2a_ph(lvar,rvar,config_flags,                  &
1858                    ids,ide, jds, jde, kds, kde,             &
1859                    ims, ime, jms, jme, kms, kme,            &
1860                    its, ite, jts, jte, kts, kte             )
1861 !------------------------------------------------------------
1862    IMPLICIT NONE
1863 !------------------------------------------------------------
1864    TYPE(grid_config_rec_type),  INTENT(IN) :: config_flags
1865
1866    INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
1867                               ims, ime, jms, jme, kms, kme, &
1868                               its, ite, jts, jte, kts, kte
1869
1870    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
1871                                                       rvar
1872    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1873                                                       lvar
1874
1875 ! LOCAL VARS
1876    INTEGER :: i,j,k,i_start,i_end,j_start,j_end
1877
1878    i_start = its
1879    i_end   = MIN(ite,ide-1)
1880    j_start = jts
1881    j_end   = MIN(jte,jde-1)
1882
1883    IF ( config_flags%specified .or. &
1884         config_flags%nested) i_start = MAX(ids+1,its)
1885    IF ( config_flags%specified .or. &
1886         config_flags%nested) i_end   = MIN(ide-2,ite)
1887    IF ( config_flags%specified .or. &
1888         config_flags%nested) j_start = MAX(jds+1,jts)
1889    IF ( config_flags%specified .or. &
1890         config_flags%nested) j_end   = MIN(jde-2,jte)
1891       IF ( config_flags%periodic_x ) i_start = its
1892       IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
1893
1894    DO j = j_start,j_end
1895    DO k = kts,kte
1896    DO i = i_start,i_end
1897       lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
1898    ENDDO
1899    ENDDO
1900    ENDDO
1901
1902 END SUBROUTINE add_a2a_ph
1903
1904 !------------------------------------------------------------
1905 SUBROUTINE add_a2c_u(lvar,rvar,config_flags,                &
1906                    ids,ide, jds, jde, kds, kde,             &
1907                    ims, ime, jms, jme, kms, kme,            &
1908                    its, ite, jts, jte, kts, kte             )
1909 !------------------------------------------------------------
1910 !------------------------------------------------------------
1911    IMPLICIT NONE
1912 !------------------------------------------------------------
1913
1914    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
1915
1916    INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
1917                               ims, ime, jms, jme, kms, kme, &
1918                               its, ite, jts, jte, kts, kte
1919
1920    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
1921                                                       rvar
1922    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1923                                                       lvar
1924
1925 ! LOCAL VARS
1926
1927    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1928
1929    ktf=min(kte,kde-1)
1930
1931    i_start = its
1932    i_end   = ite
1933    j_start = jts
1934    j_end   = MIN(jte,jde-1)
1935
1936    IF ( config_flags%specified .or. &
1937         config_flags%nested) i_start = MAX(ids+1,its)
1938    IF ( config_flags%specified .or. &
1939         config_flags%nested) i_end   = MIN(ide-1,ite)
1940    IF ( config_flags%specified .or. &
1941         config_flags%nested) j_start = MAX(jds+1,jts)
1942    IF ( config_flags%specified .or. &
1943         config_flags%nested) j_end   = MIN(jde-2,jte)
1944       IF ( config_flags%periodic_x ) i_start = its
1945       IF ( config_flags%periodic_x ) i_end = ite
1946
1947    DO j = j_start,j_end
1948    DO k = kts,ktf
1949    DO i = i_start,i_end
1950       lvar(i,k,j) = lvar(i,k,j) + &
1951                        0.5*(rvar(i,k,j)+rvar(i-1,k,j))
1952    ENDDO
1953    ENDDO
1954    ENDDO
1955
1956 END SUBROUTINE add_a2c_u
1957
1958 !------------------------------------------------------------
1959 SUBROUTINE add_a2c_v(lvar,rvar,config_flags,                &
1960                    ids,ide, jds, jde, kds, kde,             &
1961                    ims, ime, jms, jme, kms, kme,            &
1962                    its, ite, jts, jte, kts, kte             )
1963 !------------------------------------------------------------
1964 !------------------------------------------------------------
1965    IMPLICIT NONE
1966 !------------------------------------------------------------
1967
1968    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
1969
1970    INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
1971                               ims, ime, jms, jme, kms, kme, &
1972                               its, ite, jts, jte, kts, kte
1973
1974    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
1975                                                       rvar
1976    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
1977                                                       lvar
1978
1979 ! LOCAL VARS
1980
1981    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
1982
1983    ktf=min(kte,kde-1)
1984
1985    i_start = its
1986    i_end   = MIN(ite,ide-1)
1987    j_start = jts
1988    j_end   = jte
1989
1990    IF ( config_flags%specified .or. &
1991         config_flags%nested) i_start = MAX(ids+1,its)
1992    IF ( config_flags%specified .or. &
1993         config_flags%nested) i_end   = MIN(ide-2,ite)
1994    IF ( config_flags%specified .or. &
1995         config_flags%nested) j_start = MAX(jds+1,jts)
1996    IF ( config_flags%specified .or. &
1997         config_flags%nested) j_end   = MIN(jde-1,jte)
1998       IF ( config_flags%periodic_x ) i_start = its
1999       IF ( config_flags%periodic_x ) i_end = MIN( ite, ide-1 )
2000
2001    DO j = j_start,j_end
2002    DO k = kts,kte
2003    DO i = i_start,i_end
2004       lvar(i,k,j) = lvar(i,k,j) + &
2005                      0.5*(rvar(i,k,j)+rvar(i,k,j-1))
2006    ENDDO
2007    ENDDO
2008    ENDDO
2009
2010 END SUBROUTINE add_a2c_v
2011
2012
2013 !        Generated by TAPENADE     (INRIA, Tropics team)
2014 !  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
2015 !
2016 !  Differentiation of add_a2a in forward (tangent) mode:
2017 !   variations   of useful results: lvar
2018 !   with respect to varying inputs: lvar rvar
2019 !   RW status of diff variables: lvar:in-out rvar:in
2020 SUBROUTINE G_ADD_A2A(lvar, lvard, rvar, rvard, config_flags, ids, ide, &
2021 &  jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte, &
2022 &  kts, kte)
2023   IMPLICIT NONE
2024 !------------------------------------------------------------
2025   TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
2026   INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
2027 &  jme, kms, kme, its, ite, jts, jte, kts, kte
2028   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvar
2029   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvard
2030   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvar
2031   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvard
2032 ! LOCAL VARS
2033   INTEGER :: i, j, k, i_start, i_end, j_start, j_end, ktf
2034   INTRINSIC MAX
2035   INTRINSIC MIN
2036   i_start = its
2037   IF (ite .GT. ide - 1) THEN
2038     i_end = ide - 1
2039   ELSE
2040     i_end = ite
2041   END IF
2042   j_start = jts
2043   IF (jte .GT. jde - 1) THEN
2044     j_end = jde - 1
2045   ELSE
2046     j_end = jte
2047   END IF
2048   IF (kte .GT. kde - 1) THEN
2049     ktf = kde - 1
2050   ELSE
2051     ktf = kte
2052   END IF
2053   IF (config_flags%specified .OR. config_flags%nested) THEN
2054     IF (ids + 1 .LT. its) THEN
2055       i_start = its
2056     ELSE
2057       i_start = ids + 1
2058     END IF
2059   END IF
2060   IF (config_flags%specified .OR. config_flags%nested) THEN
2061     IF (ide - 2 .GT. ite) THEN
2062       i_end = ite
2063     ELSE
2064       i_end = ide - 2
2065     END IF
2066   END IF
2067   IF (config_flags%specified .OR. config_flags%nested) THEN
2068     IF (jds + 1 .LT. jts) THEN
2069       j_start = jts
2070     ELSE
2071       j_start = jds + 1
2072     END IF
2073   END IF
2074   IF (config_flags%specified .OR. config_flags%nested) THEN
2075     IF (jde - 2 .GT. jte) THEN
2076       j_end = jte
2077     ELSE
2078       j_end = jde - 2
2079     END IF
2080   END IF
2081   IF (config_flags%periodic_x) i_start = its
2082   IF (config_flags%periodic_x) THEN
2083     IF (ite .GT. ide - 1) THEN
2084       i_end = ide - 1
2085     ELSE
2086       i_end = ite
2087     END IF
2088   END IF
2089   DO j=j_start,j_end
2090     DO k=kts,ktf
2091       DO i=i_start,i_end
2092         lvard(i, k, j) = lvard(i, k, j) + rvard(i, k, j)
2093         lvar(i, k, j) = lvar(i, k, j) + rvar(i, k, j)
2094       END DO
2095     END DO
2096   END DO
2097 END SUBROUTINE G_ADD_A2A
2098
2099 !        Generated by TAPENADE     (INRIA, Tropics team)
2100 !  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
2101 !
2102 !  Differentiation of add_a2c_u in forward (tangent) mode:
2103 !   variations   of useful results: lvar
2104 !   with respect to varying inputs: lvar rvar
2105 !   RW status of diff variables: lvar:in-out rvar:in
2106 SUBROUTINE G_ADD_A2C_U(lvar, lvard, rvar, rvard, config_flags, ids, ide&
2107 &  , jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte&
2108 &  , kts, kte)
2109   IMPLICIT NONE
2110 !------------------------------------------------------------
2111   TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
2112   INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
2113 &  jme, kms, kme, its, ite, jts, jte, kts, kte
2114   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvar
2115   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvard
2116   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvar
2117   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvard
2118 ! LOCAL VARS
2119   INTEGER :: i, j, k, i_start, i_end, j_start, j_end, ktf
2120   INTRINSIC MAX
2121   INTRINSIC MIN
2122   IF (kte .GT. kde - 1) THEN
2123     ktf = kde - 1
2124   ELSE
2125     ktf = kte
2126   END IF
2127   i_start = its
2128   i_end = ite
2129   j_start = jts
2130   IF (jte .GT. jde - 1) THEN
2131     j_end = jde - 1
2132   ELSE
2133     j_end = jte
2134   END IF
2135   IF (config_flags%specified .OR. config_flags%nested) THEN
2136     IF (ids + 1 .LT. its) THEN
2137       i_start = its
2138     ELSE
2139       i_start = ids + 1
2140     END IF
2141   END IF
2142   IF (config_flags%specified .OR. config_flags%nested) THEN
2143     IF (ide - 1 .GT. ite) THEN
2144       i_end = ite
2145     ELSE
2146       i_end = ide - 1
2147     END IF
2148   END IF
2149   IF (config_flags%specified .OR. config_flags%nested) THEN
2150     IF (jds + 1 .LT. jts) THEN
2151       j_start = jts
2152     ELSE
2153       j_start = jds + 1
2154     END IF
2155   END IF
2156   IF (config_flags%specified .OR. config_flags%nested) THEN
2157     IF (jde - 2 .GT. jte) THEN
2158       j_end = jte
2159     ELSE
2160       j_end = jde - 2
2161     END IF
2162   END IF
2163   IF (config_flags%periodic_x) i_start = its
2164   IF (config_flags%periodic_x) i_end = ite
2165   DO j=j_start,j_end
2166     DO k=kts,ktf
2167       DO i=i_start,i_end
2168         lvard(i, k, j) = lvard(i, k, j) + 0.5*(rvard(i, k, j)+rvard(i-1&
2169 &          , k, j))
2170         lvar(i, k, j) = lvar(i, k, j) + 0.5*(rvar(i, k, j)+rvar(i-1, k, &
2171 &          j))
2172       END DO
2173     END DO
2174   END DO
2175 END SUBROUTINE G_ADD_A2C_U
2176
2177 !        Generated by TAPENADE     (INRIA, Tropics team)
2178 !  Tapenade 3.5 (r3785) - 22 Mar 2011 18:35
2179 !
2180 !  Differentiation of add_a2c_v in forward (tangent) mode:
2181 !   variations   of useful results: lvar
2182 !   with respect to varying inputs: lvar rvar
2183 !   RW status of diff variables: lvar:in-out rvar:in
2184 SUBROUTINE G_ADD_A2C_V(lvar, lvard, rvar, rvard, config_flags, ids, ide&
2185 &  , jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, its, ite, jts, jte&
2186 &  , kts, kte)
2187   IMPLICIT NONE
2188 !------------------------------------------------------------
2189   TYPE(GRID_CONFIG_REC_TYPE), INTENT(IN) :: config_flags
2190   INTEGER, INTENT(IN) :: ids, ide, jds, jde, kds, kde, ims, ime, jms, &
2191 &  jme, kms, kme, its, ite, jts, jte, kts, kte
2192   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvar
2193   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(IN) :: rvard
2194   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvar
2195   REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: lvard
2196 ! LOCAL VARS
2197   INTEGER :: i, j, k, i_start, i_end, j_start, j_end, ktf
2198   INTRINSIC MAX
2199   INTRINSIC MIN
2200   IF (kte .GT. kde - 1) THEN
2201     ktf = kde - 1
2202   ELSE
2203     ktf = kte
2204   END IF
2205   i_start = its
2206   IF (ite .GT. ide - 1) THEN
2207     i_end = ide - 1
2208   ELSE
2209     i_end = ite
2210   END IF
2211   j_start = jts
2212   j_end = jte
2213   IF (config_flags%specified .OR. config_flags%nested) THEN
2214     IF (ids + 1 .LT. its) THEN
2215       i_start = its
2216     ELSE
2217       i_start = ids + 1
2218     END IF
2219   END IF
2220   IF (config_flags%specified .OR. config_flags%nested) THEN
2221     IF (ide - 2 .GT. ite) THEN
2222       i_end = ite
2223     ELSE
2224       i_end = ide - 2
2225     END IF
2226   END IF
2227   IF (config_flags%specified .OR. config_flags%nested) THEN
2228     IF (jds + 1 .LT. jts) THEN
2229       j_start = jts
2230     ELSE
2231       j_start = jds + 1
2232     END IF
2233   END IF
2234   IF (config_flags%specified .OR. config_flags%nested) THEN
2235     IF (jde - 1 .GT. jte) THEN
2236       j_end = jte
2237     ELSE
2238       j_end = jde - 1
2239     END IF
2240   END IF
2241   IF (config_flags%periodic_x) i_start = its
2242   IF (config_flags%periodic_x) THEN
2243     IF (ite .GT. ide - 1) THEN
2244       i_end = ide - 1
2245     ELSE
2246       i_end = ite
2247     END IF
2248   END IF
2249   DO j=j_start,j_end
2250     DO k=kts,kte
2251       DO i=i_start,i_end
2252         lvard(i, k, j) = lvard(i, k, j) + 0.5*(rvard(i, k, j)+rvard(i, k&
2253 &          , j-1))
2254         lvar(i, k, j) = lvar(i, k, j) + 0.5*(rvar(i, k, j)+rvar(i, k, j-&
2255 &          1))
2256       END DO
2257     END DO
2258   END DO
2259 END SUBROUTINE G_ADD_A2C_V
2260
2261 !------------------------------------------------------------
2262 SUBROUTINE add_c2c_u(lvar,rvar,config_flags,                &
2263                    ids,ide, jds, jde, kds, kde,             &
2264                    ims, ime, jms, jme, kms, kme,            &
2265                    its, ite, jts, jte, kts, kte             )
2266 !------------------------------------------------------------
2267 !------------------------------------------------------------
2268    IMPLICIT NONE
2269 !------------------------------------------------------------
2270
2271    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
2272
2273    INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
2274                               ims, ime, jms, jme, kms, kme, &
2275                               its, ite, jts, jte, kts, kte
2276
2277    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
2278                                                       rvar
2279    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
2280                                                       lvar
2281
2282 ! LOCAL VARS
2283
2284    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
2285
2286    ktf=min(kte,kde-1)
2287
2288    i_start = its
2289    i_end   = ite
2290    j_start = jts
2291    j_end   = MIN(jte,jde-1)
2292
2293
2294    IF ( config_flags%specified .or. &
2295         config_flags%nested) i_start = MAX(ids+1,its)
2296    IF ( config_flags%specified .or. &
2297         config_flags%nested) i_end   = MIN(ide-1,ite)
2298    IF ( config_flags%specified .or. &
2299         config_flags%nested) j_start = MAX(jds+1,jts)
2300    IF ( config_flags%specified .or. &
2301         config_flags%nested) j_end   = MIN(jde-2,jte)
2302
2303 !  write(*,'(a,6i4)') 'call c2cu, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
2304
2305    DO j = j_start,j_end
2306    DO k = kts,ktf
2307    DO i = i_start,i_end
2308       lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
2309    ENDDO
2310    ENDDO
2311    ENDDO
2312
2313 END SUBROUTINE add_c2c_u
2314
2315 SUBROUTINE add_c2c_v(lvar,rvar,config_flags,                &
2316                    ids,ide, jds, jde, kds, kde,             &
2317                    ims, ime, jms, jme, kms, kme,            &
2318                    its, ite, jts, jte, kts, kte             )
2319 !------------------------------------------------------------
2320 !------------------------------------------------------------
2321    IMPLICIT NONE
2322 !------------------------------------------------------------
2323
2324    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
2325
2326    INTEGER , INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
2327                               ims, ime, jms, jme, kms, kme, &
2328                               its, ite, jts, jte, kts, kte
2329
2330    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(IN   ) ::&
2331                                                       rvar
2332    REAL, DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT) ::&
2333                                                       lvar
2334
2335 ! LOCAL VARS
2336
2337    INTEGER :: i,j,k,i_start,i_end,j_start,j_end,ktf
2338
2339    ktf=min(kte,kde-1)
2340
2341    i_start = its
2342    i_end   = MIN(ite,ide-1)
2343    j_start = jts
2344    j_end   = jte
2345
2346    IF ( config_flags%specified .or. &
2347         config_flags%nested) i_start = MAX(ids+1,its)
2348    IF ( config_flags%specified .or. &
2349         config_flags%nested) i_end   = MIN(ide-2,ite)
2350    IF ( config_flags%specified .or. &
2351         config_flags%nested) j_start = MAX(jds+1,jts)
2352    IF ( config_flags%specified .or. &
2353         config_flags%nested) j_end   = MIN(jde-1,jte)
2354
2355 !  write(*,'(a,6i4)') 'call c2cv, i_start, i_end, j_start, j_end=', i_start, i_end, j_start, j_end
2356
2357    DO j = j_start,j_end
2358    DO k = kts,kte
2359    DO i = i_start,i_end
2360       lvar(i,k,j) = lvar(i,k,j) + rvar(i,k,j)
2361    ENDDO
2362    ENDDO
2363    ENDDO
2364
2365 END SUBROUTINE add_c2c_v
2366
2367 #endif
2368
2369 END MODULE g_module_physics_addtendc