module module_dms_emis
USE module_data_gocartchem
contains
subroutine gocart_dmsemis(dt,config_flags,alt,t_phy,u_phy, &
v_phy,chem,rho_phy,dz8w,u10,v10,p8w,dms_0,tsk, &
ivgtyp,isltyp,xland,dx,g, &
ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte )
USE module_configure
USE module_state_description
USE module_model_constants, only : mwdry
IMPLICIT NONE
TYPE(grid_config_rec_type), INTENT(IN ) :: config_flags
INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, &
ims,ime, jms,jme, kms,kme, &
its,ite, jts,jte, kts,kte
REAL, DIMENSION( ims:ime, kms:kme, jms:jme, num_chem ), &
INTENT(INOUT ) :: chem
REAL, DIMENSION( ims:ime, jms:jme), &
INTENT(IN ) :: dms_0,tsk
REAL, DIMENSION( ims:ime , kms:kme , jms:jme ) , &
INTENT(IN ) :: alt, &
t_phy, &
dz8w, &
p8w,u_phy,v_phy,rho_phy
INTEGER,DIMENSION( ims:ime , jms:jme ) , &
INTENT(IN ) :: &
ivgtyp, &
isltyp
REAL, DIMENSION( ims:ime , jms:jme ) , &
INTENT(IN ) :: &
u10, &
v10, &
xland
real, intent(in) :: dx,g,dt
!
! local variables
!
integer :: i,j,k,ndt,imx,jmx,lmx,nmx
integer,dimension (1,1) :: ilwi
real*8, DIMENSION (1,1,1,1) :: tc
real*8, DIMENSION (1,1,1) :: bems,airmas
real*8, DIMENSION (1,1) :: emsdms
real*8, dimension (1,1) :: w10m,gwet,airden,tskin,dmso
real*8, dimension (1) :: dxy
!
! number of dust bins
!
imx=1
jmx=1
lmx=1
nmx=1
k=kts
ndt=ifix(dt)
do j=jts,jte
do i=its,ite
!
! don't do this over land
!
if(xland(i,j).gt.1.5)then
ilwi(1,1)=0
tc(1,1,1,1)=chem(i,kts,j,p_dms)*1.d-6
dmso(1,1)=dms_0(i,j)
w10m(1,1)=sqrt(u10(i,j)*u10(i,j)+v10(i,j)*v10(i,j))
!---bug fixing: modified by Qing.Yang@pnl.gov to delete a 0.01 factor -Aug,2010--
airmas(1,1,1)=-1.0*(p8w(i,kts+1,j)-p8w(i,kts,j))*dx*dx/g
dxy(1)=dx*dx
tskin(1,1)=tsk(i,j)
!
! we don't trust the u10,v10 values, is model layers are very thin near surface
!
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))
call srcdms(imx, jmx, lmx, nmx, ndt, tc, mwdry,&
tskin, ilwi, dmso, w10m, airmas, dxy, emsdms, bems)
chem(i,kts,j,p_dms)=tc(1,1,1,1)*1.e6
endif
enddo
enddo
!
end subroutine gocart_dmsemis
SUBROUTINE srcdms(imx, jmx, lmx, nmx, ndt1, tc,airmw, &
tskin, ilwi, dmso, w10m, airmas, dxy, emsdms, bems)
! **************************************************************************
! ** **
! ** This subroutine calculates DMS emissions from the ocean. **
! ** **
! **************************************************************************
IMPLICIT NONE
REAL, PARAMETER :: dms_mw = 62.00
REAL, PARAMETER :: tcmw(1)=dms_mw
INTEGER, INTENT(IN) :: imx, jmx, lmx, nmx, ndt1
REAL*8, INTENT(IN) :: tskin(imx,jmx), dmso(imx,jmx)
INTEGER, INTENT(IN) :: ilwi(imx,jmx)
REAL*8, INTENT(IN) :: dxy(jmx), w10m(imx,jmx)
REAL, INTENT(IN) :: airmw
REAL*8, INTENT(IN) :: airmas(imx,jmx,lmx)
REAL*8, INTENT(INOUT) :: tc(imx,jmx,lmx,nmx)
REAL*8, INTENT(INOUT) :: emsdms(imx,jmx)
REAL*8, INTENT(OUT) :: bems(imx,jmx,nmx)
INTEGER :: i,j
REAL*8 :: sst, sc, conc, w10, scco2, akw, erate, dmssrc, c
! **************************************************************************
! * ilwi = 0: water **
! * If ilwi = 0: DMSEMS = seawaterDMS * transfer velocity. **
! * Otherwise, DMSEMS = 0.0 **
! **************************************************************************
! executable statements
! tcmw(NDMS) = dms_mw
lat_loop: DO j = 1,jmx
lon_loop: DO i = 1,imx
! convert tskin (=sst over water) from K to degC
sst = tskin(i,j) - 273.15
if_water: IF (ilwi(i,j) == 0) THEN
! -- Schmidt number for DMS (Saltzman et al., 1993)
sc = 2674.0 - 147.12*sst + 3.726*(sst**2) - 0.038*(sst**3)
! ****************************************************************************
! * Calculate transfer velocity in cm/hr (AKw) *
! * *
! * Tans et al. transfer velocity (1990) for CO2 at 25oC (Erickson, 1993) *
! * *
! * Tans et al. assumed AKW=0 when W10<=3. I modified it to let *
! * DMS emit at low windseeds too. Chose 3.6m/s as the threshold. *
! * *
! * Schmidt number for CO2: Sc = 600 (20oC, fresh water) *
! * Sc = 660 (20oC, seawater) *
! * Sc = 428 (25oC, Erickson 93) *
! ****************************************************************************
conc = dmso(i,j)
w10 = w10m(i,j)
! ! --- GEOS-1 or GEOS-STRAT: using SSMI winds
! IF (lmx <= 26) w10 = wssmi(i,j)
! --- Tans et al. (1990) -----------------
! ScCO2 = 428.
! if (W10 .le. 3.6) then
! AKw = 1.0667 * W10
! else
! AKw = 6.4 * (W10 - 3.)
! end if
! --- Wanninkhof (1992) ------------------
! ScCO2 = 660.
! AKw = 0.31 * W10**2
! --- Liss and Merlivat (1986) -----------
scco2 = 600.0
IF (w10 <= 3.6) THEN
akw = 0.17 * w10
ELSE IF (w10 <= 13.0) THEN
akw = 2.85 * w10 - 9.65
ELSE
akw = 5.90 * w10 - 49.3
END IF
! ------------------------------------------
IF (w10 <= 3.6) THEN
akw = akw * ((scco2/sc) ** 0.667)
ELSE
akw = akw * SQRT(scco2/sc)
END IF
! ****************************************************************************
! * Calculate emission flux in kg/box/timestep *
! * *
! * AKw is in cm/hr: AKw/100/3600 -> m/sec *
! * CONC is in nmol/L (nmol/dm3): CONC*1E-12*1000 -> kmol/m3 *
! * TCMW(NDMS) : kgDMS/kmol *
! * ERATE : kgDMS/m2/timestep *
! * DMSSRC : kgDMS/box/timestep *
! ****************************************************************************
erate = akw/100.0/3600.0*conc*1.0E-12*1000.0*REAL(ndt1)*tcmw(NDMS)
dmssrc = erate * dxy(j)
ELSE ! ilwi /= 0 (water)
dmssrc = 0.0
END IF if_water
! ****************************************************************************
! * Update DMS concentration in level 1 (where emission occurs) *
! ****************************************************************************
! -- Convert emission from kg/box/timestep to mixing ratio/timestep:
c = dmssrc / airmas(i,j,1) * airmw / tcmw(NDMS)
tc(i,j,1,NDMS) = tc(i,j,1,NDMS) + c
! ---------------------------------------------------------------
! Diagnostics: DMS surface emission in kgS/timestep
! ---------------------------------------------------------------
emsdms(i,j) = emsdms(i,j) + dmssrc * smw / tcmw(NDMS) ! kgS
! bems(i,j,NDMS) = c * airmas(i,j,1) / airmw * smw ! kgS
bems(i,j,NDMS) = dmssrc ! kgDMS
END DO lon_loop
END DO lat_loop
END SUBROUTINE srcdms
END module module_dms_emis