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

Last change on this file since 5267 was 5246, checked in by abarral, 4 days ago

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)
File size: 11.6 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  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
41  !============================== 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
58  !
59  !------------------------- Scaling Parameters --------------------------
60  !
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
77  !============================== 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)
83  !=========================== 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
90  !---------------------------- SEA SALT emissions ------------------------
91  REAL :: lmt_sea_salt(klon,ss_bins) !Sea salt 0.03-8.0 um
92  !
93  !--------vent 10 m CEPMMT
94  !
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
102  !*********************** DUST EMMISSIONS *******************************
103  !
104
105  ! avgdryrate=300./365.*pdtphys/86400.
106  !
107  ! DO i=1, klon
108  !
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
112  !
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]
117  !
118  !   ENDIF
119  !
120  ! ENDDO
121  !
122  ! ==================== CALCULATING DUST EMISSIONS ======================
123  !
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
135  !
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  !*****************************************************
262  !******************* SEA SALT EMMISSIONS *******************************
263  DO i=1,klon
264     pct_ocean(i)=pctsrf(i,is_oce)
265  ENDDO
266  !
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
294  !
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
311  !
312
313END SUBROUTINE coarsemission
Note: See TracBrowser for help on using the repository browser.