Context Navigation

carbon_cycle_mod.F90 @ 3443

Last change on this file since 3443 was 3435, checked in by Laurent Fairhead, 6 years ago

"Historic" :-) commit merging the physics branch used for DYNAMICO with the LMDZ trunk.
The same physics branch can now be used seamlessly with the traditional lon-lat LMDZ
dynamical core and DYNAMICO.
Testing consisted in running a lon-lat LMDZ bucket simulation with the NPv6.1 physics package
with the original trunk sources and the merged sources. Tests were succesful in the sense that
numeric continuity was preserved in the restart files from both simulation. Further tests
included running both versions of the physics codes for one year in a LMDZOR setting in which
the restart files also came out identical.

Caution:

as the physics package now manages unstructured grids, grid information needs to be transmitted

to the surface scheme ORCHIDEE. This means that the interface defined in surf_land_orchidee_mod.F90
is only compatible with ORCHIDEE version orchidee2.1 and later versions. If previous versions of
ORCHIDEE need to be used, the CPP key ORCHIDEE_NOUNSTRUCT needs to be set at compilation time.
This is done automatically if makelmdz/makelmdz_fcm are called with the veget orchidee2.0 switch

due to a limitation in XIOS, the time at which limit conditions will be read in by DYNAMICO will be

delayed by one physic timestep with respect to the time it is read in by the lon-lat model. This is caused
by the line

IF (MOD(itime-1, lmt_pas) == 0 .OR. (jour_lu /= jour .AND. grid_type /= unstructured)) THEN ! time to read

in limit_read_mod.F90

Work still needed on COSP integration and XML files for DYNAMICO

EM, YM, LF

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.3 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	CHARACTER(len=10),SAVE :: planet_type="earth"
660
661	!-----------------------------------------------------------------------
662
663	nbcf=0
664	nbcf_in=0
665	nbcf_out=0
666
667	IF (planet_type=='earth') THEN
668
669	IF (is_mpi_root .AND. is_omp_root) THEN
670
671	IF (level_coupling_esm.GT.0) THEN
672
673	OPEN(200,file='coupling_fields.def',form='formatted',status='old', iostat=ierr)
674
675	IF (ierr.EQ.0) THEN
676
677	WRITE(lunout,*) trim(modname),': Open coupling_fields.def : ok'
678	READ(200,*) nbcf
679	WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf=',nbcf
680	ALLOCATE(cfname_root(nbcf))
681	ALLOCATE(cfintent_root(nbcf))
682	ALLOCATE(cfmod1_root(nbcf))
683	ALLOCATE(cfmod2_root(nbcf))
684	ALLOCATE(cftext_root(nbcf))
685	ALLOCATE(cfunits_root(nbcf))
686	ALLOCATE(mask_in_root(nbcf))
687	ALLOCATE(mask_out_root(nbcf))
688
689	nbcf_in=0
690	nbcf_out=0
691
692	DO iq=1,nbcf
693	WRITE(lunout,*) 'infofields : field=',iq
694	READ(200,'(A15,3X,A3,3X,A5,3X,A5,3X,A120,3X,A15)',IOSTAT=ierr) &
695	cfname_root(iq),cfintent_root(iq),cfmod1_root(iq),cfmod2_root(iq),cftext_root(iq),cfunits_root(iq)
696	cfname_root(iq)=TRIM(cfname_root(iq))
697	cfintent_root(iq)=TRIM(cfintent_root(iq))
698	cfmod1_root(iq)=TRIM(cfmod1_root(iq))
699	cfmod2_root(iq)=TRIM(cfmod2_root(iq))
700	cftext_root(iq)=TRIM(cftext_root(iq))
701	cfunits_root(iq)=TRIM(cfunits_root(iq))
702	WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &
703	', number: ',iq,', INTENT: ',cfintent_root(iq)
704	WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &
705	', number: ',iq,', model 1 (ref): ',cfmod1_root(iq),', model 2: ',cfmod2_root(iq)
706	WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &
707	', number: ',iq,', long name: ',cftext_root(iq),', units ',cfunits_root(iq)
708	IF (nbcf_in+nbcf_out.LT.nbcf) THEN
709	IF (cfintent_root(iq).NE.'OUT') THEN
710	nbcf_in=nbcf_in+1
711	mask_in_root(iq)=.TRUE.
712	mask_out_root(iq)=.FALSE.
713	ELSE IF (cfintent_root(iq).EQ.'OUT') THEN
714	nbcf_out=nbcf_out+1
715	mask_in_root(iq)=.FALSE.
716	mask_out_root(iq)=.TRUE.
717	ENDIF
718	ELSE
719	WRITE(lunout,*) 'abort_gcm --- nbcf : ',nbcf
720	WRITE(lunout,*) 'abort_gcm --- nbcf_in : ',nbcf_in
721	WRITE(lunout,*) 'abort_gcm --- nbcf_out: ',nbcf_out
722	CALL abort_physic('infocfields_init','Problem in the definition of the coupling fields',1)
723	ENDIF
724	ENDDO !DO iq=1,nbcf
725	ELSE
726	WRITE(lunout,*) trim(modname),': infocfields_mod.F90 --- Problem in opening coupling_fields.def'
727	WRITE(lunout,*) trim(modname),': infocfields_mod.F90 --- WARNING using defaut values'
728	ENDIF ! ierr
729	CLOSE(200)
730
731	ENDIF ! level_coupling_esm
732
733	ENDIF ! (is_mpi_root .AND. is_omp_root)
734	!$OMP BARRIER
735
736	CALL bcast(nbcf)
737	CALL bcast(nbcf_in)
738	CALL bcast(nbcf_out)
739
740	WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf =',nbcf
741	WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_in =',nbcf_in
742	WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_out=',nbcf_out
743
744	ALLOCATE(cfname(nbcf))
745	ALLOCATE(cfname_in(nbcf_in))
746	ALLOCATE(cftext_in(nbcf_in))
747	ALLOCATE(cfname_out(nbcf_out))
748	ALLOCATE(cftext_out(nbcf_out))
749	ALLOCATE(cfmod1(nbcf))
750	ALLOCATE(cfmod2(nbcf))
751	ALLOCATE(cfunits_in(nbcf_in))
752	ALLOCATE(cfunits_out(nbcf_out))
753
754	IF (is_mpi_root .AND. is_omp_root) THEN
755
756	IF (nbcf.GT.0) cfname=cfname_root
757	IF (nbcf_in.GT.0) cfname_in=PACK(cfname_root,mask_in_root)
758	IF (nbcf_out.GT.0) cfname_out=PACK(cfname_root,mask_out_root)
759	IF (nbcf_in.GT.0) cftext_in=PACK(cftext_root,mask_in_root)
760	IF (nbcf_out.GT.0) cftext_out=PACK(cftext_root,mask_out_root)
761	IF (nbcf.GT.0) cfmod1=cfmod1_root
762	IF (nbcf.GT.0) cfmod2=cfmod2_root
763	IF (nbcf_in.GT.0) cfunits_in=PACK(cfunits_root,mask_in_root)
764	IF (nbcf_out.GT.0) cfunits_out=PACK(cfunits_root,mask_out_root)
765
766	nbcf_in_orc=0
767	nbcf_in_nemo=0
768	nbcf_in_inca=0
769	nbcf_in_ant=0
770
771	DO iq=1,nbcf
772	IF (cfmod1(iq) == "ORC") nbcf_in_orc = nbcf_in_orc + 1
773	IF (cfmod1(iq) == "NEMO") nbcf_in_nemo = nbcf_in_nemo + 1
774	IF (cfmod1(iq) == "INCA") nbcf_in_inca = nbcf_in_inca + 1
775	IF (cfmod1(iq) == "ALL") nbcf_in_orc = nbcf_in_orc + 1 ! ALL = ORC/NEMO/INCA
776	IF (cfmod1(iq) == "ALL") nbcf_in_nemo = nbcf_in_nemo + 1 ! ALL = ORC/NEMO/INCA
777	IF (cfmod1(iq) == "ALL") nbcf_in_inca = nbcf_in_inca + 1 ! ALL = ORC/NEMO/INCA
778	IF (cfmod1(iq) == "ANT") nbcf_in_ant = nbcf_in_ant + 1
779	ENDDO
780
781	ENDIF ! (is_mpi_root .AND. is_omp_root)
782	!$OMP BARRIER
783
784	CALL bcast(nbcf_in_orc)
785	CALL bcast(nbcf_in_nemo)
786	CALL bcast(nbcf_in_inca)
787	CALL bcast(nbcf_in_ant)
788
789	WRITE(lunout,*) 'nbcf_in_orc =',nbcf_in_orc
790	WRITE(lunout,*) 'nbcf_in_nemo =',nbcf_in_nemo
791	WRITE(lunout,*) 'nbcf_in_inca =',nbcf_in_inca
792	WRITE(lunout,*) 'nbcf_in_ant =',nbcf_in_ant
793
794	IF (nbcf_in.GT.0) THEN
795	DO iq=1,nbcf_in
796	CALL bcast(cfname_in(iq))
797	CALL bcast(cftext_in(iq))
798	CALL bcast(cfunits_in(iq))
799	ENDDO
800	ENDIF
801
802	IF (nbcf_out.GT.0) THEN
803	DO iq=1,nbcf_out
804	CALL bcast(cfname_out(iq))
805	CALL bcast(cftext_out(iq))
806	CALL bcast(cfunits_out(iq))
807	ENDDO
808	ENDIF
809
810	IF (nbcf.GT.0) THEN
811	DO iq=1,nbcf
812	CALL bcast(cfmod1(iq))
813	CALL bcast(cfmod2(iq))
814	ENDDO
815	ENDIF
816
817	IF (nbcf_in.GT.0) WRITE(lunout,*)'infocfields_mod --- cfname_in: ',cfname_in
818	IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfields_mod --- cfname_out: ',cfname_out
819
820	IF (nbcf_in.GT.0) WRITE(lunout,*)'infocfields_mod --- cftext_in: ',cftext_in
821	IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfields_mod --- cftext_out: ',cftext_out
822
823	IF (nbcf.GT.0) WRITE(lunout,*)'infocfields_mod --- cfmod1: ',cfmod1
824	IF (nbcf.GT.0) WRITE(lunout,*)'infocfields_mod --- cfmod2: ',cfmod2
825
826	IF (nbcf_in.GT.0) WRITE(lunout,*)'infocfunits_mod --- cfunits_in: ',cfunits_in
827	IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfunits_mod --- cfunits_out: ',cfunits_out
828
829	IF (nbcf_in.GT.0) WRITE(,)'infocfields_init --- number of fields in to LMDZ: ',nbcf_in
830	IF (nbcf_out.GT.0) WRITE(,)'infocfields_init --- number of fields out of LMDZ: ',nbcf_out
831
832	ELSE
833	! Default values for other planets
834	nbcf=0
835	nbcf_in=0
836	nbcf_out=0
837	ENDIF ! planet_type
838
839	ALLOCATE(fields_in(klon,nbcf_in),stat=error)
840	IF (error /= 0) CALL abort_physic(modname,'Pb in allocation fields_in',1)
841	ALLOCATE(yfields_in(klon,nbcf_in),stat=error)
842	IF (error /= 0) CALL abort_physic(modname,'Pb in allocation yfields_in',1)
843	ALLOCATE(fields_out(klon,nbcf_out),stat=error)
844	IF (error /= 0) CALL abort_physic(modname,'Pb in allocation fields_out',1)
845	ALLOCATE(yfields_out(klon,nbcf_out),stat=error)
846	IF (error /= 0) CALL abort_physic(modname,'Pb in allocation yfields_out',1)
847
848	END SUBROUTINE infocfields_init
849
850	END MODULE carbon_cycle_mod

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

Download in other formats:

Original Format