source: LMDZ6/trunk/libf/phylmd/Dust/precuremission.f90 @ 5327

Last change on this file since 5327 was 5292, checked in by abarral, 3 weeks ago

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