source: LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/strataer_local_var_mod.F90

Last change on this file was 5112, checked in by abarral, 5 months ago

Rename modules in phy_common from *_mod > lmdz_*
File size: 13.3 KB
Line 
1MODULE strataer_local_var_mod
2  ! This module contains strato microphysic model parameters & variables
3  USE lmdz_abort_physic, ONLY: abort_physic
4  IMPLICIT NONE
5
6  !============= GENERAL PARAMS =============
7  !flag for type emission scenario: (0) background aer ; (1) volcanic eruption with Sulfur ;
8  !(2,3) strato aer injections (SAI) ; (4) volcanic eruption chimistry; (5) rocket
9  INTEGER, SAVE :: flag_emit
10  !$OMP THREADPRIVATE(flag_emit)
11
12  ! flag for emission altitude distribution: (0) gaussian; (1) uniform
13  INTEGER, SAVE :: flag_emit_distrib
14  !$OMP THREADPRIVATE(flag_emit_distrib)
15
16  ! flag to choose nucleation nucleation method
17  LOGICAL, SAVE :: flag_new_nucl   ! T=new routine from A. Maattanen (LATMOS), F=older routine from H. Vehkamäki (FMI)
18  !$OMP THREADPRIVATE(flag_new_nucl)
19
20  ! Use relative humidity from 2D model stratospheric H2O because LMDz is too dry in the stratosphere
21  ! (no CH4 oxidation)
22  LOGICAL, SAVE :: flag_H2O2d_nucleation
23  !$OMP THREADPRIVATE(flag_H2O2d_nucleation)
24
25  ! OH reduction from SO2. OH is reduced when its reaction with SO2 competes sufficiently with its reaction
26  ! with O3 (Bekki, 1995). As a result, SO2 lifetime is extended. 2D model O3 climatologies are needed.
27  LOGICAL, SAVE :: flag_OH_reduced
28  !$OMP THREADPRIVATE(flag_OH_reduced)
29
30  ! H2SO4 photolysis: H2SO4 is converted into SO2 by complex photolytic processes. Here simplified approach
31  ! by setting H2SO4 cross-sections = 0.3*HCl cross-sections (Rinsland et al., 1995)
32  LOGICAL, SAVE :: flag_H2SO4_photolysis
33  !$OMP THREADPRIVATE(flag_H2SO4_photolysis)
34
35  ! flag for minimum lifetime (=1.5 pdt phys)
36  LOGICAL, SAVE :: flag_min_rreduce
37  !$OMP THREADPRIVATE(flag_min_rreduce)
38
39  ! flag to read new climato (O3, H2O & H2SO4_LIFET)
40  LOGICAL, SAVE :: flag_newclim_file
41  !$OMP THREADPRIVATE(flag_newclim_file)
42
43  ! flag to choose new H2SO4 density and weight percent from Tabazadeh et al. (1994).
44  LOGICAL, SAVE :: flag_new_strat_compo
45  !$OMP THREADPRIVATE(flag_new_strat_compo)
46
47  ! Verbose mode to get more print info
48  LOGICAL, SAVE :: flag_verbose_strataer
49  !$OMP THREADPRIVATE(flag_verbose_strataer)
50
51
52  !============= NUCLEATION VARS =============
53  ! MOLECULAR ACCOMODATION OF H2SO4 (Raes and Van Dingen)
54  REAL, SAVE :: ALPH2SO4               ! H2SO4 accommodation  coefficient [condensation/evaporation]
55  !$OMP THREADPRIVATE(ALPH2SO4)
56
57  ! flag to constraint nucleation rate in a lat/pres box
58  LOGICAL, SAVE :: flag_nuc_rate_box      ! Nucleation rate limit or not to a lat/pres
59  !$OMP THREADPRIVATE(flag_nuc_rate_box)
60  REAL, SAVE :: nuclat_min             ! min lat to activate nuc rate
61  REAL, SAVE :: nuclat_max             ! max lat to activate nuc rate
62  REAL, SAVE :: nucpres_min            ! min pres to activate nuc rate
63  REAL, SAVE :: nucpres_max            ! max pres to activate nuc rate
64  !$OMP THREADPRIVATE(nuclat_min, nuclat_max, nucpres_min, nucpres_max)
65
66  LOGICAL, SAVE :: ok_qemiss
67  !$OMP THREADPRIVATE(ok_qemiss)
68  INTEGER, SAVE :: flh2o  ! ds stratemit : flh2o =0 (tr_seri), flh2o=1 (dq)
69  !$OMP THREADPRIVATE(flh2o)
70
71  REAL, ALLOCATABLE, SAVE :: budg_emi(:, :)            !DIMENSION(klon,n)
72  !$OMP THREADPRIVATE(budg_emi)
73
74
75  !============= EMISSION VARS =============
76  !--flag_emit=1 OR == 4 -- Volcanic eruption(s)
77  INTEGER, SAVE :: nErupt                    ! number of eruptions specs
78  REAL, SAVE :: injdur                    ! volcanic injection duration
79  !$OMP THREADPRIVATE(nErupt, injdur)
80  INTEGER, ALLOCATABLE, SAVE :: year_emit_vol(:)          ! year of emission date
81  INTEGER, ALLOCATABLE, SAVE :: mth_emit_vol(:)           ! month of emission date
82  INTEGER, ALLOCATABLE, SAVE :: day_emit_vol(:)           ! day of emission date
83  !$OMP THREADPRIVATE(year_emit_vol, mth_emit_vol, day_emit_vol)
84  REAL, ALLOCATABLE, SAVE :: altemiss_vol(:)           ! emission altitude in m
85  REAL, ALLOCATABLE, SAVE :: sigma_alt_vol(:)          ! standard deviation of emission altitude in m
86  !$OMP THREADPRIVATE(altemiss_vol, sigma_alt_vol)
87  INTEGER, ALLOCATABLE, SAVE :: ponde_lonlat_vol(:)       ! lon/lat ponderation factor
88  REAL, ALLOCATABLE, SAVE :: xlat_min_vol(:)           ! min latitude of volcano in degree
89  REAL, ALLOCATABLE, SAVE :: xlat_max_vol(:)           ! max latitude of volcano in degree
90  REAL, ALLOCATABLE, SAVE :: xlon_min_vol(:)           ! min longitude of volcano in degree
91  REAL, ALLOCATABLE, SAVE :: xlon_max_vol(:)           ! max longitude of volcano in degree
92  !$OMP THREADPRIVATE(ponde_lonlat_vol, xlat_min_vol, xlat_max_vol, xlon_min_vol, xlon_max_vol)
93
94  !--flag_emit=1
95  INTEGER, SAVE :: nAerErupt                 ! number Aerosol
96  !$OMP THREADPRIVATE(nAerErupt)
97  REAL, ALLOCATABLE, SAVE :: m_sulf_emiss_vol(:)        ! emitted sulfur mass in kgS, e.g. 7Tg(S)=14Tg(SO2)
98  REAL, ALLOCATABLE, SAVE :: m_aer_emiss_vol(:, :)
99  !$OMP THREADPRIVATE(m_sulf_emiss_vol,m_aer_emiss_vol)
100
101  !--flag_emit=2 --SAI
102  REAL, SAVE :: m_aer_emiss_sai        ! emitted sulfur mass in kgS, eg 1e9=1TgS, 1e10=10TgS
103  REAL, SAVE :: altemiss_sai           ! emission altitude in m
104  REAL, SAVE :: sigma_alt_sai          ! standard deviation of emission altitude in m
105  !$OMP THREADPRIVATE(m_aer_emiss_sai, altemiss_sai, sigma_alt_sai)
106  INTEGER, SAVE :: year_emit_sai_start
107  INTEGER, SAVE :: year_emit_sai_end
108  INTEGER, SAVE :: mth_emit_sai_start
109  INTEGER, SAVE :: mth_emit_sai_end
110  INTEGER, SAVE :: day_emit_sai_start
111  INTEGER, SAVE :: day_emit_sai_end
112  !$OMP THREADPRIVATE(year_emit_sai_start, year_emit_sai_end)
113  !$OMP THREADPRIVATE(mth_emit_sai_start, mth_emit_sai_end)
114  !$OMP THREADPRIVATE(day_emit_sai_start, day_emit_sai_end)
115  REAL, SAVE :: xlat_sai               ! latitude of SAI in degree
116  REAL, SAVE :: xlon_sai               ! longitude of SAI in degree
117  !$OMP THREADPRIVATE(xlat_sai, xlon_sai)
118
119  !--flag_emit=3 -- SAI
120  REAL, SAVE :: xlat_max_sai           ! maximum latitude of SAI in degrees
121  REAL, SAVE :: xlat_min_sai           ! minimum latitude of SAI in degrees
122  !$OMP THREADPRIVATE(xlat_min_sai,xlat_max_sai)
123
124  !--flag_emit=4 -- volc species
125  INTEGER, SAVE :: nSpeciesErupt            ! number of species Repr
126  INTEGER, ALLOCATABLE, SAVE :: id_species(:)            ! indice species Repr
127  REAL, ALLOCATABLE, SAVE :: m_species_emiss_vol(:, :) ! emitted species
128  !$OMP THREADPRIVATE(nSpeciesErupt,id_species,m_species_emiss_vol)
129  INTEGER, ALLOCATABLE, SAVE :: id_HCl
130  INTEGER, ALLOCATABLE, SAVE :: id_HBr
131  INTEGER, ALLOCATABLE, SAVE :: id_NOx
132  INTEGER, ALLOCATABLE, SAVE :: id_H2O
133  !$OMP THREADPRIVATE(id_HCl,id_HBr,id_NOx,id_H2O)
134  REAL, ALLOCATABLE, SAVE :: m_Chlore_emiss_vol(:)   ! emitted Chlore mass
135  REAL, ALLOCATABLE, SAVE :: m_Brome_emiss_vol(:)    ! emitted Brome mass
136  REAL, ALLOCATABLE, SAVE :: m_NOx_emiss_vol(:)      ! emitted NOx mass
137  REAL, ALLOCATABLE, SAVE :: m_H2O_emiss_vol(:)      ! emitted H2O mass
138  REAL, ALLOCATABLE, SAVE :: m_H2O_emiss_vol_daily(:)
139  !$OMP THREADPRIVATE(m_Chlore_emiss_vol,m_Brome_emiss_vol,m_NOx_emiss_vol,m_H2O_emiss_vol)
140  !$OMP THREADPRIVATE(m_H2O_emiss_vol_daily)
141
142  !--flag_emit=5 -- Rockets Emitted
143  INTEGER, SAVE :: ifreqroc        ! frequence (=2 ex: tous les 2 mois)
144  !$OMP THREADPRIVATE(ifreqroc)
145  INTEGER, ALLOCATABLE, SAVE :: day_emit_roc(:) ! day of emission date
146  !$OMP THREADPRIVATE(day_emit_roc)
147
148  REAL, ALLOCATABLE, SAVE :: RRSI(:) ! radius [cm] for each aerosol size
149  REAL, ALLOCATABLE, SAVE :: Vbin(:) ! volume [m3] for each aerosol size
150  !$OMP THREADPRIVATE(RRSI, Vbin)
151  REAL, SAVE :: dlat, dlon             ! delta latitude and d longitude of grid in degree
152  !$OMP THREADPRIVATE(dlat, dlon)
153
154CONTAINS
155
156  SUBROUTINE strataer_init()
157    USE lmdz_ioipsl_getin_p, ONLY: getin_p
158    USE lmdz_print_control, ONLY: lunout
159    USE lmdz_phys_para, ONLY: is_master
160    USE infotrac_phy, ONLY: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, nbtr_sulgas, nbtr_bin
161    USE phys_local_var_mod, ONLY: mdw
162    USE aerophys, ONLY: mdwmin, V_rat
163    USE lmdz_yomcst, ONLY: RPI
164
165    INTEGER :: it
166
167    WRITE(lunout, *) 'IN STRATAER_LOCAL_VAR INIT WELCOME!'
168
169    !============= Check Sulfur aerosols ID =============
170    WRITE(lunout, *) 'STRATAER_LOCAL_VAR INIT: id_OCS_strat=', id_OCS_strat, ' id_SO2_strat=', id_SO2_strat, ' id_H2SO4_strat=', id_H2SO4_strat
171
172    IF(id_OCS_strat < 0 .OR. id_OCS_strat > nbtr_sulgas) THEN
173      WRITE(lunout, *) 'ERROR : OCS index id_OCS_strat=', id_OCS_strat, ' is negative or superior than the total sulfur gases !'
174      CALL abort_physic('strataer_local_var_mod', 'Wrong OCS index, check your tracer.def file.', 1)
175    ELSEIF(id_SO2_strat < 0 .OR. id_SO2_strat > nbtr_sulgas) THEN
176      WRITE(lunout, *) 'ERROR : SO2 index id_SO2_strat=', id_SO2_strat, ' is negative or superior than the total sulfur gases !'
177      CALL abort_physic('strataer_local_var_mod', 'Wrong SO2 index, check your tracer.def file.', 1)
178    ELSEIF(id_H2SO4_strat < 0 .OR. id_H2SO4_strat > nbtr_sulgas) THEN
179      WRITE(lunout, *) 'ERROR : H2SO4 index id_H2SO4_strat=', id_H2SO4_strat, ' is negative or superior than the total sulfur gases !'
180      CALL abort_physic('strataer_local_var_mod', 'Wrong H2SO4 index, check your tracer.def file.', 1)
181    ENDIF
182
183    !============= Init params =============
184    flag_emit = 0                   ! Background (default)
185    flag_emit_distrib = 0           ! Gaussian (default)
186    flag_new_nucl = .TRUE.          ! Define nucleation routine (default: A. Maattanen - LATMOS)
187    flag_verbose_strataer = .FALSE. ! verbose mode
188    flag_newclim_file = .TRUE.      ! Define input climato file (default: all climato)
189    flag_H2O2d_nucleation = .FALSE. ! Use H2O 2D climato (default: No)
190    flag_OH_reduced = .FALSE.       ! OH reduce (default: No)
191    flag_H2SO4_photolysis = .FALSE. ! H2SO4 photolysis (default: No)
192    flag_min_rreduce = .TRUE.       ! Minimum lifetime=1.5 pdt phys (default: Yes)
193    flag_new_strat_compo = .TRUE.    ! H2SO4/H2O weight percent & density routine (default: S. Bekki)
194    ok_qemiss = .FALSE.             ! H2O emission flag
195
196    ! nuc init
197    ALPH2SO4 = 0.1
198    flag_nuc_rate_box = .FALSE.
199    nuclat_min = 0  ; nuclat_max = 0
200    nucpres_min = 0 ; nucpres_max = 0
201
202    ! emiss init
203    nErupt = 0 ! eruption number
204    injdur = 0 ! init injection duration
205    nAerErupt = 1 ; nSpeciesErupt = 1
206    ifreqroc = 2 ; flh2o = 0
207
208    !============= Read params =============
209    CALL getin_p('flag_emit', flag_emit)
210    CALL getin_p('flag_emit_distrib', flag_emit_distrib)
211    CALL getin_p('flag_verbose_strataer', flag_verbose_strataer)
212    CALL getin_p('flag_new_nucl', flag_new_nucl)
213    CALL getin_p('flag_newclim_file', flag_newclim_file)
214    CALL getin_p('flag_H2O2d_nucleation', flag_H2O2d_nucleation)
215    CALL getin_p('flag_OH_reduced', flag_OH_reduced)
216    CALL getin_p('flag_H2SO4_photolysis', flag_H2SO4_photolysis)
217    CALL getin_p('flag_min_rreduce', flag_min_rreduce)
218    CALL getin_p('flag_new_strat_compo', flag_new_strat_compo)
219    CALL getin_p('ok_qemiss', ok_qemiss)
220
221    !============= Test flag coherence =============
222    IF (.NOT. flag_newclim_file) THEN
223      IF (flag_H2SO4_photolysis .OR. flag_OH_reduced .OR. flag_H2O2d_nucleation) THEN
224        WRITE(lunout, *) 'ERROR : flag_newclim_file=', flag_newclim_file, &
225                ' whereas flag_H2SO4_photolysis=', flag_H2SO4_photolysis, ', flag_OH_reduced=', flag_OH_reduced, &
226                ' and flag_H2O2d_nucleation=', flag_H2O2d_nucleation
227        CALL abort_physic('strataer_local_var_mod', 'Incompatible options in physiq_def file !', 1)
228      ENDIF
229      IF(flag_min_rreduce) THEN
230        WRITE(lunout, *) 'Warning : flag_min_rreduce will be ignored with old climato file !'
231      ENDIF
232    ENDIF
233
234    !============= Print params =============
235    IF (is_master) THEN
236      WRITE(lunout, *) 'flag_emit = ', flag_emit
237      WRITE(lunout, *) 'IN STRATAER : flag_new_nucl = ', flag_new_nucl
238      WRITE(lunout, *) 'IN STRATAER : flag_newclim_file = ', flag_newclim_file
239      WRITE(lunout, *) 'IN STRATAER : flag_emit_distrib = ', flag_emit_distrib
240      WRITE(lunout, *) 'IN STRATAER : flag_verbose_strataer = ', flag_verbose_strataer
241      IF (flag_emit == 1 .OR. flag_emit == 4) THEN
242        WRITE(lunout, *) 'IN STRATAER : flag_H2O2d_nucleation = ', flag_H2O2d_nucleation
243        WRITE(lunout, *) 'IN STRATAER : flag_OH_reduced = ', flag_OH_reduced
244        WRITE(lunout, *) 'IN STRATAER : flag_H2SO4_photolysis = ', flag_H2SO4_photolysis
245        WRITE(lunout, *) 'IN STRATAER : flag_min_rreduce = ', flag_min_rreduce
246        WRITE(lunout, *) 'IN STRATAER : flag_new_strat_compo = ', flag_new_strat_compo
247        WRITE(lunout, *) 'IN STRATAER : ok_qemiss = ', ok_qemiss
248      ENDIF
249    ENDIF ! if master
250
251    !--initialising dry diameters to geometrically spaced mass/volume (see Jacobson 1994)
252    mdw(1) = mdwmin
253    IF (V_rat<1.62) THEN ! compensate for dip in second bin for lower volume ratio
254      mdw(2) = mdw(1) * 2.**(1. / 3.)
255      DO it = 3, nbtr_bin
256        mdw(it) = mdw(it - 1) * V_rat**(1. / 3.)
257      ENDDO
258    ELSE
259      DO it = 2, nbtr_bin
260        mdw(it) = mdw(it - 1) * V_rat**(1. / 3.)
261      ENDDO
262    ENDIF
263    IF (is_master) WRITE(lunout, *) 'init mdw=', mdw
264
265    !   compute particle radius RRSI [cm] and volume Vbin [m3] from diameter mdw [m]
266    ALLOCATE(RRSI(nbtr_bin), Vbin(nbtr_bin))
267
268    DO it = 1, nbtr_bin
269      !     [cm]
270      RRSI(it) = mdw(it) / 2. * 100.
271      !     [m3]
272      Vbin(it) = 4.0 * RPI * ((mdw(it) / 2.)**3) / 3.0
273    ENDDO
274
275    IF (is_master) THEN
276      WRITE(lunout, *) 'init RRSI=', RRSI
277      WRITE(lunout, *) 'init Vbin=', Vbin
278    ENDIF
279
280    WRITE(lunout, *) 'IN STRATAER INIT END'
281
282  END SUBROUTINE strataer_init
283
284END MODULE strataer_local_var_mod
Note: See TracBrowser for help on using the repository browser.