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

Last change on this file was 2304, checked in by jescribano, 9 years ago

Version for inversion. Optical and sedimentatino parameters corrected

File size: 8.9 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!JE20150618: Change in div3 of dustmod changes distribution. now is div3=6
83!div=3        mmd_dust=3.983763
84!div=3        mmd_dustsco=15.10854
85        mmd_dust=3.898047
86        mmd_dustsco=15.06167
87        ELSE
88        mmd_dust=11.0  !micrometer for bin 0.5-20 and 0.5-10 um
89        mmd_dustsco=100. ! absurd value, bin not used in this scheme
90        ENDIF
91
92
93       rho_dust=2600. !kg/m3
94c
95c--------- Air viscosity (poise=0.1 kg/m-sec)-----------
96c
97       DO k=1, klev
98       DO i=1, klon
99c
100       zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG
101c
102       temp=t_seri(i,k)-RTT
103c
104       IF (temp.LT.0.) THEN
105         air_visco(i,k)=(1.718+0.0049*temp-1.2e-5*temp*temp)*1.e-4
106       ELSE
107         air_visco(i,k)=(1.718+0.0049*temp)*1.e-4
108       ENDIF
109c
110       ENDDO
111       ENDDO
112c
113c--------- for Sea Salt -------------------
114c
115c
116c
117       IF(id_coss>0) THEN
118       DO k=1, klev
119       DO i=1,klon
120c
121c---cal. correction factor hygroscopic growth of aerosols
122c
123        rh=MIN(RHcl(i,k)*100.,RH_MAX)
124        RH_num = INT( rh/10. + 1.)
125        IF (rh.gt.85.) RH_num=10
126        IF (rh.gt.90.) RH_num=11
127        DELTA=(rh-RH_tab(RH_num))/(RH_tab(RH_num+1)-RH_tab(RH_num))
128c
129        ss_g=ss_growth_f(rh_num) +
130     .       DELTA*(ss_growth_f(RH_num+1)-ss_growth_f(RH_num))
131
132        rho_ss1=rho_ss(rh_num) +
133     .       DELTA*(rho_ss(RH_num+1)-rho_ss(RH_num))             
134c
135        v_stokes=RG*(rho_ss1-zrho(i,k))*      !m/sec
136     .           (mmd_ss*ss_g)*(mmd_ss*ss_g)*
137     .           1.e-12/(18.0*air_visco(i,k)/10.)
138c
139       lambda=6.6*1.e-8*(103125/pplay(i,k))*(t_seri(i,k)/293.15)
140c
141       CC=1.0+1.257*lambda/(mmd_ss*ss_g)/1.e6  ! C-correction factor
142c
143       v_sed=v_stokes*CC                       ! m/sec !orig
144c
145c---------check for v_sed*dt<zdz
146c
147       IF (v_sed*time_step.GT.zdz(i,k)) THEN
148         v_sed=zdz(i,k)/time_step     
149       ENDIF
150c
151       v_dep_ss(i,k)=v_sed
152       sed_flux(i,k)=tr_seri(i,k,id_coss)*v_sed !g/cm3.m/sec
153c
154       ENDDO          !klon
155       ENDDO          !klev
156c
157       DO k=1, klev
158       DO i=1, klon
159       tr_seri(i,k,id_coss)=tr_seri(i,k,id_coss)-
160     .        sed_flux(i,k)*time_step/zdz(i,k) !orig
161       ENDDO          !klon
162       ENDDO          !klev
163c
164       DO k=1, klev-1
165       DO i=1, klon
166        tr_seri(i,k,id_coss)=tr_seri(i,k,id_coss) +                   !orig
167     .                  sed_flux(i,k+1)*time_step/zdz(i,k)            !orig
168       ENDDO          !klon
169       ENDDO          !klev
170c
171       DO i=1, klon
172         sed_ss(i)=sed_flux(i,1)*1.e6*1.e3    !--unit mg/m2/s
173       ENDDO          !klon
174       ELSE
175        DO i=1, klon
176          sed_ss(i)=0.
177        ENDDO
178       ENDIF
179c
180c
181
182c--------- For dust ------------------
183c
184c
185       IF(id_codu>0) THEN
186       DO k=1, klev
187       DO i=1,klon
188c
189        v_stokes=RG*(rho_dust-zrho(i,k))*      !m/sec
190     .           mmd_dust*mmd_dust*
191     .           1.e-12/(18.0*air_visco(i,k)/10.)
192c
193       lambda=6.6*1.e-8*(103125/pplay(i,k))*(t_seri(i,k)/293.15)
194       CC=1.0+1.257*lambda/(mmd_dust)/1.e6        !dimensionless
195       v_sed=v_stokes*CC                       !m/sec
196c
197c---------check for v_sed*dt<zdz
198c
199       IF (v_sed*time_step.GT.zdz(i,k)) THEN
200         v_sed=zdz(i,k)/time_step     
201       ENDIF
202
203c
204       v_dep_dust(i,k)=v_sed
205       sed_flux(i,k)=tr_seri(i,k,id_codu)*v_sed !g/cm3.m/sec
206c
207       ENDDO          !klon
208       ENDDO          !klev
209c
210       DO k=1, klev
211       DO i=1, klon
212       tr_seri(i,k,id_codu)=tr_seri(i,k,id_codu)-
213     .                  sed_flux(i,k)*time_step/zdz(i,k)
214       ENDDO          !klon
215       ENDDO          !klev
216c
217       DO k=1, klev-1
218       DO i=1, klon
219        tr_seri(i,k,id_codu)=tr_seri(i,k,id_codu) +
220     .                  sed_flux(i,k+1)*time_step/zdz(i,k)
221       ENDDO          !klon
222       ENDDO          !klev
223c
224       DO i=1, klon
225         sed_dust(i)=sed_flux(i,1)*1.e6*1.e3    !--unit mg/m2/s
226       ENDDO          !klon
227       ELSE
228        DO i=1, klon
229          sed_dust(i)=0.
230        ENDDO
231       ENDIF
232c
233
234
235c--------- For scoarse  dust ------------------
236c
237c
238       IF(id_scdu>0) THEN
239       DO k=1, klev
240       DO i=1,klon
241c
242        v_stokes=RG*(rho_dust-zrho(i,k))*      !m/sec
243     .           mmd_dustsco*mmd_dustsco*
244     .           1.e-12/(18.0*air_visco(i,k)/10.)
245c
246       lambda=6.6*1.e-8*(103125/pplay(i,k))*(t_seri(i,k)/293.15)
247       CC=1.0+1.257*lambda/(mmd_dustsco)/1.e6        !dimensionless
248       v_sed=v_stokes*CC                       !m/sec
249c
250c---------check for v_sed*dt<zdz
251
252
253       IF (v_sed*time_step.GT.zdz(i,k)) THEN
254         v_sed=zdz(i,k)/time_step
255       ENDIF
256
257c
258       v_dep_dustsco(i,k)=v_sed
259       sed_flux(i,k)=tr_seri(i,k,id_scdu)*v_sed !g/cm3.m/sec
260c
261       ENDDO          !klon
262       ENDDO          !klev
263c
264       DO k=1, klev
265       DO i=1, klon
266       tr_seri(i,k,id_scdu)=tr_seri(i,k,id_scdu)-
267     .                  sed_flux(i,k)*time_step/zdz(i,k)
268       ENDDO          !klon
269       ENDDO          !klev
270c
271       DO k=1, klev-1
272       DO i=1, klon
273        tr_seri(i,k,id_scdu)=tr_seri(i,k,id_scdu) +
274     .                  sed_flux(i,k+1)*time_step/zdz(i,k)
275       ENDDO          !klon
276       ENDDO          !klev
277c
278       DO i=1, klon
279         sed_dustsco(i)=sed_flux(i,1)*1.e6*1.e3    !--unit mg/m2/s
280       ENDDO          !klon
281       ELSE
282        DO i=1, klon
283          sed_dustsco(i)=0.
284        ENDDO
285       ENDIF
286c
287
288
289
290
291c
292       RETURN
293       END
Note: See TracBrowser for help on using the repository browser.