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

Last change on this file since 5277 was 5274, checked in by abarral, 9 hours ago

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