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

Last change on this file since 5503 was 5485, checked in by Laurent Fairhead, 6 days ago

Some threadprivate statements were not necessary

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 22.4 KB
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)
[3857]41  LOGICAL, PUBLIC :: carbon_cycle_rad       ! flag to activate CO2 interactive radiatively
[3447]42!$OMP THREADPRIVATE(carbon_cycle_rad)
[3857]43  INTEGER, PUBLIC :: level_coupling_esm     ! Level of coupling for the ESM - 0, 1, 2, 3
[3384]44!$OMP THREADPRIVATE(level_coupling_esm)
[3857]45  LOGICAL, PUBLIC :: read_fco2_ocean_cor    ! flag to read corrective oceanic CO2 flux
46!$OMP THREADPRIVATE(read_fco2_ocean_cor) 
[3876]47  REAL, PUBLIC :: var_fco2_ocean_cor        ! corrective oceanic CO2 flux
[3857]48!$OMP THREADPRIVATE(var_fco2_ocean_cor)
[3876]49  REAL, PUBLIC :: ocean_area_tot            ! total oceanic area to convert flux
[3857]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) 
[3876]53  REAL, PUBLIC :: var_fco2_land_cor         ! corrective land CO2 flux
[3857]54!$OMP THREADPRIVATE(var_fco2_land_cor)
[3876]55  REAL, PUBLIC :: land_area_tot             ! total land area to convert flux
[3857]56!$OMP THREADPRIVATE(land_area_tot)
57
[3581]58  REAL, PUBLIC :: RCO2_glo
59!$OMP THREADPRIVATE(RCO2_glo)
60  REAL, PUBLIC :: RCO2_tot
61!$OMP THREADPRIVATE(RCO2_tot)
[1454]62
[1759]63  LOGICAL :: carbon_cycle_emis_comp_omp=.FALSE.
[1227]64  LOGICAL :: carbon_cycle_emis_comp=.FALSE. ! Calculation of emission compatible
[1454]65!$OMP THREADPRIVATE(carbon_cycle_emis_comp)
[1227]66
[1759]67  LOGICAL :: RCO2_inter_omp
[1454]68  LOGICAL :: RCO2_inter  ! RCO2 interactive : if true calculate new value RCO2 for the radiation scheme
69!$OMP THREADPRIVATE(RCO2_inter)
70
[3385]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)
[1227]75  REAL :: emis_land_s ! not yet implemented
[1250]76!$OMP THREADPRIVATE(emis_land_s)
[1227]77
[1454]78  REAL :: airetot     ! Total area of the earth surface
79!$OMP THREADPRIVATE(airetot)
[1250]80
[3385]81  INTEGER :: ntr_co2  ! Number of tracers concerning the carbon cycle
[1454]82!$OMP THREADPRIVATE(ntr_co2)
83
[3385]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)
[1454]87
[3385]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)
[3421]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)
[3453]96  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land  ! Net flux from terrestrial ecocsystems [kgCO2/m2/s]
97!$OMP THREADPRIVATE(fco2_land)
[3581]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)
[3453]108  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ocean ! Net flux from ocean [kgCO2/m2/s]
109!$OMP THREADPRIVATE(fco2_ocean)
[3876]110  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ocean_cor ! Net corrective flux from ocean [kgCO2/m2/s]
[3857]111!$OMP THREADPRIVATE(fco2_ocean_cor)
[3876]112  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_cor  ! Net corrective flux from land [kgCO2/m2/s]
[3857]113!$OMP THREADPRIVATE(fco2_land_cor)
[1227]114
[1454]115  REAL, DIMENSION(:,:), ALLOCATABLE :: dtr_add       ! Tracer concentration to be injected
116!$OMP THREADPRIVATE(dtr_add)
117
[3385]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)
[1227]123
[3385]124! Calculated co2 field to be send to the ocean via the coupler and to ORCHIDEE
[3876]125  REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: co2_send ! Field allocated in phyetat0
[1250]126!$OMP THREADPRIVATE(co2_send)
[1227]127
[3447]128  INTEGER, PARAMETER, PUBLIC :: id_CO2=1              !--temporaire OB -- to be changed
129
[3387]130! nbfields : total number of fields
131  INTEGER, PUBLIC :: nbcf
132!$OMP THREADPRIVATE(nbcf)
[1454]133
[3387]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
[3391]186  CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:), PUBLIC :: field_out_names
187!$OMP THREADPRIVATE(field_out_names)
[3387]188
[3391]189  CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:), PUBLIC :: field_in_names
190!$OMP THREADPRIVATE(field_in_names)
[3387]191
[3391]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
[3390]204  TYPE, PUBLIC :: co2_trac_type
[1454]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
[3385]208     LOGICAL            :: cpl        ! True if this tracers is coupled from ORCHIDEE or PISCES.
[1454]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
[1227]217CONTAINS
218 
[3581]219  SUBROUTINE carbon_cycle_init()
[3649]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.
[1454]222
[1227]223    USE dimphy
224    USE IOIPSL
[2311]225    USE print_control_mod, ONLY: lunout
[1227]226
[5282]227    USE clesphys_mod_h
[5271]228IMPLICIT NONE
229
[1227]230! Local variables
[3581]231    INTEGER               :: ierr
[1227]232
[3581]233    IF (carbon_cycle_cpl) THEN
[1227]234
[3581]235       ierr=0
[1227]236
[3581]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)
[1227]239
[3581]240       IF (.NOT.ALLOCATED(fco2_land_nbp)) ALLOCATE(fco2_land_nbp(klon), stat=ierr)
241       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_nbp',1)
[1454]242
[3581]243       IF (.NOT.ALLOCATED(fco2_land_nep)) ALLOCATE(fco2_land_nep(klon), stat=ierr)
244       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_nep',1)
[1227]245
[3581]246       IF (.NOT.ALLOCATED(fco2_land_fLuc)) ALLOCATE(fco2_land_fLuc(klon), stat=ierr)
247       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fLuc',1)
[1227]248
[3581]249       IF (.NOT.ALLOCATED(fco2_land_fwoodharvest)) ALLOCATE(fco2_land_fwoodharvest(klon), stat=ierr)
250       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fwoodharvest',1)
[1227]251
[3581]252       IF (.NOT.ALLOCATED(fco2_land_fHarvest)) ALLOCATE(fco2_land_fHarvest(klon), stat=ierr)
253       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fHarvest',1)
[1454]254
[3581]255       IF (.NOT.ALLOCATED(fco2_ff)) ALLOCATE(fco2_ff(klon), stat=ierr)
256       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ff',1)
[1454]257
[3581]258       IF (.NOT.ALLOCATED(fco2_bb)) ALLOCATE(fco2_bb(klon), stat=ierr)
259       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_bb',1)
[1454]260
[3581]261       IF (.NOT.ALLOCATED(fco2_ocean)) ALLOCATE(fco2_ocean(klon), stat=ierr)
262       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ocean',1)
[3857]263
264       IF (.NOT.ALLOCATED(fco2_ocean_cor)) ALLOCATE(fco2_ocean_cor(klon), stat=ierr)
265       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ocean_cor',1)
[4298]266
[3857]267       IF (.NOT.ALLOCATED(fco2_land_cor)) ALLOCATE(fco2_land_cor(klon), stat=ierr)
268       IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_cor',1)
269
[3581]270    ENDIF
[1227]271
272  END SUBROUTINE carbon_cycle_init
273
[3387]274  SUBROUTINE infocfields_init
275
[3435]276!    USE control_mod, ONLY: planet_type
[3387]277    USE phys_cal_mod, ONLY : mth_cur
278    USE mod_synchro_omp
279    USE mod_phys_lmdz_para, ONLY: is_mpi_root, is_omp_root
280    USE mod_phys_lmdz_transfert_para
281    USE mod_phys_lmdz_omp_transfert
282    USE dimphy, ONLY: klon
[5282]283    USE iniprint_mod_h
284    USE clesphys_mod_h
[3387]285
286    IMPLICIT NONE
287
288!=======================================================================
289!
[5271]290!   Authors: Patricia Cadule and Laurent Fairhead
[3387]291!   -------
292!
293!  Purpose and description:
294!  -----------------------
295!
296! Infofields
297! this routine enables to define the field exchanges in both directions between
298! the atmospheric circulation model (LMDZ) and ORCHIDEE. In the future this
299! routing might apply to other models (e.g., NEMO, INCA, ...).
300! Therefore, currently with this routine, it is possible to define the coupling
301! fields only between LMDZ and ORCHIDEE.
302! The coupling_fields.def file enables to define the name of the exchanged
303! fields at the coupling interface.
304! field_in_names : the set of names of the exchanged fields in input to ORCHIDEE
305! (LMDZ to ORCHIDEE)
306! field_out_names : the set of names of the exchanged fields in output of
307! ORCHIDEE (ORCHIDEE to LMDZ)
308! n : the number of exchanged fields at th coupling interface
309! nb_fields_in : number of inputs fields to ORCHIDEE (LMDZ to ORCHIDEE)
310! nb_fields_out : number of ouput fields of ORCHIDEE (ORCHIDEE to LMDZ)
311!
312! The syntax for coupling_fields.def is as follows:
313! IMPORTANT: each column entry must be separated from the previous one by 3
314! spaces and only that
315! field name         coupling          model 1         model 2         long_name
316!                    direction
[5271]317!   10char  -3spaces-  3char  -3spaces- 4char -3spaces- 4char -3spaces-  30char
[3387]318!
319! n
320! FIELD1 IN LMDZ ORC
321! ....
322! FIELD(j) IN LMDZ ORC
323! FIELD(j+1) OUT LMDZ ORC
324! ...
[5271]325! FIELDn OUT LMDZ ORC
326!
[3387]327!=======================================================================
328!   ... 22/12/2017 ....
329!-----------------------------------------------------------------------
330! Declarations
331
[5271]332
[3387]333
334! Local variables
335
336  INTEGER :: iq,  ierr, stat, error
337
338  CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:), SAVE  :: cfname_root
339  CHARACTER(LEN=120), ALLOCATABLE, DIMENSION(:), SAVE :: cftext_root
340  CHARACTER(LEN=15), ALLOCATABLE, DIMENSION(:), SAVE  :: cfunits_root
341
342  CHARACTER(len=3), ALLOCATABLE, DIMENSION(:) :: cfintent_root
343  CHARACTER(len=5), ALLOCATABLE, DIMENSION(:) :: cfmod1_root
344  CHARACTER(len=5), ALLOCATABLE, DIMENSION(:) :: cfmod2_root
345
346  LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: mask_in_root
347  LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: mask_out_root
348
349  CHARACTER(len=*),parameter :: modname="infocfields"
350
[3435]351  CHARACTER(len=10),SAVE :: planet_type="earth"
352
[5485]353  !$OMP THREADPRIVATE(cfname_root,cftext_root,cfunits_root)
354  !$OMP THREADPRIVATE(mask_in_root,mask_out_root)
[5483]355
356
[3387]357!-----------------------------------------------------------------------
358
359nbcf=0
360nbcf_in=0
361nbcf_out=0
362
363IF (planet_type=='earth') THEN
364
365    IF (is_mpi_root .AND. is_omp_root) THEN
366
367       IF (level_coupling_esm.GT.0) THEN
368
369          OPEN(200,file='coupling_fields.def',form='formatted',status='old', iostat=ierr)
370
371          IF (ierr.EQ.0) THEN
372
373             WRITE(lunout,*) trim(modname),': Open coupling_fields.def : ok'
374             READ(200,*) nbcf
375             WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf=',nbcf
[3390]376             ALLOCATE(cfname_root(nbcf))
377             ALLOCATE(cfintent_root(nbcf))
378             ALLOCATE(cfmod1_root(nbcf))
379             ALLOCATE(cfmod2_root(nbcf))
380             ALLOCATE(cftext_root(nbcf))
381             ALLOCATE(cfunits_root(nbcf))
382             ALLOCATE(mask_in_root(nbcf))
383             ALLOCATE(mask_out_root(nbcf))
[3387]384
385             nbcf_in=0
386             nbcf_out=0
[3390]387
[3387]388             DO iq=1,nbcf
389                WRITE(lunout,*) 'infofields : field=',iq
390                READ(200,'(A15,3X,A3,3X,A5,3X,A5,3X,A120,3X,A15)',IOSTAT=ierr) &
391                   cfname_root(iq),cfintent_root(iq),cfmod1_root(iq),cfmod2_root(iq),cftext_root(iq),cfunits_root(iq)
392                cfname_root(iq)=TRIM(cfname_root(iq))
393                cfintent_root(iq)=TRIM(cfintent_root(iq))
394                cfmod1_root(iq)=TRIM(cfmod1_root(iq))
395                cfmod2_root(iq)=TRIM(cfmod2_root(iq))
396                cftext_root(iq)=TRIM(cftext_root(iq))
397                cfunits_root(iq)=TRIM(cfunits_root(iq))
398                WRITE(lunout,*) 'coupling field: ',cfname_root(iq), & 
399                               ', number: ',iq,', INTENT: ',cfintent_root(iq)
400                WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &
401                               ', number: ',iq,', model 1 (ref): ',cfmod1_root(iq),', model 2: ',cfmod2_root(iq)
402                WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &
403                               ', number: ',iq,', long name: ',cftext_root(iq),', units ',cfunits_root(iq)
[3390]404                IF (nbcf_in+nbcf_out.LT.nbcf) THEN
405                  IF (cfintent_root(iq).NE.'OUT') THEN
406                    nbcf_in=nbcf_in+1
407                    mask_in_root(iq)=.TRUE.
408                    mask_out_root(iq)=.FALSE.
409                  ELSE IF (cfintent_root(iq).EQ.'OUT') THEN
410                    nbcf_out=nbcf_out+1
411                    mask_in_root(iq)=.FALSE.
412                    mask_out_root(iq)=.TRUE.
413                  ENDIF
[3387]414                ELSE
[3390]415                  WRITE(lunout,*) 'abort_gcm --- nbcf    : ',nbcf
416                  WRITE(lunout,*) 'abort_gcm --- nbcf_in : ',nbcf_in
[3387]417                  WRITE(lunout,*) 'abort_gcm --- nbcf_out: ',nbcf_out
[3435]418                  CALL abort_physic('infocfields_init','Problem in the definition of the coupling fields',1)
[3387]419               ENDIF
420             ENDDO !DO iq=1,nbcf
421          ELSE
422             WRITE(lunout,*) trim(modname),': infocfields_mod.F90 --- Problem in opening coupling_fields.def'
423             WRITE(lunout,*) trim(modname),': infocfields_mod.F90 --- WARNING using defaut values'
424          ENDIF ! ierr
425          CLOSE(200)
426
427       ENDIF ! level_coupling_esm
428
429    ENDIF !   (is_mpi_root .AND. is_omp_root)
430!$OMP BARRIER
431
432    CALL bcast(nbcf)
433    CALL bcast(nbcf_in)
434    CALL bcast(nbcf_out)
435
[3390]436    WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf    =',nbcf
437    WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_in =',nbcf_in
[3387]438    WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_out=',nbcf_out
439
[3390]440    ALLOCATE(cfname(nbcf))
441    ALLOCATE(cfname_in(nbcf_in))
442    ALLOCATE(cftext_in(nbcf_in))
443    ALLOCATE(cfname_out(nbcf_out))
444    ALLOCATE(cftext_out(nbcf_out))
445    ALLOCATE(cfmod1(nbcf))
446    ALLOCATE(cfmod2(nbcf))
447    ALLOCATE(cfunits_in(nbcf_in))
448    ALLOCATE(cfunits_out(nbcf_out))
[3387]449       
450    IF (is_mpi_root .AND. is_omp_root) THEN
451
[3390]452        IF (nbcf.GT.0)     cfname=cfname_root
453        IF (nbcf_in.GT.0)  cfname_in=PACK(cfname_root,mask_in_root)
[3387]454        IF (nbcf_out.GT.0) cfname_out=PACK(cfname_root,mask_out_root)
[3390]455        IF (nbcf_in.GT.0)  cftext_in=PACK(cftext_root,mask_in_root)
[3387]456        IF (nbcf_out.GT.0) cftext_out=PACK(cftext_root,mask_out_root)
[3390]457        IF (nbcf.GT.0)     cfmod1=cfmod1_root
458        IF (nbcf.GT.0)     cfmod2=cfmod2_root
459        IF (nbcf_in.GT.0)  cfunits_in=PACK(cfunits_root,mask_in_root)
[3387]460        IF (nbcf_out.GT.0) cfunits_out=PACK(cfunits_root,mask_out_root)
461
462        nbcf_in_orc=0
463        nbcf_in_nemo=0
464        nbcf_in_inca=0
465        nbcf_in_ant=0
466
467        DO iq=1,nbcf
[3390]468            IF (cfmod1(iq) == "ORC")  nbcf_in_orc  = nbcf_in_orc  + 1 
469            IF (cfmod1(iq) == "NEMO") nbcf_in_nemo = nbcf_in_nemo + 1 
470            IF (cfmod1(iq) == "INCA") nbcf_in_inca = nbcf_in_inca + 1
471            IF (cfmod1(iq) == "ALL")  nbcf_in_orc  = nbcf_in_orc  + 1  ! ALL = ORC/NEMO/INCA
472            IF (cfmod1(iq) == "ALL")  nbcf_in_nemo = nbcf_in_nemo + 1  ! ALL = ORC/NEMO/INCA
473            IF (cfmod1(iq) == "ALL")  nbcf_in_inca = nbcf_in_inca + 1  ! ALL = ORC/NEMO/INCA
474            IF (cfmod1(iq) == "ANT")  nbcf_in_ant  = nbcf_in_ant  + 1 
[3387]475        ENDDO
476
477    ENDIF !   (is_mpi_root .AND. is_omp_root)
478!$OMP BARRIER
479
480    CALL bcast(nbcf_in_orc)
481    CALL bcast(nbcf_in_nemo)
482    CALL bcast(nbcf_in_inca)
483    CALL bcast(nbcf_in_ant)
484
[3390]485    WRITE(lunout,*) 'nbcf_in_orc  =',nbcf_in_orc
486    WRITE(lunout,*) 'nbcf_in_nemo =',nbcf_in_nemo
487    WRITE(lunout,*) 'nbcf_in_inca =',nbcf_in_inca
488    WRITE(lunout,*) 'nbcf_in_ant  =',nbcf_in_ant
[3387]489
490    IF (nbcf_in.GT.0) THEN
491        DO iq=1,nbcf_in
492          CALL bcast(cfname_in(iq))
493          CALL bcast(cftext_in(iq))
494          CALL bcast(cfunits_in(iq))
495        ENDDO
496    ENDIF
497
498    IF (nbcf_out.GT.0) THEN
499        DO iq=1,nbcf_out
500          CALL bcast(cfname_out(iq))
501          CALL bcast(cftext_out(iq))
502          CALL bcast(cfunits_out(iq))
503        ENDDO
504    ENDIF
505
506    IF (nbcf.GT.0) THEN
507        DO iq=1,nbcf
508          CALL bcast(cfmod1(iq))
509          CALL bcast(cfmod2(iq))
510        ENDDO
511    ENDIF
512
[3390]513    IF (nbcf_in.GT.0)  WRITE(lunout,*)'infocfields_mod --- cfname_in: ',cfname_in
[3387]514    IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfields_mod --- cfname_out: ',cfname_out
515
[3390]516    IF (nbcf_in.GT.0)  WRITE(lunout,*)'infocfields_mod --- cftext_in: ',cftext_in
[3387]517    IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfields_mod --- cftext_out: ',cftext_out
518
519    IF (nbcf.GT.0) WRITE(lunout,*)'infocfields_mod --- cfmod1: ',cfmod1
520    IF (nbcf.GT.0) WRITE(lunout,*)'infocfields_mod --- cfmod2: ',cfmod2
521
[3390]522    IF (nbcf_in.GT.0)  WRITE(lunout,*)'infocfunits_mod --- cfunits_in: ',cfunits_in
[3387]523    IF (nbcf_out.GT.0) WRITE(lunout,*)'infocfunits_mod --- cfunits_out: ',cfunits_out
524
[3390]525    IF (nbcf_in.GT.0)  WRITE(*,*)'infocfields_init --- number of fields in to LMDZ: ',nbcf_in
[3387]526    IF (nbcf_out.GT.0) WRITE(*,*)'infocfields_init --- number of fields out of LMDZ: ',nbcf_out
527
528 ELSE
529 ! Default values for other planets
530    nbcf=0
531    nbcf_in=0
532    nbcf_out=0
533 ENDIF ! planet_type
534
[3391]535 ALLOCATE(fields_in(klon,nbcf_in),stat=error)
[3435]536 IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation fields_in',1)
[3391]537 ALLOCATE(yfields_in(klon,nbcf_in),stat=error)
[3435]538 IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation yfields_in',1)
[3391]539 ALLOCATE(fields_out(klon,nbcf_out),stat=error)
[3435]540 IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation fields_out',1)
[3391]541 ALLOCATE(yfields_out(klon,nbcf_out),stat=error)
[3435]542 IF (error /= 0)  CALL abort_physic(modname,'Pb in allocation yfields_out',1)
[3387]543
544END SUBROUTINE infocfields_init
545
[1227]546END MODULE carbon_cycle_mod
Note: See TracBrowser for help on using the repository browser.