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

Last change on this file was 5182, checked in by abarral, 10 days ago

(WIP) Replace REPROBUS CPP KEY by logical
properly name modules
File size: 12.7 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 lmdz_infotrac
30  USE dustemission_mod, ONLY: dustemission
31  ! USE lmdz_phytracr_spl, ONLY: nbreg_dust, nbreg_ind, nbreg_bb
32  USE lmdz_yomcst
33
34  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
35  USE lmdz_paramet
36  USE lmdz_chem, ONLY: idms, iso2, iso4, ih2s, idmso, imsa, ih2o2, &
37          n_avogadro, masse_s, masse_so4, rho_water, rho_ice
38  USE lmdz_chem_spla, ONLY: ss_bins
39  IMPLICIT NONE
40
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  IF (.NOT. ok_chimeredust)  THEN
138    DO i = 1, klon
139      !!     IF (cly(i).GE.9990..OR.wth(i).GE.9990..OR.
140      !!    .    t_seri(i,1).LE.273.15.OR.zprecipinsoil(i).GT.1.e-8) THEN
141      !!          dust_ec(i)=0.0
142      !!     ENDIF
143      !c Corresponds to dust_emission.EQ.3
144      !!!!!!!****************AQUIIIIIIIIIIIIIIIIIIIIIIIIIIII
145      !! Original line (4 tracers)
146      !JE<<  old 4 tracer(nhl scheme)        source_tr(i,id_fine)=scale_param_dustacc(iregion_dust(i))*
147      ! .                  dust_ec(i)*1.e3*0.093   ! g/m2/s
148      !     source_tr(i,id_codu)=scale_param_dustcoa(iregion_dust(i))*
149      ! .                  dust_ec(i)*1.e3*0.905   ! g/m2/s   bin 0.5-10um
150      !! Original line (4 tracers)
151      !     flux_tr(i,id_fine)=scale_param_dustacc(iregion_dust(i))*
152      ! .                  dust_ec(i)*1.e3*0.093*1.e3  !mg/m2/s
153      !     flux_tr(i,id_codu)=scale_param_dustcoa(iregion_dust(i))*
154      ! .                  dust_ec(i)*1.e3*0.905*1.e3  !mg/m2/s bin 0.5-10um
155      !     flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) *
156      ! .                            dust_ec(i)*1.e3*0.093*1.e3
157      !     flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) *
158      ! .                            dust_ec(i)*1.e3*0.905*1.e3
159      IF(id_fine>0)     source_tr(i, id_fine) = &
160              scale_param_dustacc(iregion_dust(i)) * &
161                      dust_ec(i) * 1.e3 * 0.093   ! g/m2/s
162      IF(id_codu>0)   source_tr(i, id_codu) = &
163              scale_param_dustcoa(iregion_dust(i)) * &
164                      dust_ec(i) * 1.e3 * 0.905   ! g/m2/s   bin 0.5-10um
165      IF(id_scdu>0)  source_tr(i, id_scdu) = 0.   ! no supercoarse
166      ! Original line (4 tracers)
167      IF(id_fine>0)   flux_tr(i, id_fine) = &
168              scale_param_dustacc(iregion_dust(i)) * &
169                      dust_ec(i) * 1.e3 * 0.093 * 1.e3  !mg/m2/s
170      IF(id_codu>0)  flux_tr(i, id_codu) = &
171              scale_param_dustcoa(iregion_dust(i)) * &
172                      dust_ec(i) * 1.e3 * 0.905 * 1.e3  !mg/m2/s bin 0.5-10um
173      IF(id_scdu>0) flux_tr(i, id_scdu) = 0.
174
175      flux_sparam_ddfine(i) = scale_param_dustacc(iregion_dust(i)) * &
176              dust_ec(i) * 1.e3 * 0.093 * 1.e3
177      flux_sparam_ddcoa(i) = scale_param_dustcoa(iregion_dust(i)) * &
178              dust_ec(i) * 1.e3 * 0.905 * 1.e3
179      flux_sparam_ddsco(i) = 0.
180    ENDDO
181  ENDIF
182  !*****************NEW CHIMERE DUST EMISSION Sahara*****
183  ! je  20140522
184  IF(ok_chimeredust) THEN
185    PRINT *, 'MIX- NEW SAHARA DUST SOURCE SCHEME...'
186
187    DO i = 1, klon
188      param_wstarBL(i) = param_wstarBLperregion(iregion_wstardust(i))
189      param_wstarWAKE(i) = param_wstarWAKEperregion(iregion_wstardust(i))
190    ENDDO
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)>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  ENDIF
257  !*****************************************************
258  !******************* SEA SALT EMMISSIONS *******************************
259  DO i = 1, klon
260    pct_ocean(i) = pctsrf(i, is_oce)
261  ENDDO
262
263  !  IF (lminmax) THEN
264  DO j = 1, nbtr
265    DO i = 1, klon
266      tmp_var2(i, j) = source_tr(i, j)
267    ENDDO
268  ENDDO
269  CALL minmaxsource(tmp_var2, qmin, qmax, 'src: before SS emiss')
270  IF(id_coss>0) THEN
271    PRINT *, 'Source = ', SUM(source_tr(:, id_coss)), &
272            MINVAL(source_tr(:, id_coss)), MAXVAL(source_tr(:, id_coss))
273  ENDIF
274
275  DO i = 1, klon
276    ! Original line (4 tracers)
277    IF(id_fine>0) source_tr(i, id_fine) = &
278            source_tr(i, id_fine) + scale_param_ssacc * &
279                    lmt_sea_salt(i, 1) * 1.e4       !g/m2/s
280
281    ! Original line (4 tracers)
282    IF(id_fine>0)  flux_tr(i, id_fine) = &
283            flux_tr(i, id_fine) + scale_param_ssacc &
284                    * lmt_sea_salt(i, 1) * 1.e4 * 1.e3      !mg/m2/s
285
286    IF(id_coss>0)  source_tr(i, id_coss) = &
287            scale_param_sscoa * lmt_sea_salt(i, 2) * 1.e4    !g/m2/s
288    IF(id_coss>0)  flux_tr(i, id_coss) = &
289            scale_param_sscoa * lmt_sea_salt(i, 2) * 1.e4 * 1.e3 !mg/m2/s
290
291    flux_sparam_ssfine(i) = scale_param_ssacc * &
292            lmt_sea_salt(i, 1) * 1.e4 * 1.e3
293    flux_sparam_sscoa(i) = scale_param_sscoa * &
294            lmt_sea_salt(i, 2) * 1.e4 * 1.e3
295  ENDDO
296  ! IF (lminmax) THEN
297  DO j = 1, nbtr
298    DO i = 1, klon
299      tmp_var2(i, j) = source_tr(i, j)
300    ENDDO
301  ENDDO
302  CALL minmaxsource(tmp_var2, qmin, qmax, 'src: after SS emiss')
303  IF(id_coss>0) THEN
304    PRINT *, 'Source = ', SUM(source_tr(:, id_coss)), &
305            MINVAL(source_tr(:, id_coss)), MAXVAL(source_tr(:, id_coss))
306  ENDIF
307  !
308
309END SUBROUTINE coarsemission
Note: See TracBrowser for help on using the repository browser.