source: LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/lmdz_precuremission.f90 @ 5185

Last change on this file since 5185 was 5182, checked in by abarral, 3 months ago

(WIP) Replace REPROBUS CPP KEY by logical
properly name modules
File size: 12.0 KB
Line 
1MODULE lmdz_precureemission
2  IMPLICIT NONE; PRIVATE
3  PUBLIC precuremission
4
5CONTAINS
6
7  ! Subroutine that calculates the emission of aerosols precursors
8  SUBROUTINE precuremission(ftsol, u10m_ec, v10m_ec, &
9          pctsrf, u_seri, v_seri, paprs, pplay, cdragh, &
10          cdragm, t_seri, q_seri, tsol, fracso2emis, &
11          frach2sofso2, bateau, zdz, zalt, &
12          kminbc, kmaxbc, pdtphys, scale_param_bb, &
13          scale_param_ind, iregion_ind, iregion_bb, &
14          nbreg_ind, nbreg_bb, &
15          lmt_so2ff_l, lmt_so2ff_h, lmt_so2nff, &
16          lmt_so2ba, lmt_so2bb_l, lmt_so2bb_h, &
17          lmt_so2volc_cont, lmt_altvolc_cont, &
18          lmt_so2volc_expl, lmt_altvolc_expl, &
19          lmt_dmsbio, lmt_h2sbio, lmt_dmsconc, &
20          lmt_dms, id_prec, id_fine, &
21          flux_sparam_ind, flux_sparam_bb, &
22          source_tr, flux_tr, tr_seri)
23
24    USE dimphy
25    USE indice_sol_mod
26    USE lmdz_infotrac
27    USE lmdz_yomcst
28
29    USE lmdz_paramet
30    USE lmdz_chem, ONLY: masse_s
31    USE lmdz_chem_spla, ONLY: masse_ammsulfate
32    IMPLICIT NONE
33
34    !============================= INPUT ===================================
35    INTEGER :: kminbc, kmaxbc
36    REAL :: ftsol(klon, nbsrf)  ! temperature du sol par type
37    REAL :: tsol(klon)         ! temperature du sol moyenne
38    REAL :: t_seri(klon, klev)  ! temperature
39    REAL :: u_seri(klon, klev)  ! vent
40    REAL :: v_seri(klon, klev)  ! vent
41    REAL :: q_seri(klon, klev)  ! vapeur d eau kg/kg
42    REAL :: u10m_ec(klon), v10m_ec(klon)  ! vent a 10 metres
43    REAL :: pctsrf(klon, nbsrf)
44    REAL :: pdtphys  ! pas d'integration pour la physique (seconde)
45    REAL :: paprs(klon, klev + 1)  ! pression pour chaque inter-couche (en Pa)
46    REAL :: pplay(klon, klev)  ! pression pour le mileu de chaque couche (en Pa)
47    REAL :: cdragh(klon), cdragm(klon)
48    REAL :: fracso2emis        !--fraction so2 emis en so2
49    REAL :: frach2sofso2       !--fraction h2s from so2
50    REAL :: zdz(klon, klev)
51    LOGICAL :: edgar, bateau
52    INTEGER :: id_prec, id_fine
53
54    !------------------------- Scaling Parameters --------------------------
55
56    INTEGER :: nbreg_ind, nbreg_bb
57    INTEGER :: iregion_ind(klon)  !Defines regions for SO2, BC & OM
58    INTEGER :: iregion_bb(klon)  !Defines regions for SO2, BC & OM
59    REAL :: scale_param_bb(nbreg_bb)  !Scaling parameter for biomas burning
60    REAL :: scale_param_ind(nbreg_ind) !Scaling parameter for industrial emissions
61
62    !============================= OUTPUT ==================================
63
64    REAL :: source_tr(klon, nbtr)
65    REAL :: flux_tr(klon, nbtr)
66    REAL :: tr_seri(klon, klev, nbtr) ! traceur
67    REAL :: flux_sparam_ind(klon), flux_sparam_bb(klon)
68    !========================= LOCAL VARIABLES =============================
69    INTEGER :: i, k, kkk_cont(klon), kkk_expl(klon)
70    REAL :: zalt(klon, klev), zaltmid(klon, klev)
71    REAL :: zzdz
72    !------------------------- SULFUR emissions ----------------------------
73    REAL :: lmt_so2volc_cont(klon)  ! emissions so2 volcan (continuous)
74    REAL :: lmt_altvolc_cont(klon)  ! altitude  so2 volcan (continuous)
75    REAL :: lmt_so2volc_expl(klon)  ! emissions so2 volcan (explosive)
76    REAL :: lmt_altvolc_expl(klon)  ! altitude  so2 volcan (explosive)
77    REAL :: lmt_so2ff_l(klon)       ! emissions so2 fossil fuel (low)
78    REAL :: lmt_so2ff_h(klon)       ! emissions so2 fossil fuel (high)
79    REAL :: lmt_so2nff(klon)        ! emissions so2 non-fossil fuel
80    REAL :: lmt_so2bb_l(klon)       ! emissions de so2 biomass burning (low)
81    REAL :: lmt_so2bb_h(klon)       ! emissions de so2 biomass burning (high)
82    REAL :: lmt_so2ba(klon)         ! emissions de so2 bateau
83    REAL :: lmt_dms(klon)           ! emissions de dms
84    REAL :: lmt_dmsconc(klon)       ! concentration de dms oceanique
85    REAL :: lmt_dmsbio(klon)        ! emissions de dms bio
86    REAL :: lmt_h2sbio(klon)        ! emissions de h2s bio
87
88    EXTERNAL condsurfs, liss, nightingale
89    !=========================================================================
90    ! Modifications introduced by NHL
91    ! -Variables to save fluxes were introduced
92    ! -lmt_so2ba was multiplied by fracso2emis in line 117
93    ! -scale_param_bb was introduced in line 105
94    ! The last two modifications were errors existing in the original version
95    !=========================================================================
96    !=========================================================================
97    ! LOW LEVEL EMISSIONS
98    !=========================================================================
99
100    CALL nightingale(u_seri, v_seri, u10m_ec, v10m_ec, paprs, &
101            pplay, cdragh, cdragm, t_seri, q_seri, ftsol, &
102            tsol, pctsrf, lmt_dmsconc, lmt_dms)
103
104    IF (.NOT.bateau) THEN
105      DO i = 1, klon
106        lmt_so2ba(i) = 0.0
107      ENDDO
108    ENDIF
109
110    DO i = 1, klon
111      IF (iregion_ind(i)>0) THEN
112        IF(id_prec>0) source_tr(i, id_prec) = source_tr(i, id_prec) &
113                + fracso2emis &
114                        * scale_param_ind(iregion_ind(i)) * lmt_so2ff_l(i) * 1.e4 &
115                + scale_param_ind(iregion_ind(i)) * lmt_so2ff_l(i) * 1.e4 &
116                        * frach2sofso2            ! molec/m2/s
117
118        IF(id_fine>0) source_tr(i, id_fine) = &
119                source_tr(i, id_fine) + (1 - fracso2emis) &
120                        * scale_param_ind(iregion_ind(i)) * lmt_so2ff_l(i) &
121                        * 1.e4 * masse_ammsulfate / RNAVO  ! g/m2/s
122
123        IF(id_prec>0)   flux_tr(i, id_prec) = flux_tr(i, id_prec) + (&
124                scale_param_ind(iregion_ind(i)) * (lmt_so2ff_l(i) + &
125                        lmt_so2ff_h(i)) &
126                        * frach2sofso2 &
127                        + scale_param_ind(iregion_ind(i)) * (lmt_so2ff_l(i) + &
128                        lmt_so2ff_h(i)) &
129                        * fracso2emis &
130                ) * 1.e4 / RNAVO * masse_s * 1.e3          ! mgS/m2/s
131
132        IF(id_fine>0)  flux_tr(i, id_fine) = &
133                flux_tr(i, id_fine) + (1 - fracso2emis) &
134                        * scale_param_ind(iregion_ind(i)) * (lmt_so2ff_l(i) + &
135                        lmt_so2ff_h(i)) &
136                        * 1.e4 / RNAVO * masse_ammsulfate * 1.e3    ! mgS/m2/s
137
138        flux_sparam_ind(i) = flux_sparam_ind(i) + (1 - fracso2emis) &
139                * scale_param_ind(iregion_ind(i)) * (lmt_so2ff_l(i) + &
140                lmt_so2ff_h(i)) &
141                * 1.e4 / RNAVO * masse_ammsulfate * 1.e3    ! mgS/m2/s
142      ENDIF
143      IF (iregion_bb(i)>0) THEN
144        IF(id_prec>0) source_tr(i, id_prec) = &
145                source_tr(i, id_prec) + fracso2emis &
146                        * scale_param_bb(iregion_bb(i)) * lmt_so2bb_l(i) &
147                        * (1. - pctsrf(i, is_oce)) * 1.e4
148
149        IF(id_fine>0)     source_tr(i, id_fine) = &
150                source_tr(i, id_fine) + (1 - fracso2emis) &
151                        * scale_param_bb(iregion_bb(i)) * lmt_so2bb_l(i) * &
152                        (1. - pctsrf(i, is_oce)) * 1.e4 * &
153                        masse_ammsulfate / RNAVO  ! g/m2/s
154
155        IF(id_prec>0)     flux_tr(i, id_prec) = flux_tr(i, id_prec) + &
156                (scale_param_bb(iregion_bb(i)) * lmt_so2bb_l(i) &
157                        + scale_param_bb(iregion_bb(i)) * lmt_so2bb_h(i)) &
158                        * (1. - pctsrf(i, is_oce)) * fracso2emis &
159                        * 1.e4 / RNAVO * masse_s * 1.e3          ! mgS/m2/s
160
161        IF(id_fine>0) flux_tr(i, id_fine) = &
162                flux_tr(i, id_fine) + (1 - fracso2emis) &
163                        * (scale_param_bb(iregion_bb(i)) * lmt_so2bb_l(i) &
164                                + scale_param_bb(iregion_bb(i)) * lmt_so2bb_h(i)) &
165                        * (1. - pctsrf(i, is_oce)) &
166                        * 1.e4 / RNAVO * masse_ammsulfate * 1.e3    ! mgS/m2/s
167
168        flux_sparam_bb(i) = &
169                scale_param_bb(iregion_bb(i)) * (lmt_so2bb_l(i) + &
170                        lmt_so2bb_h(i)) &
171                        * (1. - pctsrf(i, is_oce)) * fracso2emis &
172                        * 1.e4 / RNAVO * masse_s * 1.e3          ! mgS/m2/s
173        flux_sparam_bb(i) = flux_sparam_bb(i) + (1 - fracso2emis) * &
174                (scale_param_bb(iregion_bb(i)) * lmt_so2bb_l(i) + &
175                        scale_param_bb(iregion_bb(i)) * lmt_so2bb_h(i)) &
176                * (1. - pctsrf(i, is_oce)) &
177                * 1.e4 / RNAVO * masse_ammsulfate * 1.e3    ! mgS/m2/s
178      ENDIF
179      IF(id_prec>0)   source_tr(i, id_prec) = source_tr(i, id_prec) &
180              + fracso2emis &
181                      * (lmt_so2ba(i) + lmt_so2nff(i)) * 1.e4 &
182              + (lmt_h2sbio(i) &
183                      + lmt_dms(i) + lmt_dmsbio(i)) * 1.e4            ! molec/m2/s
184
185      IF(id_fine>0)   source_tr(i, id_fine) = source_tr(i, id_fine) &
186              + (1 - fracso2emis) &
187                      * (lmt_so2ba(i) + lmt_so2nff(i)) * 1.e4 * &
188                      masse_ammsulfate / RNAVO  ! g/m2/s
189
190      IF(id_prec>0)   flux_tr(i, id_prec) = flux_tr(i, id_prec) &
191              + (lmt_h2sbio(i) &
192                      + lmt_so2volc_cont(i) + lmt_so2volc_expl(i) &
193                      + (lmt_so2ba(i) + lmt_so2nff(i)) * fracso2emis &
194                      + lmt_dms(i) + lmt_dmsbio(i)) &
195                      * 1.e4 / RNAVO * masse_s * 1.e3          ! mgS/m2/s
196
197      IF(id_fine>0)   flux_tr(i, id_fine) = flux_tr(i, id_fine) &
198              + (1 - fracso2emis) &
199                      * (lmt_so2ba(i) + lmt_so2nff(i)) &
200                      * 1.e4 / RNAVO * masse_ammsulfate * 1.e3    ! mgS/m2/s
201
202      flux_sparam_ind(i) = flux_sparam_ind(i) + (1 - fracso2emis) &
203              * lmt_so2nff(i) &
204              * 1.e4 / RNAVO * masse_ammsulfate * 1.e3    ! mgS/m2/s
205
206    ENDDO
207
208    !========================================================================
209    ! HIGH LEVEL EMISSIONS
210    !========================================================================
211    !  Source de SO2 volcaniques
212    DO i = 1, klon
213      kkk_cont(i) = 1
214      kkk_expl(i) = 1
215    ENDDO
216    DO k = 1, klev - 1
217      DO i = 1, klon
218        zaltmid(i, k) = zalt(i, k) + zdz(i, k) / 2.
219        IF (zalt(i, k + 1)<lmt_altvolc_cont(i)) kkk_cont(i) = k + 1
220        IF (zalt(i, k + 1)<lmt_altvolc_expl(i)) kkk_expl(i) = k + 1
221      ENDDO
222    ENDDO
223    IF(id_prec>0) THEN
224      DO i = 1, klon
225        tr_seri(i, kkk_cont(i), id_prec) = tr_seri(i, kkk_cont(i), id_prec) + &
226                lmt_so2volc_cont(i) / zdz(i, kkk_cont(i)) / 100. * pdtphys
227        tr_seri(i, kkk_expl(i), id_prec) = tr_seri(i, kkk_expl(i), id_prec) + &
228                lmt_so2volc_expl(i) / zdz(i, kkk_expl(i)) / 100. * pdtphys
229      ENDDO
230    ENDIF
231    !  Sources hautes de SO2
232
233
234    !--only GEIA SO2 emissions has high emissions
235    !--unit: molec/cm2/s divided by layer height (in cm) multiplied by timestep
236
237    k = 2                             !introducing emissions in level 2
238    DO i = 1, klon
239
240      IF (iregion_bb(i)>0) THEN
241        IF(id_prec>0)   tr_seri(i, k, id_prec) = &
242                tr_seri(i, k, id_prec) + fracso2emis &
243                        * scale_param_bb(iregion_bb(i)) * lmt_so2bb_h(i) &
244                        / zdz(i, k) / 100. * pdtphys
245
246        IF(id_fine>0)     tr_seri(i, k, id_fine) = tr_seri(i, k, id_fine) &
247                + (1. - fracso2emis) &
248                        * scale_param_bb(iregion_bb(i)) * lmt_so2bb_h(i) &
249                        * masse_ammsulfate / RNAVO / zdz(i, k) / 100. * pdtphys   !g/cm3
250      ENDIF
251      IF (iregion_ind(i)>0) THEN
252        IF(id_prec>0)  tr_seri(i, k, id_prec) = &
253                tr_seri(i, k, id_prec) + (fracso2emis &
254                        * scale_param_ind(iregion_ind(i)) * lmt_so2ff_h(i) &
255                        + frach2sofso2 &
256                                * scale_param_ind(iregion_ind(i)) * lmt_so2ff_h(i)) &
257                        / zdz(i, k) / 100. * pdtphys
258
259        IF(id_fine>0)    tr_seri(i, k, id_fine) = tr_seri(i, k, id_fine) &
260                + (1. - fracso2emis) &
261                        * scale_param_ind(iregion_ind(i)) * lmt_so2ff_h(i) &
262                        * masse_ammsulfate / RNAVO / zdz(i, k) / 100. * pdtphys   !g/cm3
263      ENDIF
264
265    ENDDO
266
267  END SUBROUTINE precuremission
268END MODULE lmdz_precureemission
Note: See TracBrowser for help on using the repository browser.