source: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/coarsemission.f90 @ 5159

Last change on this file since 5159 was 5159, checked in by abarral, 5 months ago

Put dimensions.h and paramet.h into modules
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  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  USE lmdz_yomcst
33
34USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
35  USE lmdz_paramet
36  IMPLICIT NONE
37
38
39  INCLUDE "chem.h"
40  INCLUDE "chem_spla.h"
41
42
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
59
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
91
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)
98
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  !
106
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
136
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.
175
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...'
187
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
192
193    CALL dustemission(debutphy, xlat, xlon, pctsrf, &
194            zu10m, zv10m, wstar, ale_bl, ale_wake, &
195            param_wstarBL, param_wstarWAKE, &
196            dustsourceacc, dustsourcecoa, &
197            dustsourcesco, maskd)
198
199    DO i = 1, klon
200      IF (maskd(i)>0) THEN
201        IF(id_fine>0)    source_tr(i, id_fine) = &
202                scale_param_dustacc(iregion_dust(i)) * &
203                        dustsourceacc(i) * 1.e3   ! g/m2/s  bin 0.03-0.5
204        IF(id_codu>0)    source_tr(i, id_codu) = &
205                scale_param_dustcoa(iregion_dust(i)) * &
206                        dustsourcecoa(i) * 1.e3   ! g/m2/s   bin 0.5-3um
207        IF(id_scdu>0)   source_tr(i, id_scdu) = &
208                scale_param_dustsco(iregion_dust(i)) * &
209                        dustsourcesco(i) * 1.e3   ! g/m2/s   bin 3-15um
210        ! Original line (4 tracers)
211        IF(id_fine>0)  flux_tr(i, id_fine) = &
212                scale_param_dustacc(iregion_dust(i)) * &
213                        dustsourceacc(i) * 1.e3 * 1.e3  !mg/m2/s
214        IF(id_codu>0)  flux_tr(i, id_codu) = &
215                scale_param_dustcoa(iregion_dust(i)) * &
216                        dustsourcecoa(i) * 1.e3 * 1.e3  !mg/m2/s bin 0.5-3um
217        IF(id_scdu>0)  flux_tr(i, id_scdu) = &
218                scale_param_dustsco(iregion_dust(i)) * &
219                        dustsourcesco(i) * 1.e3 * 1.e3  !mg/m2/s bin 3-15um
220        flux_sparam_ddfine(i) = scale_param_dustacc(iregion_dust(i)) * &
221                dustsourceacc(i) * 1.e3 * 1.e3
222        flux_sparam_ddcoa(i) = scale_param_dustcoa(iregion_dust(i)) * &
223                dustsourcecoa(i) * 1.e3 * 1.e3
224        flux_sparam_ddsco(i) = scale_param_dustsco(iregion_dust(i)) * &
225                dustsourcesco(i) * 1.e3 * 1.e3
226      else
227        IF(id_fine>0) source_tr(i, id_fine) = &
228                scale_param_dustacc(iregion_dust(i)) * &
229                        dust_ec(i) * 1.e3 * 0.114   ! g/m2/s
230        IF(id_codu>0) source_tr(i, id_codu) = &
231                scale_param_dustcoa(iregion_dust(i)) * &
232                        dust_ec(i) * 1.e3 * 0.108   ! g/m2/s   bin 0.5-3um
233        IF(id_scdu>0) source_tr(i, id_scdu) = &
234                scale_param_dustsco(iregion_dust(i)) * &
235                        dust_ec(i) * 1.e3 * 0.778   ! g/m2/s   bin 3-15um
236        ! Original line (4 tracers)
237        IF(id_fine>0) flux_tr(i, id_fine) = &
238                scale_param_dustacc(iregion_dust(i)) * &
239                        dust_ec(i) * 1.e3 * 0.114 * 1.e3  !mg/m2/s
240        IF(id_codu>0) flux_tr(i, id_codu) = &
241                scale_param_dustcoa(iregion_dust(i)) * &
242                        dust_ec(i) * 1.e3 * 0.108 * 1.e3  !mg/m2/s bin 0.5-3um
243        IF(id_scdu>0) flux_tr(i, id_scdu) = &
244                scale_param_dustsco(iregion_dust(i)) * &
245                        dust_ec(i) * 1.e3 * 0.778 * 1.e3  !mg/m2/s bin 0.5-3um
246
247        flux_sparam_ddfine(i) = scale_param_dustacc(iregion_dust(i)) * &
248                dust_ec(i) * 1.e3 * 0.114 * 1.e3
249        flux_sparam_ddcoa(i) = scale_param_dustcoa(iregion_dust(i)) * &
250                dust_ec(i) * 1.e3 * 0.108 * 1.e3
251        flux_sparam_ddsco(i) = scale_param_dustsco(iregion_dust(i)) * &
252                dust_ec(i) * 1.e3 * 0.778 * 1.e3
253
254      endif
255    ENDDO
256
257  ENDIF
258  !*****************************************************
259  !******************* SEA SALT EMMISSIONS *******************************
260  DO i = 1, klon
261    pct_ocean(i) = pctsrf(i, is_oce)
262  ENDDO
263
264  !  IF (lminmax) THEN
265  DO j = 1, nbtr
266    DO i = 1, klon
267      tmp_var2(i, j) = source_tr(i, j)
268    ENDDO
269  ENDDO
270  CALL minmaxsource(tmp_var2, qmin, qmax, 'src: before SS emiss')
271  IF(id_coss>0) THEN
272    print *, 'Source = ', SUM(source_tr(:, id_coss)), &
273            MINVAL(source_tr(:, id_coss)), MAXVAL(source_tr(:, id_coss))
274  ENDIF
275
276  DO i = 1, klon
277    ! Original line (4 tracers)
278    IF(id_fine>0) source_tr(i, id_fine) = &
279            source_tr(i, id_fine) + scale_param_ssacc * &
280                    lmt_sea_salt(i, 1) * 1.e4       !g/m2/s
281
282    ! Original line (4 tracers)
283    IF(id_fine>0)  flux_tr(i, id_fine) = &
284            flux_tr(i, id_fine) + scale_param_ssacc &
285                    * lmt_sea_salt(i, 1) * 1.e4 * 1.e3      !mg/m2/s
286
287    IF(id_coss>0)  source_tr(i, id_coss) = &
288            scale_param_sscoa * lmt_sea_salt(i, 2) * 1.e4    !g/m2/s
289    IF(id_coss>0)  flux_tr(i, id_coss) = &
290            scale_param_sscoa * lmt_sea_salt(i, 2) * 1.e4 * 1.e3 !mg/m2/s
291
292    flux_sparam_ssfine(i) = scale_param_ssacc * &
293            lmt_sea_salt(i, 1) * 1.e4 * 1.e3
294    flux_sparam_sscoa(i) = scale_param_sscoa * &
295            lmt_sea_salt(i, 2) * 1.e4 * 1.e3
296  ENDDO
297  ! IF (lminmax) THEN
298  DO j = 1, nbtr
299    DO i = 1, klon
300      tmp_var2(i, j) = source_tr(i, j)
301    ENDDO
302  ENDDO
303  CALL minmaxsource(tmp_var2, qmin, qmax, 'src: after SS emiss')
304  IF(id_coss>0) THEN
305    print *, 'Source = ', SUM(source_tr(:, id_coss)), &
306            MINVAL(source_tr(:, id_coss)), MAXVAL(source_tr(:, id_coss))
307  ENDIF
308  !
309
310END SUBROUTINE coarsemission
Note: See TracBrowser for help on using the repository browser.