source: LMDZ5/branches/LMDZ5_SPLA/libf/phylmd/precuremission.F @ 2699

Last change on this file since 2699 was 2196, checked in by jescribano, 10 years ago

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