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

Last change on this file since 3613 was 3581, checked in by oboucher, 5 years ago

Big update to the interactive carbon cycle
from Patricia's code

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