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

Last change on this file since 5300 was 5282, checked in by abarral, 5 weeks ago

Turn iniprint.h clesphys.h into modules
Remove unused description.h
  • 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 dimensions_mod, ONLY: iim, jjm, llm, ndm
228    USE clesphys_mod_h
229IMPLICIT NONE
230
231! Local variables
232    INTEGER               :: ierr
233
234    IF (carbon_cycle_cpl) THEN
235
236       ierr=0
237
238       IF (.NOT.ALLOCATED(fco2_land)) ALLOCATE(fco2_land(klon), stat=ierr)
239       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land',1)
240
241       IF (.NOT.ALLOCATED(fco2_land_nbp)) ALLOCATE(fco2_land_nbp(klon), stat=ierr)
242       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_nbp',1)
243
244       IF (.NOT.ALLOCATED(fco2_land_nep)) ALLOCATE(fco2_land_nep(klon), stat=ierr)
245       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_nep',1)
246
247       IF (.NOT.ALLOCATED(fco2_land_fLuc)) ALLOCATE(fco2_land_fLuc(klon), stat=ierr)
248       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fLuc',1)
249
250       IF (.NOT.ALLOCATED(fco2_land_fwoodharvest)) ALLOCATE(fco2_land_fwoodharvest(klon), stat=ierr)
251       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fwoodharvest',1)
252
253       IF (.NOT.ALLOCATED(fco2_land_fHarvest)) ALLOCATE(fco2_land_fHarvest(klon), stat=ierr)
254       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fHarvest',1)
255
256       IF (.NOT.ALLOCATED(fco2_ff)) ALLOCATE(fco2_ff(klon), stat=ierr)
257       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ff',1)
258
259       IF (.NOT.ALLOCATED(fco2_bb)) ALLOCATE(fco2_bb(klon), stat=ierr)
260       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_bb',1)
261
262       IF (.NOT.ALLOCATED(fco2_ocean)) ALLOCATE(fco2_ocean(klon), stat=ierr)
263       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ocean',1)
264
265       IF (.NOT.ALLOCATED(fco2_ocean_cor)) ALLOCATE(fco2_ocean_cor(klon), stat=ierr)
266       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ocean_cor',1)
267
268       IF (.NOT.ALLOCATED(fco2_land_cor)) ALLOCATE(fco2_land_cor(klon), stat=ierr)
269       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_cor',1)
270
271    ENDIF
272
273  END SUBROUTINE carbon_cycle_init
274
275  SUBROUTINE infocfields_init
276
277!    USE control_mod, ONLY: planet_type
278    USE phys_cal_mod, ONLY : mth_cur
279    USE mod_synchro_omp
280    USE mod_phys_lmdz_para, ONLY: is_mpi_root, is_omp_root
281    USE mod_phys_lmdz_transfert_para
282    USE mod_phys_lmdz_omp_transfert
283    USE dimphy, ONLY: klon
284    USE iniprint_mod_h
285    USE clesphys_mod_h
286
287    IMPLICIT NONE
288
289!=======================================================================
290!
291!   Authors: Patricia Cadule and Laurent Fairhead
292!   -------
293!
294!  Purpose and description:
295!  -----------------------
296!
297! Infofields
298! this routine enables to define the field exchanges in both directions between
299! the atmospheric circulation model (LMDZ) and ORCHIDEE. In the future this
300! routing might apply to other models (e.g., NEMO, INCA, ...).
301! Therefore, currently with this routine, it is possible to define the coupling
302! fields only between LMDZ and ORCHIDEE.
303! The coupling_fields.def file enables to define the name of the exchanged
304! fields at the coupling interface.
305! field_in_names : the set of names of the exchanged fields in input to ORCHIDEE
306! (LMDZ to ORCHIDEE)
307! field_out_names : the set of names of the exchanged fields in output of
308! ORCHIDEE (ORCHIDEE to LMDZ)
309! n : the number of exchanged fields at th coupling interface
310! nb_fields_in : number of inputs fields to ORCHIDEE (LMDZ to ORCHIDEE)
311! nb_fields_out : number of ouput fields of ORCHIDEE (ORCHIDEE to LMDZ)
312!
313! The syntax for coupling_fields.def is as follows:
314! IMPORTANT: each column entry must be separated from the previous one by 3
315! spaces and only that
316! field name         coupling          model 1         model 2         long_name
317!                    direction
318!   10char  -3spaces-  3char  -3spaces- 4char -3spaces- 4char -3spaces-  30char
319!
320! n
321! FIELD1 IN LMDZ ORC
322! ....
323! FIELD(j) IN LMDZ ORC
324! FIELD(j+1) OUT LMDZ ORC
325! ...
326! FIELDn OUT LMDZ ORC
327!
328!=======================================================================
329!   ... 22/12/2017 ....
330!-----------------------------------------------------------------------
331! Declarations
332
333
334
335! Local variables
336
337  INTEGER :: iq,  ierr, stat, error
338
339  CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:), SAVE  :: cfname_root
340  CHARACTER(LEN=120), ALLOCATABLE, DIMENSION(:), SAVE :: cftext_root
341  CHARACTER(LEN=15), ALLOCATABLE, DIMENSION(:), SAVE  :: cfunits_root
342
343  CHARACTER(len=3), ALLOCATABLE, DIMENSION(:) :: cfintent_root
344  CHARACTER(len=5), ALLOCATABLE, DIMENSION(:) :: cfmod1_root
345  CHARACTER(len=5), ALLOCATABLE, DIMENSION(:) :: cfmod2_root
346
347  LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: mask_in_root
348  LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: mask_out_root
349
350  CHARACTER(len=*),parameter :: modname="infocfields"
351
352  CHARACTER(len=10),SAVE :: planet_type="earth"
353
354!-----------------------------------------------------------------------
355
356nbcf=0
357nbcf_in=0
358nbcf_out=0
359
360IF (planet_type=='earth') THEN
361
362    IF (is_mpi_root .AND. is_omp_root) THEN
363
364       IF (level_coupling_esm.GT.0) THEN
365
366          OPEN(200,file='coupling_fields.def',form='formatted',status='old', iostat=ierr)
367
368          IF (ierr.EQ.0) THEN
369
370             WRITE(lunout,*) trim(modname),': Open coupling_fields.def : ok'
371             READ(200,*) nbcf
372             WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf=',nbcf
373             ALLOCATE(cfname_root(nbcf))
374             ALLOCATE(cfintent_root(nbcf))
375             ALLOCATE(cfmod1_root(nbcf))
376             ALLOCATE(cfmod2_root(nbcf))
377             ALLOCATE(cftext_root(nbcf))
378             ALLOCATE(cfunits_root(nbcf))
379             ALLOCATE(mask_in_root(nbcf))
380             ALLOCATE(mask_out_root(nbcf))
381
382             nbcf_in=0
383             nbcf_out=0
384
385             DO iq=1,nbcf
386                WRITE(lunout,*) 'infofields : field=',iq
387                READ(200,'(A15,3X,A3,3X,A5,3X,A5,3X,A120,3X,A15)',IOSTAT=ierr) &
388                   cfname_root(iq),cfintent_root(iq),cfmod1_root(iq),cfmod2_root(iq),cftext_root(iq),cfunits_root(iq)
389                cfname_root(iq)=TRIM(cfname_root(iq))
390                cfintent_root(iq)=TRIM(cfintent_root(iq))
391                cfmod1_root(iq)=TRIM(cfmod1_root(iq))
392                cfmod2_root(iq)=TRIM(cfmod2_root(iq))
393                cftext_root(iq)=TRIM(cftext_root(iq))
394                cfunits_root(iq)=TRIM(cfunits_root(iq))
395                WRITE(lunout,*) 'coupling field: ',cfname_root(iq), & 
396                               ', number: ',iq,', INTENT: ',cfintent_root(iq)
397                WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &
398                               ', number: ',iq,', model 1 (ref): ',cfmod1_root(iq),', model 2: ',cfmod2_root(iq)
399                WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &
400                               ', number: ',iq,', long name: ',cftext_root(iq),', units ',cfunits_root(iq)
401                IF (nbcf_in+nbcf_out.LT.nbcf) THEN
402                  IF (cfintent_root(iq).NE.'OUT') THEN
403                    nbcf_in=nbcf_in+1
404                    mask_in_root(iq)=.TRUE.
405                    mask_out_root(iq)=.FALSE.
406                  ELSE IF (cfintent_root(iq).EQ.'OUT') THEN
407                    nbcf_out=nbcf_out+1
408                    mask_in_root(iq)=.FALSE.
409                    mask_out_root(iq)=.TRUE.
410                  ENDIF
411                ELSE
412                  WRITE(lunout,*) 'abort_gcm --- nbcf    : ',nbcf
413                  WRITE(lunout,*) 'abort_gcm --- nbcf_in : ',nbcf_in
414                  WRITE(lunout,*) 'abort_gcm --- nbcf_out: ',nbcf_out
415                  CALL abort_physic('infocfields_init','Problem in the definition of the coupling fields',1)
416               ENDIF
417             ENDDO !DO iq=1,nbcf
418          ELSE
419             WRITE(lunout,*) trim(modname),': infocfields_mod.F90 --- Problem in opening coupling_fields.def'
420             WRITE(lunout,*) trim(modname),': infocfields_mod.F90 --- WARNING using defaut values'
421          ENDIF ! ierr
422          CLOSE(200)
423
424       ENDIF ! level_coupling_esm
425
426    ENDIF !   (is_mpi_root .AND. is_omp_root)
427!$OMP BARRIER
428
429    CALL bcast(nbcf)
430    CALL bcast(nbcf_in)
431    CALL bcast(nbcf_out)
432
433    WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf    =',nbcf
434    WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_in =',nbcf_in
435    WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_out=',nbcf_out
436
437    ALLOCATE(cfname(nbcf))
438    ALLOCATE(cfname_in(nbcf_in))
439    ALLOCATE(cftext_in(nbcf_in))
440    ALLOCATE(cfname_out(nbcf_out))
441    ALLOCATE(cftext_out(nbcf_out))
442    ALLOCATE(cfmod1(nbcf))
443    ALLOCATE(cfmod2(nbcf))
444    ALLOCATE(cfunits_in(nbcf_in))
445    ALLOCATE(cfunits_out(nbcf_out))
446       
447    IF (is_mpi_root .AND. is_omp_root) THEN
448
449        IF (nbcf.GT.0)     cfname=cfname_root
450        IF (nbcf_in.GT.0)  cfname_in=PACK(cfname_root,mask_in_root)
451        IF (nbcf_out.GT.0) cfname_out=PACK(cfname_root,mask_out_root)
452        IF (nbcf_in.GT.0)  cftext_in=PACK(cftext_root,mask_in_root)
453        IF (nbcf_out.GT.0) cftext_out=PACK(cftext_root,mask_out_root)
454        IF (nbcf.GT.0)     cfmod1=cfmod1_root
455        IF (nbcf.GT.0)     cfmod2=cfmod2_root
456        IF (nbcf_in.GT.0)  cfunits_in=PACK(cfunits_root,mask_in_root)
457        IF (nbcf_out.GT.0) cfunits_out=PACK(cfunits_root,mask_out_root)
458
459        nbcf_in_orc=0
460        nbcf_in_nemo=0
461        nbcf_in_inca=0
462        nbcf_in_ant=0
463
464        DO iq=1,nbcf
465            IF (cfmod1(iq) == "ORC")  nbcf_in_orc  = nbcf_in_orc  + 1 
466            IF (cfmod1(iq) == "NEMO") nbcf_in_nemo = nbcf_in_nemo + 1 
467            IF (cfmod1(iq) == "INCA") nbcf_in_inca = nbcf_in_inca + 1
468            IF (cfmod1(iq) == "ALL")  nbcf_in_orc  = nbcf_in_orc  + 1  ! ALL = ORC/NEMO/INCA
469            IF (cfmod1(iq) == "ALL")  nbcf_in_nemo = nbcf_in_nemo + 1  ! ALL = ORC/NEMO/INCA
470            IF (cfmod1(iq) == "ALL")  nbcf_in_inca = nbcf_in_inca + 1  ! ALL = ORC/NEMO/INCA
471            IF (cfmod1(iq) == "ANT")  nbcf_in_ant  = nbcf_in_ant  + 1 
472        ENDDO
473
474    ENDIF !   (is_mpi_root .AND. is_omp_root)
475!$OMP BARRIER
476
477    CALL bcast(nbcf_in_orc)
478    CALL bcast(nbcf_in_nemo)
479    CALL bcast(nbcf_in_inca)
480    CALL bcast(nbcf_in_ant)
481
482    WRITE(lunout,*) 'nbcf_in_orc  =',nbcf_in_orc
483    WRITE(lunout,*) 'nbcf_in_nemo =',nbcf_in_nemo
484    WRITE(lunout,*) 'nbcf_in_inca =',nbcf_in_inca
485    WRITE(lunout,*) 'nbcf_in_ant  =',nbcf_in_ant
486
487    IF (nbcf_in.GT.0) THEN
488        DO iq=1,nbcf_in
489          CALL bcast(cfname_in(iq))
490          CALL bcast(cftext_in(iq))
491          CALL bcast(cfunits_in(iq))
492        ENDDO
493    ENDIF
494
495    IF (nbcf_out.GT.0) THEN
496        DO iq=1,nbcf_out
497          CALL bcast(cfname_out(iq))
498          CALL bcast(cftext_out(iq))
499          CALL bcast(cfunits_out(iq))
500        ENDDO
501    ENDIF
502
503    IF (nbcf.GT.0) THEN
504        DO iq=1,nbcf
505          CALL bcast(cfmod1(iq))
506          CALL bcast(cfmod2(iq))
507        ENDDO
508    ENDIF
509
510    IF (nbcf_in.GT.0)  WRITE(lunout,*)'infocfields_mod --- cfname_in: ',cfname_in
511    IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfields_mod --- cfname_out: ',cfname_out
512
513    IF (nbcf_in.GT.0)  WRITE(lunout,*)'infocfields_mod --- cftext_in: ',cftext_in
514    IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfields_mod --- cftext_out: ',cftext_out
515
516    IF (nbcf.GT.0) WRITE(lunout,*)'infocfields_mod --- cfmod1: ',cfmod1
517    IF (nbcf.GT.0) WRITE(lunout,*)'infocfields_mod --- cfmod2: ',cfmod2
518
519    IF (nbcf_in.GT.0)  WRITE(lunout,*)'infocfunits_mod --- cfunits_in: ',cfunits_in
520    IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfunits_mod --- cfunits_out: ',cfunits_out
521
522    IF (nbcf_in.GT.0)  WRITE(*,*)'infocfields_init --- number of fields in to LMDZ: ',nbcf_in
523    IF (nbcf_out.GT.0) WRITE(*,*)'infocfields_init --- number of fields out of LMDZ: ',nbcf_out
524
525 ELSE
526 ! Default values for other planets
527    nbcf=0
528    nbcf_in=0
529    nbcf_out=0
530 ENDIF ! planet_type
531
532 ALLOCATE(fields_in(klon,nbcf_in),stat=error)
533 IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation fields_in',1)
534 ALLOCATE(yfields_in(klon,nbcf_in),stat=error)
535 IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation yfields_in',1)
536 ALLOCATE(fields_out(klon,nbcf_out),stat=error)
537 IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation fields_out',1)
538 ALLOCATE(yfields_out(klon,nbcf_out),stat=error)
539 IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation yfields_out',1)
540
541END SUBROUTINE infocfields_init
542
543END MODULE carbon_cycle_mod
Note: See TracBrowser for help on using the repository browser.