source: LMDZ6/trunk/libf/phylmd/Dust/coarsemission.f90 @ 5635

Last change on this file since 5635 was 5635, checked in by fhourdin, 6 weeks ago

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