Context Navigation

carbon_cycle_mod.F90 @ 3447

Last change on this file since 3447 was 3447, checked in by oboucher, 5 years ago
A first package with molar masses for radiatively active gases, a new switch for interactive radiative CO2 and minor changes to the carbon_cycle module.
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory
File size: 33.6 KB

Line
1	MODULE carbon_cycle_mod
2	!=======================================================================
3	! Authors: Patricia Cadule and Laurent Fairhead
4	! base sur un travail anterieur mene par Patricia Cadule et Josefine Ghattas
5	!
6	! Purpose and description:
7	! -----------------------
8	! Control module for the carbon CO2 tracers :
9	! - Identification
10	! - Get concentrations comming from coupled model or read from file to tracers
11	! - Calculate new RCO2 for radiation scheme
12	! - Calculate new carbon flux for sending to coupled models (PISCES and ORCHIDEE)
13	!
14	! Module permettant de mettre a jour les champs (puits et sources) pour le
15	! transport de CO2 en online (IPSL-CM et LMDZOR) et offline (lecture de carte)
16	!
17	! Le cas online/offline est defini par le flag carbon_cycle_cpl (y/n)
18	! Le transport du traceur CO2 est defini par le flag carbon_cycle_tr (y/n)
19	! la provenance des champs (termes de puits) est denini par le flag level_coupling_esm
20	!
21	! level_coupling_esm : level of coupling of the biogeochemical fields between
22	! LMDZ, ORCHIDEE and NEMO
23	! Definitions of level_coupling_esm in physiq.def
24	! level_coupling_esm = 0 ! No field exchange between LMDZ and ORCHIDEE models
25	! ! No field exchange between LMDZ and NEMO
26	! level_coupling_esm = 1 ! Field exchange between LMDZ and ORCHIDEE models
27	! ! No field exchange between LMDZ and NEMO models
28	! level_coupling_esm = 2 ! No field exchange between LMDZ and ORCHIDEE models
29	! ! Field exchange between LMDZ and NEMO models
30	! level_coupling_esm = 3 ! Field exchange between LMDZ and ORCHIDEE models
31	! ! Field exchange between LMDZ and NEMO models
32	!=======================================================================
33
34	IMPLICIT NONE
35	SAVE
36	PRIVATE
37	PUBLIC :: carbon_cycle_init, carbon_cycle, infocfields_init
38
39	! Variables read from parmeter file physiq.def
40	LOGICAL, PUBLIC :: carbon_cycle_cpl ! Coupling of CO2 fluxes between LMDZ/ORCHIDEE and LMDZ/OCEAN(PISCES)
41	!$OMP THREADPRIVATE(carbon_cycle_cpl)
42	LOGICAL, PUBLIC :: carbon_cycle_tr ! 3D transport of CO2 in the atmosphere, parameter read in conf_phys
43	!$OMP THREADPRIVATE(carbon_cycle_tr)
44	LOGICAL, PUBLIC :: carbon_cycle_rad ! CO2 interactive radiatively
45	!$OMP THREADPRIVATE(carbon_cycle_rad)
46	INTEGER, PUBLIC :: level_coupling_esm ! Level of coupling for the ESM - 0, 1, 2, 3
47	!$OMP THREADPRIVATE(level_coupling_esm)
48	REAL, PUBLIC :: RCO2_glo, RCO2_tot
49	!$OMP THREADPRIVATE(RCO2_glo, RCO2_tot)
50
51	LOGICAL :: carbon_cycle_emis_comp_omp=.FALSE.
52	LOGICAL :: carbon_cycle_emis_comp=.FALSE. ! Calculation of emission compatible
53	!$OMP THREADPRIVATE(carbon_cycle_emis_comp)
54
55	LOGICAL :: RCO2_inter_omp
56	LOGICAL :: RCO2_inter ! RCO2 interactive : if true calculate new value RCO2 for the radiation scheme
57	!$OMP THREADPRIVATE(RCO2_inter)
58
59	! Scalare values when no transport, from physiq.def
60	REAL :: fos_fuel_s_omp
61	REAL :: fos_fuel_s ! carbon_cycle_fos_fuel dans physiq.def
62	!$OMP THREADPRIVATE(fos_fuel_s)
63	REAL :: emis_land_s ! not yet implemented
64	!$OMP THREADPRIVATE(emis_land_s)
65
66	REAL :: airetot ! Total area of the earth surface
67	!$OMP THREADPRIVATE(airetot)
68
69	INTEGER :: ntr_co2 ! Number of tracers concerning the carbon cycle
70	!$OMP THREADPRIVATE(ntr_co2)
71
72	! fco2_ocn_day : flux CO2 from ocean for 1 day (cumulated) [gC/m2/d]. Allocation and initalization done in cpl_mod
73	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ocn_day
74	!$OMP THREADPRIVATE(fco2_ocn_day)
75
76	REAL, DIMENSION(:), ALLOCATABLE :: fco2_land_day ! flux CO2 from land for 1 day (cumulated) [gC/m2/d]
77	!$OMP THREADPRIVATE(fco2_land_day)
78	REAL, DIMENSION(:), ALLOCATABLE :: fco2_lu_day ! Emission from land use change for 1 day (cumulated) [gC/m2/d]
79	!$OMP THREADPRIVATE(fco2_lu_day)
80	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ff ! Emission from fossil fuel [kgCO2/m2/s]
81	!$OMP THREADPRIVATE(fco2_ff)
82	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_bb ! Emission from biomass burning [kgCO2/m2/s]
83	!$OMP THREADPRIVATE(fco2_bb)
84
85	REAL, DIMENSION(:,:), ALLOCATABLE :: dtr_add ! Tracer concentration to be injected
86	!$OMP THREADPRIVATE(dtr_add)
87
88	! Following 2 fields will be allocated and initialized in surf_land_orchidee
89	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_inst ! flux CO2 from land at one time step
90	!$OMP THREADPRIVATE(fco2_land_inst)
91	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_lu_inst ! Emission from land use change at one time step
92	!$OMP THREADPRIVATE(fco2_lu_inst)
93
94	! Calculated co2 field to be send to the ocean via the coupler and to ORCHIDEE
95	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: co2_send ! Field allocated in phyetat0
96	!$OMP THREADPRIVATE(co2_send)
97
98	INTEGER, PARAMETER, PUBLIC :: id_CO2=1 !--temporaire OB -- to be changed
99
100	! nbfields : total number of fields
101	INTEGER, PUBLIC :: nbcf
102	!$OMP THREADPRIVATE(nbcf)
103
104	! nbcf_in : number of fields IN
105	INTEGER, PUBLIC :: nbcf_in
106	!$OMP THREADPRIVATE(nbcf_in)
107
108	! nbcf_in_orc : number of fields IN
109	INTEGER, PUBLIC :: nbcf_in_orc
110	!$OMP THREADPRIVATE(nbcf_in_orc)
111
112	! nbcf_in_inca : number of fields IN (from INCA)
113	INTEGER, PUBLIC :: nbcf_in_inca
114	!$OMP THREADPRIVATE(nbcf_in_inca)
115
116	! nbcf_in_nemo : number of fields IN (from nemo)
117	INTEGER, PUBLIC :: nbcf_in_nemo
118	!$OMP THREADPRIVATE(nbcf_in_nemo)
119
120	! nbcf_in_ant : number of fields IN (from anthropogenic sources)
121	INTEGER, PUBLIC :: nbcf_in_ant
122	!$OMP THREADPRIVATE(nbcf_in_ant)
123
124	! nbcf_out : number of fields OUT
125	INTEGER, PUBLIC :: nbcf_out
126	!$OMP THREADPRIVATE(nbcf_out)
127
128	! Name of variables
129	CHARACTER(len=25), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfname ! coupling field short name for restart (?) and diagnostics
130	!$OMP THREADPRIVATE(cfname)
131
132	CHARACTER(len=25), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfname_in ! coupling field short name for restart (?) and diagnostics
133	!$OMP THREADPRIVATE(cfname_in)
134
135	CHARACTER(len=25), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfname_out ! coupling field short name for restart (?) and diagnostics
136	!$OMP THREADPRIVATE(cfname_out)
137
138	CHARACTER(len=15), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfunits_in ! coupling field units for diagnostics
139	!$OMP THREADPRIVATE(cfunits_in)
140
141	CHARACTER(len=15), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfunits_out ! coupling field units for diagnostics
142	!$OMP THREADPRIVATE(cfunits_out)
143
144	CHARACTER(len=120), ALLOCATABLE, DIMENSION(:), PUBLIC :: cftext_in ! coupling field long name for diagnostics
145	!$OMP THREADPRIVATE(cftext_in)
146
147	CHARACTER(len=120), ALLOCATABLE, DIMENSION(:), PUBLIC :: cftext_out ! coupling field long name for diagnostics
148	!$OMP THREADPRIVATE(cftext_out)
149
150	CHARACTER(len=5), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfmod1 ! model 1 (rreference) : LMDz
151	!$OMP THREADPRIVATE(cfmod1)
152
153	CHARACTER(len=5), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfmod2 ! model 2
154	!$OMP THREADPRIVATE(cfmod2)
155
156	CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:), PUBLIC :: field_out_names
157	!$OMP THREADPRIVATE(field_out_names)
158
159	CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:), PUBLIC :: field_in_names
160	!$OMP THREADPRIVATE(field_in_names)
161
162	REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: fields_in ! klon,nbcf_in
163	!$OMP THREADPRIVATE(fields_in)
164
165	REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: yfields_in ! knon,nbcf_in
166	!$OMP THREADPRIVATE(yfields_in)
167
168	REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: fields_out ! klon,nbcf_out
169	!$OMP THREADPRIVATE(fields_out)
170
171	REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: yfields_out ! knon,nbcf_out
172	!$OMP THREADPRIVATE(yfields_out)
173
174	TYPE, PUBLIC :: co2_trac_type
175	CHARACTER(len = 8) :: name ! Tracer name in tracer.def
176	INTEGER :: id ! Index in total tracer list, tr_seri
177	CHARACTER(len=30) :: file ! File name
178	LOGICAL :: cpl ! True if this tracers is coupled from ORCHIDEE or PISCES.
179	! False if read from file.
180	INTEGER :: updatefreq ! Frequence to inject in second
181	INTEGER :: readstep ! Actual time step to read in file
182	LOGICAL :: updatenow ! True if this tracer should be updated this time step
183	END TYPE co2_trac_type
184	INTEGER,PARAMETER :: maxco2trac=5 ! Maximum number of different CO2 fluxes
185	TYPE(co2_trac_type), DIMENSION(maxco2trac) :: co2trac
186
187	CONTAINS
188
189	SUBROUTINE carbon_cycle_init(tr_seri, pdtphys, aerosol, radio)
190	! This subroutine is called from traclmdz_init, only at first timestep.
191	! - Read controle parameters from .def input file
192	! - Search for carbon tracers and set default values
193	! - Allocate variables
194	! - Test for compatibility
195
196	USE dimphy
197	USE geometry_mod, ONLY : cell_area
198	USE mod_phys_lmdz_transfert_para
199	USE infotrac_phy, ONLY: nbtr, nqo, niadv, tname
200	USE IOIPSL
201	USE surface_data, ONLY : ok_veget, type_ocean
202	USE phys_cal_mod, ONLY : mth_len
203	USE print_control_mod, ONLY: lunout
204
205	IMPLICIT NONE
206	INCLUDE "clesphys.h"
207
208	! Input argument
209	REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: tr_seri ! Concentration Traceur [U/KgA]
210	REAL,INTENT(IN) :: pdtphys ! length of time step in physiq (sec)
211
212	! InOutput arguments
213	LOGICAL,DIMENSION(nbtr), INTENT(INOUT) :: aerosol
214	LOGICAL,DIMENSION(nbtr), INTENT(INOUT) :: radio
215
216	! Local variables
217	INTEGER :: ierr, it, iiq, itc
218	INTEGER :: teststop
219
220	! 1) Read controle parameters from .def input file
221	! ------------------------------------------------
222	! Read fosil fuel value if no transport
223	IF (.NOT. carbon_cycle_tr) THEN
224	!$OMP MASTER
225	fos_fuel_s_omp = 0.
226	CALL getin ('carbon_cycle_fos_fuel',fos_fuel_s_omp)
227	!$OMP END MASTER
228	!$OMP BARRIER
229	fos_fuel_s=fos_fuel_s_omp
230	WRITE(lunout,*) 'carbon_cycle_fos_fuel = ', fos_fuel_s
231	END IF
232
233	! Read parmeter for calculation compatible emission
234	IF (.NOT. carbon_cycle_tr) THEN
235	!$OMP MASTER
236	carbon_cycle_emis_comp_omp=.FALSE.
237	CALL getin('carbon_cycle_emis_comp',carbon_cycle_emis_comp_omp)
238	!$OMP END MASTER
239	!$OMP BARRIER
240	carbon_cycle_emis_comp=carbon_cycle_emis_comp_omp
241	WRITE(lunout,*) 'carbon_cycle_emis_comp = ',carbon_cycle_emis_comp
242	IF (carbon_cycle_emis_comp) THEN
243	CALL abort_physic('carbon_cycle_init', 'carbon_cycle_emis_comp option not yet implemented!!',1)
244	END IF
245	END IF
246
247	! Read parameter for interactive calculation of the CO2 value for the radiation scheme
248	!$OMP MASTER
249	RCO2_inter_omp=.FALSE.
250	CALL getin('RCO2_inter',RCO2_inter_omp)
251	!$OMP END MASTER
252	!$OMP BARRIER
253	RCO2_inter=RCO2_inter_omp
254	WRITE(lunout,*) 'RCO2_inter = ', RCO2_inter
255	IF (RCO2_inter) THEN
256	WRITE(lunout,*) 'RCO2 will be recalculated once a day'
257	WRITE(lunout,*) 'RCO2 initial = ', RCO2
258	END IF
259
260
261	! 2) Search for carbon tracers and set default values
262	! ---------------------------------------------------
263	itc=0
264	DO it=1,nbtr
265	!! iiq=niadv(it+2) ! jyg
266	iiq=niadv(it+nqo) ! jyg
267
268	SELECT CASE(tname(iiq))
269	CASE("fCO2_ocn")
270	itc = itc + 1
271	co2trac(itc)%name='fCO2_ocn'
272	co2trac(itc)%id=it
273	co2trac(itc)%file='fl_co2_ocean.nc'
274	IF (carbon_cycle_cpl .AND. type_ocean=='couple') THEN
275	co2trac(itc)%cpl=.TRUE.
276	co2trac(itc)%updatefreq = 86400 ! Once a day as the coupling with OASIS/PISCES
277	ELSE
278	co2trac(itc)%cpl=.FALSE.
279	co2trac(itc)%updatefreq = 86400*mth_len ! Once a month
280	END IF
281	CASE("fCO2_land")
282	itc = itc + 1
283	co2trac(itc)%name='fCO2_land'
284	co2trac(itc)%id=it
285	co2trac(itc)%file='fl_co2_land.nc'
286	IF (carbon_cycle_cpl .AND. ok_veget) THEN
287	co2trac(itc)%cpl=.TRUE.
288	co2trac(itc)%updatefreq = INT(pdtphys) ! Each timestep as the coupling with ORCHIDEE
289	ELSE
290	co2trac(itc)%cpl=.FALSE.
291	! co2trac(itc)%updatefreq = 10800 ! 10800sec = 3H
292	co2trac(itc)%updatefreq = 86400*mth_len ! Once a month
293	END IF
294	CASE("fCO2_land_use")
295	itc = itc + 1
296	co2trac(itc)%name='fCO2_land_use'
297	co2trac(itc)%id=it
298	co2trac(itc)%file='fl_co2_land_use.nc'
299	IF (carbon_cycle_cpl .AND. ok_veget) THEN
300	co2trac(it)%cpl=.TRUE.
301	co2trac(itc)%updatefreq = INT(pdtphys) ! Each timestep as the coupling with ORCHIDEE
302	ELSE
303	co2trac(itc)%cpl=.FALSE.
304	co2trac(itc)%updatefreq = 10800 ! 10800sec = 3H
305	END IF
306	CASE("fCO2_fos_fuel")
307	itc = itc + 1
308	co2trac(itc)%name='fCO2_fos_fuel'
309	co2trac(itc)%id=it
310	co2trac(itc)%file='fossil_fuel.nc'
311	co2trac(itc)%cpl=.FALSE. ! This tracer always read from file
312	! co2trac(itc)%updatefreq = 86400 ! 86400sec = 24H Cadule case
313	co2trac(itc)%updatefreq = 86400*mth_len ! Once a month
314	CASE("fCO2_bbg")
315	itc = itc + 1
316	co2trac(itc)%name='fCO2_bbg'
317	co2trac(itc)%id=it
318	co2trac(itc)%file='fl_co2_bbg.nc'
319	co2trac(itc)%cpl=.FALSE. ! This tracer always read from file
320	co2trac(itc)%updatefreq = 86400*mth_len ! Once a month
321	CASE("fCO2")
322	! fCO2 : One tracer transporting the total CO2 flux
323	itc = itc + 1
324	co2trac(itc)%name='fCO2'
325	co2trac(itc)%id=it
326	co2trac(itc)%file='fl_co2.nc'
327	IF (carbon_cycle_cpl) THEN
328	co2trac(itc)%cpl=.TRUE.
329	ELSE
330	co2trac(itc)%cpl=.FALSE.
331	END IF
332	co2trac(itc)%updatefreq = 86400
333	! DOES THIS WORK ???? Problematic due to implementation of the coupled fluxes...
334	CALL abort_physic('carbon_cycle_init','transport of total CO2 has to be implemented and tested',1)
335	END SELECT
336	END DO
337
338	! Total number of carbon CO2 tracers
339	ntr_co2 = itc
340
341	! Definition of control varaiables for the tracers
342	DO it=1,ntr_co2
343	aerosol(co2trac(it)%id) = .FALSE.
344	radio(co2trac(it)%id) = .FALSE.
345	END DO
346
347	! Vector indicating which timestep to read for each tracer
348	! Always start read in the beginning of the file
349	co2trac(:)%readstep = 0
350
351
352	! 3) Allocate variables
353	! ---------------------
354	! Allocate vector for storing fluxes to inject
355	ALLOCATE(dtr_add(klon,maxco2trac), stat=ierr)
356	IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation 11',1)
357
358	! Allocate variables for cumulating fluxes from ORCHIDEE
359	IF (RCO2_inter) THEN
360	IF (.NOT. carbon_cycle_tr .AND. carbon_cycle_cpl) THEN
361	ALLOCATE(fco2_land_day(klon), stat=ierr)
362	IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation 2',1)
363	fco2_land_day(1:klon) = 0.
364
365	ALLOCATE(fco2_lu_day(klon), stat=ierr)
366	IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation 3',1)
367	fco2_lu_day(1:klon) = 0.
368	END IF
369	END IF
370
371
372	! 4) Test for compatibility
373	! -------------------------
374	! IF (carbon_cycle_cpl .AND. type_ocean/='couple') THEN
375	! WRITE(lunout,*) 'Coupling with ocean model is needed for carbon_cycle_cpl'
376	! CALL abort_physic('carbon_cycle_init', 'coupled ocean is needed for carbon_cycle_cpl',1)
377	! END IF
378	!
379	! IF (carbon_cycle_cpl .AND..NOT. ok_veget) THEN
380	! WRITE(lunout,*) 'Coupling with surface land model ORCHDIEE is needed for carbon_cycle_cpl'
381	! CALL abort_physic('carbon_cycle_init', 'ok_veget is needed for carbon_cycle_cpl',1)
382	! END IF
383
384	! Compiler test : following should never happen
385	teststop=0
386	DO it=1,teststop
387	CALL abort_physic('carbon_cycle_init', 'Entering loop from 1 to 0',1)
388	END DO
389
390	IF (ntr_co2==0) THEN
391	! No carbon tracers found in tracer.def. It is not possible to do carbon cycle
392	WRITE(lunout,*) 'No carbon tracers found in tracer.def. Not ok with carbon_cycle_tr and/or carbon_cycle_cp'
393	CALL abort_physic('carbon_cycle_init', 'No carbon tracers found in tracer.def',1)
394	END IF
395
396	! 5) Calculate total area of the earth surface
397	! --------------------------------------------
398	CALL reduce_sum(SUM(cell_area),airetot)
399	CALL bcast(airetot)
400
401	END SUBROUTINE carbon_cycle_init
402
403	SUBROUTINE carbon_cycle(nstep, pdtphys, pctsrf, tr_seri, source)
404	! Subroutine for injection of co2 in the tracers
405	!
406	! - Find out if it is time to update
407	! - Get tracer from coupled model or from file
408	! - Calculate new RCO2 value for the radiation scheme
409	! - Calculate CO2 flux to send to ocean and land models (PISCES and ORCHIDEE)
410
411	USE infotrac_phy, ONLY: nbtr
412	USE dimphy
413	USE mod_phys_lmdz_transfert_para
414	USE phys_cal_mod, ONLY : mth_cur, mth_len
415	USE phys_cal_mod, ONLY : day_cur
416	USE indice_sol_mod
417	USE print_control_mod, ONLY: lunout
418	USE geometry_mod, ONLY : cell_area
419
420	IMPLICIT NONE
421
422	INCLUDE "clesphys.h"
423	INCLUDE "YOMCST.h"
424
425	! In/Output arguments
426	INTEGER,INTENT(IN) :: nstep ! time step in physiq
427	REAL,INTENT(IN) :: pdtphys ! length of time step in physiq (sec)
428	REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Surface fraction
429	REAL, DIMENSION(klon,klev,nbtr), INTENT(INOUT) :: tr_seri ! All tracers
430	REAL, DIMENSION(klon,nbtr), INTENT(INOUT) :: source ! Source for all tracers
431
432	! Local variables
433	INTEGER :: it
434	LOGICAL :: newmonth ! indicates if a new month just started
435	LOGICAL :: newday ! indicates if a new day just started
436	LOGICAL :: endday ! indicated if last time step in a day
437
438	REAL, PARAMETER :: fact=1.E-15/2.12 ! transformation factor from gC/m2/day => ppm/m2/day
439	REAL, DIMENSION(klon) :: fco2_tmp
440	REAL :: sumtmp
441	REAL :: delta_co2_ppm
442
443
444	! 1) Calculate logicals indicating if it is a new month, new day or the last time step in a day (end day)
445	! -------------------------------------------------------------------------------------------------------
446
447	newday = .FALSE.; endday = .FALSE.; newmonth = .FALSE.
448
449	IF (MOD(nstep,INT(86400./pdtphys))==1) newday=.TRUE.
450	IF (MOD(nstep,INT(86400./pdtphys))==0) endday=.TRUE.
451	IF (newday .AND. day_cur==1) newmonth=.TRUE.
452
453	! 2) For each carbon tracer find out if it is time to inject (update)
454	! --------------------------------------------------------------------
455	DO it = 1, ntr_co2
456	IF ( MOD(nstep,INT(co2trac(it)%updatefreq/pdtphys)) == 1 ) THEN
457	co2trac(it)%updatenow = .TRUE.
458	ELSE
459	co2trac(it)%updatenow = .FALSE.
460	END IF
461	END DO
462
463	! 3) Get tracer update
464	! --------------------------------------
465	DO it = 1, ntr_co2
466	IF ( co2trac(it)%updatenow ) THEN
467	IF ( co2trac(it)%cpl ) THEN
468	! Get tracer from coupled model
469	SELECT CASE(co2trac(it)%name)
470	CASE('fCO2_land') ! from ORCHIDEE
471	dtr_add(:,it) = fco2_land_inst(:)pctsrf(:,is_ter)fact ! [ppm/m2/day]
472	CASE('fCO2_land_use') ! from ORCHIDEE
473	dtr_add(:,it) = fco2_lu_inst(:) pctsrf(:,is_ter)fact ! [ppm/m2/day]
474	CASE('fCO2_ocn') ! from PISCES
475	dtr_add(:,it) = fco2_ocn_day(:) pctsrf(:,is_oce)fact ! [ppm/m2/day]
476	CASE DEFAULT
477	WRITE(lunout,*) 'Error with tracer ',co2trac(it)%name
478	CALL abort_physic('carbon_cycle', 'No coupling implemented for this tracer',1)
479	END SELECT
480	ELSE
481	! Read tracer from file
482	co2trac(it)%readstep = co2trac(it)%readstep + 1 ! increment time step in file
483	! Patricia CALL read_map2D(co2trac(it)%file,'fco2',co2trac(it)%readstep,.FALSE.,dtr_add(:,it))
484	CALL read_map2D(co2trac(it)%file,'fco2',co2trac(it)%readstep,.TRUE.,dtr_add(:,it))
485
486	! Converte from kgC/m2/h to kgC/m2/s
487	dtr_add(:,it) = dtr_add(:,it)/3600
488	! Add individual treatment of values read from file
489	SELECT CASE(co2trac(it)%name)
490	CASE('fCO2_land')
491	dtr_add(:,it) = dtr_add(:,it) *pctsrf(:,is_ter)
492	CASE('fCO2_land_use')
493	dtr_add(:,it) = dtr_add(:,it) *pctsrf(:,is_ter)
494	CASE('fCO2_ocn')
495	dtr_add(:,it) = dtr_add(:,it) *pctsrf(:,is_oce)
496	! Patricia :
497	! CASE('fCO2_fos_fuel')
498	! dtr_add(:,it) = dtr_add(:,it)/mth_len
499	! co2trac(it)%readstep = 0 ! Always read same value for fossil fuel(Cadule case)
500	END SELECT
501	END IF
502	END IF
503	END DO
504
505	! 4) Update co2 tracers :
506	! Loop over all carbon tracers and add source
507	! ------------------------------------------------------------------
508	IF (carbon_cycle_tr) THEN
509	DO it = 1, ntr_co2
510	IF (.FALSE.) THEN
511	tr_seri(1:klon,1,co2trac(it)%id) = tr_seri(1:klon,1,co2trac(it)%id) + dtr_add(1:klon,it)
512	source(1:klon,co2trac(it)%id) = 0.
513	ELSE
514	source(1:klon,co2trac(it)%id) = dtr_add(1:klon,it)
515	END IF
516	END DO
517	END IF
518
519
520	! 5) Calculations for new CO2 value for the radiation scheme(instead of reading value from .def)
521	! ----------------------------------------------------------------------------------------------
522	IF (RCO2_inter) THEN
523	! Cumulate fluxes from ORCHIDEE at each timestep
524	IF (.NOT. carbon_cycle_tr .AND. carbon_cycle_cpl) THEN
525	IF (newday) THEN ! Reset cumulative variables once a day
526	fco2_land_day(1:klon) = 0.
527	fco2_lu_day(1:klon) = 0.
528	END IF
529	fco2_land_day(1:klon) = fco2_land_day(1:klon) + fco2_land_inst(1:klon) ![gC/m2/day]
530	fco2_lu_day(1:klon) = fco2_lu_day(1:klon) + fco2_lu_inst(1:klon) ![gC/m2/day]
531	END IF
532
533	! At the end of a new day, calculate a mean scalare value of CO2
534	! JG : Ici on utilise uniquement le traceur du premier couche du modele. Est-ce que c'est correcte ?
535	IF (endday) THEN
536
537	IF (carbon_cycle_tr) THEN
538	! Sum all co2 tracers to get the total delta CO2 flux
539	fco2_tmp(:) = 0.
540	DO it = 1, ntr_co2
541	fco2_tmp(1:klon) = fco2_tmp(1:klon) + tr_seri(1:klon,1,co2trac(it)%id)
542	END DO
543
544	ELSE IF (carbon_cycle_cpl) THEN ! no carbon_cycle_tr
545	! Sum co2 fluxes comming from coupled models and parameter for fossil fuel
546	fco2_tmp(1:klon) = fos_fuel_s + ((fco2_lu_day(1:klon) + fco2_land_day(1:klon))*pctsrf(1:klon,is_ter) &
547	+ fco2_ocn_day(:)pctsrf(:,is_oce)) fact
548	END IF
549
550	! Calculate a global mean value of delta CO2 flux
551	fco2_tmp(1:klon) = fco2_tmp(1:klon) * cell_area(1:klon)
552	CALL reduce_sum(SUM(fco2_tmp),sumtmp)
553	CALL bcast(sumtmp)
554	delta_co2_ppm = sumtmp/airetot
555
556	! Add initial value for co2_ppm and delta value
557	co2_ppm = co2_ppm0 + delta_co2_ppm
558
559	! Transformation of atmospheric CO2 concentration for the radiation code
560	RCO2 = co2_ppm * 1.0e-06 * RMCO2/28.97
561
562	WRITE(lunout,*) 'RCO2 is now updated! RCO2 = ', RCO2
563	END IF ! endday
564
565	END IF ! RCO2_inter
566
567
568	! 6) Calculate CO2 flux to send to ocean and land models : PISCES and ORCHIDEE
569	! ----------------------------------------------------------------------------
570	IF (carbon_cycle_cpl) THEN
571
572	IF (carbon_cycle_tr) THEN
573	! Sum all co2 tracers to get the total delta CO2 flux at first model layer
574	fco2_tmp(:) = 0.
575	DO it = 1, ntr_co2
576	fco2_tmp(1:klon) = fco2_tmp(1:klon) + tr_seri(1:klon,1,co2trac(it)%id)
577	END DO
578	co2_send(1:klon) = fco2_tmp(1:klon) + co2_ppm0
579	ELSE
580	! Send a scalare value in 2D variable to ocean and land model (PISCES and ORCHIDEE)
581	co2_send(1:klon) = co2_ppm
582	END IF
583
584	END IF
585
586	END SUBROUTINE carbon_cycle
587
588	SUBROUTINE infocfields_init
589
590	! USE control_mod, ONLY: planet_type
591	USE phys_cal_mod, ONLY : mth_cur
592	USE mod_synchro_omp
593	USE mod_phys_lmdz_para, ONLY: is_mpi_root, is_omp_root
594	USE mod_phys_lmdz_transfert_para
595	USE mod_phys_lmdz_omp_transfert
596	USE dimphy, ONLY: klon
597
598	IMPLICIT NONE
599
600	!=======================================================================
601	!
602	! Authors: Patricia Cadule and Laurent Fairhead
603	! -------
604	!
605	! Purpose and description:
606	! -----------------------
607	!
608	! Infofields
609	! this routine enables to define the field exchanges in both directions between
610	! the atmospheric circulation model (LMDZ) and ORCHIDEE. In the future this
611	! routing might apply to other models (e.g., NEMO, INCA, ...).
612	! Therefore, currently with this routine, it is possible to define the coupling
613	! fields only between LMDZ and ORCHIDEE.
614	! The coupling_fields.def file enables to define the name of the exchanged
615	! fields at the coupling interface.
616	! field_in_names : the set of names of the exchanged fields in input to ORCHIDEE
617	! (LMDZ to ORCHIDEE)
618	! field_out_names : the set of names of the exchanged fields in output of
619	! ORCHIDEE (ORCHIDEE to LMDZ)
620	! n : the number of exchanged fields at th coupling interface
621	! nb_fields_in : number of inputs fields to ORCHIDEE (LMDZ to ORCHIDEE)
622	! nb_fields_out : number of ouput fields of ORCHIDEE (ORCHIDEE to LMDZ)
623	!
624	! The syntax for coupling_fields.def is as follows:
625	! IMPORTANT: each column entry must be separated from the previous one by 3
626	! spaces and only that
627	! field name coupling model 1 model 2 long_name
628	! direction
629	! 10char -3spaces- 3char -3spaces- 4char -3spaces- 4char -3spaces- 30char
630	!
631	! n
632	! FIELD1 IN LMDZ ORC
633	! ....
634	! FIELD(j) IN LMDZ ORC
635	! FIELD(j+1) OUT LMDZ ORC
636	! ...
637	! FIELDn OUT LMDZ ORC
638	!
639	!=======================================================================
640	! ... 22/12/2017 ....
641	!-----------------------------------------------------------------------
642	! Declarations
643
644	INCLUDE "clesphys.h"
645	INCLUDE "dimensions.h"
646	INCLUDE "iniprint.h"
647
648	! Local variables
649
650	INTEGER :: iq, ierr, stat, error
651
652	CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:), SAVE :: cfname_root
653	CHARACTER(LEN=120), ALLOCATABLE, DIMENSION(:), SAVE :: cftext_root
654	CHARACTER(LEN=15), ALLOCATABLE, DIMENSION(:), SAVE :: cfunits_root
655
656	CHARACTER(len=3), ALLOCATABLE, DIMENSION(:) :: cfintent_root
657	CHARACTER(len=5), ALLOCATABLE, DIMENSION(:) :: cfmod1_root
658	CHARACTER(len=5), ALLOCATABLE, DIMENSION(:) :: cfmod2_root
659
660	LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: mask_in_root
661	LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: mask_out_root
662
663	CHARACTER(len=*),parameter :: modname="infocfields"
664
665	CHARACTER(len=10),SAVE :: planet_type="earth"
666
667	!-----------------------------------------------------------------------
668
669	nbcf=0
670	nbcf_in=0
671	nbcf_out=0
672
673	IF (planet_type=='earth') THEN
674
675	IF (is_mpi_root .AND. is_omp_root) THEN
676
677	IF (level_coupling_esm.GT.0) THEN
678
679	OPEN(200,file='coupling_fields.def',form='formatted',status='old', iostat=ierr)
680
681	IF (ierr.EQ.0) THEN
682
683	WRITE(lunout,*) trim(modname),': Open coupling_fields.def : ok'
684	READ(200,*) nbcf
685	WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf=',nbcf
686	ALLOCATE(cfname_root(nbcf))
687	ALLOCATE(cfintent_root(nbcf))
688	ALLOCATE(cfmod1_root(nbcf))
689	ALLOCATE(cfmod2_root(nbcf))
690	ALLOCATE(cftext_root(nbcf))
691	ALLOCATE(cfunits_root(nbcf))
692	ALLOCATE(mask_in_root(nbcf))
693	ALLOCATE(mask_out_root(nbcf))
694
695	nbcf_in=0
696	nbcf_out=0
697
698	DO iq=1,nbcf
699	WRITE(lunout,*) 'infofields : field=',iq
700	READ(200,'(A15,3X,A3,3X,A5,3X,A5,3X,A120,3X,A15)',IOSTAT=ierr) &
701	cfname_root(iq),cfintent_root(iq),cfmod1_root(iq),cfmod2_root(iq),cftext_root(iq),cfunits_root(iq)
702	cfname_root(iq)=TRIM(cfname_root(iq))
703	cfintent_root(iq)=TRIM(cfintent_root(iq))
704	cfmod1_root(iq)=TRIM(cfmod1_root(iq))
705	cfmod2_root(iq)=TRIM(cfmod2_root(iq))
706	cftext_root(iq)=TRIM(cftext_root(iq))
707	cfunits_root(iq)=TRIM(cfunits_root(iq))
708	WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &
709	', number: ',iq,', INTENT: ',cfintent_root(iq)
710	WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &
711	', number: ',iq,', model 1 (ref): ',cfmod1_root(iq),', model 2: ',cfmod2_root(iq)
712	WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &
713	', number: ',iq,', long name: ',cftext_root(iq),', units ',cfunits_root(iq)
714	IF (nbcf_in+nbcf_out.LT.nbcf) THEN
715	IF (cfintent_root(iq).NE.'OUT') THEN
716	nbcf_in=nbcf_in+1
717	mask_in_root(iq)=.TRUE.
718	mask_out_root(iq)=.FALSE.
719	ELSE IF (cfintent_root(iq).EQ.'OUT') THEN
720	nbcf_out=nbcf_out+1
721	mask_in_root(iq)=.FALSE.
722	mask_out_root(iq)=.TRUE.
723	ENDIF
724	ELSE
725	WRITE(lunout,*) 'abort_gcm --- nbcf : ',nbcf
726	WRITE(lunout,*) 'abort_gcm --- nbcf_in : ',nbcf_in
727	WRITE(lunout,*) 'abort_gcm --- nbcf_out: ',nbcf_out
728	CALL abort_physic('infocfields_init','Problem in the definition of the coupling fields',1)
729	ENDIF
730	ENDDO !DO iq=1,nbcf
731	ELSE
732	WRITE(lunout,*) trim(modname),': infocfields_mod.F90 --- Problem in opening coupling_fields.def'
733	WRITE(lunout,*) trim(modname),': infocfields_mod.F90 --- WARNING using defaut values'
734	ENDIF ! ierr
735	CLOSE(200)
736
737	ENDIF ! level_coupling_esm
738
739	ENDIF ! (is_mpi_root .AND. is_omp_root)
740	!$OMP BARRIER
741
742	CALL bcast(nbcf)
743	CALL bcast(nbcf_in)
744	CALL bcast(nbcf_out)
745
746	WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf =',nbcf
747	WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_in =',nbcf_in
748	WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_out=',nbcf_out
749
750	ALLOCATE(cfname(nbcf))
751	ALLOCATE(cfname_in(nbcf_in))
752	ALLOCATE(cftext_in(nbcf_in))
753	ALLOCATE(cfname_out(nbcf_out))
754	ALLOCATE(cftext_out(nbcf_out))
755	ALLOCATE(cfmod1(nbcf))
756	ALLOCATE(cfmod2(nbcf))
757	ALLOCATE(cfunits_in(nbcf_in))
758	ALLOCATE(cfunits_out(nbcf_out))
759
760	IF (is_mpi_root .AND. is_omp_root) THEN
761
762	IF (nbcf.GT.0) cfname=cfname_root
763	IF (nbcf_in.GT.0) cfname_in=PACK(cfname_root,mask_in_root)
764	IF (nbcf_out.GT.0) cfname_out=PACK(cfname_root,mask_out_root)
765	IF (nbcf_in.GT.0) cftext_in=PACK(cftext_root,mask_in_root)
766	IF (nbcf_out.GT.0) cftext_out=PACK(cftext_root,mask_out_root)
767	IF (nbcf.GT.0) cfmod1=cfmod1_root
768	IF (nbcf.GT.0) cfmod2=cfmod2_root
769	IF (nbcf_in.GT.0) cfunits_in=PACK(cfunits_root,mask_in_root)
770	IF (nbcf_out.GT.0) cfunits_out=PACK(cfunits_root,mask_out_root)
771
772	nbcf_in_orc=0
773	nbcf_in_nemo=0
774	nbcf_in_inca=0
775	nbcf_in_ant=0
776
777	DO iq=1,nbcf
778	IF (cfmod1(iq) == "ORC") nbcf_in_orc = nbcf_in_orc + 1
779	IF (cfmod1(iq) == "NEMO") nbcf_in_nemo = nbcf_in_nemo + 1
780	IF (cfmod1(iq) == "INCA") nbcf_in_inca = nbcf_in_inca + 1
781	IF (cfmod1(iq) == "ALL") nbcf_in_orc = nbcf_in_orc + 1 ! ALL = ORC/NEMO/INCA
782	IF (cfmod1(iq) == "ALL") nbcf_in_nemo = nbcf_in_nemo + 1 ! ALL = ORC/NEMO/INCA
783	IF (cfmod1(iq) == "ALL") nbcf_in_inca = nbcf_in_inca + 1 ! ALL = ORC/NEMO/INCA
784	IF (cfmod1(iq) == "ANT") nbcf_in_ant = nbcf_in_ant + 1
785	ENDDO
786
787	ENDIF ! (is_mpi_root .AND. is_omp_root)
788	!$OMP BARRIER
789
790	CALL bcast(nbcf_in_orc)
791	CALL bcast(nbcf_in_nemo)
792	CALL bcast(nbcf_in_inca)
793	CALL bcast(nbcf_in_ant)
794
795	WRITE(lunout,*) 'nbcf_in_orc =',nbcf_in_orc
796	WRITE(lunout,*) 'nbcf_in_nemo =',nbcf_in_nemo
797	WRITE(lunout,*) 'nbcf_in_inca =',nbcf_in_inca
798	WRITE(lunout,*) 'nbcf_in_ant =',nbcf_in_ant
799
800	IF (nbcf_in.GT.0) THEN
801	DO iq=1,nbcf_in
802	CALL bcast(cfname_in(iq))
803	CALL bcast(cftext_in(iq))
804	CALL bcast(cfunits_in(iq))
805	ENDDO
806	ENDIF
807
808	IF (nbcf_out.GT.0) THEN
809	DO iq=1,nbcf_out
810	CALL bcast(cfname_out(iq))
811	CALL bcast(cftext_out(iq))
812	CALL bcast(cfunits_out(iq))
813	ENDDO
814	ENDIF
815
816	IF (nbcf.GT.0) THEN
817	DO iq=1,nbcf
818	CALL bcast(cfmod1(iq))
819	CALL bcast(cfmod2(iq))
820	ENDDO
821	ENDIF
822
823	IF (nbcf_in.GT.0) WRITE(lunout,*)'infocfields_mod --- cfname_in: ',cfname_in
824	IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfields_mod --- cfname_out: ',cfname_out
825
826	IF (nbcf_in.GT.0) WRITE(lunout,*)'infocfields_mod --- cftext_in: ',cftext_in
827	IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfields_mod --- cftext_out: ',cftext_out
828
829	IF (nbcf.GT.0) WRITE(lunout,*)'infocfields_mod --- cfmod1: ',cfmod1
830	IF (nbcf.GT.0) WRITE(lunout,*)'infocfields_mod --- cfmod2: ',cfmod2
831
832	IF (nbcf_in.GT.0) WRITE(lunout,*)'infocfunits_mod --- cfunits_in: ',cfunits_in
833	IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfunits_mod --- cfunits_out: ',cfunits_out
834
835	IF (nbcf_in.GT.0) WRITE(,)'infocfields_init --- number of fields in to LMDZ: ',nbcf_in
836	IF (nbcf_out.GT.0) WRITE(,)'infocfields_init --- number of fields out of LMDZ: ',nbcf_out
837
838	ELSE
839	! Default values for other planets
840	nbcf=0
841	nbcf_in=0
842	nbcf_out=0
843	ENDIF ! planet_type
844
845	ALLOCATE(fields_in(klon,nbcf_in),stat=error)
846	IF (error /= 0) CALL abort_physic(modname,'Pb in allocation fields_in',1)
847	ALLOCATE(yfields_in(klon,nbcf_in),stat=error)
848	IF (error /= 0) CALL abort_physic(modname,'Pb in allocation yfields_in',1)
849	ALLOCATE(fields_out(klon,nbcf_out),stat=error)
850	IF (error /= 0) CALL abort_physic(modname,'Pb in allocation fields_out',1)
851	ALLOCATE(yfields_out(klon,nbcf_out),stat=error)
852	IF (error /= 0) CALL abort_physic(modname,'Pb in allocation yfields_out',1)
853
854	END SUBROUTINE infocfields_init
855
856	END MODULE carbon_cycle_mod

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format