phys/module_bl_fogdes.F

   1 MODULE module_bl_fogdes
   2
   3   USE module_model_constants
   4
   5 !-------------------------------------------------------------------
   6   IMPLICIT NONE
   7 !-------------------------------------------------------------------
   8   REAL, PARAMETER :: gno=1.0  !original value seems too aggressive: 4.64158883361278196
   9   REAL, PARAMETER :: gpw=5./3., qcgmin=1.e-8
  10
  11 CONTAINS
  12
  13   SUBROUTINE bl_fogdes(&
  14                vdfg,qc_curr,dtbl,rho,dz8w,grav_settling,dqc,       &
  15                ids,ide, jds,jde, kds,kde,                          &
  16                ims,ime, jms,jme, kms,kme,                          &
  17                its,ite, jts,jte, kts,kte                           &
  18                                                                    )
  19
  20 !  This module was written by Joseph Olson (CIRES-NOAA/GSD/AMB) to allow
  21 !  gravitational settling of cloud droplets in the atmosphere for all
  22 !  PBL schemes (when grav_settling > 0). Previously, this option was only
  23 !  available for the MYNN PBL scheme.
  24 !
  25 !  This module is a companion to module_sf_fogdes, which calulcates the
  26 !  (fog) deposition onto the surface, so it uses a consistent formulation
  27 !  at k=1. Currently, it uses a simple form taken from Dyunkerke (1991)
  28 !  and Dyunkerke and Driedonks (1988), but uses a lower settling
  29 !  velocity coefficient (gno = 1.0 instead of 4.6).
  30 !
  31 !    settling velocity:            Vd = gno*(qc)**(2/3)
  32 !    cloud water flux:  gflux = Vd*qc = gno*(qc)**(5/3)
  33 !
  34 !  This form assumes a constant number concentration: 10**8 /m**3 for
  35 !  gno = 4.6 and approx .2*10**8 /m**3 for gno = 1.0.
  36 !
  37 ! References:
  38 !
  39 ! Dyunkerke, P.G. (1991), Radiation fog: a comparison of model simulations
  40 !     with detailed observations, Mon. Wea. Rev., 119, 324-341.
  41 ! Nakanishi, Mikio (2000), Large-eddy simulation of radiation fog,
  42 !     Boundary Layer Meteorology, 94, 461-493.
  43 !
  44 !======================================================================
  45 ! Definitions
  46 !-----------
  47 !-- vdfg          deposition velocity of fog (m/s)
  48 !-- qc_curr       cloud water mixing ratio (kg/kg)
  49 !-- dqc           cloud water mixing ratio tendency
  50 !-- dtbl          timestep (s)
  51 !-- rho           density of the air (kg/m^3)
  52 !-- dp_fog        mean fog droplet diameter (m)
  53 !-- dz8w          dz between full levels (m)
  54 !-- grav_settling flag for fog deposition at the lowest atmos layer
  55 !           = 2   FogDES scheme
  56 !           = 1   use Duynkerke (1991) - same as in atmos (above k = 1)
  57 !           = 0   No gravitational settling
  58 !-- lwc           cloud liquid water content (kg/m^3)
  59 !-- ims           start index for i in memory
  60 !-- ime           end index for i in memory
  61 !-- jms           start index for j in memory
  62 !-- jme           end index for j in memory
  63 !-- kms           start index for k in memory
  64 !-- kme           end index for k in memory
  65 !-- its           start index for i in tile
  66 !-- ite           end index for i in tile
  67 !-- jts           start index for j in tile
  68 !-- jte           end index for j in tile
  69 !-- kts           start index for k in tile
  70 !-- kte           end index for k in tile
  71 !------------------------------------------------------------------
  72
  73    INTEGER, INTENT(IN)                       :: ims,ime,jms,jme,kms,kme &
  74                                                ,its,ite,jts,jte,kts,kte &
  75                                                ,ids,ide,jds,jde,kds,kde
  76
  77    INTEGER, INTENT(IN)                       :: grav_settling
  78
  79    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
  80                                        INTENT(IN),OPTIONAL    :: qc_curr
  81    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
  82                                        INTENT(IN)             :: rho
  83    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
  84                                        INTENT(IN   )          :: dz8w
  85
  86    REAL, DIMENSION( ims:ime, jms:jme ),INTENT(IN),OPTIONAL    :: vdfg
  87
  88    REAL, INTENT(INOUT),OPTIONAL                               :: dtbl
  89
  90 !JOE-added for Dyunkerke(1991) & Dyunkerke and Driedonks (1988)
  91 !    gravitational settling above the surface (creates qc tendency).
  92    REAL,parameter :: gpw2=0.66666666666667
  93    REAL :: gfluxp,gfluxm
  94    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
  95                                        INTENT(INOUT),OPTIONAL :: dqc
  96 !JOE-end
  97
  98 ! Local variables
  99    INTEGER :: i,j,k,grav_settling2
 100 !------------------------------------------------------------------
 101
 102   grav_settling2 = MIN(REAL(grav_settling), 1.)
 103
 104    DO j=jts,jte
 105      DO i=its,ite
 106
 107        !!====================================================
 108        !! Calculate gravitational settling in the atmosphere.
 109        !! This uses Dyunkerke (referenced above). Note that
 110        !! only the cloud mixing ratio is settled, not the
 111        !! number concentration.
 112        !!====================================================
 113
 114        k=kts
 115
 116        IF (qc_curr(i,k,j) > qcgmin) THEN
 117           gfluxm=grav_settling2*qc_curr(i,k,j)*vdfg(i,j)
 118        ELSE
 119           gfluxm=0.
 120        ENDIF
 121
 122        IF (.5*(qc_curr(i,k+1,j)+qc_curr(i,k,j)) > qcgmin) THEN
 123           gfluxp=grav_settling2*gno* &
 124                 & (.5*(qc_curr(i,k+1,j)+qc_curr(i,k,j)))**gpw
 125        ELSE
 126           gfluxp=0.
 127        ENDIF
 128
 129        dqc(i,k,j)=dqc(i,k,j) + (gfluxp - gfluxm)/dz8w(i,kts,j)    !*dtbl
 130
 131        !print*,"in bl_fogdes: i,j=",i,j
 132        !print*,"vdfg=",vdfg(i,j)," qc=",qc_curr(i,k,j)," dtbl=",dtbl
 133        !print*,"dqc=",dqc(i,k,j)," gfluxm=",gfluxm," gfluxp=",gfluxp
 134
 135        DO k=kts+1,kte-1
 136
 137           IF (.5*(qc_curr(i,k+1,j)+qc_curr(i,k,j)) > qcgmin) THEN
 138              gfluxp=grav_settling2*gno* &
 139                    & (.5*(qc_curr(i,k+1,j)+qc_curr(i,k,j)))**gpw
 140           ELSE
 141              gfluxp=0.
 142           ENDIF
 143
 144           IF (.5*(qc_curr(i,k-1,j)+qc_curr(i,k,j)) > qcgmin) THEN
 145              gfluxm=grav_settling2*gno* &
 146                    & (.5*(qc_curr(i,k-1,j)+qc_curr(i,k,j)))**gpw
 147           ELSE
 148              gfluxm=0.
 149           ENDIF
 150
 151           dqc(i,k,j)= dqc(i,k,j) + (gfluxp - gfluxm)/dz8w(i,k,j)  !*dtbl
 152
 153        ENDDO
 154
 155       ! dqc(i,kte,j)=0.
 156
 157      ENDDO
 158    ENDDO
 159
 160   END SUBROUTINE bl_fogdes
 161
 162 ! ==================================================================
 163
 164 END MODULE module_bl_fogdes