source: LMDZ6/trunk/libf/phylmd/carbon_cycle_mod.F90 @ 4046

Last change on this file since 4046 was 3876, checked in by oboucher, 4 years ago

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