source: LMDZ6/branches/PBLSURF_GPUPORT/libf/phylmd/Dust/coarsemission.f90

Last change on this file was 5636, checked in by fhourdin, 9 months ago

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