source: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/coarsemission.F @ 5099

Last change on this file since 5099 was 5099, checked in by abarral, 2 months ago

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