PageRenderTime 57ms CodeModel.GetById 29ms RepoModel.GetById 0ms app.codeStats 0ms

/wrfv2_fire/phys/module_gocart_seasalt.F

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