source: LMDZ6/trunk/libf/phylmd/Dust/sediment_mod.f90 @ 5310

Last change on this file since 5310 was 5292, checked in by abarral, 7 weeks ago

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