Context Navigation

carbon_cycle_mod.F90 @ 4678

Last change on this file since 4678 was 4298, checked in by pcadule, 19 months ago
modifications to ensure restartability of the model when CO2 tracer is passed to radiative code, and to add diagnostics variables
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: 22.4 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	! - Initialisation of carbon cycle fields
10	! - Definition of fluxes to be exchanged
11	!
12	! Rest of code is in tracco2i.F90
13	!
14	! Le cas online/offline est defini par le flag carbon_cycle_cpl (y/n)
15	! Le transport du traceur CO2 est defini par le flag carbon_cycle_tr (y/n)
16	! la provenance des champs (termes de puits) est denini par le flag level_coupling_esm
17	!
18	! level_coupling_esm : level of coupling of the biogeochemical fields between
19	! LMDZ, ORCHIDEE and NEMO
20	! Definitions of level_coupling_esm in physiq.def
21	! level_coupling_esm = 0 ! No field exchange between LMDZ and ORCHIDEE models
22	! ! No field exchange between LMDZ and NEMO
23	! level_coupling_esm = 1 ! Field exchange between LMDZ and ORCHIDEE models
24	! ! No field exchange between LMDZ and NEMO models
25	! level_coupling_esm = 2 ! No field exchange between LMDZ and ORCHIDEE models
26	! ! Field exchange between LMDZ and NEMO models
27	! level_coupling_esm = 3 ! Field exchange between LMDZ and ORCHIDEE models
28	! ! Field exchange between LMDZ and NEMO models
29	!=======================================================================
30
31	IMPLICIT NONE
32	SAVE
33	PRIVATE
34	PUBLIC :: carbon_cycle_init, infocfields_init
35
36	! Variables read from parmeter file physiq.def
37	LOGICAL, PUBLIC :: carbon_cycle_cpl ! Coupling of CO2 fluxes between LMDZ/ORCHIDEE and LMDZ/OCEAN(PISCES)
38	!$OMP THREADPRIVATE(carbon_cycle_cpl)
39	LOGICAL, PUBLIC :: carbon_cycle_tr ! 3D transport of CO2 in the atmosphere, parameter read in conf_phys
40	!$OMP THREADPRIVATE(carbon_cycle_tr)
41	LOGICAL, PUBLIC :: carbon_cycle_rad ! flag to activate CO2 interactive radiatively
42	!$OMP THREADPRIVATE(carbon_cycle_rad)
43	INTEGER, PUBLIC :: level_coupling_esm ! Level of coupling for the ESM - 0, 1, 2, 3
44	!$OMP THREADPRIVATE(level_coupling_esm)
45	LOGICAL, PUBLIC :: read_fco2_ocean_cor ! flag to read corrective oceanic CO2 flux
46	!$OMP THREADPRIVATE(read_fco2_ocean_cor)
47	REAL, PUBLIC :: var_fco2_ocean_cor ! corrective oceanic CO2 flux
48	!$OMP THREADPRIVATE(var_fco2_ocean_cor)
49	REAL, PUBLIC :: ocean_area_tot ! total oceanic area to convert flux
50	!$OMP THREADPRIVATE(ocean_area_tot)
51	LOGICAL, PUBLIC :: read_fco2_land_cor ! flag to read corrective land CO2 flux
52	!$OMP THREADPRIVATE(read_fco2_land_cor)
53	REAL, PUBLIC :: var_fco2_land_cor ! corrective land CO2 flux
54	!$OMP THREADPRIVATE(var_fco2_land_cor)
55	REAL, PUBLIC :: land_area_tot ! total land area to convert flux
56	!$OMP THREADPRIVATE(land_area_tot)
57
58	REAL, PUBLIC :: RCO2_glo
59	!$OMP THREADPRIVATE(RCO2_glo)
60	REAL, PUBLIC :: RCO2_tot
61	!$OMP THREADPRIVATE(RCO2_tot)
62
63	LOGICAL :: carbon_cycle_emis_comp_omp=.FALSE.
64	LOGICAL :: carbon_cycle_emis_comp=.FALSE. ! Calculation of emission compatible
65	!$OMP THREADPRIVATE(carbon_cycle_emis_comp)
66
67	LOGICAL :: RCO2_inter_omp
68	LOGICAL :: RCO2_inter ! RCO2 interactive : if true calculate new value RCO2 for the radiation scheme
69	!$OMP THREADPRIVATE(RCO2_inter)
70
71	! Scalare values when no transport, from physiq.def
72	REAL :: fos_fuel_s_omp
73	REAL :: fos_fuel_s ! carbon_cycle_fos_fuel dans physiq.def
74	!$OMP THREADPRIVATE(fos_fuel_s)
75	REAL :: emis_land_s ! not yet implemented
76	!$OMP THREADPRIVATE(emis_land_s)
77
78	REAL :: airetot ! Total area of the earth surface
79	!$OMP THREADPRIVATE(airetot)
80
81	INTEGER :: ntr_co2 ! Number of tracers concerning the carbon cycle
82	!$OMP THREADPRIVATE(ntr_co2)
83
84	! fco2_ocn_day : flux CO2 from ocean for 1 day (cumulated) [gC/m2/d]. Allocation and initalization done in cpl_mod
85	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ocn_day
86	!$OMP THREADPRIVATE(fco2_ocn_day)
87
88	REAL, DIMENSION(:), ALLOCATABLE :: fco2_land_day ! flux CO2 from land for 1 day (cumulated) [gC/m2/d]
89	!$OMP THREADPRIVATE(fco2_land_day)
90	REAL, DIMENSION(:), ALLOCATABLE :: fco2_lu_day ! Emission from land use change for 1 day (cumulated) [gC/m2/d]
91	!$OMP THREADPRIVATE(fco2_lu_day)
92	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ff ! Emission from fossil fuel [kgCO2/m2/s]
93	!$OMP THREADPRIVATE(fco2_ff)
94	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_bb ! Emission from biomass burning [kgCO2/m2/s]
95	!$OMP THREADPRIVATE(fco2_bb)
96	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land ! Net flux from terrestrial ecocsystems [kgCO2/m2/s]
97	!$OMP THREADPRIVATE(fco2_land)
98	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_nbp ! Net flux from terrestrial ecocsystems [kgCO2/m2/s]
99	!$OMP THREADPRIVATE(fco2_land_nbp)
100	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_nep ! Net flux from terrestrial ecocsystems [kgCO2/m2/s]
101	!$OMP THREADPRIVATE(fco2_land_nep)
102	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_fLuc ! Net flux from terrestrial ecocsystems [kgCO2/m2/s]
103	!$OMP THREADPRIVATE(fco2_land_fLuc)
104	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_fwoodharvest ! Net flux from terrestrial ecocsystems [kgCO2/m2/s]
105	!$OMP THREADPRIVATE(fco2_land_fwoodharvest)
106	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_fHarvest ! Net flux from terrestrial ecocsystems [kgCO2/m2/s]
107	!$OMP THREADPRIVATE(fco2_land_fHarvest)
108	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ocean ! Net flux from ocean [kgCO2/m2/s]
109	!$OMP THREADPRIVATE(fco2_ocean)
110	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ocean_cor ! Net corrective flux from ocean [kgCO2/m2/s]
111	!$OMP THREADPRIVATE(fco2_ocean_cor)
112	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_cor ! Net corrective flux from land [kgCO2/m2/s]
113	!$OMP THREADPRIVATE(fco2_land_cor)
114
115	REAL, DIMENSION(:,:), ALLOCATABLE :: dtr_add ! Tracer concentration to be injected
116	!$OMP THREADPRIVATE(dtr_add)
117
118	! Following 2 fields will be allocated and initialized in surf_land_orchidee
119	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_inst ! flux CO2 from land at one time step
120	!$OMP THREADPRIVATE(fco2_land_inst)
121	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_lu_inst ! Emission from land use change at one time step
122	!$OMP THREADPRIVATE(fco2_lu_inst)
123
124	! Calculated co2 field to be send to the ocean via the coupler and to ORCHIDEE
125	REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: co2_send ! Field allocated in phyetat0
126	!$OMP THREADPRIVATE(co2_send)
127
128	INTEGER, PARAMETER, PUBLIC :: id_CO2=1 !--temporaire OB -- to be changed
129
130	! nbfields : total number of fields
131	INTEGER, PUBLIC :: nbcf
132	!$OMP THREADPRIVATE(nbcf)
133
134	! nbcf_in : number of fields IN
135	INTEGER, PUBLIC :: nbcf_in
136	!$OMP THREADPRIVATE(nbcf_in)
137
138	! nbcf_in_orc : number of fields IN
139	INTEGER, PUBLIC :: nbcf_in_orc
140	!$OMP THREADPRIVATE(nbcf_in_orc)
141
142	! nbcf_in_inca : number of fields IN (from INCA)
143	INTEGER, PUBLIC :: nbcf_in_inca
144	!$OMP THREADPRIVATE(nbcf_in_inca)
145
146	! nbcf_in_nemo : number of fields IN (from nemo)
147	INTEGER, PUBLIC :: nbcf_in_nemo
148	!$OMP THREADPRIVATE(nbcf_in_nemo)
149
150	! nbcf_in_ant : number of fields IN (from anthropogenic sources)
151	INTEGER, PUBLIC :: nbcf_in_ant
152	!$OMP THREADPRIVATE(nbcf_in_ant)
153
154	! nbcf_out : number of fields OUT
155	INTEGER, PUBLIC :: nbcf_out
156	!$OMP THREADPRIVATE(nbcf_out)
157
158	! Name of variables
159	CHARACTER(len=25), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfname ! coupling field short name for restart (?) and diagnostics
160	!$OMP THREADPRIVATE(cfname)
161
162	CHARACTER(len=25), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfname_in ! coupling field short name for restart (?) and diagnostics
163	!$OMP THREADPRIVATE(cfname_in)
164
165	CHARACTER(len=25), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfname_out ! coupling field short name for restart (?) and diagnostics
166	!$OMP THREADPRIVATE(cfname_out)
167
168	CHARACTER(len=15), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfunits_in ! coupling field units for diagnostics
169	!$OMP THREADPRIVATE(cfunits_in)
170
171	CHARACTER(len=15), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfunits_out ! coupling field units for diagnostics
172	!$OMP THREADPRIVATE(cfunits_out)
173
174	CHARACTER(len=120), ALLOCATABLE, DIMENSION(:), PUBLIC :: cftext_in ! coupling field long name for diagnostics
175	!$OMP THREADPRIVATE(cftext_in)
176
177	CHARACTER(len=120), ALLOCATABLE, DIMENSION(:), PUBLIC :: cftext_out ! coupling field long name for diagnostics
178	!$OMP THREADPRIVATE(cftext_out)
179
180	CHARACTER(len=5), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfmod1 ! model 1 (rreference) : LMDz
181	!$OMP THREADPRIVATE(cfmod1)
182
183	CHARACTER(len=5), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfmod2 ! model 2
184	!$OMP THREADPRIVATE(cfmod2)
185
186	CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:), PUBLIC :: field_out_names
187	!$OMP THREADPRIVATE(field_out_names)
188
189	CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:), PUBLIC :: field_in_names
190	!$OMP THREADPRIVATE(field_in_names)
191
192	REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: fields_in ! klon,nbcf_in
193	!$OMP THREADPRIVATE(fields_in)
194
195	REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: yfields_in ! knon,nbcf_in
196	!$OMP THREADPRIVATE(yfields_in)
197
198	REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: fields_out ! klon,nbcf_out
199	!$OMP THREADPRIVATE(fields_out)
200
201	REAL, ALLOCATABLE, DIMENSION(:,:), PUBLIC :: yfields_out ! knon,nbcf_out
202	!$OMP THREADPRIVATE(yfields_out)
203
204	TYPE, PUBLIC :: co2_trac_type
205	CHARACTER(len = 8) :: name ! Tracer name in tracer.def
206	INTEGER :: id ! Index in total tracer list, tr_seri
207	CHARACTER(len=30) :: file ! File name
208	LOGICAL :: cpl ! True if this tracers is coupled from ORCHIDEE or PISCES.
209	! False if read from file.
210	INTEGER :: updatefreq ! Frequence to inject in second
211	INTEGER :: readstep ! Actual time step to read in file
212	LOGICAL :: updatenow ! True if this tracer should be updated this time step
213	END TYPE co2_trac_type
214	INTEGER,PARAMETER :: maxco2trac=5 ! Maximum number of different CO2 fluxes
215	TYPE(co2_trac_type), DIMENSION(maxco2trac) :: co2trac
216
217	CONTAINS
218
219	SUBROUTINE carbon_cycle_init()
220	! This subroutine is called from tracco2i_init, which is called from phytrac_init only at first timestep.
221	! - Allocate variables. These variables must be allocated before first call to phys_output_write in physiq.
222
223	USE dimphy
224	USE IOIPSL
225	USE print_control_mod, ONLY: lunout
226
227	IMPLICIT NONE
228	INCLUDE "clesphys.h"
229
230	! Local variables
231	INTEGER :: ierr
232
233	IF (carbon_cycle_cpl) THEN
234
235	ierr=0
236
237	IF (.NOT.ALLOCATED(fco2_land)) ALLOCATE(fco2_land(klon), stat=ierr)
238	IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land',1)
239
240	IF (.NOT.ALLOCATED(fco2_land_nbp)) ALLOCATE(fco2_land_nbp(klon), stat=ierr)
241	IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_nbp',1)
242
243	IF (.NOT.ALLOCATED(fco2_land_nep)) ALLOCATE(fco2_land_nep(klon), stat=ierr)
244	IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_nep',1)
245
246	IF (.NOT.ALLOCATED(fco2_land_fLuc)) ALLOCATE(fco2_land_fLuc(klon), stat=ierr)
247	IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fLuc',1)
248
249	IF (.NOT.ALLOCATED(fco2_land_fwoodharvest)) ALLOCATE(fco2_land_fwoodharvest(klon), stat=ierr)
250	IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fwoodharvest',1)
251
252	IF (.NOT.ALLOCATED(fco2_land_fHarvest)) ALLOCATE(fco2_land_fHarvest(klon), stat=ierr)
253	IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fHarvest',1)
254
255	IF (.NOT.ALLOCATED(fco2_ff)) ALLOCATE(fco2_ff(klon), stat=ierr)
256	IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ff',1)
257
258	IF (.NOT.ALLOCATED(fco2_bb)) ALLOCATE(fco2_bb(klon), stat=ierr)
259	IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_bb',1)
260
261	IF (.NOT.ALLOCATED(fco2_ocean)) ALLOCATE(fco2_ocean(klon), stat=ierr)
262	IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ocean',1)
263
264	IF (.NOT.ALLOCATED(fco2_ocean_cor)) ALLOCATE(fco2_ocean_cor(klon), stat=ierr)
265	IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ocean_cor',1)
266
267	IF (.NOT.ALLOCATED(fco2_land_cor)) ALLOCATE(fco2_land_cor(klon), stat=ierr)
268	IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_cor',1)
269
270	ENDIF
271
272	END SUBROUTINE carbon_cycle_init
273
274	SUBROUTINE infocfields_init
275
276	! USE control_mod, ONLY: planet_type
277	USE phys_cal_mod, ONLY : mth_cur
278	USE mod_synchro_omp
279	USE mod_phys_lmdz_para, ONLY: is_mpi_root, is_omp_root
280	USE mod_phys_lmdz_transfert_para
281	USE mod_phys_lmdz_omp_transfert
282	USE dimphy, ONLY: klon
283
284	IMPLICIT NONE
285
286	!=======================================================================
287	!
288	! Authors: Patricia Cadule and Laurent Fairhead
289	! -------
290	!
291	! Purpose and description:
292	! -----------------------
293	!
294	! Infofields
295	! this routine enables to define the field exchanges in both directions between
296	! the atmospheric circulation model (LMDZ) and ORCHIDEE. In the future this
297	! routing might apply to other models (e.g., NEMO, INCA, ...).
298	! Therefore, currently with this routine, it is possible to define the coupling
299	! fields only between LMDZ and ORCHIDEE.
300	! The coupling_fields.def file enables to define the name of the exchanged
301	! fields at the coupling interface.
302	! field_in_names : the set of names of the exchanged fields in input to ORCHIDEE
303	! (LMDZ to ORCHIDEE)
304	! field_out_names : the set of names of the exchanged fields in output of
305	! ORCHIDEE (ORCHIDEE to LMDZ)
306	! n : the number of exchanged fields at th coupling interface
307	! nb_fields_in : number of inputs fields to ORCHIDEE (LMDZ to ORCHIDEE)
308	! nb_fields_out : number of ouput fields of ORCHIDEE (ORCHIDEE to LMDZ)
309	!
310	! The syntax for coupling_fields.def is as follows:
311	! IMPORTANT: each column entry must be separated from the previous one by 3
312	! spaces and only that
313	! field name coupling model 1 model 2 long_name
314	! direction
315	! 10char -3spaces- 3char -3spaces- 4char -3spaces- 4char -3spaces- 30char
316	!
317	! n
318	! FIELD1 IN LMDZ ORC
319	! ....
320	! FIELD(j) IN LMDZ ORC
321	! FIELD(j+1) OUT LMDZ ORC
322	! ...
323	! FIELDn OUT LMDZ ORC
324	!
325	!=======================================================================
326	! ... 22/12/2017 ....
327	!-----------------------------------------------------------------------
328	! Declarations
329
330	INCLUDE "clesphys.h"
331	INCLUDE "dimensions.h"
332	INCLUDE "iniprint.h"
333
334	! Local variables
335
336	INTEGER :: iq, ierr, stat, error
337
338	CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:), SAVE :: cfname_root
339	CHARACTER(LEN=120), ALLOCATABLE, DIMENSION(:), SAVE :: cftext_root
340	CHARACTER(LEN=15), ALLOCATABLE, DIMENSION(:), SAVE :: cfunits_root
341
342	CHARACTER(len=3), ALLOCATABLE, DIMENSION(:) :: cfintent_root
343	CHARACTER(len=5), ALLOCATABLE, DIMENSION(:) :: cfmod1_root
344	CHARACTER(len=5), ALLOCATABLE, DIMENSION(:) :: cfmod2_root
345
346	LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: mask_in_root
347	LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: mask_out_root
348
349	CHARACTER(len=*),parameter :: modname="infocfields"
350
351	CHARACTER(len=10),SAVE :: planet_type="earth"
352
353	!-----------------------------------------------------------------------
354
355	nbcf=0
356	nbcf_in=0
357	nbcf_out=0
358
359	IF (planet_type=='earth') THEN
360
361	IF (is_mpi_root .AND. is_omp_root) THEN
362
363	IF (level_coupling_esm.GT.0) THEN
364
365	OPEN(200,file='coupling_fields.def',form='formatted',status='old', iostat=ierr)
366
367	IF (ierr.EQ.0) THEN
368
369	WRITE(lunout,*) trim(modname),': Open coupling_fields.def : ok'
370	READ(200,*) nbcf
371	WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf=',nbcf
372	ALLOCATE(cfname_root(nbcf))
373	ALLOCATE(cfintent_root(nbcf))
374	ALLOCATE(cfmod1_root(nbcf))
375	ALLOCATE(cfmod2_root(nbcf))
376	ALLOCATE(cftext_root(nbcf))
377	ALLOCATE(cfunits_root(nbcf))
378	ALLOCATE(mask_in_root(nbcf))
379	ALLOCATE(mask_out_root(nbcf))
380
381	nbcf_in=0
382	nbcf_out=0
383
384	DO iq=1,nbcf
385	WRITE(lunout,*) 'infofields : field=',iq
386	READ(200,'(A15,3X,A3,3X,A5,3X,A5,3X,A120,3X,A15)',IOSTAT=ierr) &
387	cfname_root(iq),cfintent_root(iq),cfmod1_root(iq),cfmod2_root(iq),cftext_root(iq),cfunits_root(iq)
388	cfname_root(iq)=TRIM(cfname_root(iq))
389	cfintent_root(iq)=TRIM(cfintent_root(iq))
390	cfmod1_root(iq)=TRIM(cfmod1_root(iq))
391	cfmod2_root(iq)=TRIM(cfmod2_root(iq))
392	cftext_root(iq)=TRIM(cftext_root(iq))
393	cfunits_root(iq)=TRIM(cfunits_root(iq))
394	WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &
395	', number: ',iq,', INTENT: ',cfintent_root(iq)
396	WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &
397	', number: ',iq,', model 1 (ref): ',cfmod1_root(iq),', model 2: ',cfmod2_root(iq)
398	WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &
399	', number: ',iq,', long name: ',cftext_root(iq),', units ',cfunits_root(iq)
400	IF (nbcf_in+nbcf_out.LT.nbcf) THEN
401	IF (cfintent_root(iq).NE.'OUT') THEN
402	nbcf_in=nbcf_in+1
403	mask_in_root(iq)=.TRUE.
404	mask_out_root(iq)=.FALSE.
405	ELSE IF (cfintent_root(iq).EQ.'OUT') THEN
406	nbcf_out=nbcf_out+1
407	mask_in_root(iq)=.FALSE.
408	mask_out_root(iq)=.TRUE.
409	ENDIF
410	ELSE
411	WRITE(lunout,*) 'abort_gcm --- nbcf : ',nbcf
412	WRITE(lunout,*) 'abort_gcm --- nbcf_in : ',nbcf_in
413	WRITE(lunout,*) 'abort_gcm --- nbcf_out: ',nbcf_out
414	CALL abort_physic('infocfields_init','Problem in the definition of the coupling fields',1)
415	ENDIF
416	ENDDO !DO iq=1,nbcf
417	ELSE
418	WRITE(lunout,*) trim(modname),': infocfields_mod.F90 --- Problem in opening coupling_fields.def'
419	WRITE(lunout,*) trim(modname),': infocfields_mod.F90 --- WARNING using defaut values'
420	ENDIF ! ierr
421	CLOSE(200)
422
423	ENDIF ! level_coupling_esm
424
425	ENDIF ! (is_mpi_root .AND. is_omp_root)
426	!$OMP BARRIER
427
428	CALL bcast(nbcf)
429	CALL bcast(nbcf_in)
430	CALL bcast(nbcf_out)
431
432	WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf =',nbcf
433	WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_in =',nbcf_in
434	WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_out=',nbcf_out
435
436	ALLOCATE(cfname(nbcf))
437	ALLOCATE(cfname_in(nbcf_in))
438	ALLOCATE(cftext_in(nbcf_in))
439	ALLOCATE(cfname_out(nbcf_out))
440	ALLOCATE(cftext_out(nbcf_out))
441	ALLOCATE(cfmod1(nbcf))
442	ALLOCATE(cfmod2(nbcf))
443	ALLOCATE(cfunits_in(nbcf_in))
444	ALLOCATE(cfunits_out(nbcf_out))
445
446	IF (is_mpi_root .AND. is_omp_root) THEN
447
448	IF (nbcf.GT.0) cfname=cfname_root
449	IF (nbcf_in.GT.0) cfname_in=PACK(cfname_root,mask_in_root)
450	IF (nbcf_out.GT.0) cfname_out=PACK(cfname_root,mask_out_root)
451	IF (nbcf_in.GT.0) cftext_in=PACK(cftext_root,mask_in_root)
452	IF (nbcf_out.GT.0) cftext_out=PACK(cftext_root,mask_out_root)
453	IF (nbcf.GT.0) cfmod1=cfmod1_root
454	IF (nbcf.GT.0) cfmod2=cfmod2_root
455	IF (nbcf_in.GT.0) cfunits_in=PACK(cfunits_root,mask_in_root)
456	IF (nbcf_out.GT.0) cfunits_out=PACK(cfunits_root,mask_out_root)
457
458	nbcf_in_orc=0
459	nbcf_in_nemo=0
460	nbcf_in_inca=0
461	nbcf_in_ant=0
462
463	DO iq=1,nbcf
464	IF (cfmod1(iq) == "ORC") nbcf_in_orc = nbcf_in_orc + 1
465	IF (cfmod1(iq) == "NEMO") nbcf_in_nemo = nbcf_in_nemo + 1
466	IF (cfmod1(iq) == "INCA") nbcf_in_inca = nbcf_in_inca + 1
467	IF (cfmod1(iq) == "ALL") nbcf_in_orc = nbcf_in_orc + 1 ! ALL = ORC/NEMO/INCA
468	IF (cfmod1(iq) == "ALL") nbcf_in_nemo = nbcf_in_nemo + 1 ! ALL = ORC/NEMO/INCA
469	IF (cfmod1(iq) == "ALL") nbcf_in_inca = nbcf_in_inca + 1 ! ALL = ORC/NEMO/INCA
470	IF (cfmod1(iq) == "ANT") nbcf_in_ant = nbcf_in_ant + 1
471	ENDDO
472
473	ENDIF ! (is_mpi_root .AND. is_omp_root)
474	!$OMP BARRIER
475
476	CALL bcast(nbcf_in_orc)
477	CALL bcast(nbcf_in_nemo)
478	CALL bcast(nbcf_in_inca)
479	CALL bcast(nbcf_in_ant)
480
481	WRITE(lunout,*) 'nbcf_in_orc =',nbcf_in_orc
482	WRITE(lunout,*) 'nbcf_in_nemo =',nbcf_in_nemo
483	WRITE(lunout,*) 'nbcf_in_inca =',nbcf_in_inca
484	WRITE(lunout,*) 'nbcf_in_ant =',nbcf_in_ant
485
486	IF (nbcf_in.GT.0) THEN
487	DO iq=1,nbcf_in
488	CALL bcast(cfname_in(iq))
489	CALL bcast(cftext_in(iq))
490	CALL bcast(cfunits_in(iq))
491	ENDDO
492	ENDIF
493
494	IF (nbcf_out.GT.0) THEN
495	DO iq=1,nbcf_out
496	CALL bcast(cfname_out(iq))
497	CALL bcast(cftext_out(iq))
498	CALL bcast(cfunits_out(iq))
499	ENDDO
500	ENDIF
501
502	IF (nbcf.GT.0) THEN
503	DO iq=1,nbcf
504	CALL bcast(cfmod1(iq))
505	CALL bcast(cfmod2(iq))
506	ENDDO
507	ENDIF
508
509	IF (nbcf_in.GT.0) WRITE(lunout,*)'infocfields_mod --- cfname_in: ',cfname_in
510	IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfields_mod --- cfname_out: ',cfname_out
511
512	IF (nbcf_in.GT.0) WRITE(lunout,*)'infocfields_mod --- cftext_in: ',cftext_in
513	IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfields_mod --- cftext_out: ',cftext_out
514
515	IF (nbcf.GT.0) WRITE(lunout,*)'infocfields_mod --- cfmod1: ',cfmod1
516	IF (nbcf.GT.0) WRITE(lunout,*)'infocfields_mod --- cfmod2: ',cfmod2
517
518	IF (nbcf_in.GT.0) WRITE(lunout,*)'infocfunits_mod --- cfunits_in: ',cfunits_in
519	IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfunits_mod --- cfunits_out: ',cfunits_out
520
521	IF (nbcf_in.GT.0) WRITE(,)'infocfields_init --- number of fields in to LMDZ: ',nbcf_in
522	IF (nbcf_out.GT.0) WRITE(,)'infocfields_init --- number of fields out of LMDZ: ',nbcf_out
523
524	ELSE
525	! Default values for other planets
526	nbcf=0
527	nbcf_in=0
528	nbcf_out=0
529	ENDIF ! planet_type
530
531	ALLOCATE(fields_in(klon,nbcf_in),stat=error)
532	IF (error /= 0) CALL abort_physic(modname,'Pb in allocation fields_in',1)
533	ALLOCATE(yfields_in(klon,nbcf_in),stat=error)
534	IF (error /= 0) CALL abort_physic(modname,'Pb in allocation yfields_in',1)
535	ALLOCATE(fields_out(klon,nbcf_out),stat=error)
536	IF (error /= 0) CALL abort_physic(modname,'Pb in allocation fields_out',1)
537	ALLOCATE(yfields_out(klon,nbcf_out),stat=error)
538	IF (error /= 0) CALL abort_physic(modname,'Pb in allocation yfields_out',1)
539
540	END SUBROUTINE infocfields_init
541
542	END MODULE carbon_cycle_mod

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

Download in other formats:

Original Format