source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/sediment_mod.F @ 2217

Last change on this file since 2217 was 2217, checked in by jescribano, 10 years ago

Bugs corrections. Included a correction/tunning factor for the Chimere-dust emissions, Constant of MB95 equal to 2.61 as in MB95. No spurious increase of u* before horizontal flux calculations in the dust emission scheme. Values of AG00 binding energies fixed as the original AG00 divided by 3 as is Sow et al 2011 ACPD.

File size: 8.8 KB
Line 
1c----- This subroutine calculates the sedimentation flux of Tracers
2c
3      SUBROUTINE sediment_mod(t_seri,pplay,zrho,paprs,time_step,RHcl,
4     .                                       id_coss,id_codu,id_scdu,
5     .                                        ok_chimeredust,
6     .                           sed_ss,sed_dust,sed_dustsco,tr_seri)
7cnhl     .                                       xlon,xlat,
8c
9       USE dimphy
10       USE infotrac
11      IMPLICIT NONE
12c
13#include "dimensions.h"
14#include "chem.h"
15c #include "dimphy.h"
16#include "YOMCST.h"
17#include "YOECUMF.h"
18c
19       REAL RHcl(klon,klev)     ! humidite relative ciel clair
20       REAL tr_seri(klon, klev,nbtr) !conc of tracers
21       REAL sed_ss(klon) !sedimentation flux of Sea Salt (g/m2/s)
22       REAL sed_dust(klon) !sedimentation flux of dust (g/m2/s)
23       REAL sed_dustsco(klon) !sedimentation flux of scoarse  dust (g/m2/s)
24       REAL t_seri(klon, klev)   !Temperature at mid points of Z (K)
25       REAL v_dep_ss(klon,klev)  ! sed. velocity for SS m/s
26       REAL v_dep_dust(klon,klev)  ! sed. velocity for dust m/s
27       REAL v_dep_dustsco(klon,klev)  ! sed. velocity for dust m/s
28       REAL pplay(klon, klev)    !pressure at mid points of Z (Pa)
29       REAL zrho(klon, klev)     !Density of air at mid points of Z (kg/m3)
30       REAL paprs(klon, klev+1)    !pressure at interface of layers Z (Pa)
31       REAL time_step            !time step (sec)
32       LOGICAL ok_chimeredust
33       REAL xlat(klon)       ! latitudes pour chaque point
34       REAL xlon(klon)       ! longitudes pour chaque point
35       INTEGER id_coss,id_codu,id_scdu
36c
37c------local variables
38c
39       INTEGER i, k, nbre_RH
40       PARAMETER(nbre_RH=12)
41c
42       REAL lambda, ss_g           
43       REAL mmd_ss      !mass median diameter of SS (um)
44       REAL mmd_dust          !mass median diameter of dust (um)
45       REAL mmd_dustsco          !mass median diameter of scoarse dust (um)
46       REAL rho_ss(nbre_RH),rho_ss1 !density of sea salt (kg/m3)
47       REAL rho_dust          !density of dust(kg/m3)
48       REAL v_stokes, CC, v_sed, ss_growth_f(nbre_RH)
49       REAL sed_flux(klon,klev)  ! sedimentation flux g/m2/s
50       REAL air_visco(klon,klev)
51       REAL zdz(klon,klev)       ! layers height (m)
52       REAL temp                 ! temperature in degree Celius
53c
54       INTEGER RH_num
55       REAL RH_MAX, DELTA, rh, RH_tab(nbre_RH)
56       PARAMETER (RH_MAX=95.)
57c
58       DATA RH_tab/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./
59c
60c
61       DATA rho_ss/2160. ,2160. ,2160.,  2160,  1451.6, 1367.9,
62     .             1302.9,1243.2,1182.7, 1149.5,1111.6, 1063.1/
63c
64       DATA ss_growth_f/0.503, 0.503, 0.503, 0.503, 0.724, 0.782,
65     .                  0.838, 0.905, 1.000, 1.072, 1.188, 1.447/
66c
67c
68       mmd_ss=12.7   !dia -um at 80% for bin 0.5-20 um but 90% of real mmd
69!               obsolete      mmd_dust=2.8  !micrometer for bin 0.5-20 and 0.5-10 um
70! 4tracer SPLA:       mmd_dust=11.0  !micrometer for bin 0.5-20 and 0.5-10 um
71!3days       mmd_dust=3.333464  !micrometer for bin 0.5-20 and 0.5-10 um
72!3days       mmd_dustsco=12.91315  !micrometer for bin 0.5-20 and 0.5-10 um
73!JE20140911       mmd_dust=3.002283  !micrometer for bin 0.5-20 and 0.5-10 um
74!JE20140911       mmd_dustsco=13.09771  !micrometer for bin 0.5-20 and 0.5-10 um
75!JE20140911        mmd_dust=5.156346  !micrometer for bin 0.5-20 and 0.5-10 um
76!JE20140911        mmd_dustsco=15.56554  !micrometer for bin 0.5-20 and 0.5-10 um
77        IF (ok_chimeredust) THEN
78!JE20150212<< : changes in ustar in dustmod changes emission distribution
79!        mmd_dust=3.761212  !micrometer for bin 0.5-3 and 0.5-10 um
80!        mmd_dustsco=15.06167  !micrometer for bin 3-20 and 0.5-10 um
81!JE20150212>>
82        mmd_dust=3.983763
83        mmd_dustsco=15.10854
84        ELSE
85        mmd_dust=11.0  !micrometer for bin 0.5-20 and 0.5-10 um
86        mmd_dustsco=100. ! absurd value, bin not used in this scheme
87        ENDIF
88
89
90       rho_dust=2600. !kg/m3
91c
92c--------- Air viscosity (poise=0.1 kg/m-sec)-----------
93c
94       DO k=1, klev
95       DO i=1, klon
96c
97       zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG
98c
99       temp=t_seri(i,k)-RTT
100c
101       IF (temp.LT.0.) THEN
102         air_visco(i,k)=(1.718+0.0049*temp-1.2e-5*temp*temp)*1.e-4
103       ELSE
104         air_visco(i,k)=(1.718+0.0049*temp)*1.e-4
105       ENDIF
106c
107       ENDDO
108       ENDDO
109c
110c--------- for Sea Salt -------------------
111c
112c
113c
114       IF(id_coss>0) THEN
115       DO k=1, klev
116       DO i=1,klon
117c
118c---cal. correction factor hygroscopic growth of aerosols
119c
120        rh=MIN(RHcl(i,k)*100.,RH_MAX)
121        RH_num = INT( rh/10. + 1.)
122        IF (rh.gt.85.) RH_num=10
123        IF (rh.gt.90.) RH_num=11
124        DELTA=(rh-RH_tab(RH_num))/(RH_tab(RH_num+1)-RH_tab(RH_num))
125c
126        ss_g=ss_growth_f(rh_num) +
127     .       DELTA*(ss_growth_f(RH_num+1)-ss_growth_f(RH_num))
128
129        rho_ss1=rho_ss(rh_num) +
130     .       DELTA*(rho_ss(RH_num+1)-rho_ss(RH_num))             
131c
132        v_stokes=RG*(rho_ss1-zrho(i,k))*      !m/sec
133     .           (mmd_ss*ss_g)*(mmd_ss*ss_g)*
134     .           1.e-12/(18.0*air_visco(i,k)/10.)
135c
136       lambda=6.6*1.e-8*(103125/pplay(i,k))*(t_seri(i,k)/293.15)
137c
138       CC=1.0+1.257*lambda/(mmd_ss*ss_g)/1.e6  ! C-correction factor
139c
140       v_sed=v_stokes*CC                       ! m/sec !orig
141c
142c---------check for v_sed*dt<zdz
143c
144       IF (v_sed*time_step.GT.zdz(i,k)) THEN
145         v_sed=zdz(i,k)/time_step     
146       ENDIF
147c
148       v_dep_ss(i,k)=v_sed
149       sed_flux(i,k)=tr_seri(i,k,id_coss)*v_sed !g/cm3.m/sec
150c
151       ENDDO          !klon
152       ENDDO          !klev
153c
154       DO k=1, klev
155       DO i=1, klon
156       tr_seri(i,k,id_coss)=tr_seri(i,k,id_coss)-
157     .        sed_flux(i,k)*time_step/zdz(i,k) !orig
158       ENDDO          !klon
159       ENDDO          !klev
160c
161       DO k=1, klev-1
162       DO i=1, klon
163        tr_seri(i,k,id_coss)=tr_seri(i,k,id_coss) +                   !orig
164     .                  sed_flux(i,k+1)*time_step/zdz(i,k)            !orig
165       ENDDO          !klon
166       ENDDO          !klev
167c
168       DO i=1, klon
169         sed_ss(i)=sed_flux(i,1)*1.e6*1.e3    !--unit mg/m2/s
170       ENDDO          !klon
171       ELSE
172        DO i=1, klon
173          sed_ss(i)=0.
174        ENDDO
175       ENDIF
176c
177c
178
179c--------- For dust ------------------
180c
181c
182       IF(id_codu>0) THEN
183       DO k=1, klev
184       DO i=1,klon
185c
186        v_stokes=RG*(rho_dust-zrho(i,k))*      !m/sec
187     .           mmd_dust*mmd_dust*
188     .           1.e-12/(18.0*air_visco(i,k)/10.)
189c
190       lambda=6.6*1.e-8*(103125/pplay(i,k))*(t_seri(i,k)/293.15)
191       CC=1.0+1.257*lambda/(mmd_dust)/1.e6        !dimensionless
192       v_sed=v_stokes*CC                       !m/sec
193c
194c---------check for v_sed*dt<zdz
195c
196       IF (v_sed*time_step.GT.zdz(i,k)) THEN
197         v_sed=zdz(i,k)/time_step     
198       ENDIF
199
200c
201       v_dep_dust(i,k)=v_sed
202       sed_flux(i,k)=tr_seri(i,k,id_codu)*v_sed !g/cm3.m/sec
203c
204       ENDDO          !klon
205       ENDDO          !klev
206c
207       DO k=1, klev
208       DO i=1, klon
209       tr_seri(i,k,id_codu)=tr_seri(i,k,id_codu)-
210     .                  sed_flux(i,k)*time_step/zdz(i,k)
211       ENDDO          !klon
212       ENDDO          !klev
213c
214       DO k=1, klev-1
215       DO i=1, klon
216        tr_seri(i,k,id_codu)=tr_seri(i,k,id_codu) +
217     .                  sed_flux(i,k+1)*time_step/zdz(i,k)
218       ENDDO          !klon
219       ENDDO          !klev
220c
221       DO i=1, klon
222         sed_dust(i)=sed_flux(i,1)*1.e6*1.e3    !--unit mg/m2/s
223       ENDDO          !klon
224       ELSE
225        DO i=1, klon
226          sed_dust(i)=0.
227        ENDDO
228       ENDIF
229c
230
231
232c--------- For scoarse  dust ------------------
233c
234c
235       IF(id_scdu>0) THEN
236       DO k=1, klev
237       DO i=1,klon
238c
239        v_stokes=RG*(rho_dust-zrho(i,k))*      !m/sec
240     .           mmd_dustsco*mmd_dustsco*
241     .           1.e-12/(18.0*air_visco(i,k)/10.)
242c
243       lambda=6.6*1.e-8*(103125/pplay(i,k))*(t_seri(i,k)/293.15)
244       CC=1.0+1.257*lambda/(mmd_dustsco)/1.e6        !dimensionless
245       v_sed=v_stokes*CC                       !m/sec
246c
247c---------check for v_sed*dt<zdz
248
249
250       IF (v_sed*time_step.GT.zdz(i,k)) THEN
251         v_sed=zdz(i,k)/time_step
252       ENDIF
253
254c
255       v_dep_dustsco(i,k)=v_sed
256       sed_flux(i,k)=tr_seri(i,k,id_scdu)*v_sed !g/cm3.m/sec
257c
258       ENDDO          !klon
259       ENDDO          !klev
260c
261       DO k=1, klev
262       DO i=1, klon
263       tr_seri(i,k,id_scdu)=tr_seri(i,k,id_scdu)-
264     .                  sed_flux(i,k)*time_step/zdz(i,k)
265       ENDDO          !klon
266       ENDDO          !klev
267c
268       DO k=1, klev-1
269       DO i=1, klon
270        tr_seri(i,k,id_scdu)=tr_seri(i,k,id_scdu) +
271     .                  sed_flux(i,k+1)*time_step/zdz(i,k)
272       ENDDO          !klon
273       ENDDO          !klev
274c
275       DO i=1, klon
276         sed_dustsco(i)=sed_flux(i,1)*1.e6*1.e3    !--unit mg/m2/s
277       ENDDO          !klon
278       ELSE
279        DO i=1, klon
280          sed_dustsco(i)=0.
281        ENDDO
282       ENDIF
283c
284
285
286
287
288c
289       RETURN
290       END
Note: See TracBrowser for help on using the repository browser.