Context Navigation

carbon_cycle_mod.F90 @ 3463

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

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

Download in other formats:

Original Format