wrfv2_fire/phys/module_microphysics_driver.F

   1 !WRF:MEDIATION_LAYER:PHYSICS
   2 ! *** add new modules of schemes here
   3 !
   4 MODULE module_microphysics_driver
   5 CONTAINS
   6
   7 SUBROUTINE microphysics_driver(                                          &
   8                        th, rho, pi_phy, p                                &
   9                       ,ht, dz8w, p8w, dt,dx,dy                           &
  10                       ,mp_physics, spec_zone                             &
  11                       ,specified, channel_switch                         &
  12                       ,warm_rain                                         &
  13                       ,t8w                                               &
  14                       ,chem_opt, progn                                   &
  15                       ,cldfra, cldfra_old, exch_h, nsource               &
  16                       ,qlsink, precr, preci, precs, precg                &
  17                       ,xland,itimestep                                   &
  18                       ,f_ice_phy,f_rain_phy,f_rimef_phy                  &
  19                       ,lowlyr,sr, id                                     &
  20                       ,ids,ide, jds,jde, kds,kde                         &
  21                       ,ims,ime, jms,jme, kms,kme                         &
  22                       ,ips,ipe, jps,jpe, kps,kpe                         &
  23                       ,i_start,i_end,j_start,j_end,kts,kte               &
  24                       ,num_tiles, naer                                   &
  25                       ,qv_curr,qc_curr,qr_curr,qi_curr,qs_curr,qg_curr   &
  26                       ,qndrop_curr,qni_curr                              &
  27                       ,qns_curr,qnr_curr,qng_curr                        &
  28                       ,f_qv,f_qc,f_qr,f_qi,f_qs,f_qg,f_qndrop,f_qni      &
  29                       ,f_qns,f_qnr,f_qng                                 &
  30                       ,qrcuten, qscuten, qicuten, mu                     &
  31                       ,qt_curr,f_qt                                      &
  32                       ,mp_restart_state,tbpvs_state,tbpvs0_state         & ! for etampnew
  33                       ,hail,ice2                                         & ! for gsfcgce
  34                       ,w ,z                                              &
  35                       ,rainnc, rainncv                                   &
  36                       ,snownc, snowncv                                   &
  37                       ,graupelnc, graupelncv                             &
  38                                                                          )
  39 ! Framework
  40    USE module_state_description, ONLY :                                  &
  41                      KESSLERSCHEME, LINSCHEME, WSM3SCHEME, WSM5SCHEME    &
  42                     ,WSM6SCHEME, ETAMPNEW, THOMPSON, MORR_TWO_MOMENT     &
  43                     ,GSFCGCESCHEME
  44
  45
  46 ! Model Layer
  47    USE module_model_constants
  48    USE module_wrf_error
  49
  50 ! *** add new modules of schemes here
  51
  52    USE module_mp_kessler
  53    USE module_mp_lin
  54    USE module_mp_wsm3
  55    USE module_mp_wsm5
  56    USE module_mp_wsm6
  57    USE module_mp_etanew
  58    USE module_mp_thompson
  59    USE module_mp_gsfcgce
  60    USE module_mp_morr_two_moment
  61
  62    USE module_mixactivate, only: prescribe_aerosol_mixactivate
  63
  64 !----------------------------------------------------------------------
  65    ! This driver calls subroutines for the microphys.
  66    !
  67    ! Schemes
  68    !
  69    ! Kessler scheme
  70    ! Lin et al. (1983), Rutledge and Hobbs (1984)
  71    ! WRF Single-Moment 3-class, Hong, Dudhia and Chen (2004)
  72    ! WRF Single-Moment 5-class, Hong, Dudhia and Chen (2004)
  73    ! WRF Single-Moment 6-class, Lim and Hong (2003 WRF workshop)
  74    ! Eta Grid-scale Cloud and Precipitation scheme (EGCP01, Ferrier)
  75    !
  76 !----------------------------------------------------------------------
  77    IMPLICIT NONE
  78 !======================================================================
  79 ! Grid structure in physics part of WRF
  80 !----------------------------------------------------------------------
  81 ! The horizontal velocities used in the physics are unstaggered
  82 ! relative to temperature/moisture variables. All predicted
  83 ! variables are carried at half levels except w, which is at full
  84 ! levels. Some arrays with names (*8w) are at w (full) levels.
  85 !
  86 !----------------------------------------------------------------------
  87 ! In WRF, kms (smallest number) is the bottom level and kme (largest
  88 ! number) is the top level.  In your scheme, if 1 is at the top level,
  89 ! then you have to reverse the order in the k direction.
  90 !
  91 !         kme      -   half level (no data at this level)
  92 !         kme    ----- full level
  93 !         kme-1    -   half level
  94 !         kme-1  ----- full level
  95 !         .
  96 !         .
  97 !         .
  98 !         kms+2    -   half level
  99 !         kms+2  ----- full level
 100 !         kms+1    -   half level
 101 !         kms+1  ----- full level
 102 !         kms      -   half level
 103 !         kms    ----- full level
 104 !
 105 !======================================================================
 106 ! Definitions
 107 !-----------
 108 ! Rho_d      dry density (kg/m^3)
 109 ! Theta_m    moist potential temperature (K)
 110 ! Qv         water vapor mixing ratio (kg/kg)
 111 ! Qc         cloud water mixing ratio (kg/kg)
 112 ! Qr         rain water mixing ratio (kg/kg)
 113 ! Qi         cloud ice mixing ratio (kg/kg)
 114 ! Qs         snow mixing ratio (kg/kg)
 115 ! Qndrop     droplet number mixing ratio (#/kg)
 116 ! Qni        cloud ice number concentration (#/kg)
 117 ! Qns        snow number concentration (#/kg),
 118 ! Qnr        rain number concentration (#/kg),
 119 ! Qng        graupel number concentration (#/kg),
 120
 121 !
 122 !----------------------------------------------------------------------
 123 !-- th        potential temperature    (K)
 124 !-- moist_new     updated moisture array   (kg/kg)
 125 !-- moist_old     Old moisture array       (kg/kg)
 126 !-- rho           density of air           (kg/m^3)
 127 !-- pi_phy        exner function           (dimensionless)
 128 !-- p             pressure                 (Pa)
 129 !-- RAINNC        grid scale precipitation (mm)
 130 !-- RAINNCV       one time step grid scale precipitation (mm/step)
 131 !-- SNOWNC        grid scale snow and ice (mm)
 132 !-- SNOWNCV       one time step grid scale snow and ice (mm/step)
 133 !-- GRAUPELNC     grid scale graupel (mm)
 134 !-- GRAUPELNCV    one time step grid scale graupel (mm/step)
 135 !-- SR            one time step mass ratio of snow to total precip
 136 !-- z             Height above sea level   (m)
 137 !-- dt            Time step              (s)
 138 !-- G             acceleration due to gravity  (m/s^2)
 139 !-- CP            heat capacity at constant pressure for dry air (J/kg/K)
 140 !-- R_d           gas constant for dry air (J/kg/K)
 141 !-- R_v           gas constant for water vapor (J/kg/K)
 142 !-- XLS           latent heat of sublimation   (J/kg)
 143 !-- XLV           latent heat of vaporization  (J/kg)
 144 !-- XLF           latent heat of melting       (J/kg)
 145 !-- rhowater      water density                      (kg/m^3)
 146 !-- rhosnow       snow density               (kg/m^3)
 147 !-- F_ICE_PHY     Fraction of ice.
 148 !-- F_RAIN_PHY    Fraction of rain.
 149 !-- F_RIMEF_PHY   Mass ratio of rimed ice (rime factor)
 150 !-- t8w           temperature at layer interfaces
 151 !-- cldfra, cldfra_old, current, previous cloud fraction
 152 !-- exch_h        vertical diffusivity (m2/s)
 153 !-- qlsink        Fractional cloud water sink (/s)
 154 !-- precr         rain precipitation rate at all levels (kg/m2/s)
 155 !-- preci         ice precipitation rate at all levels (kg/m2/s)
 156 !-- precs         snow precipitation rate at all levels (kg/m2/s)
 157 !-- precg         graupel precipitation rate at all levels (kg/m2/s)                             &
 158 !-- P_QV          species index for water vapor
 159 !-- P_QC          species index for cloud water
 160 !-- P_QR          species index for rain water
 161 !-- P_QI          species index for cloud ice
 162 !-- P_QS          species index for snow
 163 !-- P_QG          species index for graupel
 164 !-- P_QNDROP      species index for cloud drop mixing ratio
 165 !-- P_QNI         species index for cloud ice number concentration
 166 !-- P_QNS         species index for snow number concentration,
 167 !-- P_QNR         species index for rain number concentration,
 168 !-- P_QNG         species index for graupel number concentration,
 169 !-- id            grid id number
 170 !-- ids           start index for i in domain
 171 !-- ide           end index for i in domain
 172 !-- jds           start index for j in domain
 173 !-- jde           end index for j in domain
 174 !-- kds           start index for k in domain
 175 !-- kde           end index for k in domain
 176 !-- ims           start index for i in memory
 177 !-- ime           end index for i in memory
 178 !-- jms           start index for j in memory
 179 !-- jme           end index for j in memory
 180 !-- kms           start index for k in memory
 181 !-- kme           end index for k in memory
 182 !-- i_start       start indices for i in tile
 183 !-- i_end         end indices for i in tile
 184 !-- j_start       start indices for j in tile
 185 !-- j_end         end indices for j in tile
 186 !-- its           start index for i in tile
 187 !-- ite           end index for i in tile
 188 !-- jts           start index for j in tile
 189 !-- jte           end index for j in tile
 190 !-- kts           start index for k in tile
 191 !-- kte           end index for k in tile
 192 !-- num_tiles     number of tiles
 193 !
 194 !======================================================================
 195
 196    INTEGER,    INTENT(IN   )    :: mp_physics
 197    LOGICAL,    INTENT(IN   )    :: specified
 198    INTEGER, OPTIONAL, INTENT(IN   )    :: chem_opt, progn
 199    INTEGER, OPTIONAL, INTENT(IN   )    :: hail, ice2
 200 !
 201    INTEGER,      INTENT(IN   )    ::       ids,ide, jds,jde, kds,kde
 202    INTEGER,      INTENT(IN   )    ::       ims,ime, jms,jme, kms,kme
 203    INTEGER, OPTIONAL, INTENT(IN   )    ::       ips,ipe, jps,jpe, kps,kpe
 204    INTEGER,      INTENT(IN   )    ::                         kts,kte
 205    INTEGER,      INTENT(IN   )    ::     itimestep,num_tiles,spec_zone
 206    INTEGER, DIMENSION(num_tiles), INTENT(IN) ::                       &
 207      &           i_start,i_end,j_start,j_end
 208
 209    LOGICAL,      INTENT(IN   )    ::   warm_rain
 210 !
 211    REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                    &
 212          INTENT(INOUT) ::                                         th
 213 !
 214
 215 !
 216    REAL, DIMENSION( ims:ime , kms:kme , jms:jme ),                    &
 217          INTENT(IN   ) ::                                             &
 218                                                                  rho, &
 219                                                                 dz8w, &
 220                                                                  p8w, &
 221                                                               pi_phy, &
 222                                                                    p
 223
 224
 225    REAL, INTENT(INOUT),  DIMENSION(ims:ime, kms:kme, jms:jme ) ::     &
 226                                      F_ICE_PHY,F_RAIN_PHY,F_RIMEF_PHY
 227 !!$#ifdef WRF_CHEM
 228 !  REAL, INTENT(OUT), DIMENSION(ims:ime, kms:kme, jms:jme ) ::     &
 229    REAL, OPTIONAL, INTENT(OUT), DIMENSION(ims:ime, kms:kme, jms:jme ) ::     &
 230 !!$#else
 231 !!$  REAL, DIMENSION(ims:ime, kms:kme, jms:jme ) ::     &
 232 !!$#endif
 233          qlsink, & ! cloud water sink (/s)
 234          precr, & ! rain precipitation rate at all levels (kg/m2/s)
 235          preci, & ! ice precipitation rate at all levels (kg/m2/s)
 236          precs, & ! snow precipitation rate at all levels (kg/m2/s)
 237          precg    ! graupel precipitation rate at all levels (kg/m2/s)
 238
 239 !
 240
 241    REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(IN)   :: XLAND
 242
 243    REAL , DIMENSION( ims:ime , jms:jme ) , INTENT(OUT)   :: SR
 244
 245    REAL, INTENT(IN   ) :: dt,dx,dy
 246
 247    INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT) :: LOWLYR
 248
 249 !
 250 ! Optional
 251 !
 252    LOGICAL,  OPTIONAL,   INTENT(IN   )    :: channel_switch
 253    REAL, OPTIONAL,  INTENT(INOUT   ) :: naer  ! aerosol number concentration (/kg)
 254    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
 255          OPTIONAL,                                                &
 256          INTENT(INOUT ) ::                                        &
 257                   w, z, t8w                                       &
 258                  ,cldfra, cldfra_old, exch_h                      &
 259                  ,qv_curr,qc_curr,qr_curr,qi_curr,qs_curr,qg_curr &
 260                  ,qt_curr,qndrop_curr,qni_curr                    &
 261                  ,qns_curr,qnr_curr,qng_curr
 262
 263    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
 264          OPTIONAL,                                                &
 265          INTENT(IN) :: qrcuten, qscuten, qicuten
 266    REAL, DIMENSION( ims:ime, jms:jme ),                           &
 267          OPTIONAL,                                                &
 268          INTENT(IN) :: mu
 269
 270
 271    REAL, DIMENSION(ims:ime, kms:kme, jms:jme ),                   &
 272          OPTIONAL,                                                &
 273          INTENT(OUT ) ::                                          &
 274                   nsource
 275
 276 !
 277    REAL, DIMENSION( ims:ime , jms:jme ),                          &
 278          INTENT(INOUT),                                           &
 279          OPTIONAL   ::                                            &
 280                                                            RAINNC &
 281                                                          ,RAINNCV &
 282                                                           ,SNOWNC &
 283                                                          ,SNOWNCV &
 284                                                        ,GRAUPELNC &
 285                                                       ,GRAUPELNCV
 286    INTEGER,OPTIONAL,INTENT(IN   )    ::                        id
 287
 288    REAL , DIMENSION( ims:ime , jms:jme ) , OPTIONAL ,             &
 289          INTENT(IN)   ::                                       ht
 290
 291    REAL, DIMENSION (:), OPTIONAL, INTENT(INOUT) :: mp_restart_state &
 292                                          ,tbpvs_state,tbpvs0_state
 293 !
 294
 295    LOGICAL, OPTIONAL :: f_qv,f_qc,f_qr,f_qi,f_qs,f_qg,f_qndrop,f_qni,f_qt &
 296                                    ,f_qns,f_qnr,f_qng
 297
 298 ! LOCAL  VAR
 299
 300    INTEGER :: i,j,k,its,ite,jts,jte,ij,sz,n
 301    LOGICAL :: channel
 302
 303 !---------------------------------------------------------------------
 304 !  check for microphysics type.  We need a clean way to
 305 !  specify these things!
 306 !---------------------------------------------------------------------
 307
 308    channel = .FALSE.
 309    IF ( PRESENT ( channel_switch ) ) channel = channel_switch
 310
 311    if (mp_physics .eq. 0) return
 312    IF( specified ) THEN
 313      sz = spec_zone
 314    ELSE
 315      sz = 0
 316    ENDIF
 317
 318 #ifndef RUN_ON_GPU
 319    !$OMP PARALLEL DO   &
 320    !$OMP PRIVATE ( ij, its, ite, jts, jte, i,j,k,n )
 321
 322    DO ij = 1 , num_tiles
 323        IF (channel) THEN
 324          its = max(i_start(ij),ids)
 325          ite = min(i_end(ij),ide-1)
 326        ELSE
 327          its = max(i_start(ij),ids+sz)
 328          ite = min(i_end(ij),ide-1-sz)
 329        ENDIF
 330        jts = max(j_start(ij),jds+sz)
 331        jte = min(j_end(ij),jde-1-sz)
 332 #else
 333    DO ij = 1 , 1
 334        IF (channel) THEN
 335          its = max(ips,ids)
 336          ite = min(ipe,ide-1)
 337        ELSE
 338          its = max(ips,ids+sz)
 339          ite = min(ipe,ide-1-sz)
 340        ENDIF
 341        jts = max(jps,jds+sz)
 342        jte = min(jpe,jde-1-sz)
 343 #endif
 344
 345
 346        IF( PRESENT(qlsink) ) qlsink(its:ite,kts:kte,jts:jte) = 0.
 347
 348 !-----------
 349        IF( PRESENT(chem_opt) .AND. PRESENT(progn) ) THEN
 350        IF( chem_opt==0 .AND. progn==1 .AND. mp_physics==LINSCHEME ) THEN
 351           IF( PRESENT( QNDROP_CURR ) ) THEN
 352              CALL wrf_debug ( 100 , 'microphysics_driver: calling prescribe_aerosol_mixactivate' )
 353 ! 06-nov-2005 rce - id  & itimestep added to arg list
 354              call prescribe_aerosol_mixactivate (               &
 355                   id, itimestep, dt, naer,                      &
 356                   rho, th, pi_phy, w, cldfra, cldfra_old,       &
 357                   z, dz8w, p8w, t8w, exch_h,                    &
 358                   qv_curr, qc_curr, qi_curr, qndrop_curr,       &
 359                   nsource,                                      &
 360                   ids,ide, jds,jde, kds,kde,                    &
 361                   ims,ime, jms,jme, kms,kme,                    &
 362                   its,ite, jts,jte, kts,kte,                    &
 363                   F_QC=f_qc, F_QI=f_qi                          )
 364           END IF
 365        ELSE IF( progn==1 .AND. mp_physics/=LINSCHEME ) THEN
 366              call wrf_error_fatal("SETTINGS ERROR: Prognostic cloud droplet number can only be used with the mp_physics=LINSCHEME.")
 367        END IF
 368        END IF
 369
 370      micro_select: SELECT CASE(mp_physics)
 371
 372         CASE (KESSLERSCHEME)
 373              CALL wrf_debug ( 100 , 'microphysics_driver: calling kessler' )
 374              IF ( PRESENT( QV_CURR ) .AND. PRESENT( QC_CURR ) .AND.  &
 375                                            PRESENT( QR_CURR ) .AND.  &
 376                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
 377                                            PRESENT( Z       ))  THEN
 378                CALL kessler(                                        &
 379                   T=th                                              &
 380                  ,QV=qv_curr                                        &
 381                  ,QC=qc_curr                                        &
 382                  ,QR=qr_curr                                        &
 383                  ,RHO=rho, PII=pi_phy,DT_IN=dt, Z=z, XLV=xlv, CP=cp &
 384                  ,EP2=ep_2,SVP1=svp1,SVP2=svp2                      &
 385                  ,SVP3=svp3,SVPT0=svpt0,RHOWATER=rhowater           &
 386                  ,DZ8W=dz8w                                         &
 387                  ,RAINNC=rainnc,RAINNCV=rainncv                     &
 388                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
 389                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
 390                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
 391                                                                     )
 392              ELSE
 393                 CALL wrf_error_fatal ( 'arguments not present for calling kessler' )
 394              ENDIF
 395
 396 !
 397         CASE (THOMPSON)
 398              CALL wrf_debug ( 100 , 'microphysics_driver: calling thompson et al' )
 399              IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
 400                   PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND.  &
 401                   PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND.  &
 402                                            PRESENT ( QNI_CURR ).AND.  &
 403                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) ) THEN
 404              CALL mp_gt_driver(                          &
 405                      QV=qv_curr,                         &
 406                      QC=qc_curr,                         &
 407                      QR=qr_curr,                         &
 408                      QI=qi_curr,                         &
 409                      QS=qs_curr,                         &
 410                      QG=qg_curr,                         &
 411                      NI=qni_curr,                        &
 412                      TH=th,                              &
 413                      PII=pi_phy,                         &
 414                      P=p,                                &
 415                      DZ=dz8w,                            &
 416                      DT_IN=dt,                           &
 417                      ITIMESTEP=itimestep,                &
 418                      RAINNC=RAINNC,                      &
 419                      RAINNCV=RAINNCV,                    &
 420                      SR=SR                               &
 421                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
 422                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
 423                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte)
 424              ELSE
 425                 CALL wrf_error_fatal ( 'arguments not present for calling thompson_et_al' )
 426              ENDIF
 427 !
 428
 429     CASE (MORR_TWO_MOMENT)
 430          CALL wrf_debug(100, 'microphysics_driver: calling morrison two moment')
 431          IF (PRESENT (QV_CURR) .AND. PRESENT (QC_CURR) .AND. &
 432              PRESENT (QR_CURR) .AND. PRESENT (QI_CURR) .AND. &
 433          PRESENT (QS_CURR) .AND. PRESENT (QG_CURR) .AND. &
 434          PRESENT (QR_CURR) .AND. PRESENT (QI_CURR) .AND. &
 435          PRESENT (QNS_CURR) .AND. PRESENT (QNI_CURR).AND. &
 436          PRESENT (QNR_CURR) .AND. PRESENT (QNG_CURR).AND. &
 437          PRESENT (MU) .AND. PRESENT (QSCUTEN).AND. &
 438          PRESENT (QRCUTEN) .AND. PRESENT (QICUTEN).AND. &
 439                  PRESENT (RAINNC ) .AND. PRESENT (RAINNCV) .AND. &
 440          PRESENT (Z      ) .AND.PRESENT ( W      )  ) THEN
 441          CALL mp_morr_two_moment(                            &
 442                      ITIMESTEP=itimestep,                &  !*
 443                      TH=th,                              &  !*
 444                      QV=qv_curr,                         &  !*
 445                      QC=qc_curr,                         &  !*
 446                      QR=qr_curr,                         &  !*
 447                      QI=qi_curr,                         &  !*
 448                      QS=qs_curr,                         &  !*
 449                      QG=qg_curr,                         &  !*
 450                      NI=qni_curr,                        &  !*
 451                      NS=qns_curr,                        &  !* ! VVT
 452                      NR=qnr_curr,                        &  !* ! VVT
 453                      NG=qng_curr,                        &  !* ! VVT
 454                      RHO=rho,                            &  !*
 455                      PII=pi_phy,                         &  !*
 456                      P=p,                                &  !*
 457                      DT_IN=dt,                           &  !*
 458                      DZ=dz8w,                            &  !* !hm
 459                      HT=ht,                              &  !*
 460                      W=w                                 &  !*
 461                     ,RAINNC=RAINNC                       &  !*
 462                     ,RAINNCV=RAINNCV                     &  !*
 463                     ,SR=SR                               &  !* !hm
 464                     ,qrcuten=qrcuten                     &  ! hm
 465                     ,qscuten=qscuten                     &  ! hm
 466                     ,qicuten=qicuten                     &  ! hm
 467                     ,mu=mu                          &  ! hm
 468                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
 469                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
 470                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
 471                                                                     )
 472         ELSE
 473            Call wrf_error_fatal( 'arguments not present for calling morrison two moment')
 474         ENDIF
 475
 476 !
 477         CASE (GSFCGCESCHEME)
 478              CALL wrf_debug ( 100 , 'microphysics_driver: calling GSFCGCE' )
 479              IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
 480                   PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND.  &
 481                   PRESENT( QS_CURR )                           .AND.  &
 482                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
 483                   PRESENT( HAIL    ) .AND. PRESENT ( ICE2    ) .AND.  &
 484                   PRESENT( Z       ) .AND. PRESENT ( W       )  ) THEN
 485                CALL gsfcgce(                                        &
 486                   TH=th                                             &
 487                  ,QV=qv_curr                                        &
 488                  ,QL=qc_curr                                        &
 489                  ,QR=qr_curr                                        &
 490                  ,QI=qi_curr                                        &
 491                  ,QS=qs_curr                                        &
 492                  ,RHO=rho, PII=pi_phy, P=p, DT_IN=dt, Z=z           &
 493                  ,HT=ht, DZ8W=dz8w, GRAV=G                          &
 494                  ,RHOWATER=rhowater, RHOSNOW=rhosnow                &
 495                  ,ITIMESTEP=itimestep                               &
 496                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
 497                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
 498                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
 499                  ,RAINNC=rainnc, RAINNCV=rainncv                    &
 500                  ,SNOWNC=snownc, SNOWNCV=snowncv ,SR=sr             &
 501                  ,GRAUPELNC=graupelnc ,GRAUPELNCV=graupelncv        &
 502                  ,F_QG=f_qg                                         &
 503                  ,QG=qg_curr                                        &
 504                  ,IHAIL=hail, ICE2=ice2                             &
 505                                                                     )
 506 ! HAIL = 1,  run gsfcgce with hail option
 507 !        0,  run gsfcgce with graupel option   <---- default
 508 !        note: no effect if ice2 = 1
 509 ! ICE2 = 1,  run gsfcgce with only snow, ice
 510 !        2,  run gsfcgce with only graupel, ice
 511 !        0,  run gsfcgce with snow, ice and hail/graupel   <---- default
 512
 513              ELSE
 514                 CALL wrf_error_fatal ( 'arguments not present for calling GSFCGCE' )
 515              ENDIF
 516
 517         CASE (LINSCHEME)
 518              CALL wrf_debug ( 100 , 'microphysics_driver: calling lin_et_al' )
 519              IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
 520                   PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND.  &
 521                   PRESENT( QS_CURR )                           .AND.  &
 522                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
 523                   PRESENT( Z       ) ) THEN
 524                CALL lin_et_al(                                      &
 525                   TH=th                                             &
 526                  ,QV=qv_curr                                        &
 527                  ,QL=qc_curr                                        &
 528                  ,QR=qr_curr                                        &
 529                  ,QI=qi_curr                                        &
 530                  ,QS=qs_curr                                        &
 531                  ,QLSINK=qlsink                                     &
 532                  ,RHO=rho, PII=pi_phy, P=p, DT_IN=dt, Z=z           &
 533                  ,HT=ht, DZ8W=dz8w, GRAV=G,  CP=cp                  &
 534                  ,RAIR=r_d, RVAPOR=R_v                              &
 535                  ,XLS=xls, XLV=xlv, XLF=xlf                         &
 536                  ,RHOWATER=rhowater, RHOSNOW=rhosnow                &
 537                  ,EP2=ep_2,SVP1=svp1,SVP2=svp2                      &
 538                  ,SVP3=svp3,SVPT0=svpt0                             &
 539                  ,RAINNC=rainnc, RAINNCV=rainncv                    &
 540                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
 541                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
 542                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
 543                  ,PRECR=precr,PRECI=preci,PRECS=precs,PRECG=precg   &
 544                  ,F_QG=f_qg, F_QNDROP=f_qndrop                      &
 545                  ,QG=qg_curr                                        &
 546                  ,QNDROP=qndrop_curr                                &
 547                                                                     )
 548              ELSE
 549                 CALL wrf_error_fatal ( 'arguments not present for calling lin_et_al' )
 550              ENDIF
 551
 552         CASE (WSM3SCHEME)
 553              CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm3' )
 554              IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
 555                   PRESENT( QR_CURR ) .AND.                            &
 556                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
 557                   PRESENT( W       )                            ) THEN
 558              CALL wsm3(                                             &
 559                   TH=th                                             &
 560                  ,Q=qv_curr                                         &
 561                  ,QCI=qc_curr                                       &
 562                  ,QRS=qr_curr                                       &
 563                  ,W=w,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w              &
 564                  ,DELT=dt,G=g,CPD=cp,CPV=cpv                        &
 565                  ,RD=r_d,RV=r_v,T0C=svpt0                           &
 566                  ,EP1=ep_1, EP2=ep_2, QMIN=epsilon                  &
 567                  ,XLS=xls, XLV0=xlv, XLF0=xlf                       &
 568                  ,DEN0=rhoair0, DENR=rhowater                       &
 569                  ,CLIQ=cliq,CICE=cice,PSAT=psat                     &
 570                  ,RAIN=rainnc ,RAINNCV=rainncv                      &
 571                  ,SNOW=snownc ,SNOWNCV=snowncv                      &
 572                  ,SR=sr                                             &
 573                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
 574                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
 575                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
 576                                                                     )
 577              ELSE
 578                 CALL wrf_error_fatal ( 'arguments not present for calling wsm3' )
 579              ENDIF
 580
 581         CASE (WSM5SCHEME)
 582              CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm5' )
 583              IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
 584                   PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND.  &
 585                   PRESENT( QS_CURR ) .AND.                            &
 586                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV )  ) THEN
 587              CALL wsm5(                                             &
 588                   TH=th                                             &
 589                  ,Q=qv_curr                                         &
 590                  ,QC=qc_curr                                        &
 591                  ,QR=qr_curr                                        &
 592                  ,QI=qi_curr                                        &
 593                  ,QS=qs_curr                                        &
 594                  ,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w                  &
 595                  ,DELT=dt,G=g,CPD=cp,CPV=cpv                        &
 596                  ,RD=r_d,RV=r_v,T0C=svpt0                           &
 597                  ,EP1=ep_1, EP2=ep_2, QMIN=epsilon                  &
 598                  ,XLS=xls, XLV0=xlv, XLF0=xlf                       &
 599                  ,DEN0=rhoair0, DENR=rhowater                       &
 600                  ,CLIQ=cliq,CICE=cice,PSAT=psat                     &
 601                  ,RAIN=rainnc ,RAINNCV=rainncv                      &
 602                  ,SNOW=snownc ,SNOWNCV=snowncv                      &
 603                  ,SR=sr                                             &
 604                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
 605                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
 606                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
 607                                                                     )
 608              ELSE
 609                 CALL wrf_error_fatal ( 'arguments not present for calling wsm5' )
 610              ENDIF
 611
 612         CASE (WSM6SCHEME)
 613              CALL wrf_debug ( 100 , 'microphysics_driver: calling wsm6' )
 614              IF ( PRESENT( QV_CURR ) .AND. PRESENT ( QC_CURR ) .AND.  &
 615                   PRESENT( QR_CURR ) .AND. PRESENT ( QI_CURR ) .AND.  &
 616                   PRESENT( QS_CURR ) .AND. PRESENT ( QG_CURR ) .AND.  &
 617                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV )  ) THEN
 618              CALL wsm6(                                             &
 619                   TH=th                                             &
 620                  ,Q=qv_curr                                         &
 621                  ,QC=qc_curr                                        &
 622                  ,QR=qr_curr                                        &
 623                  ,QI=qi_curr                                        &
 624                  ,QS=qs_curr                                        &
 625                  ,QG=qg_curr                                        &
 626                  ,DEN=rho,PII=pi_phy,P=p,DELZ=dz8w                  &
 627                  ,DELT=dt,G=g,CPD=cp,CPV=cpv                        &
 628                  ,RD=r_d,RV=r_v,T0C=svpt0                           &
 629                  ,EP1=ep_1, EP2=ep_2, QMIN=epsilon                  &
 630                  ,XLS=xls, XLV0=xlv, XLF0=xlf                       &
 631                  ,DEN0=rhoair0, DENR=rhowater                       &
 632                  ,CLIQ=cliq,CICE=cice,PSAT=psat                     &
 633                  ,RAIN=rainnc ,RAINNCV=rainncv                      &
 634                  ,SNOW=snownc ,SNOWNCV=snowncv                      &
 635                  ,SR=sr                                             &
 636                  ,GRAUPEL=graupelnc ,GRAUPELNCV=graupelncv          &
 637                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
 638                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
 639                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
 640                                                                     )
 641              ELSE
 642                 CALL wrf_error_fatal ( 'arguments not present for calling wsm6' )
 643              ENDIF
 644
 645         CASE (ETAMPNEW)
 646              CALL wrf_debug ( 100 , 'microphysics_driver: calling etampnew')
 647
 648              IF ( PRESENT( qv_curr ) .AND. PRESENT( qt_curr ) .AND. &
 649                   PRESENT( RAINNC  ) .AND. PRESENT ( RAINNCV ) .AND.  &
 650                   PRESENT( mp_restart_state )                  .AND. &
 651                   PRESENT( tbpvs_state )                      .AND. &
 652                   PRESENT( tbpvs0_state )                       ) THEN
 653                CALL ETAMP_NEW(                                      &
 654                   ITIMESTEP=itimestep,DT=dt,DX=dx,DY=dy             &
 655                  ,DZ8W=dz8w,RHO_PHY=rho,P_PHY=p,PI_PHY=pi_phy,TH_PHY=th &
 656                  ,QV=qv_curr                                        &
 657                  ,QC=qc_curr                                        &
 658                  ,QS=qs_curr                                        &
 659                  ,QR=qr_curr                                        &
 660                  ,QT=qt_curr                                        &
 661                  ,LOWLYR=LOWLYR,SR=SR                               &
 662                  ,F_ICE_PHY=F_ICE_PHY,F_RAIN_PHY=F_RAIN_PHY         &
 663                  ,F_RIMEF_PHY=F_RIMEF_PHY                           &
 664                  ,RAINNC=rainnc,RAINNCV=rainncv                     &
 665                  ,IDS=ids,IDE=ide, JDS=jds,JDE=jde, KDS=kds,KDE=kde &
 666                  ,IMS=ims,IME=ime, JMS=jms,JME=jme, KMS=kms,KME=kme &
 667                  ,ITS=its,ITE=ite, JTS=jts,JTE=jte, KTS=kts,KTE=kte &
 668                  ,MP_RESTART_STATE=mp_restart_state                 &
 669                  ,TBPVS_STATE=tbpvs_state,TBPVS0_STATE=tbpvs0_state &
 670                                                                     )
 671              ELSE
 672                 CALL wrf_error_fatal ( 'arguments not present for calling etampnew' )
 673              ENDIF
 674
 675
 676       CASE DEFAULT
 677
 678          WRITE( wrf_err_message , * ) 'The microphysics option does not exist: mp_physics = ', mp_physics
 679          CALL wrf_error_fatal ( wrf_err_message )
 680
 681       END SELECT micro_select
 682
 683    ENDDO
 684 #ifndef RUN_ON_GPU
 685    !$OMP END PARALLEL DO
 686 #endif
 687
 688    CALL wrf_debug ( 200 , 'microphysics_driver: returning from' )
 689
 690    RETURN
 691
 692    END SUBROUTINE microphysics_driver
 693
 694 END MODULE module_microphysics_driver
 695