Context Navigation

carbon_cycle_mod.F90 @ 3387

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

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

Download in other formats:

Original Format