source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/sediment_mod_F_20140902 @ 5080

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

SPLA code included for first time

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