GCC Code Coverage Report


Directory: ./
File: phys/tracco2i_mod.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 142 0.0%
Branches: 0 281 0.0%

Line Branch Exec Source
1 MODULE tracco2i_mod
2 !
3 ! This module does the work for the interactive CO2 tracers
4 ! Authors: Patricia Cadule and Olivier Boucher
5 !
6 ! Purpose and description:
7 ! -----------------------
8 ! Main routine for the interactive carbon cycle
9 ! Gather all carbon fluxes and emissions from ORCHIDEE, PISCES and fossil fuel
10 ! Compute the net flux in source field which is used in phytrac
11 ! Compute global CO2 mixing ratio for radiation scheme if option is activated
12 ! Redistribute CO2 evenly over the atmosphere if transport is desactivated
13 !
14 CONTAINS
15
16 SUBROUTINE tracco2i_init()
17 ! This subroutine calls carbon_cycle_init needed to be done before first call to phys_output_write in physiq.
18 USE carbon_cycle_mod, ONLY: carbon_cycle_init, carbon_cycle_cpl
19
20 ! Initialize carbon_cycle_mod
21 IF (carbon_cycle_cpl) THEN
22 CALL carbon_cycle_init()
23 ENDIF
24
25 END SUBROUTINE tracco2i_init
26
27 SUBROUTINE tracco2i(pdtphys, debutphy, &
28 xlat, xlon, pphis, pphi, &
29 t_seri, pplay, paprs, tr_seri, source)
30
31 USE dimphy
32 USE infotrac_phy
33 USE geometry_mod, ONLY: cell_area
34 USE carbon_cycle_mod, ONLY: id_CO2, nbcf_in, fields_in, cfname_in
35 USE carbon_cycle_mod, ONLY: fco2_ocn_day, fco2_ff, fco2_bb, fco2_land, fco2_ocean
36 USE carbon_cycle_mod, ONLY: read_fco2_ocean_cor,var_fco2_ocean_cor,fco2_ocean_cor
37 USE carbon_cycle_mod, ONLY: read_fco2_land_cor,var_fco2_land_cor,fco2_land_cor
38 USE carbon_cycle_mod, ONLY: co2_send
39 USE carbon_cycle_mod, ONLY: fco2_land_nbp, fco2_land_nep, fco2_land_fLuc
40 USE carbon_cycle_mod, ONLY: fco2_land_fwoodharvest, fco2_land_fHarvest
41 USE carbon_cycle_mod, ONLY: carbon_cycle_cpl, carbon_cycle_tr, carbon_cycle_rad, RCO2_glo, RCO2_tot
42 USE carbon_cycle_mod, ONLY: ocean_area_tot
43 USE carbon_cycle_mod, ONLY: land_area_tot
44 USE mod_grid_phy_lmdz
45 USE mod_phys_lmdz_mpi_data, ONLY: is_mpi_root
46 USE mod_phys_lmdz_para, ONLY: gather, bcast, scatter
47 USE mod_phys_lmdz_omp_data, ONLY: is_omp_root
48 USE phys_cal_mod
49 USE phys_state_var_mod, ONLY: pctsrf
50 USE indice_sol_mod, ONLY: nbsrf, is_ter, is_lic, is_oce, is_sic
51
52 IMPLICIT NONE
53
54 INCLUDE "clesphys.h"
55 INCLUDE "YOMCST.h"
56
57 ! Input argument
58 !---------------
59 REAL,INTENT(IN) :: pdtphys ! Pas d'integration pour la physique (seconde)
60 LOGICAL,INTENT(IN) :: debutphy ! le flag de l'initialisation de la physique
61
62 REAL,DIMENSION(klon),INTENT(IN) :: xlat ! latitudes pour chaque point
63 REAL,DIMENSION(klon),INTENT(IN) :: xlon ! longitudes pour chaque point
64 REAL,DIMENSION(klon),INTENT(IN) :: pphis ! geopotentiel du sol
65 REAL,DIMENSION(klon,klev),INTENT(IN) :: pphi ! geopotentiel de chaque couche
66
67 REAL,DIMENSION(klon,klev),INTENT(IN) :: t_seri ! Temperature
68 REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa)
69 REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression pour chaque inter-couche (en Pa)
70 REAL,DIMENSION(klon,nbtr),INTENT(INOUT):: source ! flux de traceur [U/m2/s]
71
72 ! Output argument
73 !----------------
74 REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/kgA]
75
76 ! Local variables
77 !----------------
78
79 INTEGER :: it, k, i, nb
80 REAL, DIMENSION(klon,klev) :: m_air ! mass of air in every grid box [kg]
81 REAL, DIMENSION(klon_glo,klev) :: co2_glo ! variable temporaire sur la grille global
82 REAL, DIMENSION(klon_glo,klev) :: m_air_glo ! variable temporaire sur la grille global
83 REAL, DIMENSION(klon_glo,nbsrf):: pctsrf_glo !--fractions de maille sur la grille globale
84 REAL, DIMENSION(klon_glo) :: pctsrf_ter_glo
85 REAL, DIMENSION(klon_glo) :: pctsrf_oce_glo
86 REAL, DIMENSION(klon_glo) :: pctsrf_sic_glo
87 REAL, DIMENSION(klon_glo) :: cell_area_glo !--aire des mailles sur la grille globale
88
89 LOGICAL, SAVE :: check_fCO2_nbp_in_cfname
90 !$OMP THREADPRIVATE(check_fCO2_nbp_in_cfname)
91 INTEGER, SAVE :: day_pre=-1
92 !$OMP THREADPRIVATE(day_pre)
93
94 REAL, PARAMETER :: secinday=86400.
95
96 IF (is_mpi_root) THEN
97 PRINT *,'in tracco2i: date from phys_cal_mod =',year_cur,'-',mth_cur,'-',day_cur,'-',hour
98 ENDIF
99
100 !--initialisation of CO2 field if not in restart file
101 !--dirty way of doing, do it better later
102 !--convert 280 ppm into kg CO2 / kg air
103 IF (debutphy) THEN
104
105 ! Initialisation de tr_seri(id_CO2) si pas initialise
106 IF (MAXVAL(tr_seri(:,:,id_CO2)).LT.1.e-15) THEN
107 tr_seri(:,:,id_CO2)=co2_ppm0*1.e-6/RMD*RMCO2 !--initialised from co2_ppm0 in rdem
108 ENDIF
109
110 !--check if fCO2_nbp is in
111 check_fCO2_nbp_in_cfname=.FALSE.
112 DO nb=1, nbcf_in
113 IF (cfname_in(nb)=="fCO2_nbp") check_fCO2_nbp_in_cfname=.TRUE.
114 ENDDO
115
116 CALL gather(pctsrf,pctsrf_glo)
117 CALL gather(pctsrf(:,is_ter),pctsrf_ter_glo)
118 CALL gather(pctsrf(:,is_oce),pctsrf_oce_glo)
119 CALL gather(pctsrf(:,is_sic),pctsrf_sic_glo)
120 CALL gather(cell_area(:),cell_area_glo)
121
122 ENDIF
123
124 !--calculate mass of air in every grid box in kg air
125 DO i=1, klon
126 DO k=1, klev
127 m_air(i,k)=(paprs(i,k)-paprs(i,k+1))/RG*cell_area(i)
128 ENDDO
129 ENDDO
130
131 !--call CO2 emission routine
132 !--co2bb is zero for now
133 !--unit kg CO2 m-2 s-1
134 CALL co2_emissions(debutphy)
135
136 !--retrieving land and ocean CO2 flux
137 fco2_land(:)=0.0
138 fco2_ocean(:)=0.0
139 fco2_land_nbp(:)=0.
140 fco2_land_nep(:)=0.
141 fco2_land_fLuc(:)=0.
142 fco2_land_fwoodharvest(:)=0.
143 fco2_land_fHarvest(:)=0.
144
145 DO nb=1, nbcf_in
146
147 SELECT CASE(cfname_in(nb))
148 !--dealing with the different fluxes coming from ORCHIDEE
149 !--fluxes come in unit of kg C m-2 s-1 is converted into kg CO2 m-2 s-1
150 CASE("fCO2_nep")
151 fco2_land_nep(:)=fields_in(:,nb)*RMCO2/RMC*pctsrf(:,is_ter)
152 CASE("fCO2_fLuc")
153 fco2_land_fLuc(:)=fields_in(:,nb)*RMCO2/RMC*pctsrf(:,is_ter)
154 CASE("fCO2_fwoodharvest")
155 fco2_land_fwoodharvest(:)=fields_in(:,nb)*RMCO2/RMC*pctsrf(:,is_ter)
156 CASE("fCO2_fHarvest")
157 fco2_land_fHarvest(:)=fields_in(:,nb)*RMCO2/RMC*pctsrf(:,is_ter)
158 CASE("fCO2_nbp")
159 fco2_land_nbp(:)=fields_in(:,nb)*RMCO2/RMC*pctsrf(:,is_ter)
160 !--fCO2_fco2_ocn comes in unit of mol C02 m-2 s-1 is converted into kg CO2 m-2 s-1 + change sign
161 CASE("fCO2_fgco2")
162 fco2_ocean(:)=-1.*fco2_ocn_day(:)*RMCO2/1.e3*(pctsrf(:,is_oce)+pctsrf(:,is_sic))
163 END SELECT
164
165 ENDDO
166
167 PRINT *, 'tracco2i_mod.F90 --- read_fco2_ocean_cor ',read_fco2_ocean_cor
168 PRINT *, 'tracco2i_mod.F90 --- read_fco2_land_cor ',read_fco2_land_cor
169
170 IF (debutphy) THEN
171
172 IF (read_fco2_ocean_cor) THEN
173 !$OMP MASTER
174 IF (is_mpi_root .AND. is_omp_root) THEN
175 ocean_area_tot=0.
176 PRINT *, 'tracco2i_mod.F90 --- var_fco2_ocean_cor (PgC/yr) ',var_fco2_ocean_cor
177 DO i=1, klon_glo
178 ocean_area_tot = ocean_area_tot + (pctsrf_oce_glo(i)+pctsrf_sic_glo(i))*cell_area_glo(i)
179 ENDDO
180 ENDIF !--is_mpi_root and is_omp_root
181 !$OMP END MASTER
182 CALL bcast(ocean_area_tot)
183 PRINT *, 'tracco2i_mod.F90 --- ocean_area_tot (debutphy) ',ocean_area_tot
184 ENDIF
185
186 IF (read_fco2_land_cor) THEN
187 !$OMP MASTER
188 IF (is_mpi_root .AND. is_omp_root) THEN
189 land_area_tot=0.
190 PRINT *, 'tracco2i_mod.F90 --- var_fco2_land_cor (PgC/yr) ',var_fco2_land_cor
191 DO i=1, klon_glo
192 land_area_tot = land_area_tot + pctsrf_ter_glo(i)*cell_area_glo(i)
193 ENDDO
194 ENDIF !--is_mpi_root and is_omp_root
195 !$OMP END MASTER
196 CALL bcast(land_area_tot)
197 PRINT *, 'tracco2i_mod.F90 --- land_area_tot (debutphy) ',land_area_tot
198 ENDIF
199
200 ENDIF !-- debutphy
201
202 PRINT *, 'tracco2i_mod.F90 --- ocean_area_tot (m2) ',ocean_area_tot
203 PRINT *, 'tracco2i_mod.F90 --- land_area_tot (m2) ',land_area_tot
204
205 IF (read_fco2_ocean_cor) THEN
206 ! var_fco2_ocean_cor: correction of the surface downward CO2 flux into the ocean fgco2 (PgC/yr)
207 ! This is the correction of the the net air to ocean carbon flux. Positive flux is into the ocean.
208 ! PRINT *, 'tracco2i_mod.F90 --- var_fco2_ocean_cor (PgC/yr) ',var_fco2_ocean_cor
209
210 !var_fco2_ocean_cor: correction of the net air to ocean carbon flux (input data is a scalar in PgC/yr and must be converted in kg CO2 m-2 s-1)
211
212 ! Factors for carbon and carbon dioxide
213 ! 1 mole CO2 = 44.009 g CO2 = 12.011 g C
214 ! 1 ppm by volume of atmosphere CO2 = 2.13 Gt C
215 ! 1 gC = 44.009/12.011 gCO2
216
217 ! ocean_area_tot: ocean area (m2)
218
219 ! year_len: year length (in days)
220
221 ! conversion: PgC/yr --> kg CO2 m-2 s-1
222 ! fco2_ocean_cor / (86400.*year_len): PgC/yr to PgC/s
223 ! fco2_ocean_cor / (86400.*year_len)*(pctsrf(i,is_oce)+pctsrf(i,is_sic))/ocean_area_tot: PgC/s to PgC/s/m2
224 ! (fco2_ocean_cor / (86400.*year_len)*(pctsrf(i,is_oce)+pctsrf(i,is_sic))/ocean_area_tot) *1e12: PgC/s/m2 to kgC/s/m2
225 ! (fco2_ocean_cor / (86400.*year_len)*(pctsrf(i,is_oce)+pctsrf(i,is_sic))/ocean_area_tot) * 1e12 * (RMCO2/RMC): kgC/s/m2 to kgCO2/s/m2
226
227 DO i=1, klon
228 fco2_ocean_cor(i)=(var_fco2_ocean_cor*(RMCO2/RMC)*(pctsrf(i,is_oce)+pctsrf(i,is_sic))/ocean_area_tot/(secinday*year_len))*1.e12
229 ENDDO
230
231 PRINT *, 'tracco2i_mod.F90 --- MINVAL(fco2_ocean_cor) ',MINVAL(fco2_ocean_cor)
232 PRINT *, 'tracco2i_mod.F90 --- MAXVAL(fco2_ocean_cor) ',MAXVAL(fco2_ocean_cor)
233
234 ELSE
235 fco2_ocean_cor(:)=0.
236 ENDIF
237
238 IF (read_fco2_land_cor) THEN
239 ! var_fco2_land_cor: correction of the carbon Mass Flux out of Atmosphere Due to Net Biospheric Production on Land (PgC/yr)
240 ! This is the correction of the net mass flux of carbon between land and atmosphere calculated as
241 ! photosynthesis MINUS the sum of plant and soil respiration, carbon fluxes from
242 ! fire, harvest, grazing and land use change. Positive flux is into the land.
243 ! PRINT *, 'tracco2i_mod.F90 --- var_fco2_land_cor (m2) ',var_fco2_land_cor
244
245 !var_fco2_land_cor: correction of the et air to land carbon flux (input data is a scalar in PgC/yr and must be converted in kg CO2 m-2 s-1)
246
247 ! Factors for carbon and carbon dioxide
248 ! 1 mole CO2 = 44.009 g CO2 = 12.011 g C
249 ! 1 ppm by volume of atmosphere CO2 = 2.13 Gt C
250 ! 1 gC = 44.009/12.011 gCO2
251
252 ! land_area_tot: land area (m2)
253
254 ! year_len: year length (in days)
255
256 ! conversion: PgC/yr --> kg CO2 m-2 s-1
257 ! fco2_land_cor / (86400.*year_len): PgC/yr to PgC/s
258 ! fco2_land_cor / (86400.*year_len)*pctsrf(i,is_ter)/land_area_tot: PgC/s to PgC/s/m2
259 ! (fco2_land_cor / (86400.*year_len)*pctsrf(i,is_ter)/land_area_tot) *1e12: PgC/s/m2 to kgC/s/m2
260 ! (fco2_land_cor / (86400.*year_len)*pctsrf(i,is_ter)/land_area_tot) * 1e12 * (RMCO2/RMC): kgC/s/m2 to kgCO2/s/m2
261
262 DO i=1, klon
263 fco2_land_cor(i)=var_fco2_land_cor*RMCO2/RMC*pctsrf(i,is_ter)/land_area_tot/(secinday*year_len)*1.e12
264 ENDDO
265
266 PRINT *, 'tracco2i_mod.F90 --- MINVAL(fco2_land_cor) ',MINVAL(fco2_land_cor)
267 PRINT *, 'tracco2i_mod.F90 --- MAXVAL(fco2_land_cor) ',MAXVAL(fco2_land_cor)
268
269 ELSE
270 fco2_land_cor(:)=0.
271 ENDIF
272
273 !--if fCO2_nbp is transferred we use it, otherwise we use the sum of what has been passed from ORCHIDEE
274 IF (check_fCO2_nbp_in_cfname) THEN
275 fco2_land(:)=fco2_land_nbp(:)
276 ELSE
277 fco2_land(:)=fco2_land_nep(:)+fco2_land_fLuc(:)+fco2_land_fwoodharvest(:)+fco2_land_fHarvest(:)
278 ENDIF
279
280 !!--preparing the net anthropogenic flux at the surface for mixing layer
281 !!--unit kg CO2 / m2 / s
282 ! PRINT *, 'tracco2i_mod.F90 --- MAXVAL(fco2_ff) ',MAXVAL(fco2_ff)
283 ! PRINT *, 'tracco2i_mod.F90 --- MINVAL(fco2_ff) ',MINVAL(fco2_ff)
284 ! PRINT *, 'tracco2i_mod.F90 --- MAXVAL(fco2_bb) ',MAXVAL(fco2_bb)
285 ! PRINT *, 'tracco2i_mod.F90 --- MINVAL(fco2_bb) ',MINVAL(fco2_bb)
286 ! PRINT *, 'tracco2i_mod.F90 --- MAXVAL(fco2_land) ',MAXVAL(fco2_land)
287 ! PRINT *, 'tracco2i_mod.F90 --- MINVAL(fco2_land) ',MINVAL(fco2_land)
288 ! PRINT *, 'tracco2i_mod.F90 --- MAXVAL(fco2_ocean) ',MAXVAL(fco2_ocean)
289 ! PRINT *, 'tracco2i_mod.F90 --- MINVAL(fco2_ocean) ',MINVAL(fco2_ocean)
290 ! PRINT *, 'tracco2i_mod.F90 --- MAXVAL(source(:,id_CO2)) ',MAXVAL(source(:,id_CO2))
291 ! PRINT *, 'tracco2i_mod.F90 --- MINVAL(source(:,id_CO2)) ',MINVAL(source(:,id_CO2))
292 !
293 !--build final source term for CO2
294 source(:,id_CO2)=fco2_ff(:)+fco2_bb(:)+fco2_land(:)+fco2_ocean(:)-fco2_ocean_cor(:)-fco2_land_cor(:)
295
296 !--computing global mean CO2 for radiation
297 !--for every timestep comment out the IF ENDIF statements
298 !--otherwise this is updated every day
299 IF (debutphy.OR.day_cur.NE.day_pre) THEN
300
301 CALL gather(tr_seri(:,:,id_CO2),co2_glo)
302 CALL gather(m_air,m_air_glo)
303
304 !$OMP MASTER
305
306 !--compute a global mean CO2 value and print its value in ppm
307 IF (is_mpi_root) THEN
308 RCO2_tot=SUM(co2_glo*m_air_glo) !--unit kg CO2
309 RCO2_glo=RCO2_tot/SUM(m_air_glo) !--unit kg CO2 / kg air
310 PRINT *,'tracco2i: global CO2 in ppm =', RCO2_glo*1.e6*RMD/RMCO2
311 PRINT *,'tracco2i: total CO2 in kg =', RCO2_tot
312 ENDIF
313 !$OMP END MASTER
314 CALL bcast(RCO2_glo)
315 day_pre=day_cur
316 !--if not carbon_cycle_tr, then we reinitialize the CO2 each day to its global mean value
317 IF (.NOT.carbon_cycle_tr) THEN
318 tr_seri(:,:,id_CO2)=RCO2_glo
319 ENDIF
320 ENDIF
321
322 PRINT *, 'tracco2i_mod.F90 --- MINVAL(tr_seri(:,1,id_CO2)*1.e6*RMD/RMCO2): L1: ',MINVAL(tr_seri(:,1,id_CO2)*1.e6*RMD/RMCO2)
323 PRINT *, 'tracco2i_mod.F90 --- MAXVAL(tr_seri(:,1,id_CO2)*1.e6*RMD/RMCO2): L1: ',MAXVAL(tr_seri(:,1,id_CO2)*1.e6*RMD/RMCO2)
324
325 PRINT *, 'tracco2i_mod.F90 --- MINVAL(tr_seri(:,79,id_CO2)*1.e6*RMD/RMCO2): L79: ',MINVAL(tr_seri(:,79,id_CO2)*1.e6*RMD/RMCO2)
326 PRINT *, 'tracco2i_mod.F90 --- MAXVAL(tr_seri(:,79,id_CO2)*1.e6*RMD/RMCO2): L79: ',MAXVAL(tr_seri(:,79,id_CO2)*1.e6*RMD/RMCO2)
327
328 co2_send(:) = tr_seri(:,1,id_CO2)*1.e6*RMD/RMCO2
329
330 PRINT *, 'tracco2i_mod.F90 --- MINVAL(co2_send) ',MINVAL(co2_send)
331 PRINT *, 'tracco2i_mod.F90 --- MAXVAL(co2_send) ',MAXVAL(co2_send)
332
333 END SUBROUTINE tracco2i
334
335 SUBROUTINE co2_emissions(debutphy)
336
337 USE dimphy
338 USE infotrac_phy
339 USE geometry_mod, ONLY : cell_area
340 USE mod_grid_phy_lmdz
341 USE mod_phys_lmdz_mpi_data, ONLY: is_mpi_root
342 USE mod_phys_lmdz_para, ONLY: gather, scatter
343 USE phys_cal_mod
344
345 USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_varid, nf95_open
346 USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
347
348 USE carbon_cycle_mod, ONLY : fco2_ff, fco2_bb, fco2_land, fco2_ocean
349
350 IMPLICIT NONE
351
352 INCLUDE "YOMCST.h"
353 LOGICAL,INTENT(IN) :: debutphy
354
355 ! For NetCDF:
356 INTEGER ncid_in ! IDs for input files
357 INTEGER varid, ncerr
358
359 INTEGER :: n_glo, n_month
360 REAL, POINTER:: vector(:), time(:)
361 REAL,ALLOCATABLE :: flx_co2ff_glo(:,:) ! fossil-fuel CO2
362 REAL,ALLOCATABLE :: flx_co2bb_glo(:,:) ! biomass-burning CO2
363 REAL,ALLOCATABLE, SAVE :: flx_co2ff(:,:) ! fossil-fuel CO2
364 REAL,ALLOCATABLE, SAVE :: flx_co2bb(:,:) ! biomass-burning CO2
365 !$OMP THREADPRIVATE(flx_co2ff,flx_co2bb)
366
367 !! may be controlled via the .def later on
368 !! also co2bb for now comes from ORCHIDEE
369 LOGICAL, PARAMETER :: readco2ff=.TRUE.
370 !! this should be left to FALSE for now
371 LOGICAL, PARAMETER :: readco2bb=.FALSE.
372
373 CHARACTER (len = 20) :: modname = 'tracco2i.co2_emissions'
374 CHARACTER (len = 80) :: abort_message
375
376 IF (debutphy) THEN
377
378 ALLOCATE(flx_co2ff(klon,12))
379 ALLOCATE(flx_co2bb(klon,12))
380
381 !$OMP MASTER
382 IF (is_mpi_root) THEN
383
384 IF (.NOT.ALLOCATED(flx_co2ff_glo)) ALLOCATE(flx_co2ff_glo(klon_glo,12))
385 IF (.NOT.ALLOCATED(flx_co2bb_glo)) ALLOCATE(flx_co2bb_glo(klon_glo,12))
386
387 !--reading CO2 fossil fuel emissions
388 IF (readco2ff) THEN
389
390 ! ... Open the CO2ff file
391 CALL nf95_open("sflx_lmdz_co2_ff.nc", nf90_nowrite, ncid_in)
392
393 CALL nf95_inq_varid(ncid_in, "vector", varid)
394 CALL nf95_gw_var(ncid_in, varid, vector)
395 n_glo = size(vector)
396 IF (n_glo.NE.klon_glo) THEN
397 abort_message='sflx_lmdz_co2_ff: le nombre de points n est pas egal a klon_glo'
398 CALL abort_physic(modname,abort_message,1)
399 ENDIF
400
401 CALL nf95_inq_varid(ncid_in, "time", varid)
402 CALL nf95_gw_var(ncid_in, varid, time)
403 n_month = size(time)
404 IF (n_month.NE.12) THEN
405 abort_message='sflx_lmdz_co2_ff: le nombre de month n est pas egal a 12'
406 CALL abort_physic(modname,abort_message,1)
407 ENDIF
408
409 !--reading flx_co2 for fossil fuel
410 CALL nf95_inq_varid(ncid_in, "flx_co2", varid)
411 ncerr = nf90_get_var(ncid_in, varid, flx_co2ff_glo)
412
413 CALL nf95_close(ncid_in)
414
415 ELSE !--co2ff not to be read
416 flx_co2ff_glo(:,:)=0.0
417 ENDIF
418
419 !--reading CO2 biomass burning emissions
420 !--using it will be inconsistent with treatment in ORCHIDEE
421 IF (readco2bb) THEN
422
423 ! ... Open the CO2bb file
424 CALL nf95_open("sflx_lmdz_co2_bb.nc", nf90_nowrite, ncid_in)
425
426 CALL nf95_inq_varid(ncid_in, "vector", varid)
427 CALL nf95_gw_var(ncid_in, varid, vector)
428 n_glo = size(vector)
429 IF (n_glo.NE.klon_glo) THEN
430 abort_message='sflx_lmdz_co2_bb: le nombre de points n est pas egal a klon_glo'
431 CALL abort_physic(modname,abort_message,1)
432 ENDIF
433
434 CALL nf95_inq_varid(ncid_in, "time", varid)
435 CALL nf95_gw_var(ncid_in, varid, time)
436 n_month = size(time)
437 IF (n_month.NE.12) THEN
438 abort_message='sflx_lmdz_co2_bb: le nombre de month n est pas egal a 12'
439 CALL abort_physic(modname,abort_message,1)
440 ENDIF
441
442 !--reading flx_co2 for biomass burning
443 CALL nf95_inq_varid(ncid_in, "flx_co2", varid)
444 ncerr = nf90_get_var(ncid_in, varid, flx_co2bb_glo)
445
446 CALL nf95_close(ncid_in)
447
448 ELSE !--co2bb not to be read
449 flx_co2bb_glo(:,:)=0.0
450 ENDIF
451
452 ENDIF
453 !$OMP END MASTER
454
455 ! Allocation needed for all proc otherwise scatter might complain
456 IF (.NOT.ALLOCATED(flx_co2ff_glo)) ALLOCATE(flx_co2ff_glo(0,0))
457 IF (.NOT.ALLOCATED(flx_co2bb_glo)) ALLOCATE(flx_co2bb_glo(0,0))
458
459 !--scatter on all proc
460 CALL scatter(flx_co2ff_glo,flx_co2ff)
461 CALL scatter(flx_co2bb_glo,flx_co2bb)
462
463 IF (ALLOCATED(flx_co2ff_glo)) DEALLOCATE(flx_co2ff_glo)
464 IF (ALLOCATED(flx_co2bb_glo)) DEALLOCATE(flx_co2bb_glo)
465
466 ENDIF !--end debuthy
467
468 !---select the correct month
469 IF (mth_cur.LT.1.OR.mth_cur.GT.12) THEN
470 PRINT *,'probleme avec le mois dans co2_ini =', mth_cur
471 ENDIF
472
473 fco2_ff(:) = flx_co2ff(:,mth_cur)
474 fco2_bb(:) = flx_co2bb(:,mth_cur)
475
476 END SUBROUTINE co2_emissions
477
478 END MODULE tracco2i_mod
479