source: LMDZ5/trunk/libf/phylmd/Dust/coarsemission.F @ 3822

Last change on this file since 3822 was 2630, checked in by fhourdin, 8 years ago

Importation du modèle d'aérosols de Boucher, Escribano et al.
File size: 12.9 KB
RevLine 
[2630]1c This subroutine calculates the emissions of SEA SALT and DUST, part of
2C which goes to tracer 2 and other part to tracer 3.
3      SUBROUTINE coarsemission(pctsrf,pdtphys,
4     .                         t_seri,pmflxr,pmflxs,prfl,psfl,
5     .                         xlat,xlon,debutphy,
6     .                         zu10m,zv10m,wstar,ale_bl,ale_wake,
7     .                         scale_param_ssacc,scale_param_sscoa,
8     .                         scale_param_dustacc,scale_param_dustcoa,
9     .                         scale_param_dustsco,
10     .                         nbreg_dust,
11     .                         iregion_dust,dust_ec,
12     .                  param_wstarBLperregion,param_wstarWAKEperregion,
13     .                  nbreg_wstardust,
14     .                  iregion_wstardust,
15     .                         lmt_sea_salt,qmin,qmax,
16     .                             flux_sparam_ddfine,flux_sparam_ddcoa,
17     .                             flux_sparam_ddsco,
18     .                             flux_sparam_ssfine,flux_sparam_sscoa,
19     .                          id_prec,id_fine,id_coss,id_codu,id_scdu,
20     .                          ok_chimeredust,
21     .                                                source_tr,flux_tr)
22!     .                         wth,cly,zprecipinsoil,lmt_sea_salt,
23
24!      CALL dustemission( debutphy, xlat, xlon, pctsrf,
25!     .               zu10m     zv10m,wstar,ale_bl,ale_wake)
26!
27
28      USE dimphy
29      USE indice_sol_mod
30      USE infotrac
31      USE dustemission_mod,  ONLY : dustemission
32!      USE phytracr_spl_mod, ONLY : nbreg_dust, nbreg_ind, nbreg_bb
33      IMPLICIT NONE
34
35#include "dimensions.h"
36#include "chem.h"
37#include "chem_spla.h"
38#include "YOMCST.h"
39#include "paramet.h"
40     
41c============================== INPUT ==================================
42      INTEGER nbjour
43      LOGICAL ok_chimeredust
44      REAL pdtphys  ! pas d'integration pour la physique (seconde)
45      REAL t_seri(klon,klev)  ! temperature
46      REAL pctsrf(klon,nbsrf)
47      REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1)   !--convection
48!      REAL pmflxr(klon,klev), pmflxs(klon,klev)   !--convection
49      REAL prfl(klon,klev+1),   psfl(klon,klev+1)     !--large-scale
50!      REAL prfl(klon,klev),   psfl(klon,klev)     !--large-scale
51      LOGICAL debutphy, lafinphy
52      REAL, intent(in) ::  xlat(klon)    ! latitudes pour chaque point
53      REAL, intent(in) ::  xlon(klon)    ! longitudes pour chaque point
54      REAL,DIMENSION(klon),INTENT(IN)    :: zu10m
55      REAL,DIMENSION(klon),INTENT(IN)    :: zv10m
56      REAL,DIMENSION(klon),INTENT(IN)    :: wstar,Ale_bl,ale_wake
57
58c
59c------------------------- Scaling Parameters --------------------------
60c
61      INTEGER iregion_dust(klon) !Defines  dust regions
62      REAL scale_param_ssacc  !Scaling parameter for Fine Sea Salt
63      REAL scale_param_sscoa  !Scaling parameter for Coarse Sea Salt
64      REAL scale_param_dustacc(nbreg_dust)  !Scaling parameter for Fine Dust
65      REAL scale_param_dustcoa(nbreg_dust)  !Scaling parameter for Coarse Dust
66      REAL scale_param_dustsco(nbreg_dust)  !Scaling parameter for SCoarse Dust
67!JE20141124<<
68      INTEGER iregion_wstardust(klon) !Defines dust regions in terms of wstar
69      REAL param_wstarBLperregion(nbreg_wstardust)  !
70      REAL param_wstarWAKEperregion(nbreg_wstardust)  !
71      REAL param_wstarBL(klon)  !parameter for surface wind correction..
72      REAL param_wstarWAKE(klon)  !parameter for surface wind correction..
73      INTEGER  nbreg_wstardust
74!JE20141124>>
75      INTEGER  nbreg_dust
76      INTEGER, INTENT(IN) :: id_prec,id_fine,id_coss,id_codu,id_scdu
77c============================== OUTPUT =================================
78      REAL source_tr(klon,nbtr)
79      REAL flux_tr(klon,nbtr)
80      REAL flux_sparam_ddfine(klon), flux_sparam_ddcoa(klon)
81      REAL flux_sparam_ddsco(klon)
82      REAL flux_sparam_ssfine(klon), flux_sparam_sscoa(klon)
83c=========================== LOCAL VARIABLES ===========================           
84      INTEGER i, j
85      REAL pct_ocean(klon)
86!      REAL zprecipinsoil(klon)
87!      REAL cly(klon), wth(klon)
88      REAL clyfac, avgdryrate, drying
89           
90c---------------------------- SEA SALT emissions ------------------------
91      REAL lmt_sea_salt(klon,ss_bins) !Sea salt 0.03-8.0 um                         
92c
93c--------vent 10 m CEPMMT
94c
95      REAL dust_ec(klon)
96
97      real tmp_var2(klon,nbtr) ! auxiliary variable to replace source
98      REAL qmin, qmax
99!----------------------DUST Sahara ---------------
100      REAL, DIMENSION(klon) :: dustsourceacc,dustsourcecoa,dustsourcesco
101      INTEGER, DIMENSION(klon) :: maskd
102C*********************** DUST EMMISSIONS *******************************
103c
104     
105!     avgdryrate=300./365.*pdtphys/86400.
106c
107!     DO i=1, klon
108c
109!       IF (cly(i).LT.9990..AND.wth(i).LT.9990.) THEN
110!        zprecipinsoil(i)=zprecipinsoil(i) +
111!    .        (pmflxr(i,1)+pmflxs(i,1)+prfl(i,1)+psfl(i,1))*pdtphys
112c
113!        clyfac=MIN(16., cly(i)*0.4+8.) ![mm] max amount of water hold in top soil
114!        drying=avgdryrate*exp(0.03905491*
115!    .                    exp(0.17446*(t_seri(i,1)-273.15))) ! [mm]
116!        zprecipinsoil(i)=min(max(0.,zprecipinsoil(i)-drying),clyfac) ! [mm]
117c         
118!       ENDIF
119c
120!     ENDDO
121c               
122c ==================== CALCULATING DUST EMISSIONS ======================
123c
124!      IF (lminmax) THEN
125      DO j=1,nbtr
126      DO i=1,klon
127         tmp_var2(i,j)=source_tr(i,j)
128      ENDDO
129      ENDDO
130      CALL minmaxsource(tmp_var2,qmin,qmax,'src: before DD emiss')
131!      print *,'Source = ',SUM(source_tr),MINVAL(source_tr),
132!     .                                     MAXVAL(source_tr)
133!      ENDIF
134
135c
136      IF (.NOT. ok_chimeredust)  THEN 
137      DO i=1, klon
138!!     IF (cly(i).GE.9990..OR.wth(i).GE.9990..OR.
139!!    .    t_seri(i,1).LE.273.15.OR.zprecipinsoil(i).GT.1.e-8) THEN
140!!          dust_ec(i)=0.0
141!!     ENDIF
142!c Corresponds to dust_emission.EQ.3       
143!!!!!!!****************AQUIIIIIIIIIIIIIIIIIIIIIIIIIIII
144!! Original line (4 tracers)
145!JE<<  old 4 tracer(nhl scheme)        source_tr(i,id_fine)=scale_param_dustacc(iregion_dust(i))*
146!     .                  dust_ec(i)*1.e3*0.093   ! g/m2/s
147!         source_tr(i,id_codu)=scale_param_dustcoa(iregion_dust(i))*
148!     .                  dust_ec(i)*1.e3*0.905   ! g/m2/s   bin 0.5-10um
149!! Original line (4 tracers)
150!         flux_tr(i,id_fine)=scale_param_dustacc(iregion_dust(i))*
151!     .                  dust_ec(i)*1.e3*0.093*1.e3  !mg/m2/s
152!         flux_tr(i,id_codu)=scale_param_dustcoa(iregion_dust(i))*
153!     .                  dust_ec(i)*1.e3*0.905*1.e3  !mg/m2/s bin 0.5-10um
154!         flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) *
155!     .                            dust_ec(i)*1.e3*0.093*1.e3
156!         flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) *
157!     .                            dust_ec(i)*1.e3*0.905*1.e3
158      IF(id_fine>0)     source_tr(i,id_fine)=
159     . scale_param_dustacc(iregion_dust(i))*
160     .                  dust_ec(i)*1.e3*0.093   ! g/m2/s
161      IF(id_codu>0)   source_tr(i,id_codu)=
162     . scale_param_dustcoa(iregion_dust(i))*
163     .                  dust_ec(i)*1.e3*0.905   ! g/m2/s   bin 0.5-10um
164      IF(id_scdu>0)  source_tr(i,id_scdu)=0.   ! no supercoarse
165! Original line (4 tracers)
166       IF(id_fine>0)   flux_tr(i,id_fine)=
167     .  scale_param_dustacc(iregion_dust(i))*
168     .                  dust_ec(i)*1.e3*0.093*1.e3  !mg/m2/s
169       IF(id_codu>0)  flux_tr(i,id_codu)=
170     . scale_param_dustcoa(iregion_dust(i))*
171     .                  dust_ec(i)*1.e3*0.905*1.e3  !mg/m2/s bin 0.5-10um
172       IF(id_scdu>0) flux_tr(i,id_scdu)=0.
173
174         flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) *
175     .                            dust_ec(i)*1.e3*0.093*1.e3
176         flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) *
177     .                            dust_ec(i)*1.e3*0.905*1.e3
178         flux_sparam_ddsco(i)=0.
179      ENDDO
180      ENDIF
181!*****************NEW CHIMERE DUST EMISSION Sahara*****
182! je  20140522
183      IF(ok_chimeredust) THEN
184      print *,'MIX- NEW SAHARA DUST SOURCE SCHEME...'
185
186      DO i=1,klon
187      param_wstarBL(i)  =param_wstarBLperregion(iregion_wstardust(i))
188      param_wstarWAKE(i)=param_wstarWAKEperregion(iregion_wstardust(i))
189      ENDDO
190
191
192      CALL dustemission( debutphy, xlat, xlon, pctsrf,
193     .                  zu10m,zv10m,wstar,ale_bl,ale_wake,
194     .                  param_wstarBL, param_wstarWAKE,
195     .                  dustsourceacc,dustsourcecoa,
196     .                  dustsourcesco,maskd)
197     
198      DO i=1,klon   
199         if (maskd(i).gt.0) then
200      IF(id_fine>0)    source_tr(i,id_fine)=
201     . scale_param_dustacc(iregion_dust(i))*
202     .                  dustsourceacc(i)*1.e3   ! g/m2/s  bin 0.03-0.5
203      IF(id_codu>0)    source_tr(i,id_codu)=
204     . scale_param_dustcoa(iregion_dust(i))*
205     .                  dustsourcecoa(i)*1.e3   ! g/m2/s   bin 0.5-3um
206      IF(id_scdu>0)   source_tr(i,id_scdu)=
207     . scale_param_dustsco(iregion_dust(i))*
208     .                  dustsourcesco(i)*1.e3   ! g/m2/s   bin 3-15um
209! Original line (4 tracers)
210       IF(id_fine>0)  flux_tr(i,id_fine)=
211     .  scale_param_dustacc(iregion_dust(i))*
212     .                  dustsourceacc(i)*1.e3*1.e3  !mg/m2/s
213       IF(id_codu>0)  flux_tr(i,id_codu)=
214     . scale_param_dustcoa(iregion_dust(i))*
215     .                  dustsourcecoa(i)*1.e3*1.e3  !mg/m2/s bin 0.5-3um
216       IF(id_scdu>0)  flux_tr(i,id_scdu)=
217     . scale_param_dustsco(iregion_dust(i))*
218     .                  dustsourcesco(i)*1.e3*1.e3  !mg/m2/s bin 3-15um
219         flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) *
220     .                            dustsourceacc(i)*1.e3*1.e3
221         flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) *
222     .                            dustsourcecoa(i)*1.e3*1.e3
223         flux_sparam_ddsco(i)=scale_param_dustsco(iregion_dust(i)) *
224     .                            dustsourcesco(i)*1.e3*1.e3
225         else
226        IF(id_fine>0) source_tr(i,id_fine)=
227     .  scale_param_dustacc(iregion_dust(i))*
228     .                  dust_ec(i)*1.e3*0.114   ! g/m2/s
229        IF(id_codu>0) source_tr(i,id_codu)=
230     .  scale_param_dustcoa(iregion_dust(i))*
231     .                  dust_ec(i)*1.e3*0.108   ! g/m2/s   bin 0.5-3um
232        IF(id_scdu>0) source_tr(i,id_scdu)=
233     .  scale_param_dustsco(iregion_dust(i))*
234     .                  dust_ec(i)*1.e3*0.778   ! g/m2/s   bin 3-15um
235! Original line (4 tracers)
236        IF(id_fine>0) flux_tr(i,id_fine)=
237     . scale_param_dustacc(iregion_dust(i))*
238     .                  dust_ec(i)*1.e3*0.114*1.e3  !mg/m2/s
239        IF(id_codu>0) flux_tr(i,id_codu)=
240     . scale_param_dustcoa(iregion_dust(i))*
241     .                  dust_ec(i)*1.e3*0.108*1.e3  !mg/m2/s bin 0.5-3um
242        IF(id_scdu>0) flux_tr(i,id_scdu)=
243     . scale_param_dustsco(iregion_dust(i))*
244     .                  dust_ec(i)*1.e3*0.778*1.e3  !mg/m2/s bin 0.5-3um
245
246         flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) *
247     .                            dust_ec(i)*1.e3*0.114*1.e3
248         flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) *
249     .                            dust_ec(i)*1.e3*0.108*1.e3
250         flux_sparam_ddsco(i)=scale_param_dustsco(iregion_dust(i)) *
251     .                            dust_ec(i)*1.e3*0.778*1.e3
252
253         endif
254      ENDDO
255
256
257
258
259
260      ENDIF
261!*****************************************************                                   
262C******************* SEA SALT EMMISSIONS *******************************
263      DO i=1,klon
264         pct_ocean(i)=pctsrf(i,is_oce)
265      ENDDO
266c
267!      IF (lminmax) THEN
268      DO j=1,nbtr
269      DO i=1,klon
270         tmp_var2(i,j)=source_tr(i,j)
271      ENDDO
272      ENDDO
273      CALL minmaxsource(tmp_var2,qmin,qmax,'src: before SS emiss')
274      IF(id_coss>0) then
275      print *,'Source = ',SUM(source_tr(:,id_coss)),
276     .     MINVAL(source_tr(:,id_coss)), MAXVAL(source_tr(:,id_coss))
277      ENDIF
278!
279      DO i=1,klon
280! Original line (4 tracers)
281         IF(id_fine>0) source_tr(i,id_fine)=
282     . source_tr(i,id_fine)+scale_param_ssacc*
283     .                                 lmt_sea_salt(i,1)*1.e4       !g/m2/s
284
285! Original line (4 tracers)
286       IF(id_fine>0)  flux_tr(i,id_fine)=
287     . flux_tr(i,id_fine)+scale_param_ssacc
288     .                            *lmt_sea_salt(i,1)*1.e4*1.e3      !mg/m2/s
289!
290      IF(id_coss>0)  source_tr(i,id_coss)=
291     . scale_param_sscoa*lmt_sea_salt(i,2)*1.e4    !g/m2/s
292      IF(id_coss>0)  flux_tr(i,id_coss)=
293     . scale_param_sscoa*lmt_sea_salt(i,2)*1.e4*1.e3 !mg/m2/s
294c
295         flux_sparam_ssfine(i)=scale_param_ssacc *
296     .                                  lmt_sea_salt(i,1)*1.e4*1.e3
297         flux_sparam_sscoa(i)=scale_param_sscoa *
298     .                                  lmt_sea_salt(i,2)*1.e4*1.e3
299      ENDDO
300!      IF (lminmax) THEN
301      DO j=1,nbtr
302      DO i=1,klon
303         tmp_var2(i,j)=source_tr(i,j)
304      ENDDO
305      ENDDO
306      CALL minmaxsource(tmp_var2,qmin,qmax,'src: after SS emiss')
307      IF(id_coss>0) then
308      print *,'Source = ',SUM(source_tr(:,id_coss)),
309     .  MINVAL(source_tr(:,id_coss)), MAXVAL(source_tr(:,id_coss))
310      ENDIF
311c     
312
313      END
Note: See TracBrowser for help on using the repository browser.