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

Last change on this file since 5431 was 5337, checked in by Laurent Fairhead, 4 weeks ago

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