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

Last change on this file since 3669 was 3649, checked in by jghattas, 5 years ago

Correction necessaire pour experience IPSLESM/CO2 pour eviter plantage aleatoire en mode debug : carbon_cpl_init doit etre appele avant premier appel a phys_output_write pour que tout les variables (fco2_land, etc..) soient allouees.

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