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

Last change on this file since 5105 was 5104, checked in by abarral, 4 months ago

Replace 1DUTILS.h by module lmdz_1dutils.f90
Replace 1DConv.h by module lmdz_old_1dconv.f90 (it's only used by old_* files)
Convert *.F in DUST to *.f90
File size: 12.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  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
40  !============================== 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
57  !
58  !------------------------- Scaling Parameters --------------------------
59  !
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
76  !============================== 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)
82  !=========================== 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
89  !---------------------------- SEA SALT emissions ------------------------
90  REAL :: lmt_sea_salt(klon, ss_bins) !Sea salt 0.03-8.0 um
91  !
92  !--------vent 10 m CEPMMT
93  !
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
101  !*********************** DUST EMMISSIONS *******************************
102  !
103
104  ! avgdryrate=300./365.*pdtphys/86400.
105  !
106  ! DO i=1, klon
107  !
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
111  !
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]
116  !
117  !   ENDIF
118  !
119  ! ENDDO
120  !
121  ! ==================== CALCULATING DUST EMISSIONS ======================
122  !
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
134  !
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    CALL dustemission(debutphy, xlat, xlon, pctsrf, &
191            zu10m, zv10m, wstar, ale_bl, ale_wake, &
192            param_wstarBL, param_wstarWAKE, &
193            dustsourceacc, dustsourcecoa, &
194            dustsourcesco, maskd)
195
196    DO i = 1, klon
197      if (maskd(i)>0) then
198        IF(id_fine>0)    source_tr(i, id_fine) = &
199                scale_param_dustacc(iregion_dust(i)) * &
200                        dustsourceacc(i) * 1.e3   ! g/m2/s  bin 0.03-0.5
201        IF(id_codu>0)    source_tr(i, id_codu) = &
202                scale_param_dustcoa(iregion_dust(i)) * &
203                        dustsourcecoa(i) * 1.e3   ! g/m2/s   bin 0.5-3um
204        IF(id_scdu>0)   source_tr(i, id_scdu) = &
205                scale_param_dustsco(iregion_dust(i)) * &
206                        dustsourcesco(i) * 1.e3   ! g/m2/s   bin 3-15um
207        ! Original line (4 tracers)
208        IF(id_fine>0)  flux_tr(i, id_fine) = &
209                scale_param_dustacc(iregion_dust(i)) * &
210                        dustsourceacc(i) * 1.e3 * 1.e3  !mg/m2/s
211        IF(id_codu>0)  flux_tr(i, id_codu) = &
212                scale_param_dustcoa(iregion_dust(i)) * &
213                        dustsourcecoa(i) * 1.e3 * 1.e3  !mg/m2/s bin 0.5-3um
214        IF(id_scdu>0)  flux_tr(i, id_scdu) = &
215                scale_param_dustsco(iregion_dust(i)) * &
216                        dustsourcesco(i) * 1.e3 * 1.e3  !mg/m2/s bin 3-15um
217        flux_sparam_ddfine(i) = scale_param_dustacc(iregion_dust(i)) * &
218                dustsourceacc(i) * 1.e3 * 1.e3
219        flux_sparam_ddcoa(i) = scale_param_dustcoa(iregion_dust(i)) * &
220                dustsourcecoa(i) * 1.e3 * 1.e3
221        flux_sparam_ddsco(i) = scale_param_dustsco(iregion_dust(i)) * &
222                dustsourcesco(i) * 1.e3 * 1.e3
223      else
224        IF(id_fine>0) source_tr(i, id_fine) = &
225                scale_param_dustacc(iregion_dust(i)) * &
226                        dust_ec(i) * 1.e3 * 0.114   ! g/m2/s
227        IF(id_codu>0) source_tr(i, id_codu) = &
228                scale_param_dustcoa(iregion_dust(i)) * &
229                        dust_ec(i) * 1.e3 * 0.108   ! g/m2/s   bin 0.5-3um
230        IF(id_scdu>0) source_tr(i, id_scdu) = &
231                scale_param_dustsco(iregion_dust(i)) * &
232                        dust_ec(i) * 1.e3 * 0.778   ! g/m2/s   bin 3-15um
233        ! Original line (4 tracers)
234        IF(id_fine>0) flux_tr(i, id_fine) = &
235                scale_param_dustacc(iregion_dust(i)) * &
236                        dust_ec(i) * 1.e3 * 0.114 * 1.e3  !mg/m2/s
237        IF(id_codu>0) flux_tr(i, id_codu) = &
238                scale_param_dustcoa(iregion_dust(i)) * &
239                        dust_ec(i) * 1.e3 * 0.108 * 1.e3  !mg/m2/s bin 0.5-3um
240        IF(id_scdu>0) flux_tr(i, id_scdu) = &
241                scale_param_dustsco(iregion_dust(i)) * &
242                        dust_ec(i) * 1.e3 * 0.778 * 1.e3  !mg/m2/s bin 0.5-3um
243
244        flux_sparam_ddfine(i) = scale_param_dustacc(iregion_dust(i)) * &
245                dust_ec(i) * 1.e3 * 0.114 * 1.e3
246        flux_sparam_ddcoa(i) = scale_param_dustcoa(iregion_dust(i)) * &
247                dust_ec(i) * 1.e3 * 0.108 * 1.e3
248        flux_sparam_ddsco(i) = scale_param_dustsco(iregion_dust(i)) * &
249                dust_ec(i) * 1.e3 * 0.778 * 1.e3
250
251      endif
252    ENDDO
253
254  ENDIF
255  !*****************************************************
256  !******************* SEA SALT EMMISSIONS *******************************
257  DO i = 1, klon
258    pct_ocean(i) = pctsrf(i, is_oce)
259  ENDDO
260  !
261  !  IF (lminmax) THEN
262  DO j = 1, nbtr
263    DO i = 1, klon
264      tmp_var2(i, j) = source_tr(i, j)
265    ENDDO
266  ENDDO
267  CALL minmaxsource(tmp_var2, qmin, qmax, 'src: before SS emiss')
268  IF(id_coss>0) then
269    print *, 'Source = ', SUM(source_tr(:, id_coss)), &
270            MINVAL(source_tr(:, id_coss)), MAXVAL(source_tr(:, id_coss))
271  ENDIF
272
273  DO i = 1, klon
274    ! Original line (4 tracers)
275    IF(id_fine>0) source_tr(i, id_fine) = &
276            source_tr(i, id_fine) + scale_param_ssacc * &
277                    lmt_sea_salt(i, 1) * 1.e4       !g/m2/s
278
279    ! Original line (4 tracers)
280    IF(id_fine>0)  flux_tr(i, id_fine) = &
281            flux_tr(i, id_fine) + scale_param_ssacc &
282                    * lmt_sea_salt(i, 1) * 1.e4 * 1.e3      !mg/m2/s
283
284    IF(id_coss>0)  source_tr(i, id_coss) = &
285            scale_param_sscoa * lmt_sea_salt(i, 2) * 1.e4    !g/m2/s
286    IF(id_coss>0)  flux_tr(i, id_coss) = &
287            scale_param_sscoa * lmt_sea_salt(i, 2) * 1.e4 * 1.e3 !mg/m2/s
288    !
289    flux_sparam_ssfine(i) = scale_param_ssacc * &
290            lmt_sea_salt(i, 1) * 1.e4 * 1.e3
291    flux_sparam_sscoa(i) = scale_param_sscoa * &
292            lmt_sea_salt(i, 2) * 1.e4 * 1.e3
293  ENDDO
294  ! IF (lminmax) THEN
295  DO j = 1, nbtr
296    DO i = 1, klon
297      tmp_var2(i, j) = source_tr(i, j)
298    ENDDO
299  ENDDO
300  CALL minmaxsource(tmp_var2, qmin, qmax, 'src: after SS emiss')
301  IF(id_coss>0) then
302    print *, 'Source = ', SUM(source_tr(:, id_coss)), &
303            MINVAL(source_tr(:, id_coss)), MAXVAL(source_tr(:, id_coss))
304  ENDIF
305  !
306
307END SUBROUTINE coarsemission
Note: See TracBrowser for help on using the repository browser.