chem/module_gocart_dmsemis.F

   1 module module_dms_emis
   2   USE module_data_gocartchem
   3 contains
   4
   5         subroutine gocart_dmsemis(dt,config_flags,alt,t_phy,u_phy,  &
   6          v_phy,chem,rho_phy,dz8w,u10,v10,p8w,dms_0,tsk,                  &
   7          ivgtyp,isltyp,xland,dx,g, &
   8          ids,ide, jds,jde, kds,kde,                                        &
   9          ims,ime, jms,jme, kms,kme,                                        &
  10          its,ite, jts,jte, kts,kte                                         )
  11   USE module_configure
  12   USE module_state_description
  13   USE module_model_constants, only : mwdry
  14   IMPLICIT NONE
  15    TYPE(grid_config_rec_type),  INTENT(IN   )    :: config_flags
  16
  17    INTEGER,      INTENT(IN   ) :: ids,ide, jds,jde, kds,kde,               &
  18                                   ims,ime, jms,jme, kms,kme,               &
  19                                   its,ite, jts,jte, kts,kte
  20
  21    REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ),                 &
  22          INTENT(INOUT ) ::                                   chem
  23    REAL, DIMENSION( ims:ime, jms:jme),                                     &
  24          INTENT(IN ) ::    dms_0,tsk
  25    REAL,  DIMENSION( ims:ime , kms:kme , jms:jme )         ,               &
  26           INTENT(IN   ) ::                              alt,               &
  27                                                       t_phy,               &
  28                                                       dz8w,                &
  29                                               p8w,u_phy,v_phy,rho_phy
  30    INTEGER,DIMENSION( ims:ime , jms:jme )                  ,               &
  31           INTENT(IN   ) ::                                                 &
  32                                                      ivgtyp,               &
  33                                                      isltyp
  34    REAL,  DIMENSION( ims:ime , jms:jme )                   ,               &
  35           INTENT(IN   ) ::                                                 &
  36                                                      u10,                  &
  37                                                      v10,                  &
  38                                                      xland
  39    real, intent(in) :: dx,g,dt
  40
  41 !
  42 ! local variables
  43 !
  44   integer :: i,j,k,ndt,imx,jmx,lmx,nmx
  45   integer,dimension (1,1) :: ilwi
  46   real*8, DIMENSION (1,1,1,1) :: tc
  47   real*8, DIMENSION (1,1,1) :: bems,airmas
  48   real*8, DIMENSION (1,1) :: emsdms
  49   real*8, dimension (1,1) :: w10m,gwet,airden,tskin,dmso
  50   real*8, dimension (1) :: dxy
  51 !
  52 ! number of dust bins
  53 !
  54   imx=1
  55   jmx=1
  56   lmx=1
  57   nmx=1
  58   k=kts
  59   ndt=ifix(dt)
  60   do j=jts,jte
  61   do i=its,ite
  62 !
  63 ! don't do this over land
  64 !
  65      if(xland(i,j).gt.1.5)then
  66      ilwi(1,1)=0
  67
  68     tc(1,1,1,1)=chem(i,kts,j,p_dms)*1.d-6
  69     dmso(1,1)=dms_0(i,j)
  70      w10m(1,1)=sqrt(u10(i,j)*u10(i,j)+v10(i,j)*v10(i,j))
  71   !---bug fixing: modified by Qing.Yang@pnl.gov to delete a 0.01 factor -Aug,2010--
  72      airmas(1,1,1)=-1.0*(p8w(i,kts+1,j)-p8w(i,kts,j))*dx*dx/g
  73      dxy(1)=dx*dx
  74      tskin(1,1)=tsk(i,j)
  75 !
  76 ! we don't trust the u10,v10 values, is model layers are very thin near surface
  77 !
  78      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))
  79
  80     call  srcdms(imx, jmx, lmx, nmx, ndt, tc, mwdry,&
  81                   tskin, ilwi, dmso, w10m, airmas, dxy, emsdms, bems)
  82     chem(i,kts,j,p_dms)=tc(1,1,1,1)*1.e6
  83   endif
  84   enddo
  85   enddo
  86 !
  87 end subroutine gocart_dmsemis
  88
  89 SUBROUTINE srcdms(imx, jmx, lmx, nmx, ndt1, tc,airmw, &
  90                   tskin, ilwi, dmso, w10m, airmas, dxy, emsdms, bems)
  91
  92   ! **************************************************************************
  93   ! **                                                                      **
  94   ! **  This subroutine calculates DMS emissions from the ocean.            **
  95   ! **                                                                      **
  96   ! **************************************************************************
  97
  98
  99   IMPLICIT NONE
 100   REAL,    PARAMETER :: dms_mw = 62.00
 101   REAL,    PARAMETER :: tcmw(1)=dms_mw
 102   INTEGER, INTENT(IN)    :: imx, jmx, lmx, nmx, ndt1
 103   REAL*8,    INTENT(IN)    :: tskin(imx,jmx), dmso(imx,jmx)
 104   INTEGER, INTENT(IN)    :: ilwi(imx,jmx)
 105   REAL*8,    INTENT(IN)    :: dxy(jmx), w10m(imx,jmx)
 106   REAL,      INTENT(IN)    :: airmw
 107   REAL*8,    INTENT(IN)    :: airmas(imx,jmx,lmx)
 108   REAL*8,    INTENT(INOUT) :: tc(imx,jmx,lmx,nmx)
 109   REAL*8,    INTENT(INOUT) :: emsdms(imx,jmx)
 110   REAL*8,    INTENT(OUT)   :: bems(imx,jmx,nmx)
 111
 112   INTEGER :: i,j
 113   REAL*8    :: sst, sc, conc, w10, scco2, akw, erate, dmssrc, c
 114
 115   ! **************************************************************************
 116   ! *  ilwi = 0: water                                                      **
 117   ! *  If ilwi = 0: DMSEMS = seawaterDMS * transfer velocity.               **
 118   ! *  Otherwise,  DMSEMS = 0.0                                             **
 119   ! **************************************************************************
 120
 121   ! executable statements
 122 ! tcmw(NDMS) = dms_mw
 123   lat_loop: DO j = 1,jmx
 124      lon_loop: DO i = 1,imx
 125         ! convert tskin (=sst over water) from K to degC
 126         sst = tskin(i,j) - 273.15
 127         if_water: IF (ilwi(i,j) == 0) THEN
 128
 129            ! -- Schmidt number for DMS (Saltzman et al., 1993)
 130            sc = 2674.0 - 147.12*sst + 3.726*(sst**2) - 0.038*(sst**3)
 131
 132 ! ****************************************************************************
 133 ! *  Calculate transfer velocity in cm/hr  (AKw)                             *
 134 ! *                                                                          *
 135 ! *  Tans et al. transfer velocity (1990) for CO2 at 25oC (Erickson, 1993)   *
 136 ! *                                                                          *
 137 ! *  Tans et al. assumed AKW=0 when W10<=3. I modified it to let             *
 138 ! *  DMS emit at low windseeds too. Chose 3.6m/s as the threshold.           *
 139 ! *                                                                          *
 140 ! *  Schmidt number for CO2:       Sc = 600  (20oC, fresh water)             *
 141 ! *                                Sc = 660  (20oC, seawater)                *
 142 ! *                                Sc = 428  (25oC, Erickson 93)             *
 143 ! ****************************************************************************
 144
 145            conc = dmso(i,j)
 146
 147            w10  = w10m(i,j)
 148 !           ! --- GEOS-1 or GEOS-STRAT: using SSMI winds
 149 !           IF (lmx <= 26) w10 = wssmi(i,j)
 150
 151 ! ---  Tans et al. (1990) -----------------
 152 !       ScCO2 = 428.
 153 !       if (W10 .le. 3.6) then
 154 !        AKw = 1.0667 * W10
 155 !       else
 156 !        AKw = 6.4 * (W10 - 3.)
 157 !       end if
 158
 159 ! ---  Wanninkhof (1992) ------------------
 160 !       ScCO2 = 660.
 161 !       AKw = 0.31 * W10**2
 162
 163            ! ---  Liss and Merlivat (1986) -----------
 164            scco2 = 600.0
 165            IF (w10 <= 3.6) THEN
 166               akw = 0.17 * w10
 167            ELSE IF (w10 <= 13.0) THEN
 168               akw = 2.85 * w10 - 9.65
 169            ELSE
 170               akw = 5.90 * w10 - 49.3
 171            END IF
 172            ! ------------------------------------------
 173
 174            IF (w10 <= 3.6) THEN
 175               akw = akw * ((scco2/sc) ** 0.667)
 176            ELSE
 177               akw = akw * SQRT(scco2/sc)
 178            END IF
 179
 180 ! ****************************************************************************
 181 ! *  Calculate emission flux in kg/box/timestep                              *
 182 ! *                                                                          *
 183 ! *   AKw is in cm/hr:                 AKw/100/3600    -> m/sec              *
 184 ! *   CONC is in nmol/L (nmol/dm3):    CONC*1E-12*1000 -> kmol/m3            *
 185 ! *   TCMW(NDMS)       : kgDMS/kmol                                          *
 186 ! *   ERATE            : kgDMS/m2/timestep                                   *
 187 ! *   DMSSRC           : kgDMS/box/timestep                                  *
 188 ! ****************************************************************************
 189
 190            erate  = akw/100.0/3600.0*conc*1.0E-12*1000.0*REAL(ndt1)*tcmw(NDMS)
 191            dmssrc = erate * dxy(j)
 192
 193         ELSE   ! ilwi /= 0 (water)
 194
 195            dmssrc = 0.0
 196
 197         END IF if_water
 198
 199 ! ****************************************************************************
 200 ! *  Update DMS concentration in level 1 (where emission occurs)             *
 201 ! ****************************************************************************
 202
 203         ! -- Convert emission from kg/box/timestep to mixing ratio/timestep:
 204         c = dmssrc / airmas(i,j,1) * airmw / tcmw(NDMS)
 205         tc(i,j,1,NDMS) = tc(i,j,1,NDMS) + c
 206
 207         !    ---------------------------------------------------------------
 208         !     Diagnostics:      DMS surface emission in kgS/timestep
 209         !    ---------------------------------------------------------------
 210         emsdms(i,j) = emsdms(i,j) + dmssrc * smw / tcmw(NDMS) ! kgS
 211 !        bems(i,j,NDMS) = c * airmas(i,j,1) / airmw * smw ! kgS
 212         bems(i,j,NDMS) = dmssrc  ! kgDMS
 213
 214      END DO lon_loop
 215   END DO lat_loop
 216
 217 END SUBROUTINE srcdms
 218
 219 END module module_dms_emis