source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/coarsemission.F @ 4934

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

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