source: LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/strataer_emiss_mod.F90 @ 5128

Last change on this file since 5128 was 5117, checked in by abarral, 5 months ago

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords
File size: 11.1 KB
Line 
1MODULE strataer_emiss_mod
2  ! This module contains information about strato microphysic model emission parameters
3
4CONTAINS
5
6  SUBROUTINE strataer_emiss_init()
7
8    USE strataer_local_var_mod
9    USE lmdz_ioipsl_getin_p, ONLY: getin_p
10    USE lmdz_print_control, ONLY: lunout
11    USE lmdz_phys_para, ONLY: is_master
12    USE lmdz_abort_physic, ONLY: abort_physic
13
14    ! Local variables
15    INTEGER :: ispec
16
17    WRITE(lunout, *) 'IN STRATAER_EMISS INIT WELCOME!'
18
19    IF (flag_emit==1 .OR. flag_emit==4) THEN ! Volcano
20      CALL getin_p('nErupt', nErupt) !eruption nb
21      CALL getin_p('injdur', injdur) !injection duration
22
23      IF (flag_emit==1) THEN
24        CALL getin_p('nAerErupt', nAerErupt) !sulfur aer nb
25      ELSEIF (flag_emit==4) THEN
26        CALL getin_p('nSpeciesErupt', nSpeciesErupt) !chimical species nb
27      ENDIF
28
29      IF (nErupt>0) THEN
30        ALLOCATE(year_emit_vol(nErupt), mth_emit_vol(nErupt), day_emit_vol(nErupt))
31        year_emit_vol = 0 ; mth_emit_vol = 0 ; day_emit_vol = 0
32        ALLOCATE(altemiss_vol(nErupt), sigma_alt_vol(nErupt))
33        ALLOCATE(xlat_min_vol(nErupt), xlon_min_vol(nErupt))
34        ALLOCATE(xlat_max_vol(nErupt), xlon_max_vol(nErupt))
35        altemiss_vol = 0. ; sigma_alt_vol = 0.
36        xlon_min_vol = 0. ; xlon_max_vol = 0.
37        xlat_min_vol = 0. ; xlat_max_vol = 0.
38        ! injection params (dates, loc, injections params)
39        CALL getin_p('year_emit_vol', year_emit_vol)
40        CALL getin_p('mth_emit_vol', mth_emit_vol)
41        CALL getin_p('day_emit_vol', day_emit_vol)
42        CALL getin_p('altemiss_vol', altemiss_vol)
43        CALL getin_p('sigma_alt_vol', sigma_alt_vol)
44        CALL getin_p('xlon_min_vol', xlon_min_vol)
45        CALL getin_p('xlon_max_vol', xlon_max_vol)
46        CALL getin_p('xlat_min_vol', xlat_min_vol)
47        CALL getin_p('xlat_max_vol', xlat_max_vol)
48        IF (flag_emit==1) THEN
49          ALLOCATE(m_sulf_emiss_vol(nErupt))
50          ALLOCATE(m_aer_emiss_vol(nErupt, nAerErupt))
51          m_aer_emiss_vol = 0. ; m_sulf_emiss_vol = 0.
52          IF (ok_qemiss) THEN
53            ALLOCATE(m_H2O_emiss_vol(nErupt))
54            ALLOCATE(m_H2O_emiss_vol_daily(nErupt))
55            !                ALLOCATE(d_q_emiss(klon,klev))
56            ALLOCATE(budg_emi(klon, nAerErupt + 1))
57            m_H2O_emiss_vol(:) = 0.
58            m_H2O_emiss_vol_daily(:) = 0.
59            !                d_q_emiss(:,:)=0.
60          ELSE
61            ALLOCATE(budg_emi(klon, nAerErupt))
62          ENDIF
63          budg_emi(:, :) = 0.
64        ELSEIF (flag_emit==4) THEN
65          ALLOCATE(m_Chlore_emiss_vol(nErupt))
66          ALLOCATE(id_HCl)
67          ALLOCATE(m_Brome_emiss_vol(nErupt))
68          ALLOCATE(id_HBr)
69          ALLOCATE(id_species(nSpeciesErupt))
70          id_species = 0
71          ALLOCATE(m_species_emiss_vol(nErupt, nSpeciesErupt))
72          m_species_emiss_vol = 0.
73          ALLOCATE(m_NOx_emiss_vol(nErupt))
74          ALLOCATE(m_H2O_emiss_vol(nErupt))
75          m_Chlore_emiss_vol = 0. ; m_Brome_emiss_vol = 0.
76          m_NOx_emiss_vol = 0. ; m_H2O_emiss_vol = 0.
77          ALLOCATE(id_NOx)
78          ALLOCATE(id_H2O)
79          ALLOCATE(budg_emi(klon, nSpeciesErupt))
80          budg_emi(:, :) = 0.
81        ENDIF
82      ELSE
83        WRITE(lunout, *) 'ERROR : Using flag_emit=1 or 4 (ie Volcanic eruption) but nErupt (', nErupt, ') <=0 !'
84        CALL abort_physic('strataer_emiss_mod', &
85                'No eruption define in physiq_def (nErupt=0). Add at one eruption or use background condition.', 1)
86      ENDIF ! fin if nerupt
87
88      IF (flag_emit==1) THEN
89        CALL getin_p('m_sulf_emiss_vol', m_sulf_emiss_vol)
90        IF (ok_qemiss) THEN
91          CALL getin_p('m_H2O_emiss_vol', m_H2O_emiss_vol)
92        endif
93      ELSEIF (flag_emit==4) THEN
94        CALL getin_p('id_species', id_species)
95        CALL getin_p('m_Chlore_emiss_vol', m_Chlore_emiss_vol)
96        CALL getin_p('id_HCl', id_HCl)
97        CALL getin_p('m_Brome_emiss_vol', m_Brome_emiss_vol)
98        CALL getin_p('id_HBr', id_HBr)
99        CALL getin_p('m_NOx_emiss_vol', m_NOx_emiss_vol)
100        CALL getin_p('id_NOx', id_NOx)
101        CALL getin_p('m_H2O_emiss_vol', m_H2O_emiss_vol)
102        CALL getin_p('id_H2O', id_H2O)
103      ENDIF
104
105    ELSEIF (flag_emit == 2) THEN ! SAI
106      CALL getin_p('m_aer_emiss_sai', m_aer_emiss_sai)
107      CALL getin_p('altemiss_sai', altemiss_sai)
108      CALL getin_p('sigma_alt_sai', sigma_alt_sai)
109      CALL getin_p('xlat_sai', xlat_sai)
110      CALL getin_p('xlon_sai', xlon_sai)
111      CALL getin_p('year_emit_sai_start', year_emit_sai_start)
112      CALL getin_p('year_emit_sai_end', year_emit_sai_end)
113      CALL getin_p('mth_emit_sai_start', mth_emit_sai_start)
114      CALL getin_p('mth_emit_sai_end', mth_emit_sai_end)
115      CALL getin_p('day_emit_sai_start', day_emit_sai_start)
116      CALL getin_p('day_emit_sai_end', day_emit_sai_end)
117
118    ELSEIF (flag_emit == 3) THEN ! SAI between latitudes
119      CALL getin_p('m_aer_emiss_sai', m_aer_emiss_sai)
120      CALL getin_p('altemiss_sai', altemiss_sai)
121      CALL getin_p('sigma_alt_sai', sigma_alt_sai)
122      CALL getin_p('xlon_sai', xlon_sai)
123      CALL getin_p('xlat_max_sai', xlat_max_sai)
124      CALL getin_p('xlat_min_sai', xlat_min_sai)
125    ENDIF
126
127    IF (flag_emit == 1) THEN
128      DO ispec = 1, nAerErupt
129        m_aer_emiss_vol(:, ispec) = m_sulf_emiss_vol(:)
130      ENDDO
131    ELSEIF (flag_emit== 4) THEN
132      DO ispec = 1, nSpeciesErupt
133        IF(id_species(ispec) == id_HCl) THEN
134          m_species_emiss_vol(:, ispec) = m_Chlore_emiss_vol(:)
135        ENDIF
136        IF (id_species(ispec) == id_HBr) THEN
137          m_species_emiss_vol(:, ispec) = m_Brome_emiss_vol(:)
138        ENDIF
139        IF (id_species(ispec) == id_NOx) THEN
140          m_species_emiss_vol(:, ispec) = m_NOx_emiss_vol(:)
141        ENDIF
142        IF (id_species(ispec) == id_H2O) THEN
143          m_species_emiss_vol(:, ispec) = m_H2O_emiss_vol(:)
144        ENDIF
145      ENDDO
146    ENDIF
147
148    !============= Injection ponderation =============
149    IF (flag_emit > 0) THEN
150      CALL strataer_ponde_init
151      WRITE(lunout, *) 'IN STRATAER INIT : ponde_lonlat_vol', ponde_lonlat_vol
152    ENDIF
153
154    !============= Print params =============
155    IF (is_master) THEN
156      IF (nErupt > 0) THEN
157        IF (flag_emit == 1 .OR. flag_emit == 4) THEN
158          WRITE(lunout, *) 'IN STRATAER nErupt: ', nErupt
159          WRITE(lunout, *) 'IN STRATAER injdur: ', injdur
160          WRITE(lunout, *) 'IN STRATAER nAerErupt: ', nAerErupt
161
162          WRITE(lunout, *) 'IN STRATAER : year_emit_vol', year_emit_vol
163          WRITE(lunout, *) 'IN STRATAER : mth_emit_vol', mth_emit_vol
164          WRITE(lunout, *) 'IN STRATAER : day_emit_vol', day_emit_vol
165          WRITE(lunout, *) 'IN STRATAER : altemiss_vol', altemiss_vol
166          WRITE(lunout, *) 'IN STRATAER : sigma_alt_vol', sigma_alt_vol
167          WRITE(lunout, *) 'IN STRATAER : xlat_min_vol', xlat_min_vol
168          WRITE(lunout, *) 'IN STRATAER : xlat_max_vol', xlat_max_vol
169          WRITE(lunout, *) 'IN STRATAER : xlon_min_vol', xlon_min_vol
170          WRITE(lunout, *) 'IN STRATAER : xlon_max_vol', xlon_max_vol
171          IF (flag_emit==1) THEN
172            WRITE(lunout, *) 'IN STRATAEREMISS : m_sulf_emiss_vol', m_sulf_emiss_vol
173            WRITE(lunout, *) 'IN STRATAER : m_aer_emiss_vol', m_aer_emiss_vol
174            IF (ok_qemiss) THEN
175              WRITE(lunout, *) 'IN STRATAEREMISS : m_H2O_emiss_vol', m_H2O_emiss_vol
176            ENDIF
177          ENDIF
178        ELSEIF (flag_emit == 2) THEN
179          WRITE(lunout, *) 'IN STRATAER : m_aer_emiss_sai', m_aer_emiss_sai
180          WRITE(lunout, *) 'IN STRATAER : altemiss_sai', altemiss_sai
181          WRITE(lunout, *) 'IN STRATAER : sigma_alt_sai', sigma_alt_sai
182          WRITE(lunout, *) 'IN STRATAER : xlat_sai', xlat_sai
183          WRITE(lunout, *) 'IN STRATAER : xlon_sai', xlon_sai
184        ELSEIF (flag_emit == 3) THEN
185          WRITE(lunout, *) 'IN STRATAER : m_aer_emiss_sai', m_aer_emiss_sai
186          WRITE(lunout, *) 'IN STRATAER : altemiss_sai', altemiss_sai
187          WRITE(lunout, *) 'IN STRATAER : sigma_alt_sai', sigma_alt_sai
188          WRITE(lunout, *) 'IN STRATAER : year_emit_sai start/end', year_emit_sai_start, year_emit_sai_end
189          WRITE(lunout, *) 'IN STRATAER : mth_emit_sai start/end', mth_emit_sai_start, mth_emit_sai_end
190          WRITE(lunout, *) 'IN STRATAER : day_emit_sai start/end', day_emit_sai_start, day_emit_sai_end
191          WRITE(lunout, *) 'IN STRATAER : xlat_min_sai', xlat_min_sai
192          WRITE(lunout, *) 'IN STRATAER : xlat_max_sai', xlat_max_sai
193          WRITE(lunout, *) 'IN STRATAER : xlon_sai', xlon_sai
194        ENDIF
195        IF(flag_emit == 4) THEN
196          WRITE(lunout, *) 'IN STRATAER : nSpeciesErupt: ', nSpeciesErupt
197          WRITE(lunout, *) 'IN STRATAER : id_species = ', id_species
198          WRITE(lunout, *) 'IN STRATAER : id_HCl = ', id_HCl
199          WRITE(lunout, *) 'IN STRATAER : id_HBr = ', id_HBr
200          WRITE(lunout, *) 'IN STRATAER : id_NOx = ', id_NOx
201          WRITE(lunout, *) 'IN STRATAER : id_H2O = ', id_H2O
202          WRITE(lunout, *) 'IN STRATAER : m_Chlore_emiss_vol = ', m_Chlore_emiss_vol
203          WRITE(lunout, *) 'IN STRATAER : m_Brome_emiss_vol = ', m_Brome_emiss_vol
204          WRITE(lunout, *) 'IN STRATAER : m_NOx_emiss_vol = ', m_NOx_emiss_vol
205          WRITE(lunout, *) 'IN STRATAER : m_H2O_emiss_vol = ', m_H2O_emiss_vol
206        ENDIF
207      endif
208    ENDIF ! if master
209
210    WRITE(lunout, *) 'IN STRATAER_EMISS END'
211  END SUBROUTINE strataer_emiss_init
212
213  ! Compute the ponderation to applicate in each grid point for all eruptions and init
214  ! dlat & dlon variables
215  SUBROUTINE strataer_ponde_init()
216
217    USE lmdz_regular_lonlat, ONLY: lon_reg, lat_reg
218    USE dimphy, ONLY: klon
219    USE lmdz_grid_phy, ONLY: nbp_lat, nbp_lon
220    USE lmdz_print_control, ONLY: lunout
221    USE strataer_local_var_mod
222    USE lmdz_yomcst, ONLY: RPI
223
224    ! local var
225    REAL :: lat_reg_deg, lon_reg_deg ! lat and lon of grid points in degree
226    INTEGER :: ieru, i, j
227
228    ALLOCATE(ponde_lonlat_vol(nErupt))
229
230    !Compute lon/lat ponderation for injection
231    dlat = 180. / 2. / FLOAT(nbp_lat)   ! d latitude in degree
232    dlon = 360. / 2. / FLOAT(nbp_lon)   ! d longitude in degree
233    WRITE(lunout, *) 'IN STRATAER_INIT dlat=', dlat, 'dlon=', dlon
234    WRITE(lunout, *) 'IN STRATAER_INIT nErupt=', nErupt
235    WRITE(lunout, *) 'IN STRATAER_INIT xlat_min=', xlat_min_vol, 'xlat_max=', xlat_max_vol
236    WRITE(lunout, *) 'IN STRATAER_INIT xlon_min=', xlon_min_vol, 'xlon_max=', xlon_max_vol
237
238    DO ieru = 1, nErupt
239      ponde_lonlat_vol(ieru) = 0
240      DO i = 1, nbp_lon
241        lon_reg_deg = lon_reg(i) * 180. / RPI
242        DO j = 1, nbp_lat
243          lat_reg_deg = lat_reg(j) * 180. / RPI
244          IF  (lat_reg_deg>=xlat_min_vol(ieru) - dlat .AND. lat_reg_deg<xlat_max_vol(ieru) + dlat .AND. &
245                  lon_reg_deg>=xlon_min_vol(ieru) - dlon .AND. lon_reg_deg<xlon_max_vol(ieru) + dlon) THEN
246            ponde_lonlat_vol(ieru) = ponde_lonlat_vol(ieru) + 1
247          ENDIF
248        ENDDO
249      ENDDO
250      IF(ponde_lonlat_vol(ieru) == 0) THEN
251        WRITE(lunout, *) 'STRATAER_INIT ERROR: no grid point found for eruption ieru=', ieru
252      ENDIF
253    ENDDO !ieru
254
255    WRITE(lunout, *) 'IN STRATAER_PONDE_INIT ponde_lonlat: ', ponde_lonlat_vol
256
257  END SUBROUTINE strataer_ponde_init
258
259END MODULE strataer_emiss_mod
Note: See TracBrowser for help on using the repository browser.