Context Navigation

carbon_cycle_mod.F90 @ 3624

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

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

Download in other formats:

Original Format