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