phys/module_sf_fogdes.F

   1 MODULE module_sf_fogdes
   2
   3   USE module_model_constants
   4
   5 !-------------------------------------------------------------------
   6   IMPLICIT NONE
   7 !-------------------------------------------------------------------
   8   REAL, PARAMETER :: myu = 1.8e-5  ! air viscosity (m^2/s)
   9   REAL, PARAMETER :: gno=1.0  !original value seems too aggressive: 4.64158883361278196
  10   REAL, PARAMETER :: gpw=5./3., qcgmin=1.e-8
  11
  12 CONTAINS
  13
  14   SUBROUTINE sf_fogdes(&
  15                vdfg,fgdp,dfgdp,ivgtyp,lai,wspd,qc_curr,            &
  16                dtbl,rho,dz8w,grav_settling,nlcat,                  &
  17                ids,ide, jds,jde, kds,kde,                          &
  18                ims,ime, jms,jme, kms,kme,                          &
  19                its,ite, jts,jte, kts,kte                           &
  20                                                                    )
  21
  22 !  This module calculates the cloud water (fog) deposition onto the
  23 !  surface due to turbulent exchange and gravitational settling using
  24 !  simple Fog Deposition EStimation (FogDES) scheme.
  25
  26 ! References:
  27 !
  28 !  Katata, G., Nagai, H., Wrzesinsky, T., Klemm, O., Eugster, W.,
  29 !    Burkard, R. (2008), Development of a land surface model
  30 !    including cloud water deposition on vegetation, Journal of
  31 !    Applied Meteorology and Climatology, 47, 2129-2146.
  32 !  Katata, G., Kajino, M., Hiraki, T., Aikawa, M., Kobayashi, T.,
  33 !    Nagai, H. (2011), A method for simple and accurate estimation
  34 !    of fog deposition in a mountain forest using a meteorological
  35 !    model. Journal of Geophysical Research 116, D20102.
  36 !
  37 !-------------------------------------------------------------------
  38   IMPLICIT NONE
  39 !======================================================================
  40 ! Definitions
  41 !-----------
  42 !-- vdfg          deposition velocity of fog (m/s)
  43 !-- fgdp          accumulated fog deposition (mm)
  44 !-- dfgdp         fog deposition rate in one timestep (mm)
  45 !-- ivgtyp        dominant vegetation category
  46 !-- lai           leaf area index
  47 !-- wspd          wind speed (m/s)
  48 !-- qc_curr       cloud water mixing ratio (kg/kg)
  49 !-- dqc           cloud water mixing ratio tendency (not used -
  50 !                 claculated in MYNN PBL scheme)
  51 !-- dtbl          timestep (s)
  52 !-- rho           density of the air (kg/m^3)
  53 !-- dp_fog        mean fog droplet diameter (m)
  54 !-- dz8w          dz between full levels (m)
  55 !-- ch            drag coefficient for heat in mynn (m/s)
  56 !-- grav_settling flag for fog deposition at the lowest atmos layer
  57 !           = 2   FogDES scheme
  58 !           = 1   use Duynkerke (1991) - same as in atmos (above k = 1)
  59 !           = 0   No gravitational settling
  60 !-- lad           leaf area density (m^2/m^3)
  61 !-- spcfct        factor of vegetation species for vdfg calculation
  62 !-- vegh          canopy height for vegetative surface (m)
  63 !-- lwc           cloud liquid water content (kg/m^3)
  64 !-- ims           start index for i in memory
  65 !-- ime           end index for i in memory
  66 !-- jms           start index for j in memory
  67 !-- jme           end index for j in memory
  68 !-- kms           start index for k in memory
  69 !-- kme           end index for k in memory
  70 !-- its           start index for i in tile
  71 !-- ite           end index for i in tile
  72 !-- jts           start index for j in tile
  73 !-- jte           end index for j in tile
  74 !-- kts           start index for k in tile
  75 !-- kte           end index for k in tile
  76 !******************************************************************
  77 !------------------------------------------------------------------
  78
  79    INTEGER, INTENT(IN)                       :: ims,ime,jms,jme,kms,kme &
  80                                                ,its,ite,jts,jte,kts,kte &
  81                                                ,ids,ide,jds,jde,kds,kde
  82
  83    INTEGER, INTENT(IN)                       :: grav_settling,nlcat
  84
  85    INTEGER,DIMENSION( ims:ime , jms:jme ),INTENT(INOUT)       :: ivgtyp
  86
  87    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
  88                                        INTENT(IN),OPTIONAL    :: qc_curr
  89    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
  90                                        INTENT(IN)             :: rho
  91    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                        &
  92                                        INTENT(IN   )          :: dz8w
  93
  94    REAL, DIMENSION( ims:ime, jms:jme ),INTENT(INOUT),OPTIONAL :: vdfg
  95    REAL, DIMENSION( ims:ime, jms:jme ),INTENT(INOUT),OPTIONAL :: fgdp
  96    REAL, DIMENSION( ims:ime, jms:jme ),INTENT(INOUT),OPTIONAL :: dfgdp
  97    REAL, DIMENSION( ims:ime, jms:jme ),INTENT(INOUT),OPTIONAL :: lai
  98    REAL, DIMENSION( ims:ime, jms:jme ),INTENT(INOUT)          :: wspd
  99
 100    REAL, INTENT(INOUT),OPTIONAL                               :: dtbl
 101
 102 !JOE-added for Dyunkerke(1991) & Dyunkerke and Driedonks (1988)
 103 !  (grav_settling = 1).
 104    REAL,parameter :: gpw2=0.66666666666667
 105 !JOE-end
 106
 107 ! Local variables
 108    INTEGER :: i,j
 109    REAL    :: lad, spcfct, vegh, ftmp1, ftmp2, dp_fog, lwc
 110    CHARACTER (LEN=25) :: land_use_type, lu_fogdes
 111
 112 !------------------------------------------------------------------
 113
 114    IF     ((nlcat .eq. 20).or.(nlcat .eq. 21)) THEN ! includes lake category
 115      land_use_type = 'MODIS'
 116    ELSEIF ((nlcat .eq. 24).or.(nlcat .eq. 28)) THEN ! includes lake category
 117      land_use_type = 'USGS'
 118    ELSE
 119      PRINT *, 'Unknown landuse category (sf_fogdes.F): num_land_cat=',nlcat
 120      STOP
 121    END IF
 122
 123    DO j=jts,jte
 124     DO i=its,ite
 125        lwc = rho(i,kts,j)*qc_curr(i,kts,j)
 126 ! *-- FogDES scheme --
 127        IF ( grav_settling .eq. 2 ) THEN
 128 ! *-- USGS categories --
 129         IF (land_use_type .eq. 'USGS') THEN
 130          IF(  (ivgtyp(i,j) .ge.  2 .and. ivgtyp(i,j) .le. 15)           &
 131          .or. (ivgtyp(i,j) .ge. 17 .and. ivgtyp(i,j) .le. 18)           &
 132          .or. (ivgtyp(i,j) .ge. 20 .and. ivgtyp(i,j) .le. 22) ) THEN
 133           IF    ((ivgtyp(i,j).ge. 2 .and. ivgtyp(i,j).le. 5)            &
 134             .or. (ivgtyp(i,j).eq. 7)                                    &
 135             .or. (ivgtyp(i,j).eq. 17)                                   &
 136             .or. (ivgtyp(i,j).eq. 20)                         ) THEN
 137             lu_fogdes= 'CROP_GRASS'
 138           ELSEIF((ivgtyp(i,j).eq. 6) .or. (ivgtyp(i,j).eq. 9) ) THEN
 139             lu_fogdes= 'MIXED_CROP_GRASS_WOOD'
 140           ELSEIF( ivgtyp(i,j).eq. 8                           ) THEN
 141             lu_fogdes= 'SHRUB'
 142           ELSEIF((ivgtyp(i,j).eq.11) .or. (ivgtyp(i,j).eq.13) ) THEN
 143             lu_fogdes= 'BROAD_FOREST'
 144           ELSEIF((ivgtyp(i,j).eq.15) .or. (ivgtyp(i,j).eq.22) ) THEN
 145             lu_fogdes= 'MIXED_FOREST'
 146           ELSE
 147             lu_fogdes= 'CONIFER_FOREST_ETC'
 148           ENDIF
 149          ELSE
 150             lu_fogdes= 'OTHERS'
 151          ENDIF
 152         ELSE
 153 ! *-- MODIS categories --
 154          IF(  (ivgtyp(i,j) .ge.  1 .and. ivgtyp(i,j) .le. 10)           &
 155          .or. (ivgtyp(i,j) .eq. 12)                                     &
 156          .or. (ivgtyp(i,j) .eq. 14)                                     &
 157          .or. (ivgtyp(i,j) .ge. 18 .and. ivgtyp(i,j) .le. 19) ) THEN
 158           IF    ((ivgtyp(i,j).eq.10) .or. (ivgtyp(i,j).eq.12) ) THEN
 159             lu_fogdes= 'CROP_GRASS'
 160           ELSEIF( ivgtyp(i,j).eq.14                           ) THEN
 161             lu_fogdes= 'MIXED_CROP_GRASS_WOOD'
 162           ELSEIF((ivgtyp(i,j).eq. 6) .or. (ivgtyp(i,j).eq. 7) ) THEN
 163             lu_fogdes= 'SHRUB'
 164           ELSEIF((ivgtyp(i,j).eq. 2) .or. (ivgtyp(i,j).eq. 4) ) THEN
 165             lu_fogdes= 'BROAD_FOREST'
 166           ELSEIF((ivgtyp(i,j).eq. 5) .or. (ivgtyp(i,j).eq.19) ) THEN
 167             lu_fogdes= 'MIXED_FOREST'
 168           ELSE
 169             lu_fogdes= 'CONIFER_FOREST_ETC'
 170           ENDIF
 171          ELSE
 172             lu_fogdes= 'OTHERS'
 173          ENDIF
 174         ENDIF
 175
 176 !       PRINT *,grav_settling,'luse:',land_use_type,lu_fogdes
 177
 178 !  Deposition velocity is computed using the vegetation parameters of LAI
 179 !  and canopy height. Only gravitational settling is considered for non-
 180 !  vegetated landuse categories.
 181
 182         IF    ( lu_fogdes .eq. 'OTHERS'                ) THEN
 183          dp_fog= (17.03*lwc*1.e3 + 9.72)*1.e-6 ! Katata et al. (2008) JAMC
 184          vdfg(i,j)= (rhowater-rho(i,kts,j))*dp_fog**2.0*g/(18.0*myu)
 185         ELSE
 186          lu_select: SELECT CASE(lu_fogdes)
 187          CASE ('CROP_GRASS')
 188            spcfct= 0.2170
 189            vegh  = 3.0               !// scaled from 3m tree calc.
 190          CASE ('MIXED_CROP_GRASS_WOOD')
 191            spcfct= ( 1.0 + 0.2170 )/2.0
 192            vegh  = (20.0 + 3.0    )/2.0
 193          CASE ('SHRUB')
 194            spcfct= 1.0
 195            vegh  = 4.0
 196          CASE ('BROAD_FOREST')
 197            spcfct= 0.8255
 198            vegh  = 20.0
 199          CASE ('MIXED_FOREST')
 200            spcfct= ( 1.0 + 0.8255 )/2.0
 201            vegh  = 20.0
 202          CASE ('CONIFER_FOREST_ETC')
 203            spcfct= 1.0
 204            vegh  = 20.0
 205          END SELECT lu_select
 206
 207 !   simple linear functions for deposition velocity (vdfg)
 208 !   for large leaf area density LAD (ftmp1) and small LAD (ftmp2).
 209
 210          lad  = lai(i,j)/vegh
 211          ftmp1= 0.0164*lad**(-0.5000 )             !// LAD>0.1-0.2
 212          ftmp2= 0.0095*lai(i,j)**3.0 - 0.05*lai(i,j)**2.0             &
 213               + 0.0916*lai(i,j) + 0.0082               !// LAI<2 (LAD<0.08)
 214          vdfg(i,j)= spcfct*MIN( ftmp1, ftmp2 )*wspd(i,j)
 215         ENDIF
 216
 217 !       PRINT *,'vdfg:',spcfct,vegh,dp_fog,vdfg(i,j)
 218
 219        ELSE IF (grav_settling .eq. 0 ) THEN
 220           ! *-- No settling --
 221           vdfg(i,j) = 0.0
 222        ELSE IF (grav_settling .eq. 1 ) THEN
 223           !JOE-use the same gravitation settling as in the free atmosphere
 224           !(taken from the MYNN PBL, Duynkerke (1991))
 225           IF ((qc_curr(i,kts,j)/(1.+qc_curr(i,kts,j))) > qcgmin) THEN
 226              vdfg(i,j)=gno*(qc_curr(i,kts,j)/(1.+qc_curr(i,kts,j)))**gpw2
 227           ELSE
 228              vdfg(i,j)=0.
 229           ENDIF
 230        ENDIF
 231
 232 !   vdfg can advect moisture through the lowest half-sigma layer depth
 233 !   in one time-step.
 234        vdfg(i,j)=MIN( 0.5*dz8w(i,kts,j)/dtbl, vdfg(i,j) )
 235
 236        IF ( PRESENT( fgdp ) ) THEN
 237          dfgdp(i,j)= vdfg(i,j)*lwc*dtbl
 238          fgdp(i,j) = fgdp(i,j)+dfgdp(i,j)
 239        ELSE
 240          CALL wrf_error_fatal('Missing arguments for FGDP in sf_fogdes')
 241        ENDIF
 242
 243        dfgdp(i,j)= MAX (dfgdp(i,j), 0.0)
 244        fgdp(i,j) = MAX (fgdp(i,j),  0.0)
 245
 246      ENDDO
 247    ENDDO
 248
 249   END SUBROUTINE sf_fogdes
 250
 251 ! ==================================================================
 252
 253 END MODULE module_sf_fogdes