source: LMDZ6/branches/Amaury_dev/libf/phylmd/carbon_cycle_mod.F90 @ 5232

Last change on this file since 5232 was 5159, checked in by abarral, 16 months ago

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