chem/module_sea_salt_emis.F

   1 MODULE GOCART_SEASALT
   2
   3 CONTAINS
   4   subroutine gocart_dust_driver(ktau,dt,config_flags,julday,alt,t_phy,moist,u_phy,  &
   5          v_phy,chem,rho_phy,dz8w,emis_seas,smois,u10,v10,p8w,                  &
   6          xland,xlat,xlong,dx,g, &
   7          ids,ide, jds,jde, kds,kde,                                        &
   8          ims,ime, jms,jme, kms,kme,                                        &
   9          its,ite, jts,jte, kts,kte                                         )
  10   USE module_configure
  11   USE module_state_description
  12   IMPLICIT NONE
  13    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
  14
  15    INTEGER,      INTENT(IN   ) :: julday, ktau,                     &
  16                                   ids,ide, jds,jde, kds,kde,               &
  17                                   ims,ime, jms,jme, kms,kme,               &
  18                                   its,ite, jts,jte, kts,kte
  19    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_moist ),                &
  20          INTENT(IN ) ::                                   moist
  21    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),                 &
  22          INTENT(INOUT ) ::                                   chem
  23    REAL, DIMENSION( ims:ime, 1, jms:jme,num_emis_seas),&
  24          INTENT(INOUT ) ::                                                 &
  25          emis_seas
  26    REAL,  DIMENSION( ims:ime , jms:jme )                   ,               &
  27           INTENT(IN   ) ::                                                 &
  28                                                      u10,                  &
  29                                                      v10,                  &
  30                                                      gsw,                  &
  31                                                  vegfra,                  &
  32                                                      xland,                &
  33                                                      xlat,                 &
  34                                                      xlong
  35    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme ),                        &
  36           INTENT(IN   ) ::                                                 &
  37                                                         alt,               &
  38                                                       t_phy,               &
  39                                                      dz8w,p8w,             &
  40                                               u_phy,v_phy,rho_phy
  41
  42   REAL, INTENT(IN   ) :: dt,dx,g
  43 !
  44 ! local variables
  45 !
  46   integer :: nmx,i,j,k,ndt
  47   integer,dimension (1,1) :: ilwi
  48   real*8, DIMENSION (4) :: tc,bems
  49   real*8, dimension (1,1) :: w10m,gwet,airden,airmas
  50   real*8, dimension (1) :: dxy
  51 !
  52 ! number of dust bins
  53 !
  54   nmx=4
  55   k=kts
  56   do j=jts,jte
  57   do i=its,ite
  58 !
  59 ! don't do dust over water!!!
  60 !
  61      if(xland(i,j).gt.1.5)then
  62      ilwi(1,1)=1
  63      tc(1)=chem(i,kts,j,p_seas_1)
  64      tc(2)=chem(i,kts,j,p_seas_2)
  65      tc(3)=chem(i,kts,j,p_seas_3)
  66      tc(4)=chem(i,kts,j,p_seas_4)
  67      w10m(1,1)=sqrt(u10(i,j)*u10(i,j)+v10(i,j)*v10(i,j))
  68      airmas(1,1)=-(p8w(i,kts+1,j)-p8w(i,kts,j))*dx*dx/g
  69 !
  70 ! we don't trust the u10,v10 values, is model layers are very thin near surface
  71 !
  72      if(dz8w(i,kts,j).lt.12.)w10m=sqrt(u_phy(i,kts,j)*u_phy(i,kts,j)+v_phy(i,kts,j)*v_phy(i,kts,j))
  73 !
  74      dxy(1)=dx*dx
  75     call source_ss( nmx, dt, tc,ilwi, dxy, w10m, airmas, bems)
  76      chem(i,kts,j,p_seas_1)=tc(1)
  77      chem(i,kts,j,p_seas_2)=tc(2)
  78      chem(i,kts,j,p_seas_3)=tc(3)
  79      chem(i,kts,j,p_seas_4)=tc(4)
  80 ! for output diagnostics
  81      emis_seas(i,1,j,p_edust1)=bems(1)
  82      emis_seas(i,1,j,p_edust2)=bems(2)
  83      emis_seas(i,1,j,p_edust3)=bems(3)
  84      emis_seas(i,1,j,p_edust4)=bems(4)
  85      endif
  86   enddo
  87   enddo
  88 !
  89
  90 end subroutine gocart_seasalt_driver
  91 !
  92 SUBROUTINE source_ss(nmx, dt1, tc, &
  93                      ilwi, dxy, w10m, airmas, &
  94                      bems)
  95
  96 ! ****************************************************************************
  97 ! *  Evaluate the source of each seasalt particles size classes  (kg/m3)
  98 ! *  by soil emission.
  99 ! *  Input:
 100 ! *         SSALTDEN  Sea salt density                               (kg/m3)
 101 ! *         DXY       Surface of each grid cell                     (m2)
 102 ! *         NDT1      Time step                                     (s)
 103 ! *         W10m      Velocity at the anemometer level (10meters)   (m/s)
 104 ! *
 105 ! *  Output:
 106 ! *         DSRC      Source of each sea salt bins       (kg/timestep/cell)
 107 ! *
 108 ! *
 109 ! * Number flux density: Original formula by Monahan et al. (1986) adapted
 110 ! * by Sunling Gong (JGR 1997 (old) and GBC 2003 (new)).  The new version is
 111 ! * to better represent emission of sub-micron sea salt particles.
 112 !
 113 ! * dFn/dr = c1*u10**c2/(r**A) * (1+c3*r**c4)*10**(c5*exp(-B**2))
 114 ! * where B = (b1 -log(r))/b2
 115 ! * see c_old, c_new, b_old, b_new below for the constants.
 116 ! * number fluxes are at 80% RH.
 117 ! *
 118 ! * To calculate the flux:
 119 ! * 1) Calculate dFn based on Monahan et al. (1986) and Gong (2003)
 120 ! * 2) Assume that wet radius r at 80% RH = dry radius r_d *frh
 121 ! * 3) Convert particles flux to mass flux :
 122 ! *    dFM/dr_d = 4/3*pi*rho_d*r_d^3 *(dr/dr_d) * dFn/dr
 123 ! *             = 4/3*pi*rho_d*r_d^3 * frh * dFn/dr
 124 ! *               where rho_p is particle density [kg/m3]
 125 ! *    The factor 1.e-18 is to convert in micro-meter r_d^3
 126 ! ****************************************************************************
 127
 128
 129   USE module_data_gocart
 130
 131   IMPLICIT NONE
 132
 133   INTEGER, INTENT(IN)    :: nmx
 134   INTEGER, INTENT(IN)    :: ilwi(imx,jmx)
 135   REAL*8,    INTENT(IN)    :: dxy(jmx), w10m(imx,jmx)
 136   REAL*8,    INTENT(IN)    :: airmas(imx,jmx,lmx)
 137   REAL*8,    INTENT(INOUT) :: tc(imx,jmx,lmx,nmx)
 138   REAL*8,    INTENT(OUT)   :: bems(imx,jmx,nmx)
 139
 140   REAL*8 :: c0(5), b0(2)
 141 !  REAL*8, PARAMETER :: c_old(5)=(/1.373, 3.41, 0.057, 1.05, 1.190/)
 142 !  REAL*8, PARAMETER :: c_new(5)=(/1.373, 3.41, 0.057, 3.45, 1.607/)
 143   ! Change suggested by MC
 144   REAL*8, PARAMETER :: c_old(5)=(/1.373, 3.2, 0.057, 1.05, 1.190/)
 145   REAL*8, PARAMETER :: c_new(5)=(/1.373, 3.2, 0.057, 3.45, 1.607/)
 146   REAL*8, PARAMETER :: b_old(2)=(/0.380, 0.650/)
 147   REAL*8, PARAMETER :: b_new(2)=(/0.433, 0.433/)
 148   REAL*8, PARAMETER :: dr=5.0E-2 ! um
 149   REAL*8, PARAMETER :: theta=30.0
 150   ! Swelling coefficient frh (d rwet / d rd)
 151 !!!  REAL*8,    PARAMETER :: frh = 1.65
 152   REAL*8,    PARAMETER :: frh = 2.0
 153   LOGICAL, PARAMETER :: old=.TRUE., new=.FALSE.
 154   REAL*8 :: rho_d, r0, r1, r, r_w, a, b, dfn, r_d, dfm, src
 155   INTEGER :: i, j, n, nr, ir
 156   REAL :: dt1
 157
 158
 159   REAL*8                  :: tcmw(nmx), ar(nmx), tcvv(nmx)
 160   REAL*8                  :: ar_wetdep(nmx), kc(nmx)
 161   CHARACTER(LEN=20)     :: tcname(nmx), tcunits(nmx)
 162   LOGICAL               :: aerosol(nmx)
 163
 164
 165   REAL*8 :: tc1(imx,jmx,lmx,nmx)
 166   REAL*8, TARGET :: tcms(imx,jmx,lmx,nmx) ! tracer mass (kg; kgS for sulfur case)
 167   REAL*8, TARGET :: tcgm(imx,jmx,lmx,nmx) ! g/m3
 168
 169   !-----------------------------------------------------------------------
 170   ! sea salt specific
 171   !-----------------------------------------------------------------------
 172   REAL*8, DIMENSION(nmx) :: ssaltden, ssaltreff, ra, rb
 173   REAL*8 :: ch_ss(nmx,12)
 174
 175   !-----------------------------------------------------------------------
 176   ! emissions (input)
 177   !-----------------------------------------------------------------------
 178   REAL*8 :: e_an(imx,jmx,2,nmx), e_bb(imx,jmx,nmx), &
 179           e_ac(imx,jmx,lmx,nmx)
 180
 181   !-----------------------------------------------------------------------
 182   ! diagnostics (budget)
 183   !-----------------------------------------------------------------------
 184 !  ! tendencies per time step and process
 185 !  REAL*8, TARGET :: bems(imx,jmx,nmx), bdry(imx,jmx,nmx), bstl(imx,jmx,nmx)
 186 !  REAL*8, TARGET :: bwet(imx,jmx,nmx), bcnv(imx,jmx,nmx)!
 187
 188 !  ! integrated tendencies per process
 189 !  REAL*8, TARGET :: tems(imx,jmx,nmx), tstl(imx,jmx,nmx)
 190 !  REAL*8, TARGET :: tdry(imx,jmx,nmx), twet(imx,jmx,nmx), tcnv(imx,jmx,nmx)
 191
 192   ! global mass balance per time step
 193   REAL*8 :: tmas0(nmx), tmas1(nmx)
 194   REAL*8 :: dtems(nmx), dttrp(nmx), dtdif(nmx), dtcnv(nmx)
 195   REAL*8 :: dtwet(nmx), dtdry(nmx), dtstl(nmx)
 196   REAL*8 :: dtems2(nmx), dttrp2(nmx), dtdif2(nmx), dtcnv2(nmx)
 197   REAL*8 :: dtwet2(nmx), dtdry2(nmx), dtstl2(nmx)
 198
 199   ! detailed integrated budgets for individual emissions
 200   REAL*8, TARGET :: ems_an(imx,jmx,nmx),    ems_bb(imx,jmx,nmx), ems_tp(imx,jmx)
 201   REAL*8, TARGET :: ems_ac(imx,jmx,lmx,nmx)
 202   REAL*8, TARGET :: ems_co(imx,jmx,nmx)
 203
 204
 205   ! executable statements
 206
 207   DO n = 1,nmx
 208      bems(:,:,n) = 0.0
 209      rho_d = ssaltden(n)
 210      r0 = ra(n)*frh
 211      r1 = rb(n)*frh
 212      r = r0
 213      nr = INT((r1-r0)/dr)
 214      DO ir = 1,nr
 215         r_w = r + dr*0.5
 216         r = r + dr
 217         IF (new) THEN
 218            a = 4.7*(1.0 + theta*r_w)**(-0.017*r_w**(-1.44))
 219            c0 = c_new
 220            b0 = b_new
 221         ELSE
 222            a = 3.0
 223            c0 = c_old
 224            b0 = b_old
 225         END IF
 226         !
 227         b = (b0(1) - LOG10(r_w))/b0(2)
 228         dfn = (c0(1)/r_w**a)*(1.0 + c0(3)*r_w**c0(4))* &
 229              10**(c0(5)*EXP(-(b**2)))
 230
 231         r_d = r_w/frh*1.0E-6  ! um -> m
 232         dfm = 4.0/3.0*pi*r_d**3*rho_d*frh*dfn*dr*dt1
 233         DO i = 1,imx
 234            DO j = 1,jmx
 235 !              IF (water(i,j) > 0.0) THEN
 236               IF (ilwi(i,j) == 0) THEN
 237 !                 src = dfm*dxy(j)*water(i,j)*w10m(i,j)**c0(2)
 238                  src = dfm*dxy(j)*w10m(i,j)**c0(2)
 239 !                 src = ch_ss(n,dt(1)%mn)*dfm*dxy(j)*w10m(i,j)**c0(2)
 240                  tc(i,j,1,n) = tc(i,j,1,n) + src/airmas(i,j,1)
 241               ELSE
 242                  src = 0.0
 243               END IF
 244               bems(i,j,n) = bems(i,j,n) + src
 245            END DO  ! i
 246         END DO ! j
 247      END DO ! ir
 248   END DO ! n
 249
 250 END SUBROUTINE source_ss
 251 END MODULE SEA_SALT_EMIS