source: LMDZ6/trunk/libf/phylmd/carbon_cycle_mod.f90 @ 5503

Last change on this file since 5503 was 5485, checked in by Laurent Fairhead, 6 days ago

Some threadprivate statements were not necessary
  • 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 
1MODULE 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
217CONTAINS
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    USE clesphys_mod_h
228IMPLICIT NONE
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    USE iniprint_mod_h
284    USE clesphys_mod_h
285
286    IMPLICIT NONE
287
288!=======================================================================
289!
290!   Authors: Patricia Cadule and Laurent Fairhead
291!   -------
292!
293!  Purpose and description:
294!  -----------------------
295!
296! Infofields
297! this routine enables to define the field exchanges in both directions between
298! the atmospheric circulation model (LMDZ) and ORCHIDEE. In the future this
299! routing might apply to other models (e.g., NEMO, INCA, ...).
300! Therefore, currently with this routine, it is possible to define the coupling
301! fields only between LMDZ and ORCHIDEE.
302! The coupling_fields.def file enables to define the name of the exchanged
303! fields at the coupling interface.
304! field_in_names : the set of names of the exchanged fields in input to ORCHIDEE
305! (LMDZ to ORCHIDEE)
306! field_out_names : the set of names of the exchanged fields in output of
307! ORCHIDEE (ORCHIDEE to LMDZ)
308! n : the number of exchanged fields at th coupling interface
309! nb_fields_in : number of inputs fields to ORCHIDEE (LMDZ to ORCHIDEE)
310! nb_fields_out : number of ouput fields of ORCHIDEE (ORCHIDEE to LMDZ)
311!
312! The syntax for coupling_fields.def is as follows:
313! IMPORTANT: each column entry must be separated from the previous one by 3
314! spaces and only that
315! field name         coupling          model 1         model 2         long_name
316!                    direction
317!   10char  -3spaces-  3char  -3spaces- 4char -3spaces- 4char -3spaces-  30char
318!
319! n
320! FIELD1 IN LMDZ ORC
321! ....
322! FIELD(j) IN LMDZ ORC
323! FIELD(j+1) OUT LMDZ ORC
324! ...
325! FIELDn OUT LMDZ ORC
326!
327!=======================================================================
328!   ... 22/12/2017 ....
329!-----------------------------------------------------------------------
330! Declarations
331
332
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  !$OMP THREADPRIVATE(cfname_root,cftext_root,cfunits_root)
354  !$OMP THREADPRIVATE(mask_in_root,mask_out_root)
355
356
357!-----------------------------------------------------------------------
358
359nbcf=0
360nbcf_in=0
361nbcf_out=0
362
363IF (planet_type=='earth') THEN
364
365    IF (is_mpi_root .AND. is_omp_root) THEN
366
367       IF (level_coupling_esm.GT.0) THEN
368
369          OPEN(200,file='coupling_fields.def',form='formatted',status='old', iostat=ierr)
370
371          IF (ierr.EQ.0) THEN
372
373             WRITE(lunout,*) trim(modname),': Open coupling_fields.def : ok'
374             READ(200,*) nbcf
375             WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf=',nbcf
376             ALLOCATE(cfname_root(nbcf))
377             ALLOCATE(cfintent_root(nbcf))
378             ALLOCATE(cfmod1_root(nbcf))
379             ALLOCATE(cfmod2_root(nbcf))
380             ALLOCATE(cftext_root(nbcf))
381             ALLOCATE(cfunits_root(nbcf))
382             ALLOCATE(mask_in_root(nbcf))
383             ALLOCATE(mask_out_root(nbcf))
384
385             nbcf_in=0
386             nbcf_out=0
387
388             DO iq=1,nbcf
389                WRITE(lunout,*) 'infofields : field=',iq
390                READ(200,'(A15,3X,A3,3X,A5,3X,A5,3X,A120,3X,A15)',IOSTAT=ierr) &
391                   cfname_root(iq),cfintent_root(iq),cfmod1_root(iq),cfmod2_root(iq),cftext_root(iq),cfunits_root(iq)
392                cfname_root(iq)=TRIM(cfname_root(iq))
393                cfintent_root(iq)=TRIM(cfintent_root(iq))
394                cfmod1_root(iq)=TRIM(cfmod1_root(iq))
395                cfmod2_root(iq)=TRIM(cfmod2_root(iq))
396                cftext_root(iq)=TRIM(cftext_root(iq))
397                cfunits_root(iq)=TRIM(cfunits_root(iq))
398                WRITE(lunout,*) 'coupling field: ',cfname_root(iq), & 
399                               ', number: ',iq,', INTENT: ',cfintent_root(iq)
400                WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &
401                               ', number: ',iq,', model 1 (ref): ',cfmod1_root(iq),', model 2: ',cfmod2_root(iq)
402                WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &
403                               ', number: ',iq,', long name: ',cftext_root(iq),', units ',cfunits_root(iq)
404                IF (nbcf_in+nbcf_out.LT.nbcf) THEN
405                  IF (cfintent_root(iq).NE.'OUT') THEN
406                    nbcf_in=nbcf_in+1
407                    mask_in_root(iq)=.TRUE.
408                    mask_out_root(iq)=.FALSE.
409                  ELSE IF (cfintent_root(iq).EQ.'OUT') THEN
410                    nbcf_out=nbcf_out+1
411                    mask_in_root(iq)=.FALSE.
412                    mask_out_root(iq)=.TRUE.
413                  ENDIF
414                ELSE
415                  WRITE(lunout,*) 'abort_gcm --- nbcf    : ',nbcf
416                  WRITE(lunout,*) 'abort_gcm --- nbcf_in : ',nbcf_in
417                  WRITE(lunout,*) 'abort_gcm --- nbcf_out: ',nbcf_out
418                  CALL abort_physic('infocfields_init','Problem in the definition of the coupling fields',1)
419               ENDIF
420             ENDDO !DO iq=1,nbcf
421          ELSE
422             WRITE(lunout,*) trim(modname),': infocfields_mod.F90 --- Problem in opening coupling_fields.def'
423             WRITE(lunout,*) trim(modname),': infocfields_mod.F90 --- WARNING using defaut values'
424          ENDIF ! ierr
425          CLOSE(200)
426
427       ENDIF ! level_coupling_esm
428
429    ENDIF !   (is_mpi_root .AND. is_omp_root)
430!$OMP BARRIER
431
432    CALL bcast(nbcf)
433    CALL bcast(nbcf_in)
434    CALL bcast(nbcf_out)
435
436    WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf    =',nbcf
437    WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_in =',nbcf_in
438    WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_out=',nbcf_out
439
440    ALLOCATE(cfname(nbcf))
441    ALLOCATE(cfname_in(nbcf_in))
442    ALLOCATE(cftext_in(nbcf_in))
443    ALLOCATE(cfname_out(nbcf_out))
444    ALLOCATE(cftext_out(nbcf_out))
445    ALLOCATE(cfmod1(nbcf))
446    ALLOCATE(cfmod2(nbcf))
447    ALLOCATE(cfunits_in(nbcf_in))
448    ALLOCATE(cfunits_out(nbcf_out))
449       
450    IF (is_mpi_root .AND. is_omp_root) THEN
451
452        IF (nbcf.GT.0)     cfname=cfname_root
453        IF (nbcf_in.GT.0)  cfname_in=PACK(cfname_root,mask_in_root)
454        IF (nbcf_out.GT.0) cfname_out=PACK(cfname_root,mask_out_root)
455        IF (nbcf_in.GT.0)  cftext_in=PACK(cftext_root,mask_in_root)
456        IF (nbcf_out.GT.0) cftext_out=PACK(cftext_root,mask_out_root)
457        IF (nbcf.GT.0)     cfmod1=cfmod1_root
458        IF (nbcf.GT.0)     cfmod2=cfmod2_root
459        IF (nbcf_in.GT.0)  cfunits_in=PACK(cfunits_root,mask_in_root)
460        IF (nbcf_out.GT.0) cfunits_out=PACK(cfunits_root,mask_out_root)
461
462        nbcf_in_orc=0
463        nbcf_in_nemo=0
464        nbcf_in_inca=0
465        nbcf_in_ant=0
466
467        DO iq=1,nbcf
468            IF (cfmod1(iq) == "ORC")  nbcf_in_orc  = nbcf_in_orc  + 1 
469            IF (cfmod1(iq) == "NEMO") nbcf_in_nemo = nbcf_in_nemo + 1 
470            IF (cfmod1(iq) == "INCA") nbcf_in_inca = nbcf_in_inca + 1
471            IF (cfmod1(iq) == "ALL")  nbcf_in_orc  = nbcf_in_orc  + 1  ! ALL = ORC/NEMO/INCA
472            IF (cfmod1(iq) == "ALL")  nbcf_in_nemo = nbcf_in_nemo + 1  ! ALL = ORC/NEMO/INCA
473            IF (cfmod1(iq) == "ALL")  nbcf_in_inca = nbcf_in_inca + 1  ! ALL = ORC/NEMO/INCA
474            IF (cfmod1(iq) == "ANT")  nbcf_in_ant  = nbcf_in_ant  + 1 
475        ENDDO
476
477    ENDIF !   (is_mpi_root .AND. is_omp_root)
478!$OMP BARRIER
479
480    CALL bcast(nbcf_in_orc)
481    CALL bcast(nbcf_in_nemo)
482    CALL bcast(nbcf_in_inca)
483    CALL bcast(nbcf_in_ant)
484
485    WRITE(lunout,*) 'nbcf_in_orc  =',nbcf_in_orc
486    WRITE(lunout,*) 'nbcf_in_nemo =',nbcf_in_nemo
487    WRITE(lunout,*) 'nbcf_in_inca =',nbcf_in_inca
488    WRITE(lunout,*) 'nbcf_in_ant  =',nbcf_in_ant
489
490    IF (nbcf_in.GT.0) THEN
491        DO iq=1,nbcf_in
492          CALL bcast(cfname_in(iq))
493          CALL bcast(cftext_in(iq))
494          CALL bcast(cfunits_in(iq))
495        ENDDO
496    ENDIF
497
498    IF (nbcf_out.GT.0) THEN
499        DO iq=1,nbcf_out
500          CALL bcast(cfname_out(iq))
501          CALL bcast(cftext_out(iq))
502          CALL bcast(cfunits_out(iq))
503        ENDDO
504    ENDIF
505
506    IF (nbcf.GT.0) THEN
507        DO iq=1,nbcf
508          CALL bcast(cfmod1(iq))
509          CALL bcast(cfmod2(iq))
510        ENDDO
511    ENDIF
512
513    IF (nbcf_in.GT.0)  WRITE(lunout,*)'infocfields_mod --- cfname_in: ',cfname_in
514    IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfields_mod --- cfname_out: ',cfname_out
515
516    IF (nbcf_in.GT.0)  WRITE(lunout,*)'infocfields_mod --- cftext_in: ',cftext_in
517    IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfields_mod --- cftext_out: ',cftext_out
518
519    IF (nbcf.GT.0) WRITE(lunout,*)'infocfields_mod --- cfmod1: ',cfmod1
520    IF (nbcf.GT.0) WRITE(lunout,*)'infocfields_mod --- cfmod2: ',cfmod2
521
522    IF (nbcf_in.GT.0)  WRITE(lunout,*)'infocfunits_mod --- cfunits_in: ',cfunits_in
523    IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfunits_mod --- cfunits_out: ',cfunits_out
524
525    IF (nbcf_in.GT.0)  WRITE(*,*)'infocfields_init --- number of fields in to LMDZ: ',nbcf_in
526    IF (nbcf_out.GT.0) WRITE(*,*)'infocfields_init --- number of fields out of LMDZ: ',nbcf_out
527
528 ELSE
529 ! Default values for other planets
530    nbcf=0
531    nbcf_in=0
532    nbcf_out=0
533 ENDIF ! planet_type
534
535 ALLOCATE(fields_in(klon,nbcf_in),stat=error)
536 IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation fields_in',1)
537 ALLOCATE(yfields_in(klon,nbcf_in),stat=error)
538 IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation yfields_in',1)
539 ALLOCATE(fields_out(klon,nbcf_out),stat=error)
540 IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation fields_out',1)
541 ALLOCATE(yfields_out(klon,nbcf_out),stat=error)
542 IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation yfields_out',1)
543
544END SUBROUTINE infocfields_init
545
546END MODULE carbon_cycle_mod
Note: See TracBrowser for help on using the repository browser.