1 | ! ================================================================================================================================= |
---|
2 | ! MODULE : grassland_management |
---|
3 | ! |
---|
4 | ! CONTACT : orchidee-help _at_ ipsl.jussieu.fr |
---|
5 | ! |
---|
6 | ! LICENCE : IPSL (2006) |
---|
7 | ! This software is governed by the CeCILL licence see |
---|
8 | ! ORCHIDEE/ORCHIDEE_CeCILL.LIC |
---|
9 | ! |
---|
10 | !>\BRIEF Groups the subroutines that: (1) initialize all variables in |
---|
11 | !! grassland management, (2) call subroutines of major grassland management |
---|
12 | !! modules (cut/harvest, grazing, fertilization) , (3) read external maps |
---|
13 | !! such as mangement, livestock density, fertilization, wild animal density |
---|
14 | !! (4) calculate plants status such as developement stage and tgrowth |
---|
15 | !! |
---|
16 | !!\n DESCRIPTION : None |
---|
17 | !! |
---|
18 | !! RECENT CHANGE(S) : None |
---|
19 | !! |
---|
20 | !! REFERENCE(S) : None |
---|
21 | !! |
---|
22 | !! \n |
---|
23 | !_ |
---|
24 | !================================================================================================================================ |
---|
25 | |
---|
26 | MODULE grassland_management |
---|
27 | ! this module include grassland management from PaSim |
---|
28 | ! graze - cut - fertilisation |
---|
29 | ! with auto management or user-defined management |
---|
30 | |
---|
31 | USE grassland_constantes |
---|
32 | USE constantes |
---|
33 | USE grassland_fonctions |
---|
34 | USE grassland_grazing |
---|
35 | !USE applic_plant |
---|
36 | USE grassland_cutting |
---|
37 | USE grassland_fertilisation |
---|
38 | USE ioipsl |
---|
39 | USE ioipsl_para |
---|
40 | USE mod_orchidee_para |
---|
41 | USE xios_orchidee |
---|
42 | USE netcdf |
---|
43 | USE defprec |
---|
44 | USE grid |
---|
45 | USE matrix_resolution |
---|
46 | USE interpol_help ! necessary for management map input |
---|
47 | ! USE parallel |
---|
48 | |
---|
49 | IMPLICIT NONE |
---|
50 | |
---|
51 | PUBLIC grassmanag_clear |
---|
52 | |
---|
53 | LOGICAL, SAVE :: first_call_grassland_manag = .TRUE. |
---|
54 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: intake |
---|
55 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: intakemax |
---|
56 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: intake_litter |
---|
57 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: intake_animal_litter |
---|
58 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: litter_avail_totDM |
---|
59 | INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: grazing_litter |
---|
60 | ! shoot dry matter afer cutting Kg/m2 |
---|
61 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wshtotcutinit |
---|
62 | ! lai after cutting (m**2 leaf/m**2) |
---|
63 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: lcutinit |
---|
64 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: devstage |
---|
65 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: faecesc |
---|
66 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: faecesn |
---|
67 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: urinen |
---|
68 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: urinec |
---|
69 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nel |
---|
70 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nanimaltot |
---|
71 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: tgrowth |
---|
72 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wsh |
---|
73 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wshtotinit |
---|
74 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wshtot |
---|
75 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wr |
---|
76 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wrtot |
---|
77 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wanimal |
---|
78 | ! concentration totale en N (kg n/kg) |
---|
79 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ntot |
---|
80 | ! concentration en C du substrat de la plante (kg C/kg) |
---|
81 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: c |
---|
82 | ! concentration en N du substrat de la plante (kg N/kg) |
---|
83 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: n |
---|
84 | ! n in structral mass kgN/kg |
---|
85 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fn |
---|
86 | ! n concentration of apoplast (kgN/kg) |
---|
87 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: napo |
---|
88 | ! n concentration of symplast (kgN/kg) |
---|
89 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nsym |
---|
90 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wnapo |
---|
91 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wnsym |
---|
92 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wn |
---|
93 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nanimal |
---|
94 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tanimal |
---|
95 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: danimal |
---|
96 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tcut |
---|
97 | ! day of fertilisation (management) (d) |
---|
98 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tfert |
---|
99 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: Nliquidmanure |
---|
100 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nslurry |
---|
101 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: Nsolidmanure |
---|
102 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: legume_fraction |
---|
103 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: soil_fertility |
---|
104 | ! Threshold shoot dry matter, under which animals are moved out (kg/m2) |
---|
105 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: Animalwgrazingmin |
---|
106 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: AnimalkintakeM |
---|
107 | ! parameter for calculation of vegetation compartement selection by animals (-) |
---|
108 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: AnimalDiscremineQualite |
---|
109 | ! Valeurs associées à la croissance aérienne entre 2 évènements de fertilisation (autogestion fauches) |
---|
110 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: controle_azote |
---|
111 | ! Carbon flux from Organic fertilization to metabolic SOM pool (kg C m-2 day-1) |
---|
112 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcOrganicFertmetabolicsum |
---|
113 | ! Carbon flux from Organic fertilization to strcutural SOM pool (kg C m-2 day-1) |
---|
114 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcOrganicFertstructsum |
---|
115 | ! Nitrogen flux from Organic fertilization to strcutural SOM pool (kg N m-2 day-1) |
---|
116 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fnOrganicFertmetabolicsum |
---|
117 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fnOrganicFertstructsum |
---|
118 | ! Nitrogen flux coming from slurry and liquid manure (k N.m-2) |
---|
119 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fnOrganicFerturinesum |
---|
120 | ! Nitrogen deposition (kg N m-2 year-1) |
---|
121 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fnatmsum |
---|
122 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: controle_azote_sum |
---|
123 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nfertamm |
---|
124 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nfertnit |
---|
125 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: intakesum |
---|
126 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: intakensum |
---|
127 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: intake_animal |
---|
128 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: intake_animalsum |
---|
129 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: PIYcow |
---|
130 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: PIMcow |
---|
131 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: BCSYcow |
---|
132 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: BCSMcow |
---|
133 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: PICcow |
---|
134 | ! Age of dairy primi cow |
---|
135 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: AGE_cow_P |
---|
136 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: AGE_cow_M |
---|
137 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: Autogestion_out |
---|
138 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: Forage_quantity |
---|
139 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tcut_modif |
---|
140 | INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: countschedule |
---|
141 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: mux |
---|
142 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: mugmean |
---|
143 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sigx |
---|
144 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: sigy |
---|
145 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: gmeanslope |
---|
146 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: gzero |
---|
147 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: gcor |
---|
148 | INTEGER (i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: cuttingend |
---|
149 | LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tcut_verif |
---|
150 | INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: regcount |
---|
151 | INTEGER(i_std) :: tcutmodel |
---|
152 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wshcutinit |
---|
153 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: gmean |
---|
154 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tgmean |
---|
155 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wc_frac |
---|
156 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: wgn |
---|
157 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: tasum |
---|
158 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: loss |
---|
159 | ! perte en C lors de la fauche |
---|
160 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: lossc |
---|
161 | ! perte en N lors de la fauche |
---|
162 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: lossn |
---|
163 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: tlossstart |
---|
164 | INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: flag_fertilisation |
---|
165 | INTEGER(i_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fertcount |
---|
166 | ! C/N dans le réservoir stucturel = 150 |
---|
167 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: c2nratiostruct |
---|
168 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfertammtot |
---|
169 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfertnittot |
---|
170 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfertammtotyear |
---|
171 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfertnittotyear |
---|
172 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfertammtotprevyear |
---|
173 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfertnittotprevyear |
---|
174 | ! metabolic C in slurry and manure (kg C/m**2/d) |
---|
175 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcOrganicFertmetabolic |
---|
176 | ! structural C in slurry and manure (kg C/m**2/d) |
---|
177 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fcOrganicFertstruct |
---|
178 | ! urine N in slurry and manure (kg N/m**2/d) |
---|
179 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fnOrganicFerturine |
---|
180 | ! metabolic N in slurry and manure (kg N/m**2/d) |
---|
181 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fnOrganicFertmetabolic |
---|
182 | |
---|
183 | ! variables pour l'auto gestion de nicolas |
---|
184 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nsatur_somerror_temp |
---|
185 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nsatur_somerror |
---|
186 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tfert_modif |
---|
187 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nnonlimit_SOMerror |
---|
188 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: nnonlimit_SOMerrormax |
---|
189 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: controle_azote_sum_mem |
---|
190 | INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: n_auto |
---|
191 | INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: stoplimitant |
---|
192 | INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: fertcount_start |
---|
193 | INTEGER(i_std) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: fertcount_current |
---|
194 | LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:) :: fertil_year |
---|
195 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: toto |
---|
196 | REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: wshtotsumprevyear |
---|
197 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_sr_ugb_C3 |
---|
198 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_nb_ani_C3 |
---|
199 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_grazed_frac_C3 |
---|
200 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_import_yield_C3 |
---|
201 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_wshtotsum_C3 |
---|
202 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_sr_ugb_C4 |
---|
203 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_nb_ani_C4 |
---|
204 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_grazed_frac_C4 |
---|
205 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_import_yield_C4 |
---|
206 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: tmp_wshtotsum_C4 |
---|
207 | |
---|
208 | REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: DM_cutyearly |
---|
209 | REAL(r_std),ALLOCATABLE, SAVE, DIMENSION(:,:) :: C_cutyearly |
---|
210 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: YIELD_RETURN |
---|
211 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:) :: sr_ugb_init |
---|
212 | |
---|
213 | INTEGER(i_std) , SAVE :: cut_year = 10 |
---|
214 | INTEGER(i_std) , SAVE :: compt_fert |
---|
215 | INTEGER(i_std) , SAVE :: min_fert |
---|
216 | INTEGER(i_std) , SAVE :: fert_max |
---|
217 | INTEGER(i_std) , SAVE :: i_compt |
---|
218 | REAL(r_std) , SAVE :: deltatt ! = 0.02 |
---|
219 | ! couter number of years of simulation |
---|
220 | INTEGER(i_std) , SAVE :: count_year |
---|
221 | INTEGER(i_std) , SAVE :: year_count1 |
---|
222 | ! couter number of years of simulation |
---|
223 | INTEGER(i_std) , SAVE :: year_count2 |
---|
224 | ! couter number of years of simulation |
---|
225 | |
---|
226 | CHARACTER(len=500), ALLOCATABLE,SAVE,DIMENSION (:) :: file_management |
---|
227 | CHARACTER(len=500) , SAVE :: file_param_init |
---|
228 | CHARACTER(len=500) , SAVE :: file_import_yield |
---|
229 | |
---|
230 | INTEGER(i_std) , SAVE :: Type_animal |
---|
231 | INTEGER(i_std) , SAVE :: mcut_C3 |
---|
232 | INTEGER(i_std) , SAVE :: mauto_C3 |
---|
233 | INTEGER(i_std) , SAVE :: mcut_C4 |
---|
234 | INTEGER(i_std) , SAVE :: mauto_C4 |
---|
235 | ! yearly total azote by fertilization |
---|
236 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: apport_azote |
---|
237 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: trampling |
---|
238 | |
---|
239 | ! new variables for get map of management |
---|
240 | INTEGER(i_std) , SAVE :: f_management_map |
---|
241 | CHARACTER(len=500) , SAVE :: management_map |
---|
242 | CHARACTER(len=500) , SAVE :: fertility_map |
---|
243 | |
---|
244 | INTEGER(i_std) , SAVE :: f_deposition_map |
---|
245 | CHARACTER(len=500) , SAVE :: deposition_map |
---|
246 | INTEGER(i_std) , SAVE :: f_grazing_map |
---|
247 | CHARACTER(len=500) , SAVE :: grazing_map |
---|
248 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ndeposition |
---|
249 | REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:) :: N_fert_total |
---|
250 | ! REAL(r_std) , SAVE :: N_effect |
---|
251 | REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: compt_cut |
---|
252 | REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: frequency_cut |
---|
253 | REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: sr_wild |
---|
254 | INTEGER(i_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: flag_cutting |
---|
255 | ! from applic_plant |
---|
256 | REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tamean1 |
---|
257 | REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tamean2 |
---|
258 | REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tamean3 |
---|
259 | REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tamean4 |
---|
260 | REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tamean5 |
---|
261 | REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tamean6 |
---|
262 | REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tameand |
---|
263 | REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tameanw |
---|
264 | REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tacumm |
---|
265 | REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tacummprev |
---|
266 | REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tsoilcumm |
---|
267 | REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tsoilcummprev |
---|
268 | REAL(r_std), DIMENSION(:), ALLOCATABLE, SAVE :: tsoilmeand |
---|
269 | REAL(r_std), DIMENSION(:,:), ALLOCATABLE, SAVE :: tcut0 |
---|
270 | |
---|
271 | REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: Fert_sn |
---|
272 | REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: Fert_on |
---|
273 | REAL(r_std),ALLOCATABLE, SAVE , DIMENSION(:,:) :: Fert_PRP |
---|
274 | |
---|
275 | CONTAINS |
---|
276 | |
---|
277 | SUBROUTINE main_grassland_management(& |
---|
278 | npts ,lalo, neighbours, resolution, contfrac, & |
---|
279 | dt, tjulian, t2m_daily, t2m_min_daily, & |
---|
280 | t2m_14, tsoil, snowfall_daily, biomass, bm_to_litter, & |
---|
281 | litter, litter_avail, litter_not_avail , & |
---|
282 | !spitfire |
---|
283 | fuel_1hr, fuel_10hr, & |
---|
284 | fuel_100hr, fuel_1000hr, & |
---|
285 | !end spitfire |
---|
286 | new_day, new_year, when_growthinit_cut, nb_grazingdays,& |
---|
287 | lai, sla_calc, leaf_age, leaf_frac, & |
---|
288 | wshtotsum, sr_ugb, compt_ugb, & |
---|
289 | nb_ani, grazed_frac, import_yield, N_limfert, & |
---|
290 | !gmjc top 5 layer grassland soil moisture for grazing |
---|
291 | moiavail_daily, tmc_topgrass_daily,fc_grazing, snowmass_daily,& |
---|
292 | after_snow, after_wet, wet1day, wet2day, & |
---|
293 | !end gmjc |
---|
294 | harvest_gm, ranimal_gm, ch4_pft_gm, cinput_gm, n2o_pft_gm) |
---|
295 | |
---|
296 | INTEGER(i_std) , INTENT(in) :: npts |
---|
297 | INTEGER(i_std),DIMENSION(npts,8),INTENT(in) :: neighbours !!Neighoring grid points if land for the DGVM |
---|
298 | !!(unitless) |
---|
299 | REAL(r_std),DIMENSION(npts,2),INTENT(in) :: lalo !!Geographical coordinates (latitude,longitude) |
---|
300 | REAL(r_std),DIMENSION(npts,2),INTENT(in) :: resolution !! Size in x an y of the grid (m) - surface area of |
---|
301 | !! the gridbox |
---|
302 | REAL(r_std),DIMENSION (npts), INTENT (in) :: contfrac !!Fraction of continent in the grid cell (unitless) |
---|
303 | REAL(r_std) , INTENT(in) :: dt |
---|
304 | INTEGER(i_std) , INTENT(in) :: tjulian |
---|
305 | ! julien day |
---|
306 | REAL(r_std), DIMENSION(npts) , INTENT(in) :: t2m_daily |
---|
307 | ! air temperature |
---|
308 | REAL(r_std), DIMENSION(npts) , INTENT(in) :: t2m_min_daily |
---|
309 | ! daily minimum temperature |
---|
310 | REAL(r_std), DIMENSION(npts) , INTENT(in) :: t2m_14 |
---|
311 | ! 14 days mean temperature |
---|
312 | REAL(r_std), DIMENSION(npts) , INTENT(in) :: tsoil |
---|
313 | ! soil surface t (k) |
---|
314 | REAL(r_std), DIMENSION(npts) , INTENT(in) :: snowfall_daily |
---|
315 | ! snow fall (mm/d) |
---|
316 | REAL(r_std), DIMENSION(npts) , INTENT(in) :: snowmass_daily |
---|
317 | ! snow mass (kg/m2) |
---|
318 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: biomass |
---|
319 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: bm_to_litter |
---|
320 | ! conv of biomass to litter (gC/(m**2/agri ground)) / day |
---|
321 | REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(inout):: litter |
---|
322 | REAL(r_std), DIMENSION(npts,nlitt,nvm), INTENT(inout):: litter_avail |
---|
323 | REAL(r_std), DIMENSION(npts,nlitt,nvm) , INTENT(inout):: litter_not_avail |
---|
324 | LOGICAL , INTENT(in) :: new_day |
---|
325 | ! flag indicate new day |
---|
326 | LOGICAL , INTENT(in) :: new_year |
---|
327 | ! flag indicate new year |
---|
328 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: when_growthinit_cut |
---|
329 | ! how many days ago was the beginning of the last cut |
---|
330 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: nb_grazingdays |
---|
331 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: lai |
---|
332 | ! leaf area index OF AN INDIVIDUAL PLANT |
---|
333 | !spitfire |
---|
334 | REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout) :: fuel_1hr |
---|
335 | REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout) :: fuel_10hr |
---|
336 | REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout) :: fuel_100hr |
---|
337 | REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout) :: fuel_1000hr |
---|
338 | !end spitfire |
---|
339 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: sla_calc |
---|
340 | REAL(r_std), DIMENSION(npts,nvm,nleafages) , INTENT(inout) :: leaf_frac |
---|
341 | REAL(r_std), DIMENSION(npts,nvm,nleafages) , INTENT(inout) :: leaf_age |
---|
342 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: wshtotsum |
---|
343 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: sr_ugb |
---|
344 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: compt_ugb |
---|
345 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: nb_ani |
---|
346 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: grazed_frac |
---|
347 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: import_yield |
---|
348 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: N_limfert |
---|
349 | !gmjc top 5 layer grassland soil moisture for grazing |
---|
350 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: moiavail_daily |
---|
351 | REAL(r_std),DIMENSION (npts), INTENT(in) :: tmc_topgrass_daily |
---|
352 | REAL(r_std),DIMENSION (npts), INTENT(in) :: fc_grazing |
---|
353 | REAL(r_std),DIMENSION (npts), INTENT(inout) :: after_snow |
---|
354 | REAL(r_std),DIMENSION (npts), INTENT(inout) :: after_wet |
---|
355 | REAL(r_std),DIMENSION (npts), INTENT(inout) :: wet1day |
---|
356 | REAL(r_std),DIMENSION (npts), INTENT(inout) :: wet2day |
---|
357 | !end gmjc |
---|
358 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: harvest_gm |
---|
359 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ranimal_gm |
---|
360 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ch4_pft_gm |
---|
361 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: cinput_gm |
---|
362 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: n2o_pft_gm |
---|
363 | |
---|
364 | LOGICAL :: l_error = .FALSE. |
---|
365 | INTEGER(i_std) :: ier, i, j, k,h, m |
---|
366 | REAL(r_std), DIMENSION(npts) :: xtmp_npts |
---|
367 | REAL(r_std), DIMENSION(npts,ngmean) :: xtmp_npts_3d |
---|
368 | REAL(r_std), DIMENSION(npts,nvm) :: regcount_real |
---|
369 | REAL(r_std), DIMENSION(npts,nvm) :: fertcount_real |
---|
370 | INTEGER(i_std) :: fertcount_next |
---|
371 | REAL(r_std) :: intakemax_t |
---|
372 | REAL(r_std) :: wanimal_t |
---|
373 | REAL(r_std), DIMENSION(ncut) ::wshtotcutinit_t |
---|
374 | REAL(r_std), DIMENSION(npts,nvm) :: lm_before |
---|
375 | REAL(r_std), DIMENSION(npts,nvm) :: lm_after |
---|
376 | REAL(r_std), DIMENSION(npts,nvm) :: bm_cut |
---|
377 | |
---|
378 | REAL(r_std), PARAMETER :: n2o_EF1 = 0.01 |
---|
379 | REAL(r_std), PARAMETER :: n2o_EF2 = 0.015 |
---|
380 | REAL(r_std), PARAMETER :: n2o_EF3 = 0.01 |
---|
381 | REAL(r_std), PARAMETER :: n2o_EF4 = 0.0075 |
---|
382 | REAL(r_std), PARAMETER :: n2o_FracGASF = 0.10 |
---|
383 | REAL(r_std), PARAMETER :: n2o_FracGASM = 0.20 |
---|
384 | REAL(r_std), PARAMETER :: n2o_FracLEACH_H = 0.30 |
---|
385 | |
---|
386 | |
---|
387 | ! REAL(r_std), DIMENSION(npts,nvm) :: N_fert_total |
---|
388 | REAL(r_std) :: fertility_legume_t |
---|
389 | |
---|
390 | ! 1. initialisations |
---|
391 | init_grassland : IF (first_call_grassland_manag) THEN |
---|
392 | |
---|
393 | first_call_grassland_manag = .FALSE. |
---|
394 | |
---|
395 | ! 1.1 allocate variables |
---|
396 | |
---|
397 | ALLOCATE (intake (npts,nvm) , stat=ier) |
---|
398 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'intake', 'Not enough memory', '') |
---|
399 | ALLOCATE (intakemax (npts,nvm) , stat=ier) |
---|
400 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'intakemax', 'Not enough memory', '') |
---|
401 | ALLOCATE (intake_litter (npts,nvm) , stat=ier) |
---|
402 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'intake_litter', 'Not enough memory', '') |
---|
403 | ALLOCATE (intake_animal_litter (npts,nvm) , stat=ier) |
---|
404 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'intake_animal_litter', 'Not enough memory', '') |
---|
405 | ALLOCATE (grazing_litter (npts,nvm) , stat=ier) |
---|
406 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'grazing_litter', 'Not enough memory', '') |
---|
407 | ALLOCATE (litter_avail_totDM (npts,nvm) , stat=ier) |
---|
408 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'litter_avail_totDM', 'Not enough memory', '') |
---|
409 | ALLOCATE (wshtotcutinit (npts,nvm,ncut) , stat=ier) |
---|
410 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wshtotcutinit', 'Not enough memory', '') |
---|
411 | ALLOCATE (lcutinit (npts,nvm,ncut) , stat=ier) |
---|
412 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'lcutinit', 'Not enough memory', '') |
---|
413 | ALLOCATE (devstage (npts,nvm) , stat=ier) |
---|
414 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'devstage', 'Not enough memory', '') |
---|
415 | ALLOCATE (faecesc (npts,nvm) , stat=ier) |
---|
416 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'faecesc', 'Not enough memory', '') |
---|
417 | ALLOCATE (faecesn (npts,nvm) , stat=ier) |
---|
418 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'faecesn', 'Not enough memory', '') |
---|
419 | ALLOCATE (urinen (npts,nvm) , stat=ier) |
---|
420 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'urinen', 'Not enough memory', '') |
---|
421 | ALLOCATE (urinec (npts,nvm) , stat=ier) |
---|
422 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'urinec', 'Not enough memory', '') |
---|
423 | ALLOCATE (nel (npts,nvm) , stat=ier) |
---|
424 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nel', 'Not enough memory', '') |
---|
425 | ALLOCATE (nanimaltot (npts,nvm) , stat=ier) |
---|
426 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nanimaltot', 'Not enough memory', '') |
---|
427 | ALLOCATE (tgrowth (npts,nvm) , stat=ier) |
---|
428 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tgrowth', 'Not enough memory', '') |
---|
429 | ALLOCATE (wsh (npts,nvm) , stat=ier) |
---|
430 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wsh', 'Not enough memory', '') |
---|
431 | ALLOCATE (wshtot (npts,nvm) , stat=ier) |
---|
432 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wshtot', 'Not enough memory', '') |
---|
433 | ALLOCATE (wshtotinit (npts,nvm) , stat=ier) |
---|
434 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wshtotinit', 'Not enough memory', '') |
---|
435 | ALLOCATE (wr (npts,nvm) , stat=ier) |
---|
436 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wr', 'Not enough memory', '') |
---|
437 | ALLOCATE (wrtot (npts,nvm) , stat=ier) |
---|
438 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wrtot', 'Not enough memory', '') |
---|
439 | ALLOCATE (wanimal (npts,nvm) , stat=ier) |
---|
440 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wanimal', 'Not enough memory', '') |
---|
441 | ALLOCATE (ntot (npts,nvm) , stat=ier) |
---|
442 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'ntot', 'Not enough memory', '') |
---|
443 | ALLOCATE (c (npts,nvm) , stat=ier) |
---|
444 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'c', 'Not enough memory', '') |
---|
445 | ALLOCATE (n (npts,nvm) , stat=ier) |
---|
446 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'n', 'Not enough memory', '') |
---|
447 | ALLOCATE (fn (npts,nvm) , stat=ier) |
---|
448 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fn', 'Not enough memory', '') |
---|
449 | ALLOCATE (napo (npts,nvm) , stat=ier) |
---|
450 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'napo', 'Not enough memory', '') |
---|
451 | ALLOCATE (nsym (npts,nvm) , stat=ier) |
---|
452 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nsym', 'Not enough memory', '') |
---|
453 | ALLOCATE (wnapo (npts,nvm) , stat=ier) |
---|
454 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wnapo', 'Not enough memory', '') |
---|
455 | ALLOCATE (wnsym (npts,nvm) , stat=ier) |
---|
456 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wnsym', 'Not enough memory', '') |
---|
457 | ALLOCATE (wn (npts,nvm) , stat=ier) |
---|
458 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wn', 'Not enough memory', '') |
---|
459 | ALLOCATE (nanimal (npts,nvm,nstocking), stat=ier) |
---|
460 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nanimal', 'Not enough memory', '') |
---|
461 | ALLOCATE (tanimal (npts,nvm,nstocking), stat=ier) |
---|
462 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tanimal', 'Not enough memory', '') |
---|
463 | ALLOCATE (danimal (npts,nvm,nstocking), stat=ier) |
---|
464 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'danimal', 'Not enough memory', '') |
---|
465 | ALLOCATE (tcut (npts,nvm,nstocking), stat=ier) |
---|
466 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tcut', 'Not enough memory', '') |
---|
467 | ALLOCATE (tfert (npts,nvm,nstocking), stat=ier) |
---|
468 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tfert', 'Not enough memory', '') |
---|
469 | ALLOCATE (Nliquidmanure (npts,nvm,nstocking), stat=ier) |
---|
470 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'Nliquidmanure', 'Not enough memory', '') |
---|
471 | ALLOCATE (nslurry (npts,nvm,nstocking), stat=ier) |
---|
472 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nslurry', 'Not enough memory', '') |
---|
473 | ALLOCATE (Nsolidmanure (npts,nvm,nstocking), stat=ier) |
---|
474 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'Nsolidmanure', 'Not enough memory', '') |
---|
475 | ALLOCATE (legume_fraction (npts,nvm) , stat=ier) |
---|
476 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'legume_fraction', 'Not enough memory', '') |
---|
477 | ALLOCATE (soil_fertility (npts,nvm) , stat=ier) |
---|
478 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'soil_fertility', 'Not enough memory', '') |
---|
479 | ALLOCATE (Animalwgrazingmin (npts,nvm) , stat=ier) |
---|
480 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'Animalwgrazingmin', 'Not enough memory', '') |
---|
481 | ALLOCATE (AnimalkintakeM (npts,nvm) , stat=ier) |
---|
482 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'AnimalkintakeM', 'Not enough memory', '') |
---|
483 | ALLOCATE (AnimalDiscremineQualite (npts,nvm) , stat=ier) |
---|
484 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'AnimalDiscremineQualite', 'Not enough memory', '') |
---|
485 | ALLOCATE (controle_azote (npts,nvm,nstocking), stat=ier) |
---|
486 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'controle_azote', 'Not enough memory', '') |
---|
487 | ALLOCATE (fcOrganicFertmetabolicsum (npts,nvm) , stat=ier) |
---|
488 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fcOrganicFertmetabolicsum', 'Not enough memory', '') |
---|
489 | ALLOCATE (fcOrganicFertstructsum (npts,nvm) , stat=ier) |
---|
490 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fcOrganicFertstructsum', 'Not enough memory', '') |
---|
491 | ALLOCATE (fnOrganicFertmetabolicsum (npts,nvm) , stat=ier) |
---|
492 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fnOrganicFertmetabolicsum', 'Not enough memory', '') |
---|
493 | ALLOCATE (fnOrganicFertstructsum (npts,nvm) , stat=ier) |
---|
494 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fnOrganicFertstructsum', 'Not enough memory', '') |
---|
495 | ALLOCATE (fnOrganicFerturinesum (npts,nvm) , stat=ier) |
---|
496 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fnOrganicFerturinesum', 'Not enough memory', '') |
---|
497 | ALLOCATE (fnatmsum (npts,nvm) , stat=ier) |
---|
498 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fnatmsum', 'Not enough memory', '') |
---|
499 | ALLOCATE (controle_azote_sum (npts,nvm) , stat=ier) |
---|
500 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'controle_azote_sum', 'Not enough memory', '') |
---|
501 | ALLOCATE (nfertamm (npts,nvm,nstocking), stat=ier) |
---|
502 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nfertamm', 'Not enough memory', '') |
---|
503 | ALLOCATE (nfertnit (npts,nvm,nstocking), stat=ier) |
---|
504 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nfertnit', 'Not enough memory', '') |
---|
505 | ALLOCATE (intakesum (npts,nvm) , stat=ier) |
---|
506 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'intakesum', 'Not enough memory', '') |
---|
507 | ALLOCATE (intakensum (npts,nvm) , stat=ier) |
---|
508 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'intakensum', 'Not enough memory', '') |
---|
509 | ALLOCATE (intake_animal (npts,nvm) , stat=ier) |
---|
510 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'intake_animal', 'Not enough memory', '') |
---|
511 | ALLOCATE (intake_animalsum (npts,nvm) , stat=ier) |
---|
512 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'intake_animalsum', 'Not enough memory', '') |
---|
513 | ALLOCATE (PIYcow (npts,nvm,nstocking), stat=ier) |
---|
514 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'PIYcow', 'Not enough memory', '') |
---|
515 | ALLOCATE (PIMcow (npts,nvm,nstocking), stat=ier) |
---|
516 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'PIMcow', 'Not enough memory', '') |
---|
517 | ALLOCATE (BCSYcow (npts,nvm,nstocking), stat=ier) |
---|
518 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'BCSYcow', 'Not enough memory', '') |
---|
519 | ALLOCATE (BCSMcow (npts,nvm,nstocking), stat=ier) |
---|
520 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'BCSMcow', 'Not enough memory', '') |
---|
521 | ALLOCATE (PICcow (npts,nvm,nstocking), stat=ier) |
---|
522 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'PICcow', 'Not enough memory', '') |
---|
523 | ALLOCATE (AGE_cow_P (npts,nvm,nstocking), stat=ier) |
---|
524 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'AGE_cow_P', 'Not enough memory', '') |
---|
525 | ALLOCATE (AGE_cow_M (npts,nvm,nstocking), stat=ier) |
---|
526 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'AGE_cow_M', 'Not enough memory', '') |
---|
527 | ALLOCATE (Autogestion_out (npts,nvm,n_out) , stat=ier) |
---|
528 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'Autogestion_out', 'Not enough memory', '') |
---|
529 | ALLOCATE (Forage_quantity (npts,nvm,nstocking), stat=ier) |
---|
530 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'Forage_quantity', 'Not enough memory', '') |
---|
531 | ALLOCATE (tcut_modif (npts,nvm,nstocking), stat=ier) |
---|
532 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tcut_modif', 'Not enough memory', '') |
---|
533 | ALLOCATE (countschedule (npts,nvm) , stat=ier) |
---|
534 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'countschedule', 'Not enough memory', '') |
---|
535 | ALLOCATE (mux (npts,nvm) , stat=ier) |
---|
536 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'mux', 'Not enough memory', '') |
---|
537 | ALLOCATE (mugmean (npts,nvm) , stat=ier) |
---|
538 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'mugmean', 'Not enough memory', '') |
---|
539 | ALLOCATE (sigx (npts,nvm) , stat=ier) |
---|
540 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'sigx', 'Not enough memory', '') |
---|
541 | ALLOCATE (sigy (npts,nvm) , stat=ier) |
---|
542 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'sigy', 'Not enough memory', '') |
---|
543 | ALLOCATE (gmeanslope (npts,nvm) , stat=ier) |
---|
544 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'gmeanslope', 'Not enough memory', '') |
---|
545 | ALLOCATE (gzero (npts,nvm) , stat=ier) |
---|
546 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'gzero', 'Not enough memory', '') |
---|
547 | ALLOCATE (gcor (npts,nvm) , stat=ier) |
---|
548 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'gcor', 'Not enough memory', '') |
---|
549 | ALLOCATE (cuttingend (npts,nvm) , stat=ier) |
---|
550 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'cuttingend', 'Not enough memory', '') |
---|
551 | ALLOCATE (tcut_verif (npts,nvm,nstocking), stat=ier) |
---|
552 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tcut_verif', 'Not enough memory', '') |
---|
553 | ALLOCATE (tfert_verif (npts,nvm,nstocking), stat=ier) |
---|
554 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tfert_verif', 'Not enough memory', '') |
---|
555 | ALLOCATE (tfert_verif2 (npts,nvm,nstocking), stat=ier) |
---|
556 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tfert_verif2', 'Not enough memory', '') |
---|
557 | ALLOCATE (tfert_verif3 (npts,nvm,nstocking), stat=ier) |
---|
558 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tfert_verif3', 'Not enough memory', '') |
---|
559 | ALLOCATE (regcount (npts,nvm) , stat=ier) |
---|
560 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'regcount', 'Not enough memory', '') |
---|
561 | ALLOCATE (wshcutinit (npts,nvm) , stat=ier) |
---|
562 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wshcutinit', 'Not enough memory', '') |
---|
563 | ALLOCATE (gmean (npts,nvm,ngmean) , stat=ier) |
---|
564 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'gmean', 'Not enough memory', '') |
---|
565 | ALLOCATE (tgmean (npts,nvm,ngmean) , stat=ier) |
---|
566 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tgmean', 'Not enough memory', '') |
---|
567 | ALLOCATE (wc_frac (npts,nvm) , stat=ier) |
---|
568 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wc_frac', 'Not enough memory', '') |
---|
569 | ALLOCATE (wgn (npts,nvm) , stat=ier) |
---|
570 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wgn', 'Not enough memory', '') |
---|
571 | ALLOCATE (tasum (npts,nvm) , stat=ier) |
---|
572 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tasum', 'Not enough memory', '') |
---|
573 | ALLOCATE (loss (npts,nvm) , stat=ier) |
---|
574 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'loss', 'Not enough memory', '') |
---|
575 | ALLOCATE (lossc (npts,nvm) , stat=ier) |
---|
576 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'lossc', 'Not enough memory', '') |
---|
577 | ALLOCATE (lossn (npts,nvm) , stat=ier) |
---|
578 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'lossn', 'Not enough memory', '') |
---|
579 | ALLOCATE (tlossstart (npts,nvm) , stat=ier) |
---|
580 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tlossstart', 'Not enough memory', '') |
---|
581 | ALLOCATE (flag_fertilisation (npts,nvm) , stat=ier) |
---|
582 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'flag_fertilisation', 'Not enough memory', '') |
---|
583 | ALLOCATE (fertcount (npts,nvm) , stat=ier) |
---|
584 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fertcount', 'Not enough memory', '') |
---|
585 | ALLOCATE (c2nratiostruct (npts,nvm) , stat=ier) |
---|
586 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'c2nratiostruct', 'Not enough memory', '') |
---|
587 | ALLOCATE (nfertammtot (npts,nvm) , stat=ier) |
---|
588 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nfertammtot', 'Not enough memory', '') |
---|
589 | ALLOCATE (nfertnittot (npts,nvm) , stat=ier) |
---|
590 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nfertnittot', 'Not enough memory', '') |
---|
591 | ALLOCATE (nfertammtotyear (npts,nvm) , stat=ier) |
---|
592 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nfertammtotyear', 'Not enough memory', '') |
---|
593 | ALLOCATE (nfertnittotyear (npts,nvm) , stat=ier) |
---|
594 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nfertnittotyear', 'Not enough memory', '') |
---|
595 | ALLOCATE (nfertammtotprevyear (npts,nvm) , stat=ier) |
---|
596 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nfertammtotprevyear', 'Not enough memory', '') |
---|
597 | ALLOCATE (nfertnittotprevyear (npts,nvm) , stat=ier) |
---|
598 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nfertnittotprevyear', 'Not enough memory', '') |
---|
599 | ALLOCATE (fcOrganicFertmetabolic (npts,nvm) , stat=ier) |
---|
600 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fcOrganicFertmetabolic', 'Not enough memory', '') |
---|
601 | ALLOCATE (fcOrganicFertstruct (npts,nvm) , stat=ier) |
---|
602 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fcOrganicFertstruct', 'Not enough memory', '') |
---|
603 | ALLOCATE (fnOrganicFerturine (npts,nvm) , stat=ier) |
---|
604 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fnOrganicFerturine', 'Not enough memory', '') |
---|
605 | ALLOCATE (fnOrganicFertstruct (npts,nvm) , stat=ier) |
---|
606 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fnOrganicFertstruct', 'Not enough memory', '') |
---|
607 | ALLOCATE (fnOrganicFertmetabolic (npts,nvm) , stat=ier) |
---|
608 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fnOrganicFertmetabolic', 'Not enough memory', '') |
---|
609 | ALLOCATE (nsatur_somerror_temp (npts,nvm) , stat=ier) |
---|
610 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nsatur_somerror_temp', 'Not enough memory', '') |
---|
611 | ALLOCATE (nsatur_somerror (npts,nvm) , stat=ier) |
---|
612 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nsatur_somerror', 'Not enough memory', '') |
---|
613 | ALLOCATE (tfert_modif (npts,nvm,nstocking), stat=ier) |
---|
614 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tfert_modif', 'Not enough memory', '') |
---|
615 | ALLOCATE (nnonlimit_SOMerror (npts,nvm) , stat=ier) |
---|
616 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nnonlimit_SOMerror', 'Not enough memory', '') |
---|
617 | ALLOCATE (nnonlimit_SOMerrormax (npts,nvm) , stat=ier) |
---|
618 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'nnonlimit_SOMerrormax', 'Not enough memory', '') |
---|
619 | ALLOCATE (controle_azote_sum_mem (npts,nvm) , stat=ier) |
---|
620 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'controle_azote_sum_mem', 'Not enough memory', '') |
---|
621 | ALLOCATE (n_auto (npts,nvm) , stat=ier) |
---|
622 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'n_auto', 'Not enough memory', '') |
---|
623 | ALLOCATE (stoplimitant (npts,nvm) , stat=ier) |
---|
624 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'stoplimitant', 'Not enough memory', '') |
---|
625 | ALLOCATE (fertcount_start (npts,nvm) , stat=ier) |
---|
626 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fertcount_start', 'Not enough memory', '') |
---|
627 | ALLOCATE (fertcount_current (npts,nvm) , stat=ier) |
---|
628 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fertcount_current', 'Not enough memory', '') |
---|
629 | ALLOCATE (wshtotsumprev (npts,nvm) , stat=ier) |
---|
630 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wshtotsumprev', 'Not enough memory', '') |
---|
631 | ALLOCATE (fertil_year (npts,nvm) , stat=ier) |
---|
632 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'fertil_year', 'Not enough memory', '') |
---|
633 | ALLOCATE (toto (npts) , stat=ier) |
---|
634 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'toto', 'Not enough memory', '') |
---|
635 | ALLOCATE (apport_azote (npts,nvm) , stat=ier) |
---|
636 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'apport_azote', 'Not enough memory', '') |
---|
637 | ALLOCATE (trampling (npts,nvm) , stat=ier) |
---|
638 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'trampling', 'Not enough memory', '') |
---|
639 | ALLOCATE (wshtotsumprevyear (npts,nvm) , stat=ier) |
---|
640 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'wshtotsumprevyear', 'Not enough memory', '') |
---|
641 | ALLOCATE(file_management (nvm) , stat=ier) |
---|
642 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'file_management', 'Not enough memory', '') |
---|
643 | ALLOCATE (tmp_sr_ugb_C3 (npts) , stat=ier) |
---|
644 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_sr_ugb_C3', 'Not enough memory', '') |
---|
645 | ALLOCATE (tmp_nb_ani_C3 (npts) , stat=ier) |
---|
646 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_nb_ani_C3', 'Not enough memory', '') |
---|
647 | ALLOCATE (tmp_grazed_frac_C3 (npts) , stat=ier) |
---|
648 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_grazed_frac_C3', 'Not enough memory', '') |
---|
649 | ALLOCATE (tmp_import_yield_C3 (npts) , stat=ier) |
---|
650 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_import_yield_C3', 'Not enough memory', '') |
---|
651 | ALLOCATE (tmp_wshtotsum_C3 (npts) , stat=ier) |
---|
652 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_wshtotsum_C3', 'Not enough memory', '') |
---|
653 | ALLOCATE (tmp_sr_ugb_C4 (npts) , stat=ier) |
---|
654 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_sr_ugb_C4', 'Not enough memory', '') |
---|
655 | ALLOCATE (tmp_nb_ani_C4 (npts) , stat=ier) |
---|
656 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_nb_ani_C4', 'Not enough memory', '') |
---|
657 | ALLOCATE (tmp_grazed_frac_C4 (npts) , stat=ier) |
---|
658 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_grazed_frac_C4', 'Not enough memory', '') |
---|
659 | ALLOCATE (tmp_import_yield_C4 (npts) , stat=ier) |
---|
660 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_import_yield_C4', 'Not enough memory', '') |
---|
661 | ALLOCATE (tmp_wshtotsum_C4 (npts) , stat=ier) |
---|
662 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'tmp_wshtotsum_C4', 'Not enough memory', '') |
---|
663 | ALLOCATE (DM_cutyearly (npts,nvm) , stat=ier) |
---|
664 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'DM_cutyearly', 'Not enough memory', '') |
---|
665 | ALLOCATE (C_cutyearly (npts,nvm) , stat=ier) |
---|
666 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'C_cutyearly', 'Not enough memory', '') |
---|
667 | ALLOCATE (YIELD_RETURN (npts,nvm) , stat=ier) |
---|
668 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'YIELD_RETURN', 'Not enough memory', '') |
---|
669 | ALLOCATE (sr_ugb_init (npts) , stat=ier) |
---|
670 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'sr_ugb_init', 'Not enough memory', '') |
---|
671 | ALLOCATE (N_fert_total (npts,nvm) , stat=ier) |
---|
672 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'N_fert_total', 'Not enough memory', '') |
---|
673 | ALLOCATE (ndeposition (npts,nvm) , stat=ier) |
---|
674 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'ndeposition', 'Not enough memory', '') |
---|
675 | ALLOCATE (compt_cut (npts,nvm) , stat=ier) |
---|
676 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'compt_cut', 'Not enough memory', '') |
---|
677 | ALLOCATE (frequency_cut (npts,nvm) , stat=ier) |
---|
678 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'frequency_cut', 'Not enough memory', '') |
---|
679 | ALLOCATE (sr_wild (npts,nvm) , stat=ier) |
---|
680 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'sr_wild', 'Not enough memory', '') |
---|
681 | ALLOCATE (flag_cutting (npts,nvm) , stat=ier) |
---|
682 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_GM', 'flag_cutting', 'Not enough memory', '') |
---|
683 | |
---|
684 | ! from applic_plant |
---|
685 | ALLOCATE (tamean1 (npts), stat=ier) |
---|
686 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tamean1', 'Not enough memory', '') |
---|
687 | ALLOCATE (tamean2 (npts), stat=ier) |
---|
688 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tamean2', 'Not enough memory', '') |
---|
689 | ALLOCATE (tamean3 (npts), stat=ier) |
---|
690 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tamean3', 'Not enough memory', '') |
---|
691 | ALLOCATE (tamean4 (npts), stat=ier) |
---|
692 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tamean4', 'Not enough memory', '') |
---|
693 | ALLOCATE (tamean5 (npts), stat=ier) |
---|
694 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tamean5', 'Not enough memory', '') |
---|
695 | ALLOCATE (tamean6 (npts), stat=ier) |
---|
696 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tamean6', 'Not enough memory', '') |
---|
697 | ALLOCATE (tameand (npts), stat=ier) |
---|
698 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tameand', 'Not enough memory', '') |
---|
699 | ALLOCATE (tameanw (npts), stat=ier) |
---|
700 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tameanw', 'Not enough memory', '') |
---|
701 | ALLOCATE (tacumm (npts), stat=ier) |
---|
702 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tacumm', 'Not enough memory', '') |
---|
703 | ALLOCATE (tacummprev (npts), stat=ier) |
---|
704 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tacummprev', 'Not enough memory', '') |
---|
705 | ALLOCATE (tsoilcumm (npts), stat=ier) |
---|
706 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tsoilcumm', 'Not enough memory', '') |
---|
707 | ALLOCATE (tsoilcummprev (npts), stat=ier) |
---|
708 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tsoilcummprev', 'Not enough memory', '') |
---|
709 | ALLOCATE (tsoilmeand (npts), stat=ier) |
---|
710 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tsoilmeand', 'Not enough memory', '') |
---|
711 | ALLOCATE (tcut0 (npts,nvm), stat=ier) |
---|
712 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'tcut0', 'Not enough memory', '') |
---|
713 | ALLOCATE (Fert_sn (npts,nvm), stat=ier) |
---|
714 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'Fert_sn', 'Not enough memory', '') |
---|
715 | ALLOCATE (Fert_on (npts,nvm), stat=ier) |
---|
716 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'Fert_on', 'Not enough memory', '') |
---|
717 | ALLOCATE (Fert_PRP (npts,nvm), stat=ier) |
---|
718 | IF (ier /= 0) CALL ipslerr_p(3, 'Main_appl_pre_animal', 'Fert_PRP', 'Not enough memory', '') |
---|
719 | |
---|
720 | ! 1.2 set flags and variables need to read in Pasim |
---|
721 | |
---|
722 | ! saturant N supply |
---|
723 | f_saturant = 0 |
---|
724 | CALL getin_p('GRM_F_SATURANT',f_saturant) |
---|
725 | ! N fertilization without limitation |
---|
726 | f_nonlimitant = 0 |
---|
727 | CALL getin_p('GRM_F_NONLIMITANT',f_nonlimitant) |
---|
728 | ! f_autogestion = 1-5 |
---|
729 | ! 1: auto cut for PFT m_auto |
---|
730 | ! 2: auto graze for PFT m_auto |
---|
731 | ! 3: auto cut and graze for PFT m_cut and m_grazed with increasing sr_ugb |
---|
732 | ! 4: auto cut and graze for PFT m_cut and m_grazed with constant sr_ugb |
---|
733 | ! 5: auto graze for PFT m_grazed with grazing litter during winter for LGM period |
---|
734 | f_autogestion = 0 |
---|
735 | CALL getin_p('GRM_F_AUTOGESTION',f_autogestion) |
---|
736 | WRITE(numout,*) 'GRM_F_AUTOGESTION',f_autogestion |
---|
737 | ! whether animal is fed by extra feedstuffs |
---|
738 | f_complementation = 0 |
---|
739 | CALL getin_p('GRM_F_COMPLEMENTATION',f_complementation) |
---|
740 | ! whether apply fertilizer |
---|
741 | f_fertilization = 1 |
---|
742 | CALL getin_p('GRM_F_FERTILIZATION',f_fertilization) |
---|
743 | ! JCCOMMENT 10April2015 already set and read at src_parameter |
---|
744 | ! ! number of management year cycled |
---|
745 | ! nb_year_management(:) = 0 |
---|
746 | ! CALL getin_p('NB_YEAR_MANAGEMENT',nb_year_management) |
---|
747 | ! WRITE(numout,*) 'NB_YEAR_MANAGEMENT',nb_year_management |
---|
748 | ! f_postauto = 0-5 |
---|
749 | ! 1: after f_autogestion=2 with varied sr_ugb and nb_ani |
---|
750 | ! 2: after f_postauto=1 with varied sr_ugb and nb_ani |
---|
751 | ! 3: simulation with constant sr_ugb and grazed_frac |
---|
752 | ! 4: simulation with increasing sr_ugb and constant grazed_frac |
---|
753 | ! 5: global simulation with prescribed sr_ugb from external file |
---|
754 | f_postauto = 0 |
---|
755 | CALL getin_p('GRM_F_POSTAUTO',f_postauto) |
---|
756 | WRITE(numout,*) 'GRM_F_POSTAUTO',f_postauto |
---|
757 | ! the maximum impact to vcmax due to N fertilization |
---|
758 | ! N_effect =0.0 - 1.0 |
---|
759 | N_effect=0.6 |
---|
760 | CALL getin_p('GRM_N_EFFECT',N_effect) |
---|
761 | IF (N_effect .LT. 0.0 .OR. N_effect .GT. 1.0) THEN |
---|
762 | N_effect =0.6 |
---|
763 | ENDIF |
---|
764 | |
---|
765 | ! 1.3 READ INITIAL CONDITION FILE FOR OLD/NEW ANIMAL MODULE |
---|
766 | |
---|
767 | file_param_init='/ccc/work/cont003/dsm/p529chan/input_gm/laq-int.init_cond.par' |
---|
768 | |
---|
769 | CALL getin_p('GRM_FILE_PARAM_INIT',file_param_init) |
---|
770 | WRITE (numout,*) 'GRM_FILE_PARAM_INIT',file_param_init |
---|
771 | OPEN(unit=61, file = file_param_init) |
---|
772 | |
---|
773 | READ(61, *, iostat = ier) toto(:) |
---|
774 | READ(61, *, iostat = ier) (wshtotcutinit_t(h), h=1,ncut) |
---|
775 | READ(61, *, iostat = ier) toto(:) |
---|
776 | READ(61, *, iostat = ier) toto(:) |
---|
777 | READ(61, *, iostat = ier) toto(:) |
---|
778 | |
---|
779 | READ(61, *, iostat = ier) toto(:) |
---|
780 | READ(61, *, iostat = ier) toto(:) |
---|
781 | READ(61, *, iostat = ier) toto(:) |
---|
782 | READ(61, *, iostat = ier) toto(:) |
---|
783 | READ(61, *, iostat = ier) toto(:) |
---|
784 | |
---|
785 | READ(61, *, iostat = ier) toto(:) |
---|
786 | READ(61, *, iostat = ier) toto(:) |
---|
787 | READ(61, *, iostat = ier) toto(:) |
---|
788 | READ(61, *, iostat = ier) toto(:) |
---|
789 | READ(61, *, iostat = ier) toto(:) |
---|
790 | |
---|
791 | READ(61, *, iostat = ier) toto(:) |
---|
792 | READ(61, *, iostat = ier) toto(:) |
---|
793 | READ(61, *, iostat = ier) toto(:) |
---|
794 | READ(61, *, iostat = ier) toto(:) |
---|
795 | READ(61, *, iostat = ier) toto(:) |
---|
796 | |
---|
797 | READ(61, *, iostat = ier) toto(:) |
---|
798 | READ(61, *, iostat = ier) toto(:) |
---|
799 | READ(61, *, iostat = ier) toto(:) |
---|
800 | READ(61, *, iostat = ier) toto(:) |
---|
801 | READ(61, *, iostat = ier) toto(:) |
---|
802 | |
---|
803 | READ(61, *, iostat = ier) toto(:) |
---|
804 | READ(61, *, iostat = ier) toto(:) |
---|
805 | READ(61, *, iostat = ier) toto(:) |
---|
806 | READ(61, *, iostat = ier) tcutmodel |
---|
807 | READ(61, *, iostat = ier) intakemax_t |
---|
808 | |
---|
809 | READ(61, *, iostat = ier) wanimal_t |
---|
810 | READ(61, *, iostat = ier) Type_animal |
---|
811 | READ(61, *, iostat = ier) toto(:) |
---|
812 | READ(61, *, iostat = ier) toto(:) |
---|
813 | READ(61, *, iostat = ier) toto(:) |
---|
814 | |
---|
815 | READ(61, *, iostat = ier) toto(:) |
---|
816 | READ(61, *, iostat = ier) toto(:) |
---|
817 | READ(61, *, iostat = ier) toto(:) |
---|
818 | READ(61, *, iostat = ier) toto(:) |
---|
819 | READ(61, *, iostat = ier) toto(:) |
---|
820 | |
---|
821 | READ(61, *, iostat = ier) toto(:) |
---|
822 | READ(61, *, iostat = ier) toto(:) |
---|
823 | READ(61, *, iostat = ier) toto(:) |
---|
824 | READ(61, *, iostat = ier) toto(:) |
---|
825 | READ(61, *, iostat = ier) toto(:) |
---|
826 | |
---|
827 | READ(61, *, iostat = ier) toto(:) |
---|
828 | READ(61, *, iostat = ier) toto(:) |
---|
829 | |
---|
830 | intakemax(:,:)=intakemax_t |
---|
831 | wanimal(:,:)=wanimal_t |
---|
832 | DO h=1,ncut |
---|
833 | wshtotcutinit(:,:,h)=wshtotcutinit_t(h) |
---|
834 | END DO |
---|
835 | CLOSE (61) |
---|
836 | WRITE(numout,*) 'Animal type',Type_Animal |
---|
837 | |
---|
838 | ! 1.4 set constantes and initialise variables allocated above |
---|
839 | |
---|
840 | ! 1.4.1 initialisation the variables lied on animals cattle or sheep ? |
---|
841 | ! Type_Animal = 1,2,3 : Dairy cows, suckler cows, cows in old module |
---|
842 | ! Type_Animal = 4,5 : Dairy heifers, suckler heifers |
---|
843 | ! Type_Animal = 6 : sheep in old module |
---|
844 | IF (Type_Animal==3) THEN ! old module |
---|
845 | !090810 AIG changement du seuil de sortie des animaux Animalwgrazingmin trop faible |
---|
846 | ! changement de AnimalkintakeM pour garder que l'ingere garde la meme pente |
---|
847 | ! en fonction de la biomasse disponible et pour eviter un artefact de calcul |
---|
848 | ! Animalwgrazingmin = 0.03 ! Threshold shoot dry matter, under which animals are moved out for old module (kg.m-2) |
---|
849 | Animalwgrazingmin(:,:) = 0.03 ! N. Vuichard |
---|
850 | !AnimalkintakeM = 0.18 ! AI Graux |
---|
851 | AnimalkintakeM(:,:) = 0.1 ! N. Vuichard |
---|
852 | AnimalDiscremineQualite(:,:) = 2 ! AI Graux |
---|
853 | ELSEIF (Type_Animal .EQ. 6)THEN ! Sheep |
---|
854 | Animalwgrazingmin(:,:) = 0.015 |
---|
855 | AnimalkintakeM(:,:) = 0.045 |
---|
856 | AnimalDiscremineQualite(:,:) = 3 |
---|
857 | ELSE !new module |
---|
858 | !Animalwgrazingmin = 0.11 ! AI Graux ! unsued in the new module |
---|
859 | !AnimalkintakeM = 0.18 ! AI Graux ! unsued in the new module |
---|
860 | AnimalDiscremineQualite(:,:) = 2 ! AI Graux |
---|
861 | ENDIF ! Type_Animal |
---|
862 | |
---|
863 | ! 1.4.2 concentrations : mean value |
---|
864 | c(:,:) = 0.0365122 ! 4.22e-02 |
---|
865 | n(:,:) = 0.00732556 ! 8.17e-03 |
---|
866 | napo(:,:) = 0.000542054 ! 6.39e-04 |
---|
867 | nsym(:,:) = 0.0108071 ! 6.15e-03 |
---|
868 | fn(:,:) = 0.0316223 ! 4.15e-02 ! 2.64e-02 |
---|
869 | ntot(:,:) = 0.03471895 ! 2.89e-02 |
---|
870 | |
---|
871 | ! 1.4.3 initialisations of variables allocated above |
---|
872 | intake(:,:) = 0.0 |
---|
873 | intake_litter(:,:) = 0.0 |
---|
874 | intake_animal_litter(:,:) = 0.0 |
---|
875 | grazing_litter(:,:) = 2 |
---|
876 | litter_avail_totDM(:,:) = 0.0 |
---|
877 | devstage(:,:) = 0.0 |
---|
878 | faecesc(:,:) = 0.0 |
---|
879 | faecesn(:,:) = 0.0 |
---|
880 | urinen(:,:) = 0.0 |
---|
881 | urinec(:,:) = 0.0 |
---|
882 | nel(:,:) = 0.0 |
---|
883 | nanimaltot(:,:) = 0.0 |
---|
884 | !grazingcstruct(:,:) = 0.0 |
---|
885 | !grazingnstruct(:,:) = 0.0 |
---|
886 | tgrowth(:,:) = 0.0 |
---|
887 | wshtot(:,:) = (biomass(:,:,ileaf,icarbon) + biomass(:,:,isapabove,icarbon) + & |
---|
888 | & biomass(:,:,ifruit,icarbon))/(1000*CtoDM) ! Unit: kgDM/m2 |
---|
889 | wsh(:,:) = wshtot(:,:) / (1.0 + (mc /12.0)*c(:,:) + (mn /14.0)*n(:,:) ) |
---|
890 | wshtotinit(:,:) = wshtot(:,:) |
---|
891 | wrtot(:,:) = (biomass(:,:,iroot,icarbon) + biomass(:,:,isapbelow,icarbon))/ & |
---|
892 | & (1000*CtoDM) ! Unit: kg/m2 |
---|
893 | wr(:,:) = wrtot(:,:) / (1.0 + (mc /12.0)*c(:,:) + (mn /14.0)*n(:,:) ) |
---|
894 | wnapo(:,:) = 0.0 |
---|
895 | wnsym(:,:) = 0.0 |
---|
896 | mux(:,:) = 0.0 |
---|
897 | mugmean(:,:) = 0.0 |
---|
898 | sigx(:,:) = 0.0 |
---|
899 | sigy(:,:) = 0.0 |
---|
900 | gmeanslope(:,:) = 0.0 |
---|
901 | gzero(:,:) = 0.0 |
---|
902 | gcor(:,:) = 0.0 |
---|
903 | countschedule(:,:) = 0 |
---|
904 | cuttingend(:,:) = 0 |
---|
905 | regcount(:,:) = 1 |
---|
906 | gmean(:,:,:) = 0.0 |
---|
907 | tgmean(:,:,:) = 0.0 |
---|
908 | wc_frac(:,:) = 0.0 |
---|
909 | wgn(:,:) = 0.0 |
---|
910 | tasum(:,:) = 0.0 |
---|
911 | loss(:,:) = 0.0 |
---|
912 | lossc(:,:) = 0.0 |
---|
913 | lossn(:,:) = 0.0 |
---|
914 | tlossstart(:,:) = 0.0 |
---|
915 | wshcutinit(:,:) = 0.0 |
---|
916 | deltatt = dt |
---|
917 | fertcount(:,:) = 0.0 |
---|
918 | c2nratiostruct(:,:) = 150.0 |
---|
919 | nfertammtot(:,:) = 0.0 |
---|
920 | nfertnittot(:,:) = 0.0 |
---|
921 | nfertammtotyear(:,:) = 0.0 |
---|
922 | nfertnittotyear(:,:) = 0.0 |
---|
923 | nfertammtotprevyear(:,:) = 0.0 |
---|
924 | nfertnittotprevyear(:,:) = 0.0 |
---|
925 | fcOrganicFertmetabolic(:,:) = 0.0 |
---|
926 | fcOrganicFertstruct(:,:) = 0.0 |
---|
927 | fnOrganicFertmetabolic(:,:) = 0.0 |
---|
928 | fnOrganicFertstruct(:,:) = 0.0 |
---|
929 | fnOrganicFerturine(:,:) = 0.0 |
---|
930 | flag_fertilisation(:,:) = 0 |
---|
931 | fertil_year(:,:) = .TRUE. |
---|
932 | tcut_verif(:,:,:) = .FALSE. |
---|
933 | tfert_verif(:,:,:) = .FALSE. |
---|
934 | tfert_verif2(:,:,:) = .FALSE. |
---|
935 | tfert_verif3(:,:,:) = .FALSE. |
---|
936 | nsatur_somerror_temp(:,:) = 0.0 |
---|
937 | nsatur_somerror(:,:) = 0.0 |
---|
938 | stoplimitant(:,:) = 0 |
---|
939 | fertcount_start(:,:) = 0 |
---|
940 | fertcount_current(:,:) = 0 |
---|
941 | nnonlimit_SOMerror(:,:) = 0.0 |
---|
942 | nnonlimit_SOMerrormax(:,:) = 0.5 |
---|
943 | controle_azote_sum_mem(:,:) = 0.0 |
---|
944 | n_auto(:,:) = 4 |
---|
945 | flag_fertilisation(:,:) = 0 |
---|
946 | YIELD_RETURN(:,:) = 0.0 |
---|
947 | sr_ugb_init(:) = 0.0 |
---|
948 | compt_cut(:,:) =0.0 |
---|
949 | frequency_cut(:,:) =0.0 |
---|
950 | sr_wild(:,:) = 0.0 |
---|
951 | flag_cutting(:,:) = 0 |
---|
952 | tamean1(:) = 273.0 |
---|
953 | tamean2(:) = 273.0 |
---|
954 | tamean3(:) = 273.0 |
---|
955 | tamean4(:) = 273.0 |
---|
956 | tamean5(:) = 273.0 |
---|
957 | tamean6(:) = 273.0 |
---|
958 | tameand(:) = 273.0 |
---|
959 | tameanw(:) = 0.0 |
---|
960 | tacumm(:) = 0.0 |
---|
961 | tacummprev(:) = 0.0 |
---|
962 | tsoilcumm(:) = 0.0 |
---|
963 | tsoilcummprev(:) = 0.0 |
---|
964 | tsoilmeand(:) = 273.0 |
---|
965 | tcut0(:,:) = 0.0 |
---|
966 | N_fert_total(:,:) = 0.0 |
---|
967 | Fert_on(:,:) = 0.0 |
---|
968 | Fert_sn(:,:) = 0.0 |
---|
969 | Fert_PRP(:,:) = 0.0 |
---|
970 | ! 1.5 Define PFT that used for optimization, cutting, and grazing |
---|
971 | DO j=2,nvm |
---|
972 | IF (is_grassland_cut(j) .AND. (.NOT. is_grassland_grazed(j)) .AND. & |
---|
973 | (.NOT. is_c4(j)) .AND. (.NOT.is_tree(j))) THEN |
---|
974 | mcut_C3=j |
---|
975 | END IF |
---|
976 | IF (is_grassland_manag(j) .AND. (.NOT. is_grassland_cut(j)) .AND. & |
---|
977 | (.NOT.is_grassland_grazed(j)) .AND. (.NOT. is_c4(j)) .AND. & |
---|
978 | (.NOT. is_tree(j))) THEN |
---|
979 | mauto_C3=j |
---|
980 | END IF |
---|
981 | IF (is_grassland_manag(j) .AND. (is_grassland_grazed(j)) .AND. & |
---|
982 | (.NOT. is_grassland_cut(j)) .AND. (.NOT. is_c4(j)) .AND. & |
---|
983 | (.NOT. is_tree(j))) THEN |
---|
984 | mgraze_C3=j |
---|
985 | END IF |
---|
986 | IF (is_grassland_cut(j) .AND. (.NOT. is_grassland_grazed(j)) .AND. & |
---|
987 | (is_c4(j)) .AND. (.NOT. is_tree(j))) THEN |
---|
988 | mcut_C4=j |
---|
989 | END IF |
---|
990 | IF ( is_grassland_manag(j) .AND. (.NOT. is_grassland_cut(j)) .AND. & |
---|
991 | (.NOT. is_grassland_grazed(j)) .AND. (is_c4(j)) .AND. & |
---|
992 | (.NOT. is_tree(j))) THEN |
---|
993 | mauto_C4=j |
---|
994 | END IF |
---|
995 | IF ( is_grassland_manag(j) .AND. (is_grassland_grazed(j)) .AND. & |
---|
996 | (.NOT. is_grassland_cut(j)) .AND. (is_c4(j)) .AND. & |
---|
997 | (.NOT. is_tree(j))) THEN |
---|
998 | mgraze_C4=j |
---|
999 | END IF |
---|
1000 | IF ((.NOT. is_grassland_manag(j)) .AND. (.NOT. is_grassland_grazed(j)) .AND. & |
---|
1001 | (.NOT. is_grassland_cut(j)) .AND. (.NOT. is_c4(j)) .AND. & |
---|
1002 | (.NOT. is_tree(j)) .AND. natural(j)) THEN |
---|
1003 | mnatural_C3=j |
---|
1004 | END IF |
---|
1005 | IF ((.NOT. is_grassland_manag(j)) .AND. (.NOT. is_grassland_grazed(j)).AND. & |
---|
1006 | (.NOT. is_grassland_cut(j)) .AND. (is_c4(j)) .AND. & |
---|
1007 | (.NOT. is_tree(j)) .AND. natural(j)) THEN |
---|
1008 | mnatural_C4=j |
---|
1009 | END IF |
---|
1010 | END DO ! nvm |
---|
1011 | !WRITE(numout,*) 'PFT_M',mauto_C3,mcut_C3,mgraze_C3,mauto_C4,mcut_C4,mgraze_C4,mnatural_C3,mnatural_C4 |
---|
1012 | ! avoid PFT = 0 |
---|
1013 | IF (mauto_C4 .EQ. 0) THEN |
---|
1014 | mauto_C4=1 |
---|
1015 | ENDIF |
---|
1016 | IF (mcut_C4 .EQ. 0) THEN |
---|
1017 | mcut_C4=1 |
---|
1018 | ENDIF |
---|
1019 | IF (mgraze_C4 .EQ. 0) THEN |
---|
1020 | mgraze_C4=1 |
---|
1021 | ENDIF |
---|
1022 | IF (mauto_C3 .EQ. 0) THEN |
---|
1023 | mauto_C3=1 |
---|
1024 | ENDIF |
---|
1025 | IF (mcut_C3 .EQ. 0) THEN |
---|
1026 | mcut_C3=1 |
---|
1027 | ENDIF |
---|
1028 | IF (mgraze_C3 .EQ. 0) THEN |
---|
1029 | mgraze_C3=1 |
---|
1030 | ENDIF |
---|
1031 | IF (mnatural_C4 .EQ. 0) THEN |
---|
1032 | mnatural_C4=1 |
---|
1033 | ENDIF |
---|
1034 | IF (mnatural_C3 .EQ. 0) THEN |
---|
1035 | mnatural_C3=1 |
---|
1036 | ENDIF |
---|
1037 | WRITE(numout,*) 'PFT_M2',mauto_C3,mcut_C3,mgraze_C3,mauto_C4,mcut_C4,mgraze_C4,mnatural_C3,mnatural_C4 |
---|
1038 | |
---|
1039 | ! 1.6 Initialization of management related parameters |
---|
1040 | ! for each management option |
---|
1041 | IF (f_postauto .EQ. 0) THEN |
---|
1042 | IF (f_autogestion .EQ. 1) THEN |
---|
1043 | ! 1: auto cut for PFT m_auto |
---|
1044 | ! keep wshtotsum for mauto_C3 and C4 |
---|
1045 | sr_ugb = 1e-5 |
---|
1046 | compt_ugb = 0.0 |
---|
1047 | nb_ani = 5e-6 |
---|
1048 | grazed_frac = 0.50 |
---|
1049 | ELSE IF (f_autogestion .EQ. 2) THEN |
---|
1050 | ! 2: auto graze for PFT m_auto |
---|
1051 | ! keep wshtotsum for each year calculation of import_yield |
---|
1052 | cut_year = 10 |
---|
1053 | CALL getin_p('GRM_NB_CUT_YEAR',cut_year) |
---|
1054 | WHERE ( wshtotsum(:,mauto_C3) .GE. 0.0) |
---|
1055 | import_yield(:,mauto_C3) = wshtotsum(:,mauto_C3) / cut_year |
---|
1056 | ENDWHERE |
---|
1057 | WHERE ( wshtotsum(:,mauto_C4) .GE. 0.0) |
---|
1058 | import_yield(:,mauto_C4) = wshtotsum(:,mauto_C4) / cut_year |
---|
1059 | ENDWHERE |
---|
1060 | ! keep sr_ugb, compt_ugb, nb_ani, grazed_frac |
---|
1061 | ! infact it could be keep just the value read from restart |
---|
1062 | compt_ugb = 0.0 |
---|
1063 | ELSE IF ((f_autogestion .GE. 3) .AND. & |
---|
1064 | (f_autogestion .LE. 5)) THEN |
---|
1065 | ! 3: auto cut and graze for PFT m_cut and m_grazed with increasing sr_ugb |
---|
1066 | ! 4: auto cut and graze for PFT m_cut and m_grazed with constant sr_ugb |
---|
1067 | ! 5: auto graze for PFT m_grazed with grazing litter during winter for LGM |
---|
1068 | ! keep the grazing variables from restart |
---|
1069 | compt_ugb = 0.0 |
---|
1070 | wshtotsum (:,:) = 0.0 |
---|
1071 | import_yield (:,:) = 0.0 |
---|
1072 | ELSE ! f_postauto = 0 and f_autogestion > 5 |
---|
1073 | sr_ugb = 1e-5 |
---|
1074 | compt_ugb = 0.0 |
---|
1075 | nb_ani = 5e-6 |
---|
1076 | grazed_frac = 0.50 |
---|
1077 | wshtotsum (:,:) = 0.0 |
---|
1078 | import_yield (:,:) = 0.0 |
---|
1079 | ENDIF ! f_autogestion |
---|
1080 | ELSE IF (f_postauto .EQ. 1) THEN |
---|
1081 | ! 1: after f_autogestion=2 with varied sr_ugb and nb_ani |
---|
1082 | ! ONLY run for one years |
---|
1083 | tmp_sr_ugb_C3(:)=sr_ugb(:,mauto_C3) |
---|
1084 | tmp_sr_ugb_C4(:)=sr_ugb(:,mauto_C4) |
---|
1085 | sr_ugb = 1e-5 |
---|
1086 | sr_ugb(:,mgraze_C3) = tmp_sr_ugb_C3(:) |
---|
1087 | sr_ugb(:,mgraze_C4) = tmp_sr_ugb_C4(:) |
---|
1088 | tmp_nb_ani_C3(:)=nb_ani(:,mauto_C3) |
---|
1089 | tmp_nb_ani_C4(:)=nb_ani(:,mauto_C4) |
---|
1090 | nb_ani = 5e-6 |
---|
1091 | nb_ani(:,mgraze_C3) = tmp_nb_ani_C3(:) |
---|
1092 | nb_ani(:,mgraze_C4) = tmp_nb_ani_C4(:) |
---|
1093 | tmp_grazed_frac_C3(:)=grazed_frac(:,mauto_C3) |
---|
1094 | tmp_grazed_frac_C4(:)=grazed_frac(:,mauto_C4) |
---|
1095 | grazed_frac = 0.50 |
---|
1096 | grazed_frac(:,mgraze_C3) = tmp_grazed_frac_C3(:) |
---|
1097 | grazed_frac(:,mgraze_C4) = tmp_grazed_frac_C4(:) |
---|
1098 | WHERE (sr_ugb(:,mgraze_C3) .GT. 0.0) |
---|
1099 | grazed_frac(:,mgraze_C3) = nb_ani(:,mgraze_C3)/sr_ugb(:,mgraze_C3) |
---|
1100 | ELSEWHERE |
---|
1101 | grazed_frac(:,mgraze_C3) = tmp_grazed_frac_C3(:) |
---|
1102 | ENDWHERE |
---|
1103 | WHERE (sr_ugb(:,mgraze_C4) .GT. 0.0) |
---|
1104 | grazed_frac(:,mgraze_C4) = nb_ani(:,mgraze_C4)/sr_ugb(:,mgraze_C4) |
---|
1105 | ELSEWHERE |
---|
1106 | grazed_frac(:,mgraze_C4) = tmp_grazed_frac_C4(:) |
---|
1107 | ENDWHERE |
---|
1108 | compt_ugb = 0.0 |
---|
1109 | wshtotsum (:,:) = 0.0 |
---|
1110 | tmp_import_yield_C3(:) = import_yield(:,mauto_C3) |
---|
1111 | tmp_import_yield_C4(:) = import_yield(:,mauto_C4) |
---|
1112 | import_yield = 0.0 |
---|
1113 | import_yield (:,mgraze_C3) = tmp_import_yield_C3(:) |
---|
1114 | import_yield (:,mgraze_C4) = tmp_import_yield_C4(:) |
---|
1115 | ELSE IF (f_postauto .GE. 2) THEN |
---|
1116 | ! 2: after f_postauto=1 with varied sr_ugb and nb_ani |
---|
1117 | ! 3: simulation with constant sr_ugb and grazed_frac |
---|
1118 | ! 4: simulation with increasing sr_ugb and constant grazed_frac |
---|
1119 | ! 5: global simulation with prescribed sr_ugb from external file |
---|
1120 | ! keep the grazing variables from restart |
---|
1121 | compt_ugb = 0.0 |
---|
1122 | wshtotsum (:,:) = 0.0 |
---|
1123 | ! keep import_yield from restart for mean value saving |
---|
1124 | ! import_yield = 0.0 |
---|
1125 | ELSE |
---|
1126 | sr_ugb = 1e-5 |
---|
1127 | compt_ugb = 0.0 |
---|
1128 | nb_ani = 5e-6 |
---|
1129 | grazed_frac = 0.50 |
---|
1130 | compt_ugb = 0.0 |
---|
1131 | wshtotsum (:,:) = 0.0 |
---|
1132 | import_yield = 0.0 |
---|
1133 | ENDIF ! f_autogestion or f_postauto |
---|
1134 | |
---|
1135 | wshtotsumprevyear(:,:) = 0.0 |
---|
1136 | DM_cutyearly(:,:)=0.0 |
---|
1137 | C_cutyearly(:,:) =0.0 |
---|
1138 | wshtotsumprev (:,:) = 0.0 |
---|
1139 | controle_azote(:,:,:) = 0.0 |
---|
1140 | controle_azote_sum(:,:) = 0.0 |
---|
1141 | trampling(:,:) = 0.0 |
---|
1142 | count_year = 1 |
---|
1143 | year_count1 = 0 |
---|
1144 | year_count2 = 0 |
---|
1145 | tcut(:,:,:) = 500.0 |
---|
1146 | tfert(:,:,:) = 500.0 |
---|
1147 | nfertamm(:,:,:) = 0.0 |
---|
1148 | nfertnit(:,:,:) = 0.0 |
---|
1149 | nanimal(:,:,:) = 0.0 |
---|
1150 | tanimal(:,:,:) = 500.0 |
---|
1151 | danimal(:,:,:) = 0.0 |
---|
1152 | nliquidmanure(:,:,:) = 0.0 |
---|
1153 | nslurry(:,:,:) = 0.0 |
---|
1154 | nsolidmanure(:,:,:) = 0.0 |
---|
1155 | legume_fraction(:,:) =0.0 |
---|
1156 | soil_fertility(:,:) = 1.0 |
---|
1157 | ndeposition(:,:) = 0.0 |
---|
1158 | PIYcow(:,:,:) = 0.0 |
---|
1159 | PIMcow(:,:,:) = 0.0 |
---|
1160 | BCSYcow(:,:,:) = 0.0 |
---|
1161 | BCSMcow(:,:,:) = 0.0 |
---|
1162 | PICcow(:,:,:) = 0.0 |
---|
1163 | AGE_cow_P(:,:,:) = 36.0 |
---|
1164 | AGE_cow_M(:,:,:) = 54.0 |
---|
1165 | Forage_quantity(:,:,:) = 0 |
---|
1166 | |
---|
1167 | IF (blabla_pasim) PRINT *, 'PASIM : end memory allocation' |
---|
1168 | |
---|
1169 | ! 1.7 read management maps/files |
---|
1170 | ! get_map of 1 spatial .nc file or 0 old txt/dat file |
---|
1171 | f_management_map = 0 |
---|
1172 | CALL getin_p ('GRM_F_MANAGEMENT_MAP',f_management_map) |
---|
1173 | WRITE(numout,*) 'GRM_F_MANAGEMENT_MAP',f_management_map |
---|
1174 | f_deposition_map = 0 |
---|
1175 | CALL getin_p ('GRM_F_DEPOSITION_MAP',f_deposition_map) |
---|
1176 | WRITE(numout,*) 'GRM_F_DEPOSITION_MAP',f_deposition_map |
---|
1177 | f_grazing_map = 0 |
---|
1178 | CALL getin_p ('GRM_F_GRAZING_MAP',f_grazing_map) |
---|
1179 | WRITE(numout,*) 'GRM_F_GRAZING_MAP',f_grazing_map |
---|
1180 | |
---|
1181 | IF (f_management_map) THEN |
---|
1182 | management_map='GRM_input.nc' |
---|
1183 | !'/ccc/work/cont003/dsm/p529chan/data/eur_management_interpolated.nc' |
---|
1184 | CALL getin_p('GRM_MANAGEMENT_MAP',management_map) |
---|
1185 | WRITE(numout,*) 'GRM_MANAGEMENT_MAP',management_map |
---|
1186 | fertility_map='/ccc/work/cont003/dsm/p529chan/data/eur_fertility.nc' |
---|
1187 | CALL getin_p('GRM_FERTILITY_MAP',fertility_map) |
---|
1188 | WRITE(numout,*) 'GRM_FERTILITY_MAP',fertility_map |
---|
1189 | |
---|
1190 | deposition_map='GRM_input.nc' |
---|
1191 | !'/ccc/work/cont003/dsm/p529chan/data/eur_Ndeposition_NCAR.nc' |
---|
1192 | CALL getin_p('GRM_DEPOSITION_MAP',deposition_map) |
---|
1193 | WRITE(numout,*) 'GRM_DEPOSITION_MAP',deposition_map |
---|
1194 | grazing_map='GRM_input.nc' |
---|
1195 | !'/ccc/scratch/cont003/dsm/p529chan/glbdata/glb_sr_ugb_1961_2010_adjusted.nc' |
---|
1196 | CALL getin_p('GRM_GRAZING_MAP',grazing_map) |
---|
1197 | WRITE(numout,*) 'GRM_GRAZING_MAP',grazing_map |
---|
1198 | |
---|
1199 | ! read management map |
---|
1200 | CALL reading_map_manag(& |
---|
1201 | npts,lalo, neighbours, resolution, contfrac, & |
---|
1202 | count_year, nb_year_management,& |
---|
1203 | management_intensity,& |
---|
1204 | management_start,& |
---|
1205 | tcut, tfert, nfertamm, nfertnit,& |
---|
1206 | nanimal, tanimal, danimal,& |
---|
1207 | nliquidmanure, nslurry, nsolidmanure,& |
---|
1208 | legume_fraction,soil_fertility,& |
---|
1209 | deposition_start,ndeposition,sr_ugb,sr_wild) |
---|
1210 | ! calculate effect of N fertilizer to vcmax |
---|
1211 | CALL calc_N_limfert(& |
---|
1212 | npts,nfertamm, nfertnit,& |
---|
1213 | nliquidmanure, nslurry, nsolidmanure,& |
---|
1214 | legume_fraction,soil_fertility,ndeposition,& |
---|
1215 | N_fert_total,N_limfert) |
---|
1216 | ELSE |
---|
1217 | ! re-initial management variables |
---|
1218 | tcut(:,:,:) = 500.0 |
---|
1219 | tfert(:,:,:) = 500.0 |
---|
1220 | nfertamm(:,:,:) = 0.0 |
---|
1221 | nfertnit(:,:,:) = 0.0 |
---|
1222 | nanimal(:,:,:) = 0.0 |
---|
1223 | tanimal(:,:,:) = 500.0 |
---|
1224 | danimal(:,:,:) = 0.0 |
---|
1225 | nliquidmanure(:,:,:) = 0.0 |
---|
1226 | nslurry(:,:,:) = 0.0 |
---|
1227 | nsolidmanure(:,:,:) = 0.0 |
---|
1228 | ndeposition(:,:) = 0.0 |
---|
1229 | !!! delete FIRE_MANAGEMENT READ: not used in LGM |
---|
1230 | ! CALL getin_p('FILE_MANAGEMENT',file_management) |
---|
1231 | ! WRITE(numout,*) 'FILE_MANAGEMENT',file_management |
---|
1232 | ! IF (blabla_pasim) PRINT *, 'PASIM : reading management conditions' |
---|
1233 | ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
1234 | ! !!!!!!!!! READ NEW MANAGEMENT TXT DAT FILE gmjc |
---|
1235 | ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
1236 | ! CALL reading_new_animal(& |
---|
1237 | ! npts , & |
---|
1238 | ! nb_year_management , & |
---|
1239 | ! tcutmodel , & |
---|
1240 | ! tcut , & |
---|
1241 | ! tfert , & |
---|
1242 | ! nfertamm , & |
---|
1243 | ! nfertnit , & |
---|
1244 | ! nanimal , & |
---|
1245 | ! tanimal , & |
---|
1246 | ! danimal , & |
---|
1247 | ! nliquidmanure , & |
---|
1248 | ! nslurry , & |
---|
1249 | ! nsolidmanure , & |
---|
1250 | ! PIYcow , & |
---|
1251 | ! PIMcow , & |
---|
1252 | ! BCSYcow , & |
---|
1253 | ! BCSMcow , & |
---|
1254 | ! PICcow , & |
---|
1255 | ! AGE_cow_P , & |
---|
1256 | ! AGE_cow_M , & |
---|
1257 | ! Forage_quantity) |
---|
1258 | ! CALL getin('SOIL_FERTILITY',fertility_legume_t) |
---|
1259 | ! soil_fertility(:,:)=fertility_legume_t |
---|
1260 | ! CALL getin('LEGUME_FRACTION',fertility_legume_t) |
---|
1261 | ! legume_fraction(:,:)=fertility_legume_t |
---|
1262 | ! |
---|
1263 | ! CALL calc_N_limfert(& |
---|
1264 | ! npts,nfertamm, nfertnit,& |
---|
1265 | ! nliquidmanure, nslurry, nsolidmanure,& |
---|
1266 | ! legume_fraction,soil_fertility,ndeposition,& |
---|
1267 | ! N_fert_total,N_limfert) |
---|
1268 | |
---|
1269 | ENDIF ! f_management_map |
---|
1270 | |
---|
1271 | DO k=1,nstocking |
---|
1272 | WHERE (tfert(:,:,k) .NE. 500) |
---|
1273 | apport_azote(:,:) = apport_azote(:,:) + nfertamm(:,:,k) + nfertnit(:,:,k) |
---|
1274 | END WHERE |
---|
1275 | END DO |
---|
1276 | !************************************************ |
---|
1277 | !************************************************ |
---|
1278 | ! modifs Nico 20/07/2004 |
---|
1279 | !************************************************ |
---|
1280 | !************************************************ |
---|
1281 | ! MODIF INN |
---|
1282 | IF (f_nonlimitant .EQ. 1) THEN |
---|
1283 | IF (f_autogestion .NE. 2) THEN |
---|
1284 | WHERE (tcut(:,:,1) .EQ. 500.0) |
---|
1285 | stoplimitant(:,:) = 1 |
---|
1286 | END WHERE |
---|
1287 | ENDIF |
---|
1288 | DO j=2,nvm |
---|
1289 | DO i=1,npts |
---|
1290 | IF (tfert(i,j,1) .EQ. 500.0) THEN |
---|
1291 | stoplimitant(i,j) = 1 |
---|
1292 | ELSE |
---|
1293 | compt_fert = 1 |
---|
1294 | min_fert = 1 |
---|
1295 | DO WHILE (tfert(i,j,compt_fert) .NE. 500.0) |
---|
1296 | ! print *, compt_fert, min_fert |
---|
1297 | ! print *, controle_azote(i,j,compt_fert) |
---|
1298 | ! print *, controle_azote(i,j,min_fert) |
---|
1299 | IF (controle_azote(i,j,compt_fert) .GT. controle_azote(i,j,min_fert)) THEN |
---|
1300 | min_fert = compt_fert |
---|
1301 | ENDIF |
---|
1302 | compt_fert = compt_fert + 1 |
---|
1303 | END DO |
---|
1304 | fert_max = compt_fert - 1 |
---|
1305 | IF ((min_fert - 1) .EQ. 0) THEN |
---|
1306 | fertcount_start(i,j) = fert_max |
---|
1307 | ELSE |
---|
1308 | fertcount_start(i,j) = min_fert - 1 |
---|
1309 | ENDIF |
---|
1310 | i_compt = min_fert + 1 |
---|
1311 | DO WHILE ( tfert(i,j,i_compt) .NE. 500.0 ) |
---|
1312 | controle_azote(i,j,i_compt) = controle_azote(i,j,i_compt - 1)+& |
---|
1313 | controle_azote(i,j,i_compt) |
---|
1314 | i_compt = i_compt + 1 |
---|
1315 | END DO |
---|
1316 | IF ( min_fert .NE. 1. ) THEN |
---|
1317 | controle_azote(i,j,1) = controle_azote(i,j,1) + controle_azote(i,j,fert_max) |
---|
1318 | i_compt = 2 |
---|
1319 | DO WHILE (i_compt .NE. min_fert) |
---|
1320 | controle_azote(i,j,i_compt) = controle_azote(i,j,i_compt-1)+& |
---|
1321 | controle_azote(i,j,i_compt) |
---|
1322 | i_compt = i_compt + 1 |
---|
1323 | END DO |
---|
1324 | ENDIF |
---|
1325 | ENDIF |
---|
1326 | END DO ! i |
---|
1327 | END DO !j |
---|
1328 | fertcount_current(:,:) = fertcount_start(:,:) |
---|
1329 | ENDIF |
---|
1330 | ! fin initialisation auto gestion nicolas |
---|
1331 | END IF init_grassland |
---|
1332 | |
---|
1333 | ! 2 updating variables each day (new_day) |
---|
1334 | ! update the root/shoot dry matter variables |
---|
1335 | wshtot(:,:) = (biomass(:,:,ileaf,icarbon) + biomass(:,:,isapabove,icarbon) + & |
---|
1336 | & biomass(:,:,ifruit,icarbon))/(1000*CtoDM) ! Unit: kgDM/m2 |
---|
1337 | wsh(:,:) = wshtot(:,:) / (1.0 + (mc /12.0)*c(:,:) + (mn /14.0)*n(:,:) ) |
---|
1338 | wrtot(:,:) = (biomass(:,:,iroot,icarbon) + biomass(:,:,isapbelow,icarbon))/ & |
---|
1339 | & (1000*CtoDM) ! Unit: kg/m2 |
---|
1340 | wr(:,:) = wrtot(:,:) / (1.0 + (mc /12.0)*c(:,:) + (mn /14.0)*n(:,:) ) |
---|
1341 | |
---|
1342 | n_day : IF (new_day) THEN |
---|
1343 | |
---|
1344 | ! GMEAN |
---|
1345 | ! Taux de croissance moyen de la repousse |
---|
1346 | h = 1 |
---|
1347 | |
---|
1348 | DO WHILE (h .LT. ngmean) |
---|
1349 | gmean(:,:,h ) = gmean(:,:,h +1) |
---|
1350 | h = h + 1 |
---|
1351 | END DO |
---|
1352 | |
---|
1353 | DO j=2,nvm |
---|
1354 | DO i=1,npts |
---|
1355 | IF ((tgrowth(i,j) .GT. 0.0) .AND. (devstage(i,j) .GE. 2.0)) THEN |
---|
1356 | gmean(i,j,ngmean) = MAX (0.0, (wshtot(i,j) - wshtotcutinit(i,j,regcount(i,j)))/tgrowth(i,j)) |
---|
1357 | ELSEIF ((tgrowth(i,j) .GT. 0.0) .AND. (devstage(i,j) .GT. 0.0) .AND. & |
---|
1358 | & (regcount(i,j) .GT. 1)) THEN |
---|
1359 | gmean(i,j,ngmean) = MAX (0.0, (wshtot(i,j) - wshtotcutinit(i,j,regcount(i,j)))/tgrowth(i,j)) |
---|
1360 | ELSEIF ((tgrowth(i,j) .GT. 0.0) .AND. (devstage(i,j) .GT. 0.0) .AND. & |
---|
1361 | & (regcount(i,j) .EQ. 1)) THEN |
---|
1362 | gmean(i,j,ngmean) = MAX (0.0, (wshtot(i,j) - wshtotinit(i,j))/tgrowth(i,j)) |
---|
1363 | ELSE |
---|
1364 | gmean(i,j,ngmean) = 0.0 |
---|
1365 | ENDIF |
---|
1366 | END DO |
---|
1367 | ENDDO |
---|
1368 | |
---|
1369 | h = 1 |
---|
1370 | DO WHILE (h .LE. ngmean) |
---|
1371 | tgmean(:,:,h) = h |
---|
1372 | h = h + 1 |
---|
1373 | END DO |
---|
1374 | |
---|
1375 | END IF n_day |
---|
1376 | |
---|
1377 | ! 3 updating variables at the end of the year (last day = new_year = |
---|
1378 | ! EndOfYear |
---|
1379 | n_year : IF (new_year) THEN |
---|
1380 | WRITE(numout,*) 'EndOfYear gm' |
---|
1381 | tcut_verif(:,:,:) = .FALSE. |
---|
1382 | fertil_year(:,:) = .TRUE. |
---|
1383 | tasum(:,:) = 0.0 |
---|
1384 | regcount(:,:) = 1 |
---|
1385 | nfertammtotprevyear(:,:) = nfertammtot |
---|
1386 | nfertnittotprevyear(:,:) = nfertnittot |
---|
1387 | fertcount(:,:) = 0 |
---|
1388 | nfertammtotyear(:,:) = 0.0 |
---|
1389 | nfertnittotyear(:,:) = 0.0 |
---|
1390 | fnatmsum(:,:) = 0.0 |
---|
1391 | tfert_verif(:,:,:) = .FALSE. |
---|
1392 | tfert_verif2(:,:,:) = .FALSE. |
---|
1393 | tfert_verif3(:,:,:) = .FALSE. |
---|
1394 | fcOrganicFertmetabolicsum(:,:) = 0.0 |
---|
1395 | fcOrganicFertstructsum(:,:) = 0.0 |
---|
1396 | fnOrganicFertmetabolicsum(:,:) = 0.0 |
---|
1397 | fnOrganicFertstructsum(:,:) = 0.0 |
---|
1398 | fnOrganicFerturinesum(:,:) = 0.0 |
---|
1399 | devstage(:,:) = 0.0 |
---|
1400 | fertcount(:,:) = 0 |
---|
1401 | tgrowth (:,:) = 0.0 |
---|
1402 | tfert_modif(:,:,:) = 500.0 |
---|
1403 | frequency_cut(:,:) = compt_cut(:,:) |
---|
1404 | compt_cut(:,:) = 0.0 |
---|
1405 | |
---|
1406 | IF (f_saturant .EQ. 1) THEN |
---|
1407 | nfertamm(:,:,:) = 0.025 |
---|
1408 | nfertnit(:,:,:) = 0.025 |
---|
1409 | nsatur_somerror(:,:) = 0.0 |
---|
1410 | nsatur_somerror_temp(:,:) = 0.0 |
---|
1411 | END IF |
---|
1412 | ! calculate annual grass forage production |
---|
1413 | DM_cutyearly(:,:)= wshtotsum(:,:)-wshtotsumprevyear(:,:) |
---|
1414 | C_cutyearly(:,:) = DM_cutyearly(:,:) * 1000 * CtoDM |
---|
1415 | ! should be after calculating the import_yield |
---|
1416 | !wshtotsumprevyear(:,:) = wshtotsum(:,:) |
---|
1417 | |
---|
1418 | ! calculate import_yield saved to restart for output |
---|
1419 | ! and for updating grazing variables in grazing subroutine |
---|
1420 | IF ((f_postauto .GE. 1) .OR. (f_autogestion .EQ. 4) .OR. & |
---|
1421 | !!!! JCMODIF 290714 for postaut = 5 |
---|
1422 | (f_autogestion .EQ. 3) ) THEN |
---|
1423 | import_yield(:,mgraze_C3) = wshtotsum(:,mcut_C3)-wshtotsumprevyear(:,mcut_C3) |
---|
1424 | wshtotsumprevyear(:,mcut_C3) = wshtotsum(:,mcut_C3) |
---|
1425 | import_yield(:,mgraze_C4) = wshtotsum(:,mcut_C4)-wshtotsumprevyear(:,mcut_C4) |
---|
1426 | wshtotsumprevyear(:,mcut_C4) = wshtotsum(:,mcut_C4) |
---|
1427 | ! if as trunk that restart and initiailize every year |
---|
1428 | ! save wshtotsumprevyear is useless |
---|
1429 | ! but if as NV driver run for many years |
---|
1430 | ! save wshtotsumprevyear is necessary because wshtotsum will keep |
---|
1431 | ! inscresing |
---|
1432 | END IF |
---|
1433 | |
---|
1434 | wshtotsumprevyear(:,:) = wshtotsum(:,:) |
---|
1435 | wshtotsumprev(:,:) = 0.0 |
---|
1436 | c(:,:) = 0.0365122 ! 4.22e-02 |
---|
1437 | n(:,:) = 0.00732556 ! 8.17e-03 |
---|
1438 | napo(:,:) = 0.000542054 ! 6.39e-04 |
---|
1439 | nsym(:,:) = 0.0108071 ! 6.15e-03 |
---|
1440 | fn(:,:) = 0.0316223 ! 4.15e-02 ! 2.64e-02 |
---|
1441 | ntot(:,:) = 0.03471895 ! 2.89e-02 |
---|
1442 | |
---|
1443 | ! count_year is useless for trunk driver |
---|
1444 | ! only necessary for NV driver run for many years |
---|
1445 | ! unless save it to restart in the future |
---|
1446 | count_year = count_year + 1 |
---|
1447 | IF (count_year .LT. 30) THEN |
---|
1448 | year_count1 = count_year-1 |
---|
1449 | year_count2 = 0 |
---|
1450 | ELSEIF (count_year .GE. 30) THEN |
---|
1451 | year_count1 = 29 |
---|
1452 | year_count2 = count_year - 29 |
---|
1453 | ELSE |
---|
1454 | year_count1 = 29 |
---|
1455 | year_count2 = 21 |
---|
1456 | ENDIF |
---|
1457 | |
---|
1458 | !JCCOMMENT There is no need to read again in standard trunk driver |
---|
1459 | !!! ! read management map at the end of year |
---|
1460 | !!! ! is only useful for NV driver and multi-year maps |
---|
1461 | !!! ! for trunk driver, the annual file will be changed every year |
---|
1462 | !!! ! and read when initialize |
---|
1463 | !!! |
---|
1464 | !!! ! get_map of spatial .nc file or old txt/dat file |
---|
1465 | !!! IF (f_management_map) THEN |
---|
1466 | !!! ! re-initial management variables |
---|
1467 | !!! tcut(:,:,:) = 500.0 |
---|
1468 | !!! tfert(:,:,:) = 500.0 |
---|
1469 | !!! nfertamm(:,:,:) = 0.0 |
---|
1470 | !!! nfertnit(:,:,:) = 0.0 |
---|
1471 | !!! nanimal(:,:,:) = 0.0 |
---|
1472 | !!! tanimal(:,:,:) = 500.0 |
---|
1473 | !!! danimal(:,:,:) = 0.0 |
---|
1474 | !!! nliquidmanure(:,:,:) = 0.0 |
---|
1475 | !!! nslurry(:,:,:) = 0.0 |
---|
1476 | !!! nsolidmanure(:,:,:) = 0.0 |
---|
1477 | !!! ndeposition(:,:) = 0.0 |
---|
1478 | !!! CALL reading_map_manag(& |
---|
1479 | !!! npts, lalo, neighbours, resolution, contfrac, & |
---|
1480 | !!! count_year, nb_year_management,& |
---|
1481 | !!! management_intensity,& |
---|
1482 | !!! management_start,& |
---|
1483 | !!! tcut, tfert, nfertamm, nfertnit,& |
---|
1484 | !!! nanimal, tanimal, danimal,& |
---|
1485 | !!! nliquidmanure, nslurry, nsolidmanure,& |
---|
1486 | !!! legume_fraction,soil_fertility,& |
---|
1487 | !!! deposition_start,ndeposition,sr_ugb,sr_wild) |
---|
1488 | !!! |
---|
1489 | !!! CALL calc_N_limfert(& |
---|
1490 | !!! npts,nfertamm, nfertnit,& |
---|
1491 | !!! nliquidmanure, nslurry, nsolidmanure,& |
---|
1492 | !!! legume_fraction,soil_fertility,ndeposition,& |
---|
1493 | !!! N_fert_total,N_limfert) |
---|
1494 | !!! |
---|
1495 | !!! ELSE |
---|
1496 | !!! IF (ANY(nb_year_management(:) .GT. 1)) THEN |
---|
1497 | !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
1498 | !!! !!!!!!!!!! READ NEW MANAGEMENT FILE gmjc |
---|
1499 | !!! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
1500 | !!! !!! delete FIRE_MANAGEMENT READ: not used in LGM |
---|
1501 | !!! ! CALL reading_new_animal(& |
---|
1502 | !!! ! npts , & |
---|
1503 | !!! ! nb_year_management , & |
---|
1504 | !!! ! tcutmodel , & |
---|
1505 | !!! ! tcut , & |
---|
1506 | !!! ! tfert , & |
---|
1507 | !!! ! nfertamm , & |
---|
1508 | !!! ! nfertnit , & |
---|
1509 | !!! ! nanimal , & |
---|
1510 | !!! ! tanimal , & |
---|
1511 | !!! ! danimal , & |
---|
1512 | !!! ! nliquidmanure , & |
---|
1513 | !!! ! nslurry , & |
---|
1514 | !!! ! nsolidmanure , & |
---|
1515 | !!! ! PIYcow , & |
---|
1516 | !!! ! PIMcow , & |
---|
1517 | !!! ! BCSYcow , & |
---|
1518 | !!! ! BCSMcow , & |
---|
1519 | !!! ! PICcow , & |
---|
1520 | !!! ! AGE_cow_P , & |
---|
1521 | !!! ! AGE_cow_M , & |
---|
1522 | !!! ! Forage_quantity) |
---|
1523 | !!! ! re-initial management variables |
---|
1524 | !!! tcut(:,:,:) = 500.0 |
---|
1525 | !!! tfert(:,:,:) = 500.0 |
---|
1526 | !!! nfertamm(:,:,:) = 0.0 |
---|
1527 | !!! nfertnit(:,:,:) = 0.0 |
---|
1528 | !!! nanimal(:,:,:) = 0.0 |
---|
1529 | !!! tanimal(:,:,:) = 500.0 |
---|
1530 | !!! danimal(:,:,:) = 0.0 |
---|
1531 | !!! nliquidmanure(:,:,:) = 0.0 |
---|
1532 | !!! nslurry(:,:,:) = 0.0 |
---|
1533 | !!! nsolidmanure(:,:,:) = 0.0 |
---|
1534 | !!! ndeposition(:,:) = 0.0 |
---|
1535 | !!! CALL calc_N_limfert(& |
---|
1536 | !!! npts,nfertamm, nfertnit,& |
---|
1537 | !!! nliquidmanure, nslurry, nsolidmanure,& |
---|
1538 | !!! legume_fraction,soil_fertility,ndeposition,& |
---|
1539 | !!! N_fert_total,N_limfert) |
---|
1540 | !!! |
---|
1541 | !!! END IF ! nb_year_management |
---|
1542 | !!! |
---|
1543 | !!! DO k=1,nstocking |
---|
1544 | !!! WHERE (tfert(:,:,k) .NE. 500) |
---|
1545 | !!! apport_azote(:,:) = apport_azote(:,:) + nfertamm(:,:,k) + nfertnit(:,:,k) |
---|
1546 | !!! END WHERE |
---|
1547 | !!! END DO |
---|
1548 | !!! |
---|
1549 | !!! END IF ! f_management_map |
---|
1550 | |
---|
1551 | END IF n_year |
---|
1552 | |
---|
1553 | ! 4 fertilization |
---|
1554 | ! Fertilisation from PaSim 2011 |
---|
1555 | ! 4.1 ****** RUN USERS OR RUN SATURANT ***** |
---|
1556 | users_or_saturant_fert : IF ((tcutmodel .EQ. 0) .AND. (f_saturant .EQ. 0)) THEN |
---|
1557 | |
---|
1558 | ! flag_fertilisation : flag for spatialization of cutting |
---|
1559 | |
---|
1560 | DO k=1,nstocking |
---|
1561 | flag_fertilisation(:,:) = 0 |
---|
1562 | |
---|
1563 | IF (ANY(tfert_verif(:,:,k) .EQV. .FALSE. )) THEN |
---|
1564 | WHERE ((tjulian .GE. tfert(:,:,k)) .AND. (tjulian .LE. tfert(:,:,k)+0.9) .AND. & |
---|
1565 | (tfert_verif(:,:,k) .EQV. .FALSE.)) |
---|
1566 | tfert_verif(:,:,k) = .TRUE. |
---|
1567 | flag_fertilisation(:,:) = 1 |
---|
1568 | END WHERE |
---|
1569 | END IF |
---|
1570 | |
---|
1571 | IF (ANY(flag_fertilisation(:,:) .EQ. 1)) THEN |
---|
1572 | CALL fertilisation_spa(& |
---|
1573 | npts , & |
---|
1574 | flag_fertilisation , & |
---|
1575 | fertcount_start , & |
---|
1576 | tjulian , & |
---|
1577 | tfert , & |
---|
1578 | nfertnittotprevyear, & |
---|
1579 | nfertammtotprevyear, & |
---|
1580 | nfertnit, nfertamm , & |
---|
1581 | fertcount , & |
---|
1582 | nfertammtot , & |
---|
1583 | nfertnittot , & |
---|
1584 | nfertammtotyear , & |
---|
1585 | nfertnittotyear , & |
---|
1586 | controle_azote_sum , & |
---|
1587 | controle_azote_sum_mem) |
---|
1588 | END IF |
---|
1589 | !jcadd Fsn calculation |
---|
1590 | WHERE ((tjulian .GE. tfert(:,:,k)) .AND. (tjulian .LE. tfert(:,:,k)+0.9)) |
---|
1591 | Fert_sn(:,:) = nfertamm(:,:,k) + nfertnit(:,:,k) |
---|
1592 | ELSEWHERE |
---|
1593 | Fert_sn(:,:) = zero |
---|
1594 | ENDWHERE |
---|
1595 | !end jcadd |
---|
1596 | END DO |
---|
1597 | !***************************************** |
---|
1598 | ! MODIFS NICO AUTO MANAGEMENT DE PASIM |
---|
1599 | !***************************************** |
---|
1600 | |
---|
1601 | ELSE IF (f_saturant .EQ. 1) THEN !***** RUN SATURANT ******* |
---|
1602 | |
---|
1603 | flag_fertilisation(:,:) = 0 |
---|
1604 | DO j=2 ,nvm |
---|
1605 | DO i=1,npts |
---|
1606 | IF (( tjulian .GE. tfert(i,j,fertcount(i,j) + 1)) .AND. & |
---|
1607 | ( tjulian .LT. (tfert(i,j,fertcount(i,j) + 2) - 1))) THEN |
---|
1608 | !JCmodif 110523 with problem |
---|
1609 | !above means tjulian between two tfert |
---|
1610 | !undaily(i) uptake n daily always=0 |
---|
1611 | !thetas volumetric water content in soil layer h |
---|
1612 | !thetasfc water field capacity |
---|
1613 | !!!!! For we did not consider undaily , there will be no point need to fert??? |
---|
1614 | ! IF ((undaily(i) .GT. 0.0) .AND. (thetas(i,1) .LE. thetasfc(i,1))) THEN |
---|
1615 | flag_fertilisation(i,j) = 1 |
---|
1616 | ELSE |
---|
1617 | flag_fertilisation(i,j) = 2 |
---|
1618 | END IF |
---|
1619 | END DO |
---|
1620 | END DO |
---|
1621 | |
---|
1622 | IF (ANY(flag_fertilisation(:,:) .EQ. 1)) THEN |
---|
1623 | CALL fertilisation_spa(& |
---|
1624 | npts , & |
---|
1625 | flag_fertilisation , & |
---|
1626 | fertcount_start , & |
---|
1627 | tjulian , & |
---|
1628 | tfert , & |
---|
1629 | nfertnittotprevyear , & |
---|
1630 | nfertammtotprevyear , & |
---|
1631 | nfertnit , & |
---|
1632 | nfertamm , & |
---|
1633 | fertcount , & |
---|
1634 | nfertammtot , & |
---|
1635 | nfertnittot , & |
---|
1636 | nfertammtotyear , & |
---|
1637 | nfertnittotyear , & |
---|
1638 | controle_azote_sum , & |
---|
1639 | controle_azote_sum_mem) |
---|
1640 | |
---|
1641 | DO j=2, nvm |
---|
1642 | DO i=1,npts |
---|
1643 | IF (flag_fertilisation(i,j) .EQ. 1) THEN |
---|
1644 | IF (controle_azote_sum(i,j) .GT. 0.) THEN |
---|
1645 | nsatur_somerror_temp(i,j) = & |
---|
1646 | ABS(controle_azote(i,j,fertcount(i,j)) - controle_azote_sum(i,j)) / & |
---|
1647 | controle_azote_sum(i,j) |
---|
1648 | ENDIF |
---|
1649 | IF (nsatur_somerror_temp(i,j) .GT. nsatur_somerror(i,j)) THEN |
---|
1650 | nsatur_somerror(i,j) = nsatur_somerror_temp(i,j) |
---|
1651 | ENDIF |
---|
1652 | controle_azote(i,j,fertcount(i,j) ) = controle_azote_sum(i,j) |
---|
1653 | tfert_modif(i,j,fertcount(i,j) ) = tjulian |
---|
1654 | END IF |
---|
1655 | END DO |
---|
1656 | END DO |
---|
1657 | END IF ! flag_fertilisation(:,:) .EQ. 1 |
---|
1658 | |
---|
1659 | IF (ANY(flag_fertilisation(:,:) .EQ. 2)) THEN |
---|
1660 | WHERE (flag_fertilisation(:,:) .NE. 2) |
---|
1661 | flag_fertilisation(:,:) = 0 |
---|
1662 | END WHERE |
---|
1663 | DO j = 2, nvm |
---|
1664 | DO i=1,npts |
---|
1665 | IF ((tjulian .GE. (tfert(i,j,fertcount(i,j)+2)-1)) .AND. & |
---|
1666 | (tjulian .LE. (tfert(i,j,fertcount(i,j)+2)-0.1)) .AND. & |
---|
1667 | (.NOT.(tfert_verif2(i,j,fertcount(i,j)+2)) ) .AND. & |
---|
1668 | (flag_fertilisation(i,j) .EQ. 2) ) THEN |
---|
1669 | |
---|
1670 | flag_fertilisation(i,j) = 1 |
---|
1671 | tfert_verif2(i,j,fertcount(i,j)+2) = .TRUE. |
---|
1672 | nfertamm(i,j,fertcount(i,j) + 1) = 0. |
---|
1673 | nfertnit(i,j,fertcount(i,j) + 1) = 0. |
---|
1674 | tfert_modif(i,j,fertcount(i,j) + 1) = 500.0 |
---|
1675 | END IF |
---|
1676 | END DO |
---|
1677 | END DO |
---|
1678 | |
---|
1679 | IF (ANY(flag_fertilisation(:,:) .EQ. 1)) THEN |
---|
1680 | |
---|
1681 | CALL fertilisation_spa(& |
---|
1682 | npts , & |
---|
1683 | flag_fertilisation , & |
---|
1684 | fertcount_start , & |
---|
1685 | tjulian , & |
---|
1686 | tfert , & |
---|
1687 | nfertnittotprevyear , & |
---|
1688 | nfertammtotprevyear , & |
---|
1689 | nfertnit , & |
---|
1690 | nfertamm , & |
---|
1691 | fertcount , & |
---|
1692 | nfertammtot , & |
---|
1693 | nfertnittot , & |
---|
1694 | nfertammtotyear , & |
---|
1695 | nfertnittotyear , & |
---|
1696 | controle_azote_sum , & |
---|
1697 | controle_azote_sum_mem) |
---|
1698 | |
---|
1699 | END IF |
---|
1700 | |
---|
1701 | END IF ! flag_fertilisation(:,:) .EQ. 2 |
---|
1702 | |
---|
1703 | END IF users_or_saturant_fert |
---|
1704 | |
---|
1705 | |
---|
1706 | ! 4.2 ***** RUN NONLIMITANT ***** |
---|
1707 | ! recherche des erreurs pour l'équilibre |
---|
1708 | ! recherche de stoplimitant (fin du run) |
---|
1709 | run_nonlimitant : IF ((f_nonlimitant .EQ. 1) .AND. (ANY(stoplimitant(:,:) .EQ. 0))) THEN ! any ? |
---|
1710 | |
---|
1711 | DO j=2,nvm |
---|
1712 | DO i=1,npts |
---|
1713 | ! search the last time of fertilization |
---|
1714 | IF (tfert(i,j,fertcount_current(i,j) + 1) .EQ. 500) THEN |
---|
1715 | fertcount_next = 1 |
---|
1716 | ELSE |
---|
1717 | fertcount_next = fertcount_current(i,j) + 1 |
---|
1718 | ENDIF |
---|
1719 | |
---|
1720 | ! if tjulian correspond to next time of fertilization |
---|
1721 | IF ((tjulian .GE. tfert(i,j,fertcount_next)) .AND. & |
---|
1722 | (tjulian .LE. tfert(i,j,fertcount_next)+0.9) .AND. & |
---|
1723 | (tfert_verif2(i,j,fertcount_next) .EQV. .FALSE.)) THEN |
---|
1724 | |
---|
1725 | tfert_verif2(i,j,fertcount_next) = .TRUE. |
---|
1726 | |
---|
1727 | ! calcul de somerror |
---|
1728 | IF(controle_azote(i,j,fertcount_next) .GT. 0.) THEN |
---|
1729 | nnonlimit_SOMerror(i,j) = & |
---|
1730 | (controle_azote(i,j,fertcount_next) - controle_azote_sum_mem(i,j))/ & |
---|
1731 | controle_azote(i,j,fertcount_next) |
---|
1732 | ELSE |
---|
1733 | nnonlimit_SOMerror(i,j) = 0. |
---|
1734 | ENDIF |
---|
1735 | ! on regarde si on ne dépasse pas l'erreur max voulue |
---|
1736 | ! puis on réajuste cette erreur max suivant dans quel cas |
---|
1737 | ! nous sommes |
---|
1738 | IF (nnonlimit_SOMerror(i,j) .GT. nnonlimit_SOMerrormax(i,j)) THEN |
---|
1739 | |
---|
1740 | nfertamm(i,j,fertcount_current(i,j)) = nfertamm(i,j,fertcount_current(i,j)) + 0.00125 |
---|
1741 | nfertnit(i,j,fertcount_current(i,j)) = nfertnit(i,j,fertcount_current(i,j)) + 0.00125 |
---|
1742 | PRINT *, '!!! apport en azote !!! pour fertcount_current = ', fertcount_current(i,j) & |
---|
1743 | ,' nfertamm= ',nfertamm(i,j,fertcount_current(i,j)) |
---|
1744 | ELSE |
---|
1745 | fertcount_current(i,j) = fertcount_current(i,j) + 1 |
---|
1746 | |
---|
1747 | IF(tfert(i,j,fertcount_current(i,j)) .EQ. 500.) THEN |
---|
1748 | fertcount_current(i,j) = 1 |
---|
1749 | ENDIF |
---|
1750 | |
---|
1751 | IF (fertcount_current(i,j) .EQ. fertcount_start(i,j)) THEN |
---|
1752 | nnonlimit_SOMerrormax(i,j) = nnonlimit_SOMerrormax(i,j) - n_auto(i,j)*0.05 |
---|
1753 | n_auto(i,j) = n_auto(i,j) - 1. |
---|
1754 | IF ( nnonlimit_SOMerrormax(i,j) .LE. 0.) THEN |
---|
1755 | nnonlimit_SOMerrormax(i,j)=0.025 |
---|
1756 | ENDIF |
---|
1757 | IF (n_auto(i,j) .LT. 0.) THEN |
---|
1758 | stoplimitant(i,j) = 1 |
---|
1759 | print *,'*********************************' |
---|
1760 | print *,'stoplimitant =1 ' |
---|
1761 | print *,'********************************' |
---|
1762 | ENDIF ! n_auto |
---|
1763 | ENDIF ! fertcount_current |
---|
1764 | ENDIF ! nnonlimit |
---|
1765 | ENDIF ! tjulian |
---|
1766 | END DO ! npts |
---|
1767 | END DO ! nvm |
---|
1768 | END IF run_nonlimitant |
---|
1769 | |
---|
1770 | ! 4.3 run spatialize fertilization |
---|
1771 | ! calculating organic C input into soil |
---|
1772 | CALL fertilisation_pas_temps(& |
---|
1773 | npts , & |
---|
1774 | fertcount , & |
---|
1775 | dt , & |
---|
1776 | tjulian , & |
---|
1777 | deltatt , & |
---|
1778 | tfert , & |
---|
1779 | Nliquidmanure , & |
---|
1780 | nslurry , & |
---|
1781 | Nsolidmanure , & |
---|
1782 | fcOrganicFertmetabolic , & |
---|
1783 | fcOrganicFertstruct , & |
---|
1784 | fnOrganicFerturine , & |
---|
1785 | fnOrganicFertmetabolic , & |
---|
1786 | c2nratiostruct , & |
---|
1787 | Fert_on) |
---|
1788 | |
---|
1789 | DO j=2,nvm |
---|
1790 | CALL Euler_funct(npts, dt, MAX(0.0,(t2m_daily - 278.15)), tasum(:,j)) |
---|
1791 | END DO |
---|
1792 | |
---|
1793 | ! 5 calculate variables that not included in ORCHIDEE |
---|
1794 | ! liste : |
---|
1795 | ! * devstage |
---|
1796 | ! * tgrowth |
---|
1797 | CALL Main_appl_pre_animal(& |
---|
1798 | npts , & |
---|
1799 | dt , & |
---|
1800 | tjulian , & |
---|
1801 | t2m_daily , & |
---|
1802 | tsoil , & |
---|
1803 | new_day , & |
---|
1804 | new_year , & |
---|
1805 | regcount , & |
---|
1806 | tcut , & |
---|
1807 | devstage , & |
---|
1808 | tgrowth ) |
---|
1809 | |
---|
1810 | ! 6 start grazing practice |
---|
1811 | ! 6.1 updating available litter for wild animal grazing |
---|
1812 | !gmjc prepare litter_avail for grazing litter |
---|
1813 | ! kg DM/m^2 |
---|
1814 | litter_avail_totDM(:,:) = (litter_avail(:,istructural,:) + & |
---|
1815 | & litter_avail(:,imetabolic,:)) / (1000. * CtoDM) |
---|
1816 | !end gmjc |
---|
1817 | ! 6.2 grazing |
---|
1818 | IF ((Type_animal.EQ.3).OR.(Type_animal.EQ.6)) THEN ! old animal module |
---|
1819 | CALL Animaux_main(& |
---|
1820 | npts, dt, devstage, wsh, intakemax, & |
---|
1821 | snowfall_daily, wshtot, Animalwgrazingmin, & |
---|
1822 | AnimalkintakeM, nel, wanimal, nanimaltot, & |
---|
1823 | ntot, intake, urinen, faecesn, urinec, faecesc, & |
---|
1824 | tgrowth, new_year, new_day, & |
---|
1825 | nanimal, tanimal, danimal, & |
---|
1826 | tcutmodel, tjulian, import_yield, & |
---|
1827 | intakesum, intakensum, fn, c, n, leaf_frac, & |
---|
1828 | intake_animal, intake_animalsum, & |
---|
1829 | biomass, trampling, sr_ugb,sr_wild, & |
---|
1830 | compt_ugb, nb_ani, grazed_frac,AnimalDiscremineQualite, & |
---|
1831 | YIELD_RETURN,sr_ugb_init,year_count1,year_count2, & |
---|
1832 | grazing_litter, litter_avail_totDM, & |
---|
1833 | intake_animal_litter, intake_litter,nb_grazingdays, & |
---|
1834 | !gmjc top 5 layer grassland soil moisture for grazing |
---|
1835 | moiavail_daily, tmc_topgrass_daily,fc_grazing, & |
---|
1836 | after_snow, after_wet, wet1day, wet2day, & |
---|
1837 | snowmass_daily, t2m_daily, & |
---|
1838 | !end gmjc |
---|
1839 | ranimal_gm, ch4_pft_gm, Fert_PRP) |
---|
1840 | ELSE ! new animal module |
---|
1841 | |
---|
1842 | CALL Animaux_main_dynamic(& |
---|
1843 | npts, dt, devstage , & |
---|
1844 | intakemax, snowfall_daily, wshtot, wsh , & |
---|
1845 | nel, nanimaltot , & |
---|
1846 | intake , & |
---|
1847 | import_yield , & |
---|
1848 | new_year, new_day , & |
---|
1849 | nanimal, tanimal, danimal , & |
---|
1850 | PIYcow, PIMcow, BCSYcow , & |
---|
1851 | BCSMcow, PICcow, AGE_cow_P , & |
---|
1852 | AGE_cow_M, tcutmodel, tjulian , & |
---|
1853 | intakesum , & |
---|
1854 | intakensum, fn, ntot, c, n,leaf_frac, & |
---|
1855 | intake_animal, intake_animalsum , & |
---|
1856 | t2m_min_daily, type_animal , & |
---|
1857 | t2m_daily, intakemax, Autogestion_out , & |
---|
1858 | Forage_quantity,t2m_14 , & |
---|
1859 | intake_tolerance , & |
---|
1860 | q_max_complement , & |
---|
1861 | biomass, urinen, faecesn, urinec,faecesc, & |
---|
1862 | file_param_init,trampling,sr_ugb,sr_wild, & |
---|
1863 | compt_ugb, nb_ani,grazed_frac,AnimalDiscremineQualite, & |
---|
1864 | grazing_litter, nb_grazingdays) |
---|
1865 | |
---|
1866 | ENDIF ! Type_Animal |
---|
1867 | |
---|
1868 | ! 7 CUTTING |
---|
1869 | ! Cutting Management: auto_fauche and user_fauche |
---|
1870 | flag_cutting(:,:) = 0 |
---|
1871 | ! 7.1 user defined cut |
---|
1872 | user_fauche : IF ((f_autogestion .EQ. 0) .AND. (f_postauto .EQ. 0)) THEN |
---|
1873 | |
---|
1874 | flag_cutting(:,:) = 0 |
---|
1875 | when_growthinit_cut(:,:) = when_growthinit_cut(:,:) + dt |
---|
1876 | lm_before(:,:)= biomass(:,:,ileaf,icarbon) |
---|
1877 | |
---|
1878 | DO k=1,nstocking |
---|
1879 | |
---|
1880 | flag_cutting(:,:) = 0 |
---|
1881 | |
---|
1882 | DO j=2,nvm |
---|
1883 | IF (is_grassland_manag(j) )THEN |
---|
1884 | |
---|
1885 | IF (ANY(tcut_verif(:,j,k) .EQ. .FALSE.)) THEN |
---|
1886 | WHERE ((tjulian .GE. tcut(:,j,k)) .AND. (tjulian .LE. tcut(:,j,k)+0.9) .AND. & |
---|
1887 | (tcut_verif(:,j,k) .EQ. .FALSE.)) |
---|
1888 | |
---|
1889 | tcut_verif(:,j,k) = .TRUE. |
---|
1890 | flag_cutting(:,j) = 1 |
---|
1891 | compt_cut(:,j) = compt_cut(:,j) + 1 |
---|
1892 | when_growthinit_cut(:,j) = 0.0 |
---|
1893 | END WHERE |
---|
1894 | END IF |
---|
1895 | END IF |
---|
1896 | END DO |
---|
1897 | IF (ANY (flag_cutting(:,:) .EQ. 1)) THEN |
---|
1898 | |
---|
1899 | IF (blabla_pasim) PRINT *, 'cutting users', tjulian |
---|
1900 | |
---|
1901 | CALL cutting_spa(& |
---|
1902 | npts , & |
---|
1903 | tjulian , & |
---|
1904 | flag_cutting , & |
---|
1905 | wshtotcutinit , & |
---|
1906 | lcutinit , & |
---|
1907 | wsh , & |
---|
1908 | wshtot , & |
---|
1909 | wr , & |
---|
1910 | c , & |
---|
1911 | n , & |
---|
1912 | napo , & |
---|
1913 | nsym , & |
---|
1914 | fn , & |
---|
1915 | tjulian , & |
---|
1916 | nel , & |
---|
1917 | biomass , & |
---|
1918 | devstage , & |
---|
1919 | regcount , & |
---|
1920 | wshcutinit , & |
---|
1921 | gmean , & |
---|
1922 | wc_frac , & |
---|
1923 | wnapo , & |
---|
1924 | wnsym , & |
---|
1925 | wgn , & |
---|
1926 | tasum , & |
---|
1927 | tgrowth , & |
---|
1928 | loss , & |
---|
1929 | lossc , & |
---|
1930 | lossn , & |
---|
1931 | tlossstart , & |
---|
1932 | lai , & |
---|
1933 | tcut , & |
---|
1934 | tcut_modif , & |
---|
1935 | wshtotsum , & |
---|
1936 | controle_azote_sum) |
---|
1937 | |
---|
1938 | WHERE ((wsh + wr .GT. 0.0).AND. (flag_cutting .EQ. 1)) |
---|
1939 | c = wc_frac / (wsh + wr) |
---|
1940 | n = (wnapo + wnsym) / (wsh + wr) |
---|
1941 | fn = wgn / (wr + wsh) |
---|
1942 | napo = wnapo / (wsh + wr) |
---|
1943 | nsym = wnsym / (wsh + wr) |
---|
1944 | END WHERE |
---|
1945 | |
---|
1946 | WHERE (wshtot + wrtot .GT. 0.0) |
---|
1947 | ntot = (wnapo + wnsym + wgn) / (wshtot + wrtot) |
---|
1948 | END WHERE |
---|
1949 | END IF |
---|
1950 | |
---|
1951 | END DO !nstocking |
---|
1952 | |
---|
1953 | END IF user_fauche |
---|
1954 | |
---|
1955 | ! 7.2 auto cut |
---|
1956 | n_day_autofauche : IF (new_day) THEN |
---|
1957 | DO j=2,nvm |
---|
1958 | CALL linreg_pasim (& |
---|
1959 | npts , & |
---|
1960 | ngmean , & |
---|
1961 | tgmean(:,j,:) , & |
---|
1962 | gmean(:,j,:) , & |
---|
1963 | ngmean , & |
---|
1964 | misval , & |
---|
1965 | mux(:,j) , & |
---|
1966 | mugmean(:,j) , & |
---|
1967 | sigx(:,j) , & |
---|
1968 | sigy(:,j) , & |
---|
1969 | gmeanslope(:,j) , & |
---|
1970 | gzero(:,j) , & |
---|
1971 | gcor(:,j)) |
---|
1972 | END DO |
---|
1973 | countschedule(:,:) = 1 |
---|
1974 | |
---|
1975 | auto_fauche : IF (f_autogestion .EQ. 1) THEN ! for optimalize sr_ugb and nb_ani |
---|
1976 | |
---|
1977 | flag_cutting(:,:) = 0 |
---|
1978 | when_growthinit_cut(:,:) = when_growthinit_cut(:,:) + dt |
---|
1979 | DO j=2,nvm |
---|
1980 | IF (is_grassland_manag(j) .AND. (.NOT. is_grassland_cut(j)) .AND. & |
---|
1981 | (.NOT. is_grassland_grazed(j)))THEN |
---|
1982 | |
---|
1983 | ! FIRST test for automanagement > 45 days |
---|
1984 | WHERE((nanimal(:,j,1) .EQ. 0.0) .AND. (cuttingend(:,j) .EQ. 0) .AND. & |
---|
1985 | (countschedule(:,j) .EQ. 1) .AND. (((tgrowth(:,j) .GE. tgrowthmin) .AND. & |
---|
1986 | (gmean(:,j,ngmean) .GT. 0.0) .AND.(lai(:,j) .GE. 2.5) .AND. & |
---|
1987 | (devstage(:,j) .GT. devstagemin ) .AND. & |
---|
1988 | (gmeanslope(:,j) .LT. gmeansloperel * mugmean(:,j))))) |
---|
1989 | |
---|
1990 | flag_cutting(:,j) = 1 |
---|
1991 | countschedule(:,j) = countschedule(:,j) + 1 |
---|
1992 | compt_cut(:,j) = compt_cut(:,j) + 1 |
---|
1993 | END WHERE |
---|
1994 | END IF |
---|
1995 | END DO !nvm |
---|
1996 | |
---|
1997 | ! If there is at least one point concerned (flag_cutting = 1) |
---|
1998 | IF (ANY (flag_cutting(:,:) .EQ. 1)) THEN |
---|
1999 | ! IF (blabla_pasim) PRINT *, 'FAUCHE AVEC METHODE NV ', tjulian |
---|
2000 | ! There will be one fertilization the day after cutting |
---|
2001 | ! A COURT-CIRCUITER si couplage autogestion ferti avec INN |
---|
2002 | ! AIG 06/10/2009 |
---|
2003 | |
---|
2004 | IF (f_fertilization.NE.1) THEN |
---|
2005 | DO j=2,nvm |
---|
2006 | DO i=1,npts |
---|
2007 | IF (flag_cutting(i,j) .EQ. 1) THEN |
---|
2008 | tfert(i,j,regcount(i,j) + 1) = tjulian + 1 |
---|
2009 | ! print*, 'FERTILISATION AVEC METHODE NV', tjulian |
---|
2010 | END IF |
---|
2011 | END DO |
---|
2012 | END DO |
---|
2013 | END IF |
---|
2014 | |
---|
2015 | CALL cutting_spa(& |
---|
2016 | npts , & |
---|
2017 | tjulian , & |
---|
2018 | flag_cutting , & |
---|
2019 | wshtotcutinit , & |
---|
2020 | lcutinit , & |
---|
2021 | wsh , & |
---|
2022 | wshtot , & |
---|
2023 | wr , & |
---|
2024 | c , & |
---|
2025 | n , & |
---|
2026 | napo , & |
---|
2027 | nsym , & |
---|
2028 | fn , & |
---|
2029 | tjulian , & |
---|
2030 | nel , & |
---|
2031 | biomass , & |
---|
2032 | devstage , & |
---|
2033 | regcount , & |
---|
2034 | wshcutinit , & |
---|
2035 | gmean , & |
---|
2036 | wc_frac , & |
---|
2037 | wnapo , & |
---|
2038 | wnsym , & |
---|
2039 | wgn , & |
---|
2040 | tasum , & |
---|
2041 | tgrowth , & |
---|
2042 | loss , & |
---|
2043 | lossc , & |
---|
2044 | lossn , & |
---|
2045 | tlossstart , & |
---|
2046 | lai , & |
---|
2047 | tcut , & |
---|
2048 | tcut_modif , & |
---|
2049 | wshtotsum , & |
---|
2050 | controle_azote_sum) |
---|
2051 | |
---|
2052 | ! ****************************************************** |
---|
2053 | ! update plant c n concentrations |
---|
2054 | ! ****************************************************** |
---|
2055 | |
---|
2056 | WHERE ((wsh + wr .GT. 0.0) .AND. (flag_cutting .EQ. 1) ) |
---|
2057 | c = wc_frac / (wsh + wr) |
---|
2058 | n = (wnapo + wnsym) / (wsh + wr) |
---|
2059 | fn = wgn / (wr + wsh) |
---|
2060 | napo = wnapo / (wsh + wr) |
---|
2061 | nsym = wnsym / (wsh + wr) |
---|
2062 | END WHERE |
---|
2063 | |
---|
2064 | WHERE (wshtot + wrtot .GT. 0.0) |
---|
2065 | ntot = (wnapo + wnsym + wgn) / (wshtot + wrtot) |
---|
2066 | END WHERE |
---|
2067 | |
---|
2068 | END IF |
---|
2069 | |
---|
2070 | WHERE (flag_cutting(:,:) .EQ. 1) |
---|
2071 | when_growthinit_cut(:,:) = 0.0 |
---|
2072 | END WHERE |
---|
2073 | |
---|
2074 | ! SECOND test for automanagement lai & accumulated temperature over shreshold |
---|
2075 | flag_cutting(:,:) = 0 |
---|
2076 | |
---|
2077 | DO j=2,nvm |
---|
2078 | IF (is_grassland_manag(j) .AND. (.NOT. is_grassland_cut(j)) .AND. & |
---|
2079 | (.NOT. is_grassland_grazed(j))) THEN |
---|
2080 | |
---|
2081 | WHERE ((countschedule(:,j) .EQ. 1) .AND. (nanimal(:,j,1) .EQ. 0.0) .AND. & |
---|
2082 | (devstage(:,j) .LT. 2.0) .AND. (tasum(:,j) .GE. tasumrep ) .AND. & |
---|
2083 | (lai(:,j) .GE. 2.5)) |
---|
2084 | |
---|
2085 | flag_cutting(:,j) = 1 |
---|
2086 | |
---|
2087 | countschedule(:,j) = countschedule(:,j) + 1 |
---|
2088 | compt_cut(:,j) = compt_cut(:,j) + 1 |
---|
2089 | END WHERE |
---|
2090 | END IF |
---|
2091 | END DO !nvm |
---|
2092 | |
---|
2093 | ! If there is at least one point concerned |
---|
2094 | IF (ANY (flag_cutting(:,:) .EQ. 1)) THEN |
---|
2095 | ! IF (blabla_pasim) PRINT *, 'FAUCHE AVEC METHODE NV', tjulian |
---|
2096 | |
---|
2097 | ! There will be one fertilization the day after cutting |
---|
2098 | ! MODIF INN |
---|
2099 | !courciruiter le calcul de tfert si f_fertiliZation = 0 |
---|
2100 | IF (f_fertilization.NE.1) THEN |
---|
2101 | DO j=2,nvm |
---|
2102 | DO i=1,npts |
---|
2103 | IF (flag_cutting(i,j) .EQ. 1) THEN |
---|
2104 | tfert(i,j,regcount(i,j) + 1) = tjulian + 1 |
---|
2105 | ! print*, 'FERTILISATION AVEC METHODE NV', tjulian |
---|
2106 | END IF |
---|
2107 | END DO |
---|
2108 | END DO |
---|
2109 | END IF |
---|
2110 | |
---|
2111 | CALL cutting_spa(& |
---|
2112 | npts , & |
---|
2113 | tjulian , & |
---|
2114 | flag_cutting , & |
---|
2115 | wshtotcutinit , & |
---|
2116 | lcutinit , & |
---|
2117 | wsh , & |
---|
2118 | wshtot , & |
---|
2119 | wr , & |
---|
2120 | c , & |
---|
2121 | n , & |
---|
2122 | napo , & |
---|
2123 | nsym , & |
---|
2124 | fn , & |
---|
2125 | tjulian , & |
---|
2126 | nel , & |
---|
2127 | biomass , & |
---|
2128 | devstage , & |
---|
2129 | regcount , & |
---|
2130 | wshcutinit , & |
---|
2131 | gmean , & |
---|
2132 | wc_frac , & |
---|
2133 | wnapo , & |
---|
2134 | wnsym , & |
---|
2135 | wgn , & |
---|
2136 | tasum , & |
---|
2137 | tgrowth , & |
---|
2138 | loss , & |
---|
2139 | lossc , & |
---|
2140 | lossn , & |
---|
2141 | tlossstart , & |
---|
2142 | lai , & |
---|
2143 | tcut , & |
---|
2144 | tcut_modif , & |
---|
2145 | wshtotsum , & |
---|
2146 | controle_azote_sum) |
---|
2147 | |
---|
2148 | ! ****************************************************** |
---|
2149 | ! update plant c n concentrations |
---|
2150 | ! ****************************************************** |
---|
2151 | WHERE ((wsh + wr .GT. 0.0) .AND. (flag_cutting .EQ. 1)) |
---|
2152 | c = wc_frac / (wsh + wr) |
---|
2153 | n = (wnapo + wnsym) / (wsh + wr) |
---|
2154 | fn = wgn / (wr + wsh) |
---|
2155 | napo = wnapo / (wsh + wr) |
---|
2156 | nsym = wnsym / (wsh + wr) |
---|
2157 | END WHERE |
---|
2158 | |
---|
2159 | WHERE (wshtot + wrtot .GT. 0.0) |
---|
2160 | ntot = (wnapo + wnsym + wgn) / (wshtot + wrtot) |
---|
2161 | END WHERE |
---|
2162 | |
---|
2163 | END IF |
---|
2164 | |
---|
2165 | WHERE (flag_cutting(:,:) .EQ. 1) |
---|
2166 | when_growthinit_cut(:,:) = 0.0 |
---|
2167 | END WHERE |
---|
2168 | |
---|
2169 | !If there are ncut cutting, it's finish |
---|
2170 | |
---|
2171 | WHERE (regcount(:,:) .EQ. ncut ) |
---|
2172 | cuttingend(:,:) = 1 |
---|
2173 | END WHERE |
---|
2174 | |
---|
2175 | !end of the cutting season by snow fall |
---|
2176 | |
---|
2177 | ELSE IF ((f_postauto .EQ.1 ) .OR. (f_autogestion .EQ. 3) .OR. & |
---|
2178 | (f_autogestion .EQ. 4) & |
---|
2179 | !! JCMODIF 290714 for postauto 5 |
---|
2180 | .OR. (f_postauto .GE. 2)) THEN |
---|
2181 | |
---|
2182 | flag_cutting(:,:) = 0 |
---|
2183 | when_growthinit_cut(:,:) = when_growthinit_cut(:,:) + dt |
---|
2184 | ! gmjc 07082016 reset lossc to zero for history writing |
---|
2185 | ! NOTE:the flag_cutting will be determined twice a day, thus we cannot |
---|
2186 | ! reset them in the cutting subroutine |
---|
2187 | loss(:,:) = 0.0 |
---|
2188 | lossc(:,:) = 0.0 |
---|
2189 | lossn(:,:) = 0.0 |
---|
2190 | tlossstart(:,:) = 500.0 |
---|
2191 | ! FIRST test for automanagement |
---|
2192 | WHERE((nanimal(:,mcut_C3,1) .EQ. 0.0) .AND. (cuttingend(:,mcut_C3) .EQ. 0) .AND. & |
---|
2193 | (countschedule(:,mcut_C3) .EQ. 1) .AND. (((tgrowth(:,mcut_C3).GE.tgrowthmin) .AND. & |
---|
2194 | (gmean(:,mcut_C3,ngmean).GT. 0.0) .AND. & |
---|
2195 | (lai(:,mcut_C3) .GE. 2.5) .AND. (devstage(:,mcut_C3) .GT. devstagemin ) .AND. & |
---|
2196 | (gmeanslope(:,mcut_C3) .LT.gmeansloperel * mugmean(:,mcut_C3))))) |
---|
2197 | |
---|
2198 | flag_cutting(:,mcut_C3) = 1 |
---|
2199 | countschedule(:,mcut_C3) = countschedule(:,mcut_C3) + 1 |
---|
2200 | compt_cut(:,mcut_C3) = compt_cut(:,mcut_C3) + 1 |
---|
2201 | END WHERE |
---|
2202 | |
---|
2203 | WHERE((nanimal(:,mcut_C4,1) .EQ. 0.0) .AND. (cuttingend(:,mcut_C4) .EQ. 0).AND. & |
---|
2204 | (countschedule(:,mcut_C4) .EQ. 1) .AND. (((tgrowth(:,mcut_C4).GE.tgrowthmin).AND. & |
---|
2205 | (gmean(:,mcut_C4,ngmean).GT. 0.0) .AND. & |
---|
2206 | (lai(:,mcut_C4) .GE. 2.5) .AND. (devstage(:,mcut_C4) .GT. devstagemin ).AND. & |
---|
2207 | (gmeanslope(:,mcut_C4) .LT.gmeansloperel * mugmean(:,mcut_C4))))) |
---|
2208 | |
---|
2209 | flag_cutting(:,mcut_C4) = 1 |
---|
2210 | countschedule(:,mcut_C4) = countschedule(:,mcut_C4) + 1 |
---|
2211 | compt_cut(:,mcut_C4) = compt_cut(:,mcut_C4) + 1 |
---|
2212 | END WHERE |
---|
2213 | |
---|
2214 | ! If there is at least one point concerned (flag_cutting = 1) |
---|
2215 | |
---|
2216 | IF ((ANY(flag_cutting(:,mcut_C3) .EQ. 1)) .OR. & |
---|
2217 | (ANY(flag_cutting(:,mcut_C4) .EQ. 1))) THEN |
---|
2218 | ! IF (blabla_pasim) PRINT *, 'FAUCHE AVEC METHODE NV ', tjulian |
---|
2219 | ! There will be one fertilization the day after cutting |
---|
2220 | ! A COURT-CIRCUITER si couplage autogestion ferti avec INN |
---|
2221 | ! AIG 06/10/2009 |
---|
2222 | |
---|
2223 | IF (f_fertilization.NE.1) THEN |
---|
2224 | DO j=2,nvm |
---|
2225 | DO i=1,npts |
---|
2226 | IF (flag_cutting(i,j) .EQ. 1) THEN |
---|
2227 | tfert(i,j,regcount(i,j) + 1) = tjulian + 1 |
---|
2228 | ! print*, 'FERTILISATION AVEC METHODE NV', tjulian |
---|
2229 | END IF |
---|
2230 | END DO |
---|
2231 | END DO |
---|
2232 | END IF |
---|
2233 | CALL cutting_spa(& |
---|
2234 | npts , & |
---|
2235 | tjulian , & |
---|
2236 | flag_cutting , & |
---|
2237 | wshtotcutinit , & |
---|
2238 | lcutinit , & |
---|
2239 | wsh , & |
---|
2240 | wshtot , & |
---|
2241 | wr , & |
---|
2242 | c , & |
---|
2243 | n , & |
---|
2244 | napo , & |
---|
2245 | nsym , & |
---|
2246 | fn , & |
---|
2247 | tjulian , & |
---|
2248 | nel , & |
---|
2249 | biomass , & |
---|
2250 | devstage , & |
---|
2251 | regcount , & |
---|
2252 | wshcutinit , & |
---|
2253 | gmean , & |
---|
2254 | wc_frac , & |
---|
2255 | wnapo , & |
---|
2256 | wnsym , & |
---|
2257 | wgn , & |
---|
2258 | tasum , & |
---|
2259 | tgrowth , & |
---|
2260 | loss , & |
---|
2261 | lossc , & |
---|
2262 | lossn , & |
---|
2263 | tlossstart , & |
---|
2264 | lai , & |
---|
2265 | tcut , & |
---|
2266 | tcut_modif , & |
---|
2267 | wshtotsum , & |
---|
2268 | controle_azote_sum) |
---|
2269 | |
---|
2270 | ! ****************************************************** |
---|
2271 | ! mise à jour des concentrations |
---|
2272 | ! ****************************************************** |
---|
2273 | |
---|
2274 | WHERE ((wsh + wr .GT. 0.0) .AND. (flag_cutting .EQ. 1) ) |
---|
2275 | c = wc_frac / (wsh + wr) |
---|
2276 | n = (wnapo + wnsym) / (wsh + wr) |
---|
2277 | fn = wgn / (wr + wsh) |
---|
2278 | napo = wnapo / (wsh + wr) |
---|
2279 | nsym = wnsym / (wsh + wr) |
---|
2280 | END WHERE |
---|
2281 | |
---|
2282 | WHERE (wshtot + wrtot .GT. 0.0) |
---|
2283 | ntot = (wnapo + wnsym + wgn) / (wshtot + wrtot) |
---|
2284 | END WHERE |
---|
2285 | |
---|
2286 | END IF |
---|
2287 | |
---|
2288 | WHERE (flag_cutting(:,mcut_C3) .EQ. 1) |
---|
2289 | when_growthinit_cut(:,mcut_C3) = 0.0 |
---|
2290 | END WHERE |
---|
2291 | WHERE (flag_cutting(:,mcut_C4) .EQ. 1) |
---|
2292 | when_growthinit_cut(:,mcut_C4) = 0.0 |
---|
2293 | END WHERE |
---|
2294 | |
---|
2295 | ! SECOND test for automanagement |
---|
2296 | flag_cutting(:,mcut_C3) = 0 |
---|
2297 | flag_cutting(:,mcut_C4) = 0 |
---|
2298 | |
---|
2299 | WHERE ((countschedule(:,mcut_C3) .EQ. 1) .AND. (nanimal(:,mcut_C3,1) .EQ.0.0) .AND. & |
---|
2300 | (devstage(:,mcut_C3) .LT. 2.0) .AND. (tasum(:,mcut_C3) .GE. tasumrep ) .AND. & |
---|
2301 | (lai(:,mcut_C3) .GE. 2.5)) |
---|
2302 | |
---|
2303 | flag_cutting(:,mcut_C3) = 1 |
---|
2304 | countschedule(:,mcut_C3) = countschedule(:,mcut_C3) + 1 |
---|
2305 | compt_cut(:,mcut_C3) = compt_cut(:,mcut_C3) + 1 |
---|
2306 | END WHERE |
---|
2307 | |
---|
2308 | WHERE ((countschedule(:,mcut_C4) .EQ. 1) .AND. (nanimal(:,mcut_C4,1).EQ.0.0) .AND. & |
---|
2309 | (devstage(:,mcut_C4) .LT. 2.0) .AND. (tasum(:,mcut_C4) .GE. tasumrep ).AND. & |
---|
2310 | (lai(:,mcut_C4) .GE. 2.5)) |
---|
2311 | |
---|
2312 | flag_cutting(:,mcut_C4) = 1 |
---|
2313 | countschedule(:,mcut_C4) = countschedule(:,mcut_C4) + 1 |
---|
2314 | compt_cut(:,mcut_C4) = compt_cut(:,mcut_C4) + 1 |
---|
2315 | END WHERE |
---|
2316 | |
---|
2317 | ! If there is at least one point concerned |
---|
2318 | IF ((ANY(flag_cutting(:,mcut_C3) .EQ. 1)) .OR. & |
---|
2319 | (ANY(flag_cutting(:,mcut_C4) .EQ. 1))) THEN |
---|
2320 | |
---|
2321 | ! IF (blabla_pasim) PRINT *, 'FAUCHE AVEC METHODE NV', tjulian |
---|
2322 | |
---|
2323 | ! There will be one fertilization the day after cutting |
---|
2324 | ! MODIF INN |
---|
2325 | !courciruiter le calcul de tfert si f_fertiliZation = 0 |
---|
2326 | IF (f_fertilization.NE.1) THEN |
---|
2327 | DO j=2,nvm |
---|
2328 | DO i=1,npts |
---|
2329 | IF (flag_cutting(i,j) .EQ. 1) THEN |
---|
2330 | tfert(i,j,regcount(i,j) + 1) = tjulian + 1 |
---|
2331 | ! print*, 'FERTILISATION AVEC METHODE NV', tjulian |
---|
2332 | END IF |
---|
2333 | END DO |
---|
2334 | END DO |
---|
2335 | END IF |
---|
2336 | |
---|
2337 | CALL cutting_spa(& |
---|
2338 | npts , & |
---|
2339 | tjulian , & |
---|
2340 | flag_cutting , & |
---|
2341 | wshtotcutinit , & |
---|
2342 | lcutinit , & |
---|
2343 | wsh , & |
---|
2344 | wshtot , & |
---|
2345 | wr , & |
---|
2346 | c , & |
---|
2347 | n , & |
---|
2348 | napo , & |
---|
2349 | nsym , & |
---|
2350 | fn , & |
---|
2351 | tjulian , & |
---|
2352 | nel , & |
---|
2353 | biomass , & |
---|
2354 | devstage , & |
---|
2355 | regcount , & |
---|
2356 | wshcutinit , & |
---|
2357 | gmean , & |
---|
2358 | wc_frac , & |
---|
2359 | wnapo , & |
---|
2360 | wnsym , & |
---|
2361 | wgn , & |
---|
2362 | tasum , & |
---|
2363 | tgrowth , & |
---|
2364 | loss , & |
---|
2365 | lossc , & |
---|
2366 | lossn , & |
---|
2367 | tlossstart , & |
---|
2368 | lai , & |
---|
2369 | tcut , & |
---|
2370 | tcut_modif , & |
---|
2371 | wshtotsum , & |
---|
2372 | controle_azote_sum) |
---|
2373 | |
---|
2374 | ! ****************************************************** |
---|
2375 | ! update plant c n concentrations |
---|
2376 | ! ****************************************************** |
---|
2377 | WHERE ((wsh + wr .GT. 0.0) .AND. (flag_cutting .EQ. 1)) |
---|
2378 | c = wc_frac / (wsh + wr) |
---|
2379 | n = (wnapo + wnsym) / (wsh + wr) |
---|
2380 | fn = wgn / (wr + wsh) |
---|
2381 | napo = wnapo / (wsh + wr) |
---|
2382 | nsym = wnsym / (wsh + wr) |
---|
2383 | END WHERE |
---|
2384 | |
---|
2385 | WHERE (wshtot + wrtot .GT. 0.0) |
---|
2386 | ntot = (wnapo + wnsym + wgn) / (wshtot + wrtot) |
---|
2387 | END WHERE |
---|
2388 | |
---|
2389 | END IF |
---|
2390 | |
---|
2391 | WHERE (flag_cutting(:,mcut_C3) .EQ. 1) |
---|
2392 | when_growthinit_cut(:,mcut_C3) = 0.0 |
---|
2393 | END WHERE |
---|
2394 | |
---|
2395 | !If there are ncut cutting, it's finish |
---|
2396 | WHERE (regcount(:,mcut_C3) .EQ. ncut ) |
---|
2397 | cuttingend(:,mcut_C3) = 1 |
---|
2398 | END WHERE |
---|
2399 | |
---|
2400 | WHERE (flag_cutting(:,mcut_C4) .EQ. 1) |
---|
2401 | when_growthinit_cut(:,mcut_C4) = 0.0 |
---|
2402 | END WHERE |
---|
2403 | |
---|
2404 | !If there are ncut cutting, it's finish |
---|
2405 | |
---|
2406 | WHERE (regcount(:,mcut_C4) .EQ. ncut ) |
---|
2407 | cuttingend(:,mcut_C4) = 1 |
---|
2408 | END WHERE |
---|
2409 | |
---|
2410 | !end of the cutting season by snow fall |
---|
2411 | |
---|
2412 | END IF auto_fauche |
---|
2413 | END IF n_day_autofauche |
---|
2414 | |
---|
2415 | ! 8 updating plant and soil variables after management practice |
---|
2416 | ! maintenant nous allons regarder les changements que le management apporte à Orchidee. |
---|
2417 | ! Dans un premier temps uniquement ceux sur le Carbone vu qu'Orchidee n'a pas d'azote. |
---|
2418 | ! ****************************************************** |
---|
2419 | ! 8.1 updating soil status |
---|
2420 | ! ****************************************************** |
---|
2421 | CALL chg_sol_bio(& |
---|
2422 | npts , & |
---|
2423 | tjulian , & |
---|
2424 | bm_to_litter , & |
---|
2425 | litter , & |
---|
2426 | litter_avail , & |
---|
2427 | litter_not_avail , & |
---|
2428 | !spitfire |
---|
2429 | fuel_1hr, & |
---|
2430 | fuel_10hr, & |
---|
2431 | fuel_100hr, & |
---|
2432 | fuel_1000hr, & |
---|
2433 | !end spitfire |
---|
2434 | litter_avail_totDM , & |
---|
2435 | intake_litter , & |
---|
2436 | biomass , & |
---|
2437 | faecesc , & |
---|
2438 | urinec , & |
---|
2439 | fcOrganicFertmetabolic , & |
---|
2440 | fcOrganicFertstruct , & |
---|
2441 | fnOrganicFerturine , & |
---|
2442 | fnOrganicFertstruct , & |
---|
2443 | fnOrganicFertmetabolic , & |
---|
2444 | trampling , & |
---|
2445 | YIELD_RETURN , & |
---|
2446 | harvest_gm, cinput_gm) |
---|
2447 | |
---|
2448 | !jcadd calculate N2O emission |
---|
2449 | ! Fert_sn mineral fertilizer N kg N m-2 d-1 |
---|
2450 | ! Fert_on organic fertilizer N kg N m-2 d-1 |
---|
2451 | ! Fert_PRP N in grazing excreta kg N m-2 d-1 |
---|
2452 | ! ndeposition N deposition kg N ha yr-1 |
---|
2453 | n2o_pft_gm = & |
---|
2454 | ! Direct emission |
---|
2455 | ((Fert_sn+Fert_on + ndeposition/1e4/365.) * n2o_EF1 + & |
---|
2456 | Fert_PRP * n2o_EF2) + & |
---|
2457 | ! Volatilization |
---|
2458 | ((Fert_sn + ndeposition/1e4/365.) * n2o_FracGASF + & |
---|
2459 | (Fert_on + Fert_PRP) * n2o_FracGASM) * n2o_EF3 + & |
---|
2460 | ! Leaching |
---|
2461 | (Fert_sn+Fert_on + ndeposition/1e4/365. + Fert_PRP) * & |
---|
2462 | n2o_FracLEACH_H * n2o_EF4 |
---|
2463 | !end jcadd |
---|
2464 | |
---|
2465 | lai(:,:) = biomass(:,:,ileaf,icarbon)*sla_calc(:,:) |
---|
2466 | |
---|
2467 | ! 8.2 write history |
---|
2468 | ! HISTWRITE |
---|
2469 | CALL xios_orchidee_send_field("FERT_SN",Fert_sn) |
---|
2470 | CALL xios_orchidee_send_field("FERT_ON",Fert_on) |
---|
2471 | CALL xios_orchidee_send_field("FERT_PRP",Fert_PRP) |
---|
2472 | CALL xios_orchidee_send_field("WSHTOT",wshtot) |
---|
2473 | CALL xios_orchidee_send_field("WRTOT",wrtot) |
---|
2474 | CALL xios_orchidee_send_field("WSHTOTSUM",wshtotsum) |
---|
2475 | CALL xios_orchidee_send_field("SR_UGB",sr_ugb) |
---|
2476 | CALL xios_orchidee_send_field("FCORGFERTMET",fcOrganicFertmetabolic) |
---|
2477 | CALL xios_orchidee_send_field("FCORGFERTSTR",fcOrganicFertstruct) |
---|
2478 | CALL xios_orchidee_send_field("LOSSC",lossc) |
---|
2479 | CALL xios_orchidee_send_field("C_CUTYEARLY",C_cutyearly) |
---|
2480 | CALL xios_orchidee_send_field("FREQUENCY_CUT",frequency_cut) |
---|
2481 | CALL xios_orchidee_send_field("NFERT_TOTAL",N_fert_total) |
---|
2482 | CALL xios_orchidee_send_field("NDEP",ndeposition) |
---|
2483 | CALL xios_orchidee_send_field("TMCGRASS_DAILY",tmc_topgrass_daily) |
---|
2484 | CALL xios_orchidee_send_field("FC_GRAZING",fc_grazing) |
---|
2485 | CALL xios_orchidee_send_field("CINPUT_GM",cinput_gm) |
---|
2486 | CALL xios_orchidee_send_field("HARVEST_GM",harvest_gm) |
---|
2487 | |
---|
2488 | regcount_real = regcount |
---|
2489 | fertcount_real = fertcount |
---|
2490 | CALL histwrite_p(hist_id_stomate ,'YIELD_RETURN',itime,YIELD_RETURN,npts*nvm, horipft_index) |
---|
2491 | CALL histwrite_p(hist_id_stomate ,'REGCOUNT' ,itime ,regcount_real , npts*nvm, horipft_index) |
---|
2492 | CALL histwrite_p(hist_id_stomate ,'FERTCOUNT',itime ,fertcount_real, npts*nvm, horipft_index) |
---|
2493 | CALL histwrite_p(hist_id_stomate ,'GMEAN1',itime ,gmean(:,:,1) ,npts*nvm, horipft_index) |
---|
2494 | CALL histwrite_p(hist_id_stomate ,'GMEAN2',itime ,gmean(:,:,2) ,npts*nvm, horipft_index) |
---|
2495 | CALL histwrite_p(hist_id_stomate ,'GMEAN3',itime ,gmean(:,:,3) ,npts*nvm, horipft_index) |
---|
2496 | CALL histwrite_p(hist_id_stomate ,'GMEAN4',itime ,gmean(:,:,4) ,npts*nvm, horipft_index) |
---|
2497 | CALL histwrite_p(hist_id_stomate ,'GMEAN5',itime ,gmean(:,:,5) ,npts*nvm, horipft_index) |
---|
2498 | CALL histwrite_p(hist_id_stomate ,'GMEAN6',itime ,gmean(:,:,6) ,npts*nvm, horipft_index) |
---|
2499 | CALL histwrite_p(hist_id_stomate ,'GMEAN7',itime ,gmean(:,:,7) ,npts*nvm, horipft_index) |
---|
2500 | CALL histwrite_p(hist_id_stomate ,'GMEAN8',itime ,gmean(:,:,8) ,npts*nvm, horipft_index) |
---|
2501 | CALL histwrite_p(hist_id_stomate ,'GMEAN9',itime ,gmean(:,:,9) ,npts*nvm, horipft_index) |
---|
2502 | CALL histwrite_p(hist_id_stomate ,'GMEAN0',itime ,gmean(:,:,10) ,npts*nvm, horipft_index) |
---|
2503 | CALL histwrite_p(hist_id_stomate ,'WSH' ,itime , wsh , npts*nvm, horipft_index) |
---|
2504 | CALL histwrite_p(hist_id_stomate ,'WSHTOT',itime , wshtot, npts*nvm, horipft_index) |
---|
2505 | CALL histwrite_p(hist_id_stomate ,'WR', itime , wr, npts*nvm, horipft_index) |
---|
2506 | CALL histwrite_p(hist_id_stomate ,'WRTOT', itime , wrtot, npts*nvm, horipft_index) |
---|
2507 | CALL histwrite_p(hist_id_stomate ,'WSHTOTSUM', itime , wshtotsum, npts*nvm, horipft_index) |
---|
2508 | CALL histwrite_p(hist_id_stomate ,'SR_UGB', itime , sr_ugb, npts*nvm,horipft_index) |
---|
2509 | ! HISTWRITE POUR LA FERTIILSATION |
---|
2510 | CALL histwrite_p(hist_id_stomate ,'FCORGFERTMET',itime , fcOrganicFertmetabolic,npts*nvm, horipft_index) |
---|
2511 | CALL histwrite_p(hist_id_stomate ,'FCORGFERTSTR' ,itime , fcOrganicFertstruct ,npts*nvm, horipft_index) |
---|
2512 | !CALL histwrite_p(hist_id_stomate ,'FNORGFERTURINE' ,itime , fnOrganicFerturine ,npts*nvm, horipft_index) |
---|
2513 | !CALL histwrite_p(hist_id_stomate ,'FNORGFERTSTR' ,itime , fnOrganicFertstruct ,npts*nvm, horipft_index) |
---|
2514 | !CALL histwrite_p(hist_id_stomate ,'FNORGFERTMET',itime , fnOrganicFertmetabolic,npts*nvm, horipft_index) |
---|
2515 | !CALL histwrite_p(hist_id_stomate ,'NFERTNITTOT' ,itime , nfertnit(:,:,1) ,npts*nvm, horipft_index) |
---|
2516 | !CALL histwrite_p(hist_id_stomate ,'NFERTAMMTOT' ,itime , nfertamm(:,:,1) ,npts*nvm, horipft_index) |
---|
2517 | ! HISTWRITE POUR LA FAUCHE |
---|
2518 | CALL histwrite_p(hist_id_stomate ,'LOSS' ,itime ,loss ,npts*nvm, horipft_index) |
---|
2519 | CALL histwrite_p(hist_id_stomate ,'LOSSC',itime ,lossc ,npts*nvm, horipft_index) |
---|
2520 | CALL histwrite_p(hist_id_stomate ,'LOSSN',itime ,lossn ,npts*nvm, horipft_index) |
---|
2521 | CALL histwrite_p(hist_id_stomate ,'DM_CUTYEARLY',itime ,DM_cutyearly ,npts*nvm, horipft_index) |
---|
2522 | CALL histwrite_p(hist_id_stomate ,'C_CUTYEARLY',itime ,C_cutyearly ,npts*nvm, horipft_index) |
---|
2523 | CALL histwrite_p(hist_id_stomate ,'COMPT_CUT' ,itime ,compt_cut ,npts*nvm, horipft_index) |
---|
2524 | CALL histwrite_p(hist_id_stomate ,'FREQUENCY_CUT',itime ,frequency_cut ,npts*nvm, horipft_index) |
---|
2525 | CALL histwrite_p(hist_id_stomate ,'NFERT_TOTAL',itime ,N_fert_total ,npts*nvm, horipft_index) |
---|
2526 | CALL histwrite_p(hist_id_stomate ,'NDEP',itime ,ndeposition ,npts*nvm,horipft_index) |
---|
2527 | CALL histwrite_p(hist_id_stomate ,'LEGUME_FRACTION',itime ,legume_fraction ,npts*nvm, horipft_index) |
---|
2528 | CALL histwrite_p(hist_id_stomate ,'SOIL_FERTILITY',itime ,soil_fertility ,npts*nvm, horipft_index) |
---|
2529 | CALL histwrite_p(hist_id_stomate ,'C' ,itime, c , npts*nvm, horipft_index) |
---|
2530 | CALL histwrite_p(hist_id_stomate ,'N' ,itime, n , npts*nvm, horipft_index) |
---|
2531 | CALL histwrite_p(hist_id_stomate ,'FN' ,itime, fn , npts*nvm, horipft_index) |
---|
2532 | CALL histwrite_p(hist_id_stomate ,'NTOT' ,itime, ntot , npts*nvm, horipft_index) |
---|
2533 | CALL histwrite_p(hist_id_stomate ,'NAPO' ,itime, napo , npts*nvm, horipft_index) |
---|
2534 | CALL histwrite_p(hist_id_stomate ,'NSYM' ,itime, nsym , npts*nvm, horipft_index) |
---|
2535 | CALL histwrite_p(hist_id_stomate ,'DEVSTAGE',itime, devstage, npts*nvm, horipft_index) |
---|
2536 | CALL histwrite_p(hist_id_stomate ,'TGROWTH' ,itime, tgrowth , npts*nvm, horipft_index) |
---|
2537 | CALL histwrite_p(hist_id_stomate ,'GRAZINGCSTRUCT',itime, grazingcstruct , npts*nvm, horipft_index) |
---|
2538 | CALL histwrite_p(hist_id_stomate ,'GRAZINGNSTRUCT',itime, grazingnstruct , npts*nvm, horipft_index) |
---|
2539 | CALL histwrite_p(hist_id_stomate ,'GRAZINGWN' ,itime, Substrate_grazingwn, npts*nvm, horipft_index) |
---|
2540 | CALL histwrite_p(hist_id_stomate ,'GRAZINGWC' ,itime, Substrate_grazingwc, npts*nvm, horipft_index) |
---|
2541 | !gmjc top 5 layer grassland soil moisture for grazing |
---|
2542 | CALL histwrite_p(hist_id_stomate ,'TMCGRASS_DAILY',itime,tmc_topgrass_daily, npts, hori_index) |
---|
2543 | CALL histwrite_p(hist_id_stomate ,'FC_GRAZING',itime,fc_grazing, npts, hori_index) |
---|
2544 | !end gmjc |
---|
2545 | END SUBROUTINE main_grassland_management |
---|
2546 | |
---|
2547 | ! modules calculating devstage and tgrowth for grazing |
---|
2548 | ! liste of functions calculated |
---|
2549 | ! - devstage |
---|
2550 | ! - tgrowth |
---|
2551 | ! - dndfi |
---|
2552 | SUBROUTINE Main_appl_pre_animal(& |
---|
2553 | npts , & |
---|
2554 | dt , & |
---|
2555 | tjulian , & |
---|
2556 | t2m_daily , & |
---|
2557 | tsoil , & |
---|
2558 | new_day , & |
---|
2559 | new_year , & |
---|
2560 | regcount , & |
---|
2561 | tcut , & |
---|
2562 | devstage , & |
---|
2563 | tgrowth ) |
---|
2564 | |
---|
2565 | INTEGER (i_std) , INTENT(in) :: npts |
---|
2566 | LOGICAL , INTENT(in) :: new_day |
---|
2567 | LOGICAL , INTENT(in) :: new_year |
---|
2568 | REAL(r_std) , INTENT(in) :: dt |
---|
2569 | INTEGER(i_std) , INTENT(in) :: tjulian |
---|
2570 | REAL(r_std), DIMENSION(npts) , INTENT(in) :: t2m_daily |
---|
2571 | ! air temperature (K) |
---|
2572 | REAL(r_std), DIMENSION(npts) , INTENT(in) :: tsoil |
---|
2573 | ! soil surface temperature |
---|
2574 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: tcut |
---|
2575 | INTEGER(i_std) , DIMENSION(npts,nvm) , INTENT(in) :: regcount |
---|
2576 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: devstage |
---|
2577 | ! state of developpement of growth |
---|
2578 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: tgrowth |
---|
2579 | ! time from last cut (d) |
---|
2580 | |
---|
2581 | INTEGER(i_std) :: ier |
---|
2582 | REAL(r_std), DIMENSION(npts) :: xtmp_npts |
---|
2583 | IF (new_year) THEN |
---|
2584 | tcut0(:,:) = 0.0 |
---|
2585 | END IF |
---|
2586 | |
---|
2587 | CALL cal_devstage(npts, dt, t2m_daily, tsoil, new_day, & |
---|
2588 | new_year, regcount, devstage) |
---|
2589 | CALL cal_tgrowth(npts, dt, devstage, tjulian, new_day, & |
---|
2590 | new_year, regcount, tcut, tgrowth) |
---|
2591 | |
---|
2592 | |
---|
2593 | END SUBROUTINE Main_appl_pre_animal |
---|
2594 | |
---|
2595 | ! module calculating devstage |
---|
2596 | SUBROUTINE cal_devstage(& |
---|
2597 | npts,dt,t2m_daily,tsoil,new_day, & |
---|
2598 | new_year, regcount, devstage) |
---|
2599 | |
---|
2600 | INTEGER (i_std) , INTENT(in) :: npts |
---|
2601 | REAL(r_std) , INTENT(in) :: dt |
---|
2602 | REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_daily |
---|
2603 | REAL(r_std), DIMENSION(npts), INTENT(in) :: tsoil |
---|
2604 | LOGICAL , INTENT(in) :: new_day |
---|
2605 | LOGICAL , INTENT(in) :: new_year |
---|
2606 | INTEGER(i_std) , DIMENSION(npts,nvm), INTENT(in) :: regcount |
---|
2607 | REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: devstage |
---|
2608 | |
---|
2609 | INTEGER(i_std) :: i,j |
---|
2610 | |
---|
2611 | CALL Euler_funct(npts,dt,t2m_daily,tacumm) |
---|
2612 | CALL Euler_funct(npts,dt,tsoil,tsoilcumm) |
---|
2613 | |
---|
2614 | CALL histwrite_p(hist_id_stomate ,'TSOILCUMM',itime,tsoilcumm, npts, hori_index) |
---|
2615 | |
---|
2616 | |
---|
2617 | IF (new_day) THEN |
---|
2618 | |
---|
2619 | tamean1(:) = tamean2(:) |
---|
2620 | tamean2(:) = tamean3(:) |
---|
2621 | tamean3(:) = tamean4(:) |
---|
2622 | tamean4(:) = tamean5(:) |
---|
2623 | tamean5(:) = tamean6(:) |
---|
2624 | tamean6(:) = tameand(:) |
---|
2625 | |
---|
2626 | tameand(:) = tacumm(:) - tacummprev(:) |
---|
2627 | tacummprev(:) = tacumm(:) |
---|
2628 | |
---|
2629 | tameanw(:) = (& |
---|
2630 | tamean1(:) + & |
---|
2631 | tamean2(:) + & |
---|
2632 | tamean3(:) + & |
---|
2633 | tamean4(:) + & |
---|
2634 | tamean5(:) + & |
---|
2635 | tamean6(:) + & |
---|
2636 | tameand(:))/7.0 |
---|
2637 | |
---|
2638 | tsoilmeand(:) = tsoilcumm(:) - tsoilcummprev(:) |
---|
2639 | tsoilcummprev(:) = tsoilcumm(:) |
---|
2640 | |
---|
2641 | DO j=2,nvm |
---|
2642 | DO i=1,npts |
---|
2643 | |
---|
2644 | IF ((devstage(i,j) .LE. 0.0) .AND. ( (tameanw(i) .GT. trep) .OR. & |
---|
2645 | (regcount(i,j) .EQ. 2) ) ) THEN |
---|
2646 | |
---|
2647 | devstage(i,j) = MAX(0.0, tameand(i) - tbase)/tasumrep |
---|
2648 | |
---|
2649 | ELSEIF ((devstage(i,j) .GT. 0.0) .AND. & |
---|
2650 | (tsoilmeand(i) .GT. tbase) .AND. & |
---|
2651 | (devstage(i,j) .LT. 2.0) ) THEN |
---|
2652 | |
---|
2653 | devstage(i,j) = devstage(i,j) + MAX(0.0, tameand(i) - & |
---|
2654 | tbase)/tasumrep |
---|
2655 | |
---|
2656 | ELSE |
---|
2657 | devstage(i,j) = devstage(i,j) |
---|
2658 | |
---|
2659 | ENDIF |
---|
2660 | END DO ! npts |
---|
2661 | END DO ! nvm |
---|
2662 | END IF |
---|
2663 | |
---|
2664 | IF (new_year) THEN |
---|
2665 | |
---|
2666 | devstage(:,:) = 0.0 |
---|
2667 | |
---|
2668 | END IF |
---|
2669 | |
---|
2670 | END SUBROUTINE cal_devstage |
---|
2671 | |
---|
2672 | ! module calculating tgrowth |
---|
2673 | SUBROUTINE cal_tgrowth(& |
---|
2674 | npts, dt, devstage, tjulian, new_day, & |
---|
2675 | new_year, regcount, tcut, tgrowth) |
---|
2676 | |
---|
2677 | INTEGER(i_std) , INTENT(in) :: npts |
---|
2678 | REAL(r_std) , INTENT(in) :: dt |
---|
2679 | INTEGER(i_std) , INTENT(in) :: tjulian ! julien day (d) |
---|
2680 | LOGICAL , INTENT(in) :: new_day |
---|
2681 | LOGICAL , INTENT(in) :: new_year |
---|
2682 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: devstage ! state of developpement |
---|
2683 | INTEGER(i_std) , DIMENSION(npts,nvm), INTENT(in) :: regcount ! number of cut |
---|
2684 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: tcut ! cut date |
---|
2685 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: tgrowth ! regrowth time after last cut (d) |
---|
2686 | |
---|
2687 | INTEGER(i_std) :: i,j |
---|
2688 | |
---|
2689 | IF (new_day) THEN |
---|
2690 | |
---|
2691 | ! TGROWTH |
---|
2692 | !(robson, m. j. et al., 1988) |
---|
2693 | DO j=2,nvm |
---|
2694 | WHERE ((devstage(:,j) .GT. 0.0) .AND. (tcut0(:,j) .LE. 0.0)) |
---|
2695 | |
---|
2696 | tcut0(:,j) = FLOAT(tjulian) |
---|
2697 | |
---|
2698 | END WHERE |
---|
2699 | END DO |
---|
2700 | |
---|
2701 | DO j=2,nvm |
---|
2702 | DO i=1,npts |
---|
2703 | IF ((regcount(i,j) .EQ. 1) .AND. (tcut0(i,j) .LE. 0.0)) THEN |
---|
2704 | |
---|
2705 | tgrowth(i,j) = 0.0 |
---|
2706 | ELSEIF (regcount(i,j) .EQ. 1) THEN |
---|
2707 | |
---|
2708 | tgrowth(i,j) = tjulian - tcut0(i,j) |
---|
2709 | |
---|
2710 | ELSE |
---|
2711 | |
---|
2712 | tgrowth(i,j) = tjulian - tcut(i,j,regcount(i,j)-1) |
---|
2713 | |
---|
2714 | ENDIF |
---|
2715 | END DO ! npts |
---|
2716 | END DO ! nvm |
---|
2717 | END IF |
---|
2718 | |
---|
2719 | IF (new_year) THEN |
---|
2720 | tgrowth(:,:) = 0.0 |
---|
2721 | END IF |
---|
2722 | END SUBROUTINE cal_tgrowth |
---|
2723 | |
---|
2724 | ! module updating soil status |
---|
2725 | SUBROUTINE chg_sol_bio(& |
---|
2726 | npts , & |
---|
2727 | tjulian , & |
---|
2728 | bm_to_litter , & |
---|
2729 | litter , & |
---|
2730 | litter_avail , & |
---|
2731 | litter_not_avail , & |
---|
2732 | !spitfire |
---|
2733 | fuel_1hr, & |
---|
2734 | fuel_10hr, & |
---|
2735 | fuel_100hr, & |
---|
2736 | fuel_1000hr, & |
---|
2737 | !end spitfire |
---|
2738 | litter_avail_totDM , & |
---|
2739 | intake_litter , & |
---|
2740 | biomass , & |
---|
2741 | faecesc , & |
---|
2742 | urinec , & |
---|
2743 | fcOrganicFertmetabolic , & |
---|
2744 | fcOrganicFertstruct , & |
---|
2745 | fnOrganicFerturine , & |
---|
2746 | fnOrganicFertstruct , & |
---|
2747 | fnOrganicFertmetabolic , & |
---|
2748 | trampling , & |
---|
2749 | YIELD_RETURN , & |
---|
2750 | harvest_gm, cinput_gm) |
---|
2751 | |
---|
2752 | INTEGER , INTENT(in) :: npts |
---|
2753 | INTEGER(i_std) , INTENT(in) :: tjulian ! jour julien |
---|
2754 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(inout):: bm_to_litter |
---|
2755 | REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(inout):: litter |
---|
2756 | REAL(r_std), DIMENSION(npts,nlitt,nvm), INTENT(inout):: litter_avail |
---|
2757 | REAL(r_std), DIMENSION(npts,nlitt,nvm), INTENT(inout):: litter_not_avail |
---|
2758 | !spitfire |
---|
2759 | REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout) :: fuel_1hr |
---|
2760 | REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout) :: fuel_10hr |
---|
2761 | REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout) :: fuel_100hr |
---|
2762 | REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout) :: fuel_1000hr |
---|
2763 | !end spitfire |
---|
2764 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout):: litter_avail_totDM |
---|
2765 | REAL(r_std), DIMENSION(npts,nvm), INTENT(in):: intake_litter |
---|
2766 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: faecesc |
---|
2767 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: urinec |
---|
2768 | REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in) :: biomass |
---|
2769 | ! totalité de masse sèche du shoot(kg/m**2) |
---|
2770 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: fcOrganicFertmetabolic |
---|
2771 | ! metabolic C in slurry and manure (kg C/m**2/d) |
---|
2772 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: fcOrganicFertstruct |
---|
2773 | ! structural C in slurry and manure (kg C/m**2/d) |
---|
2774 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: fnOrganicFerturine |
---|
2775 | ! urine N in slurry and manure (kg N/m**2/d) |
---|
2776 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: fnOrganicFertstruct |
---|
2777 | ! structural N in slurry and manure (kg N/m**2/d) |
---|
2778 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: fnOrganicFertmetabolic |
---|
2779 | ! metabolic N in slurry and manure (kg N/m**2/d) |
---|
2780 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: trampling |
---|
2781 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(inout) :: YIELD_RETURN |
---|
2782 | |
---|
2783 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: harvest_gm |
---|
2784 | REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: cinput_gm |
---|
2785 | |
---|
2786 | REAL(r_std), DIMENSION(npts,nvm) :: litter_avail_totDM_old |
---|
2787 | REAL(r_std), DIMENSION(npts,nvm) :: fcloss |
---|
2788 | REAL(r_std), DIMENSION(npts,nvm) :: fnloss |
---|
2789 | REAL(r_std), DIMENSION(npts,nvm) :: floss |
---|
2790 | REAL(r_std), DIMENSION(npts,nvm) :: fcplantsoil |
---|
2791 | REAL(r_std), DIMENSION(npts,nvm) :: fnplantsoil |
---|
2792 | REAL(r_std), DIMENSION(npts,nvm) :: fplantsoil |
---|
2793 | REAL(r_std), DIMENSION(npts,nvm) :: l2nratio |
---|
2794 | REAL(r_std), DIMENSION(npts,nvm) :: fmetabolic |
---|
2795 | REAL(r_std), DIMENSION(npts,nvm) :: manure_barn |
---|
2796 | INTEGER(i_std) :: j |
---|
2797 | REAL(r_std), PARAMETER :: yieldloss = 0.05 |
---|
2798 | !spitfire |
---|
2799 | REAL(r_std), DIMENSION(npts,nvm,nlitt) :: fuel_all_type |
---|
2800 | REAL(r_std), DIMENSION(npts,nvm,nlitt,4) :: fuel_type_frac |
---|
2801 | !end spitfire |
---|
2802 | |
---|
2803 | IF (blabla_pasim) PRINT *, 'PASIM main grassland : call chg_sol_bio' |
---|
2804 | fmetabolic = 0.0 |
---|
2805 | |
---|
2806 | !spitfire |
---|
2807 | fuel_type_frac(:,:,:,:) = zero |
---|
2808 | fuel_all_type(:,:,:) = fuel_1hr(:,:,:) + fuel_10hr(:,:,:) + & |
---|
2809 | fuel_100hr(:,:,:) + fuel_1000hr(:,:,:) |
---|
2810 | WHERE (fuel_all_type(:,:,:) .GT. min_stomate) |
---|
2811 | fuel_type_frac(:,:,:,1) = fuel_1hr(:,:,:)/fuel_all_type(:,:,:) |
---|
2812 | fuel_type_frac(:,:,:,2) = fuel_10hr(:,:,:)/fuel_all_type(:,:,:) |
---|
2813 | fuel_type_frac(:,:,:,3) = fuel_100hr(:,:,:)/fuel_all_type(:,:,:) |
---|
2814 | fuel_type_frac(:,:,:,4) = fuel_1000hr(:,:,:)/fuel_all_type(:,:,:) |
---|
2815 | ENDWHERE |
---|
2816 | !end spitfire |
---|
2817 | |
---|
2818 | DO j=2,nvm |
---|
2819 | ! tlossstart will be set to tjulian when cutting is trigered at the point |
---|
2820 | ! deltatt = 1.000000 |
---|
2821 | WHERE ((tjulian .GE. tlossstart(:,j)) .AND. & |
---|
2822 | (tjulian .LT. (tlossstart(:,j) + deltatt/2.0))) |
---|
2823 | |
---|
2824 | fcloss(:,j) = lossc(:,j)/deltatt |
---|
2825 | fnloss(:,j) = lossn(:,j)/deltatt |
---|
2826 | floss(:,j) = loss(:,j) /deltatt |
---|
2827 | ! loss is 5% of total harvest, 95% is exported out of ecosystem |
---|
2828 | ! kgC m-2 day-1 -> g C m-2 day-1 |
---|
2829 | harvest_gm(:,j) = fcloss(:,j)/yieldloss*(1-yieldloss)*1e3 |
---|
2830 | |
---|
2831 | ELSEWHERE |
---|
2832 | |
---|
2833 | fcloss(:,j) = zero |
---|
2834 | fnloss(:,j) = zero |
---|
2835 | floss(:,j) = zero |
---|
2836 | harvest_gm(:,j) = zero |
---|
2837 | END WHERE |
---|
2838 | |
---|
2839 | cinput_gm(:,j) = (fcOrganicFertstruct(:,j)+fcOrganicFertmetabolic(:,j))*1e3 |
---|
2840 | |
---|
2841 | fcplantsoil(:,j) = fcloss(:,j) |
---|
2842 | fnplantsoil(:,j) = fnloss(:,j) |
---|
2843 | fplantsoil(:,j) = floss(:,j) |
---|
2844 | |
---|
2845 | WHERE (fnplantsoil(:,j) .GT. 0.0) |
---|
2846 | |
---|
2847 | l2nratio(:,j) = fligninresidue * fplantsoil(:,j)/ fnplantsoil(:,j) |
---|
2848 | |
---|
2849 | ELSEWHERE |
---|
2850 | |
---|
2851 | l2nratio(:,j) = 0.0 |
---|
2852 | |
---|
2853 | END WHERE |
---|
2854 | |
---|
2855 | IF (is_grassland_cut(j).AND.(.NOT.is_grassland_grazed(j)))THEN |
---|
2856 | |
---|
2857 | ! Manure produced at barn |
---|
2858 | ! 0.05 yieldloss 0.95 import_yield/harvest 0.85 loss during trasportation |
---|
2859 | ! 0.12 fraction of manure spread to field in total intake dry matter at barn (0.85*0.95harvest) |
---|
2860 | !JCcomment for accounting for Manurefert only not return |
---|
2861 | ! WHERE (YIELD_RETURN(:,:) .GT. 0.0) |
---|
2862 | ! manure_barn(:,j) = fcplantsoil(:,j) / 0.05 * 0.95 * 0.85 *0.12 +& |
---|
2863 | ! YIELD_RETURN(:,:) * CtoDM |
---|
2864 | ! YIELD_RETURN(:,:) = 0.0 |
---|
2865 | ! ELSEWHERE |
---|
2866 | ! manure_barn(:,j) = fcplantsoil(:,j) / 0.05 * 0.95 * 0.85 *0.12 |
---|
2867 | ! ENDWHERE |
---|
2868 | manure_barn(:,j) = 0.0 |
---|
2869 | |
---|
2870 | ELSE |
---|
2871 | manure_barn(:,j) = 0.0 |
---|
2872 | END IF |
---|
2873 | |
---|
2874 | fmetabolic(:,j) = MAX(0.625,MIN(0.85 - 0.018 * l2nratio(:,j), 1.0 - fligninresidue)) |
---|
2875 | bm_to_litter(:,j,ileaf,icarbon) = bm_to_litter(:,j,ileaf,icarbon) + & |
---|
2876 | & fmetabolic(:,j) * (fcplantsoil(:,j) * 1000.0 + trampling(:,j)) |
---|
2877 | |
---|
2878 | bm_to_litter(:,j,isapabove,icarbon) = bm_to_litter(:,j,isapabove,icarbon) + & |
---|
2879 | & (1.0 - fmetabolic(:,j)) * (fcplantsoil(:,j) * 1000.0 + trampling(:,j)) |
---|
2880 | litter_avail_totDM_old(:,j) = litter_avail_totDM(:,j) |
---|
2881 | ! new litter available tot DM after intake litter |
---|
2882 | litter_avail_totDM(:,j) = litter_avail_totDM(:,j) - intake_litter(:,j) |
---|
2883 | IF (ANY(litter_avail_totDM(:,j) .LT. -0.01 ) ) THEN |
---|
2884 | WRITE(numout,*) 'zd ','litter avail', j, litter_avail_totDM_old(:,j) |
---|
2885 | WRITE(numout,*) 'zd ','intake litter', j, intake_litter(:,j) |
---|
2886 | STOP 'available litter is not enough for grazing' |
---|
2887 | |
---|
2888 | ENDIF |
---|
2889 | ! litter available C left is recalculated |
---|
2890 | ! assuming the same structural and metabolic fraction |
---|
2891 | WHERE (litter_avail_totDM_old(:,j) .GT. 0.0 ) |
---|
2892 | litter_avail(:,istructural,j) = litter_avail(:,istructural,j) * & |
---|
2893 | & (litter_avail_totDM(:,j)/litter_avail_totDM_old(:,j)) |
---|
2894 | litter_avail(:,imetabolic,j) = litter_avail(:,imetabolic,j) * & |
---|
2895 | & (litter_avail_totDM(:,j)/litter_avail_totDM_old(:,j)) |
---|
2896 | ELSEWHERE |
---|
2897 | litter_avail(:,istructural,j) = litter_avail(:,istructural,j) |
---|
2898 | litter_avail(:,imetabolic,j) = litter_avail(:,imetabolic,j) |
---|
2899 | ENDWHERE |
---|
2900 | ! new litter not available after manure/urine |
---|
2901 | |
---|
2902 | litter_not_avail(:,istructural,j) = litter_not_avail(:,istructural,j) + & |
---|
2903 | & (faecesc(:,j) + urinec(:,j) + manure_barn(:,j) ) * 1000.0 * (1.0 - fmetabolic(:,j)) + & |
---|
2904 | & fcOrganicFertstruct(:,j) * 1000.0 |
---|
2905 | |
---|
2906 | litter_not_avail(:,imetabolic,j) = litter_not_avail(:,imetabolic,j) + & |
---|
2907 | & (faecesc(:,j) + urinec(:,j) + manure_barn(:,j) ) * 1000.0 * fmetabolic(:,j) + & |
---|
2908 | & fcOrganicFertmetabolic(:,j) * 1000.0 |
---|
2909 | ! update litter |
---|
2910 | litter(:,:,j,iabove,icarbon) = litter_avail(:,:,j) + litter_not_avail(:,:,j) |
---|
2911 | !spitfire |
---|
2912 | fuel_1hr(:,j,:) = litter(:,:,j,iabove,icarbon) * fuel_type_frac(:,j,:,1) |
---|
2913 | fuel_10hr(:,j,:) = litter(:,:,j,iabove,icarbon) * fuel_type_frac(:,j,:,2) |
---|
2914 | fuel_100hr(:,j,:) = litter(:,:,j,iabove,icarbon) * fuel_type_frac(:,j,:,3) |
---|
2915 | fuel_1000hr(:,j,:) = litter(:,:,j,iabove,icarbon) * fuel_type_frac(:,j,:,4) |
---|
2916 | !endspit |
---|
2917 | |
---|
2918 | END DO |
---|
2919 | END SUBROUTINE chg_sol_bio |
---|
2920 | |
---|
2921 | ! clear memory used by grassland management module |
---|
2922 | SUBROUTINE grassmanag_clear |
---|
2923 | IF (ALLOCATED(intake)) DEALLOCATE(intake) |
---|
2924 | IF (ALLOCATED(intakemax)) DEALLOCATE(intakemax) |
---|
2925 | IF (ALLOCATED(intake_litter)) DEALLOCATE(intake_litter) |
---|
2926 | IF (ALLOCATED(intake_animal_litter)) DEALLOCATE(intake_animal_litter) |
---|
2927 | IF (ALLOCATED(grazing_litter)) DEALLOCATE(grazing_litter) |
---|
2928 | IF (ALLOCATED(litter_avail_totDM)) DEALLOCATE(litter_avail_totDM) |
---|
2929 | IF (ALLOCATED(wshtotcutinit)) DEALLOCATE(wshtotcutinit) |
---|
2930 | IF (ALLOCATED(lcutinit)) DEALLOCATE(lcutinit) |
---|
2931 | IF (ALLOCATED(devstage)) DEALLOCATE(devstage) |
---|
2932 | IF (ALLOCATED(faecesc)) DEALLOCATE(faecesc) |
---|
2933 | IF (ALLOCATED(faecesn)) DEALLOCATE(faecesn) |
---|
2934 | IF (ALLOCATED(urinen)) DEALLOCATE(urinen) |
---|
2935 | IF (ALLOCATED(urinec)) DEALLOCATE(urinec) |
---|
2936 | IF (ALLOCATED(nel)) DEALLOCATE(nel) |
---|
2937 | IF (ALLOCATED(nanimaltot)) DEALLOCATE(nanimaltot) |
---|
2938 | IF (ALLOCATED(tgrowth)) DEALLOCATE(tgrowth) |
---|
2939 | IF (ALLOCATED(wsh)) DEALLOCATE(wsh) |
---|
2940 | IF (ALLOCATED(wshtot)) DEALLOCATE(wshtot) |
---|
2941 | IF (ALLOCATED(wshtotinit)) DEALLOCATE(wshtotinit) |
---|
2942 | IF (ALLOCATED(wr)) DEALLOCATE(wr) |
---|
2943 | IF (ALLOCATED(wrtot)) DEALLOCATE(wrtot) |
---|
2944 | IF (ALLOCATED(wanimal)) DEALLOCATE(wanimal) |
---|
2945 | IF (ALLOCATED(ntot)) DEALLOCATE(ntot) |
---|
2946 | IF (ALLOCATED(c)) DEALLOCATE(c) |
---|
2947 | IF (ALLOCATED(n)) DEALLOCATE(n) |
---|
2948 | IF (ALLOCATED(fn)) DEALLOCATE(fn) |
---|
2949 | IF (ALLOCATED(napo)) DEALLOCATE(napo) |
---|
2950 | IF (ALLOCATED(nsym)) DEALLOCATE(nsym) |
---|
2951 | IF (ALLOCATED(wnapo)) DEALLOCATE(wnapo) |
---|
2952 | IF (ALLOCATED(wnsym)) DEALLOCATE(wnsym) |
---|
2953 | IF (ALLOCATED(wn)) DEALLOCATE(wn) |
---|
2954 | IF (ALLOCATED(nanimal)) DEALLOCATE(nanimal) |
---|
2955 | IF (ALLOCATED(tanimal)) DEALLOCATE(tanimal) |
---|
2956 | IF (ALLOCATED(danimal)) DEALLOCATE(danimal) |
---|
2957 | IF (ALLOCATED(tcut)) DEALLOCATE(tcut) |
---|
2958 | IF (ALLOCATED(tfert)) DEALLOCATE(tfert) |
---|
2959 | IF (ALLOCATED(Nliquidmanure)) DEALLOCATE(Nliquidmanure) |
---|
2960 | IF (ALLOCATED(nslurry)) DEALLOCATE(nslurry) |
---|
2961 | IF (ALLOCATED(Nsolidmanure)) DEALLOCATE(Nsolidmanure) |
---|
2962 | IF (ALLOCATED(legume_fraction)) DEALLOCATE(legume_fraction) |
---|
2963 | IF (ALLOCATED(soil_fertility)) DEALLOCATE(soil_fertility) |
---|
2964 | IF (ALLOCATED(Animalwgrazingmin)) DEALLOCATE(Animalwgrazingmin) |
---|
2965 | IF (ALLOCATED(AnimalkintakeM)) DEALLOCATE(AnimalkintakeM) |
---|
2966 | IF (ALLOCATED(AnimalDiscremineQualite)) DEALLOCATE(AnimalDiscremineQualite) |
---|
2967 | IF (ALLOCATED(controle_azote)) DEALLOCATE(controle_azote) |
---|
2968 | IF (ALLOCATED(fcOrganicFertmetabolicsum)) DEALLOCATE(fcOrganicFertmetabolicsum) |
---|
2969 | IF (ALLOCATED(fcOrganicFertstructsum)) DEALLOCATE(fcOrganicFertstructsum) |
---|
2970 | IF (ALLOCATED(fnOrganicFertmetabolicsum)) DEALLOCATE(fnOrganicFertmetabolicsum) |
---|
2971 | IF (ALLOCATED(fnOrganicFertstructsum)) DEALLOCATE(fnOrganicFertstructsum) |
---|
2972 | IF (ALLOCATED(fnOrganicFerturinesum)) DEALLOCATE(fnOrganicFerturinesum) |
---|
2973 | IF (ALLOCATED(fnatmsum)) DEALLOCATE(fnatmsum) |
---|
2974 | IF (ALLOCATED(controle_azote_sum)) DEALLOCATE(controle_azote_sum) |
---|
2975 | IF (ALLOCATED(nfertamm)) DEALLOCATE(nfertamm) |
---|
2976 | IF (ALLOCATED(nfertnit)) DEALLOCATE(nfertnit) |
---|
2977 | IF (ALLOCATED(intakesum)) DEALLOCATE(intakesum) |
---|
2978 | IF (ALLOCATED(intakensum)) DEALLOCATE(intakensum) |
---|
2979 | IF (ALLOCATED(intake_animal)) DEALLOCATE(intake_animal) |
---|
2980 | IF (ALLOCATED(intake_animalsum)) DEALLOCATE(intake_animalsum) |
---|
2981 | IF (ALLOCATED(PIYcow)) DEALLOCATE(PIYcow) |
---|
2982 | IF (ALLOCATED(PIMcow)) DEALLOCATE(PIMcow) |
---|
2983 | IF (ALLOCATED(BCSYcow)) DEALLOCATE(BCSYcow) |
---|
2984 | IF (ALLOCATED(BCSMcow)) DEALLOCATE(BCSMcow) |
---|
2985 | IF (ALLOCATED(PICcow)) DEALLOCATE(PICcow) |
---|
2986 | IF (ALLOCATED(AGE_cow_P)) DEALLOCATE(AGE_cow_P) |
---|
2987 | IF (ALLOCATED(AGE_cow_M)) DEALLOCATE(AGE_cow_M) |
---|
2988 | IF (ALLOCATED(Autogestion_out)) DEALLOCATE(Autogestion_out) |
---|
2989 | IF (ALLOCATED(Forage_quantity)) DEALLOCATE(Forage_quantity) |
---|
2990 | IF (ALLOCATED(tcut_modif)) DEALLOCATE(tcut_modif) |
---|
2991 | IF (ALLOCATED(countschedule)) DEALLOCATE(countschedule) |
---|
2992 | IF (ALLOCATED(mux)) DEALLOCATE(mux) |
---|
2993 | IF (ALLOCATED(mugmean)) DEALLOCATE(mugmean) |
---|
2994 | IF (ALLOCATED(sigx)) DEALLOCATE(sigx) |
---|
2995 | IF (ALLOCATED(sigy)) DEALLOCATE(sigy) |
---|
2996 | IF (ALLOCATED(gmeanslope)) DEALLOCATE(gmeanslope) |
---|
2997 | IF (ALLOCATED(gzero)) DEALLOCATE(gzero) |
---|
2998 | IF (ALLOCATED(gcor)) DEALLOCATE(gcor) |
---|
2999 | IF (ALLOCATED(cuttingend)) DEALLOCATE(cuttingend) |
---|
3000 | IF (ALLOCATED(tcut_verif)) DEALLOCATE(tcut_verif) |
---|
3001 | IF (ALLOCATED(tfert_verif)) DEALLOCATE(tfert_verif) |
---|
3002 | IF (ALLOCATED(tfert_verif2)) DEALLOCATE(tfert_verif2) |
---|
3003 | IF (ALLOCATED(tfert_verif3)) DEALLOCATE(tfert_verif3) |
---|
3004 | IF (ALLOCATED(regcount)) DEALLOCATE(regcount) |
---|
3005 | IF (ALLOCATED(wshcutinit)) DEALLOCATE(wshcutinit) |
---|
3006 | IF (ALLOCATED(gmean)) DEALLOCATE(gmean) |
---|
3007 | IF (ALLOCATED(tgmean)) DEALLOCATE(tgmean) |
---|
3008 | IF (ALLOCATED(wc_frac)) DEALLOCATE(wc_frac) |
---|
3009 | IF (ALLOCATED(wgn)) DEALLOCATE(wgn) |
---|
3010 | IF (ALLOCATED(tasum)) DEALLOCATE(tasum) |
---|
3011 | IF (ALLOCATED(loss)) DEALLOCATE(loss) |
---|
3012 | IF (ALLOCATED(lossc)) DEALLOCATE(lossc) |
---|
3013 | IF (ALLOCATED(lossn)) DEALLOCATE(lossn) |
---|
3014 | IF (ALLOCATED(tlossstart)) DEALLOCATE(tlossstart) |
---|
3015 | IF (ALLOCATED(flag_fertilisation)) DEALLOCATE(flag_fertilisation) |
---|
3016 | IF (ALLOCATED(fertcount)) DEALLOCATE(fertcount) |
---|
3017 | IF (ALLOCATED(c2nratiostruct)) DEALLOCATE(c2nratiostruct) |
---|
3018 | IF (ALLOCATED(nfertammtot)) DEALLOCATE(nfertammtot) |
---|
3019 | IF (ALLOCATED(nfertnittot)) DEALLOCATE(nfertnittot) |
---|
3020 | IF (ALLOCATED(nfertammtotyear)) DEALLOCATE(nfertammtotyear) |
---|
3021 | IF (ALLOCATED(nfertnittotyear)) DEALLOCATE(nfertnittotyear) |
---|
3022 | IF (ALLOCATED(nfertammtotprevyear)) DEALLOCATE(nfertammtotprevyear) |
---|
3023 | IF (ALLOCATED(nfertnittotprevyear)) DEALLOCATE(nfertnittotprevyear) |
---|
3024 | IF (ALLOCATED(fcOrganicFertmetabolic)) DEALLOCATE(fcOrganicFertmetabolic) |
---|
3025 | IF (ALLOCATED(fcOrganicFertstruct)) DEALLOCATE(fcOrganicFertstruct) |
---|
3026 | IF (ALLOCATED(fnOrganicFerturine)) DEALLOCATE(fnOrganicFerturine) |
---|
3027 | IF (ALLOCATED(fnOrganicFertstruct)) DEALLOCATE(fnOrganicFertstruct) |
---|
3028 | IF (ALLOCATED(fnOrganicFertmetabolic)) DEALLOCATE(fnOrganicFertmetabolic) |
---|
3029 | IF (ALLOCATED(nsatur_somerror_temp)) DEALLOCATE(nsatur_somerror_temp) |
---|
3030 | IF (ALLOCATED(nsatur_somerror)) DEALLOCATE(nsatur_somerror) |
---|
3031 | IF (ALLOCATED(tfert_modif)) DEALLOCATE(tfert_modif) |
---|
3032 | IF (ALLOCATED(nnonlimit_SOMerror)) DEALLOCATE(nnonlimit_SOMerror) |
---|
3033 | IF (ALLOCATED(nnonlimit_SOMerrormax)) DEALLOCATE(nnonlimit_SOMerrormax) |
---|
3034 | IF (ALLOCATED(controle_azote_sum_mem)) DEALLOCATE(controle_azote_sum_mem) |
---|
3035 | IF (ALLOCATED(n_auto)) DEALLOCATE(n_auto) |
---|
3036 | IF (ALLOCATED(stoplimitant)) DEALLOCATE(stoplimitant) |
---|
3037 | IF (ALLOCATED(fertcount_start)) DEALLOCATE(fertcount_start) |
---|
3038 | IF (ALLOCATED(fertcount_current)) DEALLOCATE(fertcount_current) |
---|
3039 | IF (ALLOCATED(wshtotsumprev)) DEALLOCATE(wshtotsumprev) |
---|
3040 | IF (ALLOCATED(fertil_year)) DEALLOCATE(fertil_year) |
---|
3041 | IF (ALLOCATED(toto)) DEALLOCATE(toto) |
---|
3042 | IF (ALLOCATED(apport_azote)) DEALLOCATE(apport_azote) |
---|
3043 | IF (ALLOCATED(trampling)) DEALLOCATE(trampling) |
---|
3044 | IF (ALLOCATED(wshtotsumprevyear)) DEALLOCATE(wshtotsumprevyear) |
---|
3045 | IF (ALLOCATED(file_management)) DEALLOCATE(file_management) |
---|
3046 | IF (ALLOCATED(tmp_sr_ugb_C3)) DEALLOCATE(tmp_sr_ugb_C3) |
---|
3047 | IF (ALLOCATED(tmp_nb_ani_C3)) DEALLOCATE(tmp_nb_ani_C3) |
---|
3048 | IF (ALLOCATED(tmp_grazed_frac_C3)) DEALLOCATE(tmp_grazed_frac_C3) |
---|
3049 | IF (ALLOCATED(tmp_import_yield_C3)) DEALLOCATE(tmp_import_yield_C3) |
---|
3050 | IF (ALLOCATED(tmp_wshtotsum_C3)) DEALLOCATE(tmp_wshtotsum_C3) |
---|
3051 | IF (ALLOCATED(tmp_sr_ugb_C4)) DEALLOCATE(tmp_sr_ugb_C4) |
---|
3052 | IF (ALLOCATED(tmp_nb_ani_C4)) DEALLOCATE(tmp_nb_ani_C4) |
---|
3053 | IF (ALLOCATED(tmp_grazed_frac_C4)) DEALLOCATE(tmp_grazed_frac_C4) |
---|
3054 | IF (ALLOCATED(tmp_import_yield_C4)) DEALLOCATE(tmp_import_yield_C4) |
---|
3055 | IF (ALLOCATED(tmp_wshtotsum_C4)) DEALLOCATE(tmp_wshtotsum_C4) |
---|
3056 | IF (ALLOCATED(DM_cutyearly)) DEALLOCATE(DM_cutyearly) |
---|
3057 | IF (ALLOCATED(C_cutyearly)) DEALLOCATE(C_cutyearly) |
---|
3058 | IF (ALLOCATED(YIELD_RETURN)) DEALLOCATE(YIELD_RETURN) |
---|
3059 | IF (ALLOCATED(sr_ugb_init)) DEALLOCATE(sr_ugb_init) |
---|
3060 | IF (ALLOCATED(N_fert_total)) DEALLOCATE(N_fert_total) |
---|
3061 | IF (ALLOCATED(ndeposition)) DEALLOCATE(ndeposition) |
---|
3062 | IF (ALLOCATED(compt_cut)) DEALLOCATE(compt_cut) |
---|
3063 | IF (ALLOCATED(frequency_cut)) DEALLOCATE(frequency_cut) |
---|
3064 | IF (ALLOCATED(sr_wild)) DEALLOCATE(sr_wild) |
---|
3065 | IF (ALLOCATED(flag_cutting)) DEALLOCATE(flag_cutting) |
---|
3066 | ! from applic_plant |
---|
3067 | IF (ALLOCATED(tamean1)) DEALLOCATE(tamean1) |
---|
3068 | IF (ALLOCATED(tamean2)) DEALLOCATE(tamean2) |
---|
3069 | IF (ALLOCATED(tamean3)) DEALLOCATE(tamean3) |
---|
3070 | IF (ALLOCATED(tamean4)) DEALLOCATE(tamean4) |
---|
3071 | IF (ALLOCATED(tamean5)) DEALLOCATE(tamean5) |
---|
3072 | IF (ALLOCATED(tamean6)) DEALLOCATE(tamean6) |
---|
3073 | IF (ALLOCATED(tameand)) DEALLOCATE(tameand) |
---|
3074 | IF (ALLOCATED(tameanw)) DEALLOCATE(tameanw) |
---|
3075 | IF (ALLOCATED(tacumm)) DEALLOCATE(tacumm) |
---|
3076 | IF (ALLOCATED(tacummprev)) DEALLOCATE(tacummprev) |
---|
3077 | IF (ALLOCATED(tsoilcumm)) DEALLOCATE(tsoilcumm) |
---|
3078 | IF (ALLOCATED(tsoilcummprev)) DEALLOCATE(tsoilcummprev) |
---|
3079 | IF (ALLOCATED(tsoilmeand)) DEALLOCATE(tsoilmeand) |
---|
3080 | IF (ALLOCATED(tcut0)) DEALLOCATE(tcut0) |
---|
3081 | IF (ALLOCATED(Fert_sn)) DEALLOCATE(Fert_sn) |
---|
3082 | IF (ALLOCATED(Fert_on)) DEALLOCATE(Fert_on) |
---|
3083 | IF (ALLOCATED(Fert_PRP)) DEALLOCATE(Fert_PRP) |
---|
3084 | CALL animal_clear |
---|
3085 | |
---|
3086 | END SUBROUTINE grassmanag_clear |
---|
3087 | |
---|
3088 | ! ________________________________________________________________ |
---|
3089 | ! Functions read management.dat text file (not used for non-site simulation |
---|
3090 | ! ________________________________________________________________ |
---|
3091 | |
---|
3092 | SUBROUTINE reading_new_animal(& |
---|
3093 | npts , & |
---|
3094 | nb_year_management, & |
---|
3095 | tcutmodel , & |
---|
3096 | tcut , & |
---|
3097 | tfert , & |
---|
3098 | nfertamm , & |
---|
3099 | nfertnit , & |
---|
3100 | nanimal , & |
---|
3101 | tanimal , & |
---|
3102 | danimal , & |
---|
3103 | nliquidmanure , & |
---|
3104 | nslurry , & |
---|
3105 | nsolidmanure , & |
---|
3106 | PIYcow , & |
---|
3107 | PIMcow , & |
---|
3108 | BCSYcow , & |
---|
3109 | BCSMcow , & |
---|
3110 | PICcow , & |
---|
3111 | AGE_cow_P , & |
---|
3112 | AGE_cow_M , & |
---|
3113 | Forage_quantity) |
---|
3114 | |
---|
3115 | INTEGER (i_std) , INTENT(in) :: npts |
---|
3116 | INTEGER(i_std) , INTENT(in) :: tcutmodel |
---|
3117 | INTEGER(i_std),DIMENSION(nvm) , INTENT(in) :: nb_year_management |
---|
3118 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: tcut |
---|
3119 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: tfert |
---|
3120 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nfertamm |
---|
3121 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nfertnit |
---|
3122 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nanimal |
---|
3123 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: tanimal |
---|
3124 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: danimal |
---|
3125 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nliquidmanure |
---|
3126 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nslurry |
---|
3127 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nsolidmanure |
---|
3128 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: PIYcow |
---|
3129 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: PIMcow |
---|
3130 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: BCSYcow |
---|
3131 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: BCSMcow |
---|
3132 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: PICcow |
---|
3133 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: AGE_cow_P |
---|
3134 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: AGE_cow_M |
---|
3135 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: Forage_quantity |
---|
3136 | |
---|
3137 | REAL(r_std), DIMENSION(nstocking) :: nanimal_t |
---|
3138 | REAL(r_std), DIMENSION(nstocking) :: tanimal_t |
---|
3139 | REAL(r_std), DIMENSION(nstocking) :: danimal_t |
---|
3140 | REAL(r_std), DIMENSION(nstocking) :: tcut_t |
---|
3141 | REAL(r_std), DIMENSION(nstocking) :: tfert_t |
---|
3142 | REAL(r_std), DIMENSION(nstocking) :: nfertamm_t |
---|
3143 | REAL(r_std), DIMENSION(nstocking) :: nfertnit_t |
---|
3144 | REAL(r_std), DIMENSION(nstocking) :: nliquidmanure_t |
---|
3145 | REAL(r_std), DIMENSION(nstocking) :: nslurry_t |
---|
3146 | REAL(r_std), DIMENSION(nstocking) :: nsolidmanure_t |
---|
3147 | |
---|
3148 | REAL(r_std), DIMENSION(nstocking) :: PIYcow_t |
---|
3149 | REAL(r_std), DIMENSION(nstocking) :: PIMcow_t |
---|
3150 | REAL(r_std), DIMENSION(nstocking) :: BCSYcow_t |
---|
3151 | REAL(r_std), DIMENSION(nstocking) :: BCSMcow_t |
---|
3152 | REAL(r_std), DIMENSION(nstocking) :: PICcow_t |
---|
3153 | REAL(r_std), DIMENSION(nstocking) :: AGE_cow_P_t |
---|
3154 | REAL(r_std), DIMENSION(nstocking) :: AGE_cow_M_t |
---|
3155 | REAL(r_std), DIMENSION(nstocking) :: Forage_quantity_t |
---|
3156 | |
---|
3157 | INTEGER(i_std) :: ier, i, year, fin,j |
---|
3158 | CHARACTER(len=200) :: description |
---|
3159 | |
---|
3160 | DO j=2,nvm |
---|
3161 | OPEN(unit=60, file = file_management(j)) |
---|
3162 | |
---|
3163 | READ(60, * , iostat = ier) description |
---|
3164 | read_management : IF (tcutmodel .EQ. 0) THEN |
---|
3165 | IF (blabla_pasim) PRINT *, 'USERS MANAGEMENT' |
---|
3166 | |
---|
3167 | IF (nb_year_management(j) .LT. 1 ) STOP 'error with the nb_year_management' |
---|
3168 | |
---|
3169 | IF (MOD(count_year,nb_year_management(j)) .EQ. 0) THEN |
---|
3170 | fin = nb_year_management(j) |
---|
3171 | ELSE |
---|
3172 | fin = MOD(count_year,nb_year_management(j)) |
---|
3173 | END IF |
---|
3174 | |
---|
3175 | DO year = 1, fin |
---|
3176 | READ(60, *, iostat=ier) tcut_t(:) |
---|
3177 | READ(60, *, iostat=ier) tfert_t(:) |
---|
3178 | READ(60, *, iostat=ier) nfertamm_t(:) |
---|
3179 | READ(60, *, iostat=ier) nfertnit_t(:) |
---|
3180 | READ(60, *, iostat=ier) nanimal_t(:) |
---|
3181 | READ(60, *, iostat=ier) tanimal_t(:) |
---|
3182 | READ(60, *, iostat=ier) danimal_t(:) |
---|
3183 | READ(60, *, iostat=ier) nliquidmanure_t(:) |
---|
3184 | READ(60, *, iostat=ier) nslurry_t(:) |
---|
3185 | READ(60, *, iostat=ier) nsolidmanure_t(:) |
---|
3186 | |
---|
3187 | READ(60, *, iostat=ier) PIYcow_t(:) |
---|
3188 | READ(60, *, iostat=ier) PIMcow_t(:) |
---|
3189 | READ(60, *, iostat=ier) BCSYcow_t(:) |
---|
3190 | READ(60, *, iostat=ier) BCSMcow_t(:) |
---|
3191 | READ(60, *, iostat=ier) PICcow_t(:) |
---|
3192 | READ(60, *, iostat=ier) AGE_cow_P_t(:) |
---|
3193 | READ(60, *, iostat=ier) AGE_cow_M_t(:) |
---|
3194 | READ(60, *, iostat=ier) Forage_quantity_t(:) |
---|
3195 | DO i=1,npts |
---|
3196 | nanimal(i,j,:)=nanimal_t(:) |
---|
3197 | tanimal(i,j,:)=tanimal_t(:) |
---|
3198 | danimal(i,j,:)=danimal_t(:) |
---|
3199 | tcut(i,j,:)=tcut_t(:) |
---|
3200 | tfert(i,j,:)=tfert_t(:) |
---|
3201 | nfertamm(i,j,:)=nfertamm_t(:) |
---|
3202 | nfertnit(i,j,:)=nfertnit_t(:) |
---|
3203 | nliquidmanure(i,j,:)=nliquidmanure_t(:) |
---|
3204 | nslurry(i,j,:)=nslurry_t(:) |
---|
3205 | nsolidmanure(i,j,:)=nsolidmanure_t(:) |
---|
3206 | |
---|
3207 | PIYcow(i,j,:)=PIYcow_t(:) |
---|
3208 | PIMcow(i,j,:)=PIMcow_t(:) |
---|
3209 | BCSYcow(i,j,:)=BCSYcow_t(:) |
---|
3210 | BCSMcow(i,j,:)=BCSMcow_t(:) |
---|
3211 | PICcow(i,j,:)=PICcow_t(:) |
---|
3212 | AGE_cow_P(i,j,:)=AGE_cow_P_t(:) |
---|
3213 | AGE_cow_M(i,j,:)=AGE_cow_M_t(:) |
---|
3214 | Forage_quantity(i,j,:)=Forage_quantity_t(:) |
---|
3215 | |
---|
3216 | END DO |
---|
3217 | END DO |
---|
3218 | |
---|
3219 | ELSE IF (tcutmodel .EQ. 1) THEN |
---|
3220 | |
---|
3221 | PRINT *, 'AUTO MANAGEMENT' |
---|
3222 | READ(61, *, iostat = ier) toto(:) |
---|
3223 | READ(61, *, iostat = ier) toto(:) |
---|
3224 | READ(61, *, iostat = ier) toto(:) |
---|
3225 | READ(61, *, iostat = ier) toto(:) |
---|
3226 | |
---|
3227 | READ(60, *, iostat=ier) nanimal_t |
---|
3228 | DO i=1,npts |
---|
3229 | nanimal(i,j,:)=nanimal_t(:) |
---|
3230 | END DO |
---|
3231 | ELSE |
---|
3232 | |
---|
3233 | STOP 'PASIM ERROR :: tcutmodel must be 0 or 1' |
---|
3234 | |
---|
3235 | END IF read_management |
---|
3236 | CLOSE(60) |
---|
3237 | END DO !nvm |
---|
3238 | END SUBROUTINE reading_new_animal |
---|
3239 | |
---|
3240 | ! subroutine for reading management from map nc file |
---|
3241 | |
---|
3242 | SUBROUTINE reading_map_manag(& |
---|
3243 | npts, lalo, neighbours, resolution, contfrac, & |
---|
3244 | count_year , & |
---|
3245 | nb_year_management, & |
---|
3246 | management_intensity, & |
---|
3247 | management_start, & |
---|
3248 | tcut , & |
---|
3249 | tfert , & |
---|
3250 | nfertamm , & |
---|
3251 | nfertnit , & |
---|
3252 | nanimal , & |
---|
3253 | tanimal , & |
---|
3254 | danimal , & |
---|
3255 | nliquidmanure , & |
---|
3256 | nslurry , & |
---|
3257 | nsolidmanure , & |
---|
3258 | legume_fraction, & |
---|
3259 | soil_fertility , & |
---|
3260 | deposition_start, & |
---|
3261 | ndeposition, & |
---|
3262 | sr_ugb, & |
---|
3263 | sr_wild) |
---|
3264 | |
---|
3265 | INTEGER (i_std) , INTENT(in) :: npts |
---|
3266 | INTEGER(i_std),DIMENSION(npts,8),INTENT(in) :: neighbours !!Neighoring grid points if land for the DGVM |
---|
3267 | !!(unitless) |
---|
3268 | REAL(r_std),DIMENSION(npts,2),INTENT(in) :: lalo !!Geographical coordinates (latitude,longitude) |
---|
3269 | !! for pixels (degrees) |
---|
3270 | REAL(r_std),DIMENSION(npts,2),INTENT(in) :: resolution !! Size in x an y of the grid (m) - surface area of |
---|
3271 | !! the gridbox |
---|
3272 | REAL(r_std),DIMENSION (npts), INTENT (in) :: contfrac !! Fraction of continent in the grid cell (unitless) |
---|
3273 | INTEGER (i_std) , INTENT(in) :: count_year |
---|
3274 | INTEGER(i_std),DIMENSION(nvm) , INTENT(in) :: nb_year_management |
---|
3275 | INTEGER(i_std),DIMENSION(nvm) , INTENT(in) :: management_intensity |
---|
3276 | INTEGER(i_std),DIMENSION(nvm) , INTENT(in) :: management_start |
---|
3277 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: tcut |
---|
3278 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: tfert |
---|
3279 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nfertamm |
---|
3280 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nfertnit |
---|
3281 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nanimal |
---|
3282 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: tanimal |
---|
3283 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: danimal |
---|
3284 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nliquidmanure |
---|
3285 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nslurry |
---|
3286 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(out) :: nsolidmanure |
---|
3287 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: legume_fraction |
---|
3288 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: soil_fertility |
---|
3289 | INTEGER(i_std),DIMENSION(nvm) , INTENT(in) :: deposition_start |
---|
3290 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: ndeposition |
---|
3291 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(inout) :: sr_ugb |
---|
3292 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(inout) :: sr_wild |
---|
3293 | ! new variables for get map of management |
---|
3294 | REAL(r_std), DIMENSION(npts) :: nfert_temp |
---|
3295 | REAL(r_std), DIMENSION(npts) :: nmanure_temp |
---|
3296 | REAL(r_std), DIMENSION(npts) :: nanimal_temp |
---|
3297 | REAL(r_std), DIMENSION(npts) :: tcut_temp |
---|
3298 | REAL(r_std), DIMENSION(npts) :: grazing_temp |
---|
3299 | REAL(r_std), DIMENSION(npts) :: wild_temp |
---|
3300 | INTEGER(i_std) :: management_year |
---|
3301 | INTEGER(i_std) :: deposition_year |
---|
3302 | REAL(r_std), ALLOCATABLE,DIMENSION(:,:,:) :: manage1 |
---|
3303 | REAL(r_std), ALLOCATABLE,DIMENSION(:,:,:) :: manage2 |
---|
3304 | REAL(r_std), ALLOCATABLE,DIMENSION(:,:,:) :: manage3 |
---|
3305 | REAL(r_std), ALLOCATABLE,DIMENSION(:,:,:) :: manage4 |
---|
3306 | REAL(r_std), ALLOCATABLE,DIMENSION(:,:,:) :: manage5 |
---|
3307 | REAL(r_std), ALLOCATABLE,DIMENSION(:,:,:) :: manage6 |
---|
3308 | INTEGER(i_std) :: j |
---|
3309 | ! CROP spec |
---|
3310 | INTEGER(i_std) :: yrlen |
---|
3311 | CHARACTER(LEN=30) :: strManage |
---|
3312 | CHARACTER(LEN=30) :: strVar1 |
---|
3313 | CHARACTER(LEN=30) :: strVar2 |
---|
3314 | CHARACTER(LEN=30) :: strVar3 |
---|
3315 | CHARACTER(LEN=30) :: strVar4 |
---|
3316 | CHARACTER(LEN=30) :: strVar5 |
---|
3317 | CHARACTER(LEN=30) :: strVar6 |
---|
3318 | !initialize variables |
---|
3319 | tcut(:,:,:) = 500.0 |
---|
3320 | tfert(:,:,:) = 500.0 |
---|
3321 | nfertamm(:,:,:) = 0.0 |
---|
3322 | nfertnit(:,:,:) = 0.0 |
---|
3323 | nanimal(:,:,:) = 0.0 |
---|
3324 | tanimal(:,:,:) = 500.0 |
---|
3325 | danimal(:,:,:) = 0.0 |
---|
3326 | nliquidmanure(:,:,:) = 0.0 |
---|
3327 | nslurry(:,:,:) = 0.0 |
---|
3328 | nsolidmanure(:,:,:) = 0.0 |
---|
3329 | |
---|
3330 | legume_fraction(:,:) =0.0 |
---|
3331 | soil_fertility(:,:) = 1.0 |
---|
3332 | ndeposition(:,:) = 0.0 |
---|
3333 | |
---|
3334 | nfert_temp(:) =0.0 |
---|
3335 | nmanure_temp(:) =0.0 |
---|
3336 | nanimal_temp(:) = 0.0 |
---|
3337 | grazing_temp(:) =0.0 |
---|
3338 | wild_temp(:) =0.0 |
---|
3339 | |
---|
3340 | !JCMODIF to avoid read nc file many times (cost lot of CPU time) |
---|
3341 | ! modify the processes to read only once the file and save all variables |
---|
3342 | ! then put the temporary variables to PFTs that need it |
---|
3343 | ! though in this case the ManagInput module is only for postauto = 5 |
---|
3344 | ! rather than general reading |
---|
3345 | yrlen=1 |
---|
3346 | ! read file |
---|
3347 | ! fixed variable name |
---|
3348 | ! if run non-global simulation, should still present all 6 variables |
---|
3349 | strManage = "GRM_MANAGEMENT_MAP" |
---|
3350 | strVar1 = "Ndep" |
---|
3351 | strVar2 = "Nmanure" |
---|
3352 | strVar3 = "Nmineral" |
---|
3353 | strVar4 = "Tfert" |
---|
3354 | strVar5 = "sr_ugb" |
---|
3355 | strVar6 = "sr_wild" |
---|
3356 | |
---|
3357 | CALL slowproc_GRM_ManageInput(npts,lalo,neighbours,resolution,contfrac, & |
---|
3358 | strManage,strVar1,manage1,strVar2,manage2,strVar3,manage3,& |
---|
3359 | strVar4,manage4,strVar5,manage5,strVar6,manage6,yrlen) |
---|
3360 | ! gmjc add this for grids fail to read grid (fopt=0) |
---|
3361 | WHERE (manage1 .EQ. val_exp) |
---|
3362 | manage1 = 0.0 |
---|
3363 | ENDWHERE |
---|
3364 | WHERE (manage2 .EQ. val_exp) |
---|
3365 | manage2 = 0.0 |
---|
3366 | ENDWHERE |
---|
3367 | WHERE (manage3 .EQ. val_exp) |
---|
3368 | manage3 = 0.0 |
---|
3369 | ENDWHERE |
---|
3370 | ! Tfert default is 500 (no Tfert) |
---|
3371 | WHERE (manage4 .EQ. val_exp) |
---|
3372 | manage4 = 500.0 |
---|
3373 | ENDWHERE |
---|
3374 | WHERE (manage5 .EQ. val_exp) |
---|
3375 | manage5 = 0.0 |
---|
3376 | ENDWHERE |
---|
3377 | WHERE (manage6 .EQ. val_exp) |
---|
3378 | manage6 = 0.0 |
---|
3379 | ENDWHERE |
---|
3380 | |
---|
3381 | DO j=2,nvm |
---|
3382 | ! NOT necessary in reading 2D management since they are all 1 year per |
---|
3383 | ! file |
---|
3384 | ! IF (nb_year_management(j) .LT. 1 ) STOP 'error with the nb_year_management' |
---|
3385 | ! get which year of management should be read |
---|
3386 | IF (MOD(count_year,nb_year_management(j)) .EQ. 0) THEN |
---|
3387 | management_year = nb_year_management(j) + management_start(j)-1 |
---|
3388 | deposition_year = nb_year_management(j) + deposition_start(j)-1 |
---|
3389 | ELSE |
---|
3390 | management_year = MOD(count_year,nb_year_management(j)) + management_start(j)-1 |
---|
3391 | deposition_year = MOD(count_year,nb_year_management(j)) + deposition_start(j)-1 |
---|
3392 | END IF |
---|
3393 | WRITE(numout,*) management_year,deposition_year |
---|
3394 | !!!! read deposition global file for all grassland including nature |
---|
3395 | IF ( (.NOT. is_tree(j)) .AND. natural(j) .AND. (f_deposition_map .EQ. 1)) THEN |
---|
3396 | ndeposition(:,j)=manage1(:,1,1) |
---|
3397 | ELSE |
---|
3398 | ndeposition(:,j)=0.0 |
---|
3399 | ENDIF |
---|
3400 | !!!! read fertilization global file |
---|
3401 | IF (management_intensity(j) .EQ. 4) THEN |
---|
3402 | nslurry(:,j,1)=manage2(:,1,1)/10000. |
---|
3403 | nfertamm(:,j,1)=0.5*manage3(:,1,1)/10000. |
---|
3404 | nfertnit(:,j,1)=0.5*manage3(:,1,1)/10000. |
---|
3405 | ! tfert at global scale is not defined, set to 1st April |
---|
3406 | tfert(:,j,1) = manage4(:,1,1) |
---|
3407 | ! tfert(:,j,1)=90 |
---|
3408 | ENDIF |
---|
3409 | !!!! read sr_ugb global file |
---|
3410 | IF (f_postauto .EQ. 5 .AND. f_grazing_map .EQ. 1) THEN |
---|
3411 | sr_ugb(:,mgraze_C3)=manage5(:,1,1)/10000. |
---|
3412 | sr_ugb(:,mgraze_C4)=manage5(:,1,1)/10000. |
---|
3413 | WHERE (sr_ugb(:,mgraze_C3) .GT. 0.001) |
---|
3414 | sr_ugb(:,mgraze_C3) = 0.001 |
---|
3415 | sr_ugb(:,mgraze_C4) = 0.001 |
---|
3416 | END WHERE |
---|
3417 | if (ANY(sr_ugb(:,mgraze_C3) .EQ. 0.001)) then |
---|
3418 | print *, 'error sr_ugb',sr_ugb(:,mgraze_C3) |
---|
3419 | endif |
---|
3420 | !!!! read sr_wild global file wild animal density |
---|
3421 | !!!! only natural grassland will be grazed by wild animal |
---|
3422 | !!!! only when f_autogestion = 5 or f_postauto = 5 |
---|
3423 | IF ((.NOT. is_tree(j)) .AND. natural(j) .AND. & |
---|
3424 | & (.NOT. is_grassland_cut(j)) .AND. (.NOT.is_grassland_grazed(j))) THEN |
---|
3425 | sr_wild(:,j)=manage6(:,1,1)/10000. |
---|
3426 | ENDIF |
---|
3427 | ENDIF |
---|
3428 | |
---|
3429 | IF (management_intensity(j) .EQ. 1) THEN |
---|
3430 | ! low intensity of management in Europe ; NOT used anymore |
---|
3431 | ELSEIF (management_intensity(j) .EQ. 2) THEN |
---|
3432 | ! middle intensity of management in Europe ; for Leip et al., data only |
---|
3433 | nslurry(:,j,1)=manage2(:,1,1)/10000. |
---|
3434 | nfertamm(:,j,1)=0.5*manage3(:,1,1)/10000. |
---|
3435 | nfertnit(:,j,1)=0.5*manage3(:,1,1)/10000. |
---|
3436 | tfert(:,j,1)=90!manage4(:,1,1) |
---|
3437 | ELSEIF (management_intensity(j) .EQ. 3) THEN |
---|
3438 | ! high intensity of management in Europe ; NOT used anymore |
---|
3439 | ENDIF |
---|
3440 | |
---|
3441 | END DO ! nvm |
---|
3442 | END SUBROUTINE reading_map_manag |
---|
3443 | |
---|
3444 | ! subrouting calculate Nitrogen effect to vcmax |
---|
3445 | SUBROUTINE calc_N_limfert(& |
---|
3446 | npts,nfertamm, nfertnit,& |
---|
3447 | nliquidmanure, nslurry, nsolidmanure,& |
---|
3448 | legume_fraction,soil_fertility,ndeposition,& |
---|
3449 | N_fert_total,N_limfert) |
---|
3450 | |
---|
3451 | INTEGER (i_std) , INTENT(in) :: npts |
---|
3452 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nfertamm |
---|
3453 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nfertnit |
---|
3454 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nliquidmanure |
---|
3455 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nslurry |
---|
3456 | REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nsolidmanure |
---|
3457 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: legume_fraction |
---|
3458 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: soil_fertility |
---|
3459 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: N_fert_total |
---|
3460 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: N_limfert |
---|
3461 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: ndeposition |
---|
3462 | |
---|
3463 | INTEGER(i_std) :: k,j |
---|
3464 | |
---|
3465 | N_fert_total(:,:) = 0.0 |
---|
3466 | DO k=1,nstocking |
---|
3467 | N_fert_total(:,:) = (N_fert_total(:,:) + nfertamm(:,:,k) + & |
---|
3468 | nfertnit(:,:,k) + nliquidmanure(:,:,k) + & |
---|
3469 | nslurry(:,:,k) + nsolidmanure(:,:,k)) |
---|
3470 | ENDDO |
---|
3471 | N_fert_total(:,:) = N_fert_total(:,:) * 10000. + ndeposition(:,:) |
---|
3472 | N_fert_total(:,1) = 0.0 |
---|
3473 | ! DO j=2,nvm |
---|
3474 | ! IF ((management_intensity(j) .EQ. 2).AND. (.NOT. is_c4(j))) THEN |
---|
3475 | ! N_fert_total(:,mcut_C3)=N_fert_total(:,j) |
---|
3476 | ! N_fert_total(:,mgraze_C3)=N_fert_total(:,j) |
---|
3477 | ! ENDIF |
---|
3478 | ! IF ((management_intensity(j) .EQ. 2).AND. (is_c4(j))) THEN |
---|
3479 | ! N_fert_total(:,mcut_C4)=N_fert_total(:,j) |
---|
3480 | ! N_fert_total(:,mgraze_C4)=N_fert_total(:,j) |
---|
3481 | ! ENDIF |
---|
3482 | ! |
---|
3483 | ! ENDDO |
---|
3484 | !gmjc new fertilization effect |
---|
3485 | ! linear |
---|
3486 | !N_limfert(:,:) = 1.0 + (1.60-1.0)/320 * N_fert_total(:,:) |
---|
3487 | ! index |
---|
3488 | N_limfert(:,:) = 1. + N_effect - N_effect * (0.75 ** (N_fert_total(:,:)/30)) |
---|
3489 | |
---|
3490 | WHERE (N_limfert(:,:) .LT. 1.0) |
---|
3491 | N_limfert(:,:) = 1.0 |
---|
3492 | ELSEWHERE (N_limfert(:,:) .GT. 2.0) |
---|
3493 | N_limfert(:,:) = 1.+N_effect |
---|
3494 | ENDWHERE |
---|
3495 | |
---|
3496 | END SUBROUTINE calc_N_limfert |
---|
3497 | |
---|
3498 | ! Author: Xuhui Wang |
---|
3499 | ! Date: Oct. 18th, 2010 |
---|
3500 | ! Interpolate (extract) Planting Date information |
---|
3501 | ! for a specific crop type |
---|
3502 | ! Modified by Jinfeng Chang |
---|
3503 | ! Date: Dec. 1st, 2014 |
---|
3504 | ! General management map reading for grassland management module |
---|
3505 | ! Modified by Jinfeng Chang |
---|
3506 | ! Date: Apr. 21st, 2016 |
---|
3507 | ! to speed up the running, only open management file once |
---|
3508 | ! reading all variables |
---|
3509 | SUBROUTINE slowproc_GRM_ManageInput(npts,lalo,neighbours,resolution,contfrac, & |
---|
3510 | strIn,varname1,manage1,varname2,manage2,varname3,manage3,& |
---|
3511 | varname4,manage4,varname5,manage5,varname6,manage6,yrlen) |
---|
3512 | |
---|
3513 | ! INTEGER, parameter :: i_std = 4 |
---|
3514 | ! REAL, parameter :: r_std = 8 |
---|
3515 | ! |
---|
3516 | ! 0.1 INPUT |
---|
3517 | ! |
---|
3518 | INTEGER(i_std), INTENT(in) :: npts ! Number of points for which the data needs to be interpolated (extracted) |
---|
3519 | REAL(r_std), INTENT(in) :: lalo(npts,2) ! Vector of latitude and longtitude |
---|
3520 | INTEGER(i_std), INTENT(in) :: neighbours(npts,8) ! Vectors of neighbours for each grid point |
---|
3521 | ! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) |
---|
3522 | REAL(r_std),INTENT(in) :: resolution(npts,2) ! The size in km of each grid box in lat and lon |
---|
3523 | !REAL(r_std) :: resolution(npts,2) ! The size in km of each |
---|
3524 | !grid box in lat and lon |
---|
3525 | REAL(r_std),INTENT(in) :: contfrac(npts) ! The fraction of land in each grid box |
---|
3526 | CHARACTER(LEN=30),INTENT(in) :: strIn ! getin parameter and Call Sign of the management data |
---|
3527 | CHARACTER(LEN=30),INTENT(in) :: varname1 ! variable name in the nc file |
---|
3528 | CHARACTER(LEN=30),INTENT(in) :: varname2 ! variable name in the nc file |
---|
3529 | CHARACTER(LEN=30),INTENT(in) :: varname3 ! variable name in the nc file |
---|
3530 | CHARACTER(LEN=30),INTENT(in) :: varname4 ! variable name in the nc file |
---|
3531 | CHARACTER(LEN=30),INTENT(in) :: varname5 ! variable name in the nc file |
---|
3532 | CHARACTER(LEN=30),INTENT(in) :: varname6 ! variable name in the nc file |
---|
3533 | |
---|
3534 | ! |
---|
3535 | ! 0.2 OUTPUT |
---|
3536 | ! |
---|
3537 | REAL(r_std),ALLOCATABLE, INTENT(out) :: manage1(:,:,:) ! The planting date of the crop: npts, veg, year |
---|
3538 | REAL(r_std),ALLOCATABLE, INTENT(out) :: manage2(:,:,:) |
---|
3539 | REAL(r_std),ALLOCATABLE, INTENT(out) :: manage3(:,:,:) |
---|
3540 | REAL(r_std),ALLOCATABLE, INTENT(out) :: manage4(:,:,:) |
---|
3541 | REAL(r_std),ALLOCATABLE, INTENT(out) :: manage5(:,:,:) |
---|
3542 | REAL(r_std),ALLOCATABLE, INTENT(out) :: manage6(:,:,:) |
---|
3543 | ! nvm is the number of PFTs, there may not be planting date for all the PFTs |
---|
3544 | INTEGER(i_std), INTENT(out) :: yrlen ! year length of the output matrix |
---|
3545 | ! |
---|
3546 | ! 0.3 LOCAL |
---|
3547 | ! |
---|
3548 | INTEGER(i_std) :: nbvmax ! a parameter for interpolation |
---|
3549 | REAL(r_std) :: myres(npts,2) |
---|
3550 | CHARACTER(LEN=80) :: filename |
---|
3551 | INTEGER(i_std) :: iml, jml, lml, tml, fid, fid1 |
---|
3552 | INTEGER(i_std) :: ip, jp, ib, ilf, fopt, it ! for-loop variable |
---|
3553 | INTEGER(i_std) :: nbexp |
---|
3554 | REAL(r_std) :: lev(1), date, dt |
---|
3555 | REAL(r_std) :: missing_val |
---|
3556 | INTEGER(i_std) :: itau(1) |
---|
3557 | |
---|
3558 | INTEGER(i_std) :: nb_dim |
---|
3559 | INTEGER,DIMENSION(flio_max_var_dims) :: l_d_w |
---|
3560 | LOGICAL :: l_ex |
---|
3561 | |
---|
3562 | REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: lat_rel, lon_rel |
---|
3563 | REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: manage_mat1 ! LON LAT VEGET, Time |
---|
3564 | REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: manage_mat2 |
---|
3565 | REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: manage_mat3 |
---|
3566 | REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: manage_mat4 |
---|
3567 | REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: manage_mat5 |
---|
3568 | REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: manage_mat6 |
---|
3569 | ! JC for loop variables |
---|
3570 | REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:,:) :: manage_mat_all |
---|
3571 | REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: manage_all |
---|
3572 | INTEGER(i_std) :: nb_var_manag |
---|
3573 | INTEGER(i_std) :: iv_manag |
---|
3574 | ! end gmjc |
---|
3575 | INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask |
---|
3576 | REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: temp_data |
---|
3577 | REAL(r_std), ALLOCATABLE, DIMENSION(:,:) :: sub_area |
---|
3578 | INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:) :: sub_index |
---|
3579 | |
---|
3580 | REAL(r_std) :: sgn, sum_float |
---|
3581 | INTEGER(i_std) :: ivgt ! , icyc, pltcyc |
---|
3582 | CHARACTER(LEN=30) :: callsign |
---|
3583 | LOGICAL :: ok_interpol |
---|
3584 | INTEGER :: ALLOC_ERR |
---|
3585 | LOGICAL :: mydebug = .true. |
---|
3586 | |
---|
3587 | ! ! croptype = TRIM(croptype) !if croptype is a string |
---|
3588 | ! ! else a switch expression is needed |
---|
3589 | ! filename = "/work/cont003/p529tan/WXH/plt_date_modif.nc" ! default input |
---|
3590 | ! file |
---|
3591 | ! ! String operation needed |
---|
3592 | filename = "PlantingDate.nc" |
---|
3593 | CALL getin_p(strIn,filename) |
---|
3594 | |
---|
3595 | IF (is_root_prc) THEN |
---|
3596 | ! ? what does is_root_prc mean? |
---|
3597 | CALL flininfo(filename, iml, jml, lml, tml, fid) |
---|
3598 | ENDIF |
---|
3599 | CALL bcast(iml) |
---|
3600 | CALL bcast(jml) |
---|
3601 | ! CALL bcast(lml) |
---|
3602 | ! CALL bcast(tml) |
---|
3603 | |
---|
3604 | ! Printing information for debugging |
---|
3605 | IF (mydebug) THEN |
---|
3606 | WRITE(numout, *) "Xuhui's debug info for slowproc_ManageInput #1:" |
---|
3607 | WRITE(numout, *) "string in: ", strIn |
---|
3608 | WRITE(numout, *) "variable name: ", varname1,varname2,varname3,& |
---|
3609 | varname4,varname5,varname6 |
---|
3610 | WRITE(numout, *) "filename is: ", filename |
---|
3611 | WRITE(numout, *) "Dimension 1, lon, iml:", iml |
---|
3612 | WRITE(numout, *) "Dimension 2, lat, jml:", jml |
---|
3613 | WRITE(numout, *) "Dimension 3, veget, lml:", lml |
---|
3614 | WRITE(numout, *) "Dimension 4, time, tml:", tml |
---|
3615 | ENDIF |
---|
3616 | ! apparently, flinget function is not designed to take veget but levels to |
---|
3617 | ! be the |
---|
3618 | ! 3rd dimension, modification to lml is needed |
---|
3619 | |
---|
3620 | !JG all flio calls must be done by is_root_prc |
---|
3621 | IF (is_root_prc) THEN |
---|
3622 | CALL flioopfd(filename,fid1) |
---|
3623 | ! JC here only use dimension of the first variable |
---|
3624 | CALL flioinqv(fid1,v_n=varname1, l_ex = l_ex, nb_dims = nb_dim, len_dims =l_d_w) |
---|
3625 | IF (lml == 0) THEN |
---|
3626 | ! CALL |
---|
3627 | ! flioinqv(fid1,v_n="PLNTDT",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w) |
---|
3628 | lml=l_d_w(3) |
---|
3629 | IF (mydebug) THEN |
---|
3630 | WRITE(numout, *) "len_dims: ", l_d_w |
---|
3631 | WRITE(numout, *) "lml AFTER revision" |
---|
3632 | WRITE(numout, *) "lml: ", lml |
---|
3633 | ENDIF |
---|
3634 | ENDIF |
---|
3635 | IF (mydebug) THEN |
---|
3636 | WRITE(numout,*) "nb_dim: ", nb_dim |
---|
3637 | WRITE(numout,*) "resolution: ", resolution(1,:) |
---|
3638 | ENDIF |
---|
3639 | |
---|
3640 | IF (nb_dim .NE. 4) THEN |
---|
3641 | WRITE(numout,*) "dimension not supported for ", nb_dim |
---|
3642 | ENDIF |
---|
3643 | tml = l_d_w(4) |
---|
3644 | !yrlen = tml |
---|
3645 | END IF |
---|
3646 | IF (mydebug) THEN |
---|
3647 | WRITE(numout, *) "Now the tml is, :", tml |
---|
3648 | WRITE(numout, *) "Now the lml is:", lml |
---|
3649 | ENDIF |
---|
3650 | |
---|
3651 | !JG REMVOVE CALL flioclo(fid1) |
---|
3652 | CALL bcast(lml) |
---|
3653 | CALL bcast(tml) |
---|
3654 | CALL bcast(nb_dim) |
---|
3655 | ! CALL bcast(plantcyc) |
---|
3656 | |
---|
3657 | ! JG yrlen must not be done after bcast(tml) |
---|
3658 | yrlen = tml |
---|
3659 | nb_var_manag = INT(6) |
---|
3660 | |
---|
3661 | ALLOC_ERR=-1 |
---|
3662 | ALLOCATE(manage_all(nb_var_manag,npts,lml,tml),STAT=ALLOC_ERR) |
---|
3663 | IF (ALLOC_ERR/=0) THEN |
---|
3664 | WRITE(numout,*) "ERROR IN ALLOCATION OF manage: ", ALLOC_ERR |
---|
3665 | ENDIF |
---|
3666 | WRITE(numout,*) "manage ALLOCATED" |
---|
3667 | !CALL bcast(manage) |
---|
3668 | ALLOC_ERR=-1 |
---|
3669 | ALLOCATE(manage1(npts,lml,tml),STAT=ALLOC_ERR) |
---|
3670 | IF (ALLOC_ERR/=0) THEN |
---|
3671 | WRITE(numout,*) "ERROR IN ALLOCATION OF manage: ", ALLOC_ERR |
---|
3672 | ENDIF |
---|
3673 | WRITE(numout,*) "manage ALLOCATED" |
---|
3674 | !CALL bcast(manage) |
---|
3675 | ALLOC_ERR=-1 |
---|
3676 | ALLOCATE(manage2(npts,lml,tml),STAT=ALLOC_ERR) |
---|
3677 | IF (ALLOC_ERR/=0) THEN |
---|
3678 | WRITE(numout,*) "ERROR IN ALLOCATION OF manage: ", ALLOC_ERR |
---|
3679 | ENDIF |
---|
3680 | WRITE(numout,*) "manage ALLOCATED" |
---|
3681 | !CALL bcast(manage) |
---|
3682 | ALLOC_ERR=-1 |
---|
3683 | ALLOCATE(manage3(npts,lml,tml),STAT=ALLOC_ERR) |
---|
3684 | IF (ALLOC_ERR/=0) THEN |
---|
3685 | WRITE(numout,*) "ERROR IN ALLOCATION OF manage: ", ALLOC_ERR |
---|
3686 | ENDIF |
---|
3687 | WRITE(numout,*) "manage ALLOCATED" |
---|
3688 | !CALL bcast(manage) |
---|
3689 | ALLOC_ERR=-1 |
---|
3690 | ALLOCATE(manage4(npts,lml,tml),STAT=ALLOC_ERR) |
---|
3691 | IF (ALLOC_ERR/=0) THEN |
---|
3692 | WRITE(numout,*) "ERROR IN ALLOCATION OF manage: ", ALLOC_ERR |
---|
3693 | ENDIF |
---|
3694 | WRITE(numout,*) "manage ALLOCATED" |
---|
3695 | !CALL bcast(manage) |
---|
3696 | ALLOC_ERR=-1 |
---|
3697 | ALLOCATE(manage5(npts,lml,tml),STAT=ALLOC_ERR) |
---|
3698 | IF (ALLOC_ERR/=0) THEN |
---|
3699 | WRITE(numout,*) "ERROR IN ALLOCATION OF manage: ", ALLOC_ERR |
---|
3700 | ENDIF |
---|
3701 | WRITE(numout,*) "manage ALLOCATED" |
---|
3702 | !CALL bcast(manage) |
---|
3703 | ALLOC_ERR=-1 |
---|
3704 | ALLOCATE(manage6(npts,lml,tml),STAT=ALLOC_ERR) |
---|
3705 | IF (ALLOC_ERR/=0) THEN |
---|
3706 | WRITE(numout,*) "ERROR IN ALLOCATION OF manage: ", ALLOC_ERR |
---|
3707 | ENDIF |
---|
3708 | WRITE(numout,*) "manage ALLOCATED" |
---|
3709 | !CALL bcast(manage) |
---|
3710 | ! |
---|
3711 | ALLOC_ERR=-1 |
---|
3712 | ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR) |
---|
3713 | IF (ALLOC_ERR/=0) THEN |
---|
3714 | WRITE(numout,*) "ERROR IN ALLOCATION of lat_rel : ",ALLOC_ERR |
---|
3715 | STOP |
---|
3716 | ENDIF |
---|
3717 | ! CALL bcast(lat_rel) |
---|
3718 | |
---|
3719 | ALLOC_ERR=-1 |
---|
3720 | ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR) |
---|
3721 | IF (ALLOC_ERR/=0) THEN |
---|
3722 | WRITE(numout,*) "ERROR IN ALLOCATION of lon_rel : ",ALLOC_ERR |
---|
3723 | STOP |
---|
3724 | ENDIF |
---|
3725 | ! CALL bcast(lon_rel) |
---|
3726 | |
---|
3727 | ALLOC_ERR=-1 |
---|
3728 | ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR) |
---|
3729 | IF (ALLOC_ERR/=0) THEN |
---|
3730 | WRITE(numout,*) "ERROR IN ALLOCATION of mask : ",ALLOC_ERR |
---|
3731 | STOP |
---|
3732 | ENDIF |
---|
3733 | ! CALL bcast(mask) |
---|
3734 | |
---|
3735 | |
---|
3736 | ALLOC_ERR=-1 |
---|
3737 | ALLOCATE(manage_mat_all(nb_var_manag,iml,jml,lml,tml), STAT=ALLOC_ERR) |
---|
3738 | ! !lml is supposed to be nvm (number of PFTs), if not ,change it |
---|
3739 | IF (ALLOC_ERR/=0) THEN |
---|
3740 | WRITE(numout,*) "ERROR IN ALLOCATION of manage_mat : ",ALLOC_ERR |
---|
3741 | STOP |
---|
3742 | ENDIF |
---|
3743 | |
---|
3744 | ALLOC_ERR=-1 |
---|
3745 | ALLOCATE(manage_mat1(iml,jml,lml,tml), STAT=ALLOC_ERR) |
---|
3746 | ! !lml is supposed to be nvm (number of PFTs), if not ,change it |
---|
3747 | IF (ALLOC_ERR/=0) THEN |
---|
3748 | WRITE(numout,*) "ERROR IN ALLOCATION of manage_mat : ",ALLOC_ERR |
---|
3749 | STOP |
---|
3750 | ENDIF |
---|
3751 | ! CALL bcast(manage_mat) |
---|
3752 | ALLOC_ERR=-1 |
---|
3753 | ALLOCATE(manage_mat2(iml,jml,lml,tml), STAT=ALLOC_ERR) |
---|
3754 | ! !lml is supposed to be nvm (number of PFTs), if not ,change it |
---|
3755 | IF (ALLOC_ERR/=0) THEN |
---|
3756 | WRITE(numout,*) "ERROR IN ALLOCATION of manage_mat : ",ALLOC_ERR |
---|
3757 | STOP |
---|
3758 | ENDIF |
---|
3759 | ! CALL bcast(manage_mat) |
---|
3760 | ALLOC_ERR=-1 |
---|
3761 | ALLOCATE(manage_mat3(iml,jml,lml,tml), STAT=ALLOC_ERR) |
---|
3762 | ! !lml is supposed to be nvm (number of PFTs), if not ,change it |
---|
3763 | IF (ALLOC_ERR/=0) THEN |
---|
3764 | WRITE(numout,*) "ERROR IN ALLOCATION of manage_mat : ",ALLOC_ERR |
---|
3765 | STOP |
---|
3766 | ENDIF |
---|
3767 | ! CALL bcast(manage_mat) |
---|
3768 | ALLOC_ERR=-1 |
---|
3769 | ALLOCATE(manage_mat4(iml,jml,lml,tml), STAT=ALLOC_ERR) |
---|
3770 | ! !lml is supposed to be nvm (number of PFTs), if not ,change it |
---|
3771 | IF (ALLOC_ERR/=0) THEN |
---|
3772 | WRITE(numout,*) "ERROR IN ALLOCATION of manage_mat : ",ALLOC_ERR |
---|
3773 | STOP |
---|
3774 | ENDIF |
---|
3775 | ! CALL bcast(manage_mat) |
---|
3776 | ALLOC_ERR=-1 |
---|
3777 | ALLOCATE(manage_mat5(iml,jml,lml,tml), STAT=ALLOC_ERR) |
---|
3778 | ! !lml is supposed to be nvm (number of PFTs), if not ,change it |
---|
3779 | IF (ALLOC_ERR/=0) THEN |
---|
3780 | WRITE(numout,*) "ERROR IN ALLOCATION of manage_mat : ",ALLOC_ERR |
---|
3781 | STOP |
---|
3782 | ENDIF |
---|
3783 | ! CALL bcast(manage_mat) |
---|
3784 | ALLOC_ERR=-1 |
---|
3785 | ALLOCATE(manage_mat6(iml,jml,lml,tml), STAT=ALLOC_ERR) |
---|
3786 | ! !lml is supposed to be nvm (number of PFTs), if not ,change it |
---|
3787 | IF (ALLOC_ERR/=0) THEN |
---|
3788 | WRITE(numout,*) "ERROR IN ALLOCATION of manage_mat : ",ALLOC_ERR |
---|
3789 | STOP |
---|
3790 | ENDIF |
---|
3791 | ! CALL bcast(manage_mat) |
---|
3792 | ! WRITE (numout,*) 'bcast manage_mat' |
---|
3793 | |
---|
3794 | ! input of some attributes |
---|
3795 | IF (is_root_prc) THEN |
---|
3796 | ! JG with the flioclo, done before this was not ok. Now ok |
---|
3797 | CALL flinget(fid, 'LON', iml, jml, lml, tml, 1, 1, lon_rel) |
---|
3798 | CALL flinget(fid, 'LAT', iml, jml, lml, tml, 1, 1, lat_rel) |
---|
3799 | ENDIF |
---|
3800 | CALL bcast(lon_rel) |
---|
3801 | CALL bcast(lat_rel) |
---|
3802 | WRITE (numout,*) 'lon_rel size: ', SIZE(lon_rel) |
---|
3803 | WRITE (numout,*) 'lat_rel size: ', SIZE(lat_rel) |
---|
3804 | |
---|
3805 | |
---|
3806 | ! input of the matrix |
---|
3807 | IF (is_root_prc) THEN |
---|
3808 | ! CALL flinget(fid, 'PLNTDT', iml, jml, lml, tml, 1, 1, plntdt_mat) |
---|
3809 | ! JG remove CALL flioopfd: already done |
---|
3810 | ! CALL flioopfd(filename,fid1) |
---|
3811 | CALL fliogetv(fid1,trim(varname1),manage_mat1,start=(/1,1,1,1/),count=(/iml,jml,lml,tml/)) |
---|
3812 | CALL fliogetv(fid1,trim(varname2),manage_mat2,start=(/1,1,1,1/),count=(/iml,jml,lml,tml/)) |
---|
3813 | CALL fliogetv(fid1,trim(varname3),manage_mat3,start=(/1,1,1,1/),count=(/iml,jml,lml,tml/)) |
---|
3814 | CALL fliogetv(fid1,trim(varname4),manage_mat4,start=(/1,1,1,1/),count=(/iml,jml,lml,tml/)) |
---|
3815 | CALL fliogetv(fid1,trim(varname5),manage_mat5,start=(/1,1,1,1/),count=(/iml,jml,lml,tml/)) |
---|
3816 | CALL fliogetv(fid1,trim(varname6),manage_mat6,start=(/1,1,1,1/),count=(/iml,jml,lml,tml/)) |
---|
3817 | ! get missing_val |
---|
3818 | CALL fliogeta(fid1,varname1,'missing_value',missing_val) |
---|
3819 | |
---|
3820 | CALL flioclo(fid1) |
---|
3821 | ENDIF |
---|
3822 | CALL bcast(manage_mat1) |
---|
3823 | CALL bcast(manage_mat2) |
---|
3824 | CALL bcast(manage_mat3) |
---|
3825 | CALL bcast(manage_mat4) |
---|
3826 | CALL bcast(manage_mat5) |
---|
3827 | CALL bcast(manage_mat6) |
---|
3828 | WRITE (numout,*) 'bcast manage_mat' |
---|
3829 | |
---|
3830 | ! JC combine matrix for loop |
---|
3831 | manage_mat_all(1,:,:,:,:) = manage_mat1 |
---|
3832 | manage_mat_all(2,:,:,:,:) = manage_mat2 |
---|
3833 | manage_mat_all(3,:,:,:,:) = manage_mat3 |
---|
3834 | manage_mat_all(4,:,:,:,:) = manage_mat4 |
---|
3835 | manage_mat_all(5,:,:,:,:) = manage_mat5 |
---|
3836 | manage_mat_all(6,:,:,:,:) = manage_mat6 |
---|
3837 | |
---|
3838 | ! WRITE(numout,*) 'manage_mat size: ',SIZE(manage_mat) |
---|
3839 | ! WRITE(numout,*) 'missing value: ', missing_val |
---|
3840 | ! WRITE(numout,*) 'lat(361,284): ',lat_rel(361,284) |
---|
3841 | ! WRITE(numout,*) 'lon(361,284): ',lon_rel(361,284) |
---|
3842 | ! WRITE(numout,*) 'plntdt(361,284,1,1): ',plntdt_mat(361,284,1,1) |
---|
3843 | |
---|
3844 | IF (is_root_prc) CALL flinclo(fid) |
---|
3845 | |
---|
3846 | manage1(:,:,:) = zero ! npts veget year |
---|
3847 | manage2(:,:,:) = zero ! npts veget year |
---|
3848 | manage3(:,:,:) = zero ! npts veget year |
---|
3849 | manage4(:,:,:) = zero ! npts veget year |
---|
3850 | manage5(:,:,:) = zero ! npts veget year |
---|
3851 | manage6(:,:,:) = zero ! npts veget year |
---|
3852 | manage_all(:,:,:,:) = zero |
---|
3853 | |
---|
3854 | DO iv_manag = 1,nb_var_manag |
---|
3855 | DO it = 1,tml |
---|
3856 | DO ivgt = 1,lml ! ? We can suppose PFTs less than 10 are natural veg without planting date, but not now |
---|
3857 | ! IF (.NOT. natural(ivgt)) THEN |
---|
3858 | WRITE(numout,*) "variable, veget, time: ",iv_manag, ivgt,it |
---|
3859 | nbexp = 0 |
---|
3860 | ! the number of exceptions |
---|
3861 | |
---|
3862 | !JCCOMMENT GRM_input.nc for every grid value >=0 |
---|
3863 | ! thus mask = un |
---|
3864 | ! mask of available value |
---|
3865 | ! mask(:,:) = zero; ! Defined in constante.f90 |
---|
3866 | IF (iv_manag .EQ. 1) THEN |
---|
3867 | mask(:,:) = un |
---|
3868 | ! DO ip = 1,iml |
---|
3869 | ! DO jp = 1,jml |
---|
3870 | ! IF ((manage_mat_all(iv_manag,ip,jp,ivgt,it) .GT. min_sechiba) .AND. & |
---|
3871 | ! (manage_mat_all(iv_manag,ip,jp,ivgt,it) /= missing_val)) THEN |
---|
3872 | ! mask(ip,jp) = un; ! Defined in constante.f90 |
---|
3873 | ! ! here we assumed that for each plant cycle at each |
---|
3874 | ! ! there might be missing data at different grid |
---|
3875 | ! ! in this case, mask has to be generated each plant |
---|
3876 | ! ! cycle each time step |
---|
3877 | ! ENDIF |
---|
3878 | ! ENDDO |
---|
3879 | ! ENDDO |
---|
3880 | |
---|
3881 | ! Interpolation started |
---|
3882 | nbvmax = 200 |
---|
3883 | ! the maximum amount of fine grids that one coarse grid may have |
---|
3884 | |
---|
3885 | callsign = strIn |
---|
3886 | |
---|
3887 | ok_interpol = .FALSE. |
---|
3888 | |
---|
3889 | DO WHILE ( .NOT. ok_interpol ) |
---|
3890 | WRITE(numout,*) "Pojection arrays for ", callsign, ":" |
---|
3891 | WRITE(numout,*) "nbvmax = ", nbvmax |
---|
3892 | |
---|
3893 | ALLOC_ERR = -1 |
---|
3894 | ALLOCATE(temp_data(nbvmax,lml), STAT=ALLOC_ERR) |
---|
3895 | IF (ALLOC_ERR /=0) THEN |
---|
3896 | WRITE(numout,*) "ERROR IN ALLOCATION OF temp_data :", ALLOC_ERR |
---|
3897 | STOP |
---|
3898 | ENDIF |
---|
3899 | ALLOC_ERR = -1 |
---|
3900 | ALLOCATE(sub_index(npts,nbvmax,2), STAT=ALLOC_ERR) |
---|
3901 | IF (ALLOC_ERR /=0) THEN |
---|
3902 | WRITE(numout,*) "ERROR IN ALLOCATION OF sub_index :", ALLOC_ERR |
---|
3903 | STOP |
---|
3904 | ENDIF |
---|
3905 | sub_index(:,:,:) = zero |
---|
3906 | ALLOC_ERR = -1 |
---|
3907 | ALLOCATE(sub_area(npts, nbvmax), STAT=ALLOC_ERR) |
---|
3908 | IF (ALLOC_ERR /=0) THEN |
---|
3909 | WRITE(numout,*) "ERROR IN ALLOCATION OF sub_area :",ALLOC_ERR |
---|
3910 | STOP |
---|
3911 | ENDIF |
---|
3912 | sub_area(:,:) = zero |
---|
3913 | myres(:,:) = resolution(:,:)/1000 !m -> km |
---|
3914 | write(numout,*) "resolution updated: ", myres(1,:), " km" |
---|
3915 | !CALL bcast(myres) |
---|
3916 | ! CALL bcast(myres) |
---|
3917 | |
---|
3918 | write(*,*) "calling aggregate_p? " |
---|
3919 | CALL aggregate_p(npts, lalo, neighbours, myres, contfrac, & |
---|
3920 | & iml, jml, lon_rel, lat_rel, mask, callsign, & |
---|
3921 | & nbvmax, sub_index, sub_area, ok_interpol) |
---|
3922 | write(numout,*) "wu: we finished aggregate_p:) " |
---|
3923 | |
---|
3924 | IF ( .NOT. ok_interpol ) THEN |
---|
3925 | DEALLOCATE(temp_data) |
---|
3926 | DEALLOCATE(sub_index) |
---|
3927 | DEALLOCATE(sub_area) |
---|
3928 | nbvmax = nbvmax * 2 |
---|
3929 | ENDIF |
---|
3930 | ENDDO |
---|
3931 | |
---|
3932 | WRITE(numout,*) "called aggregate_p" |
---|
3933 | ENDIF ! only call aggregate once |
---|
3934 | ! assign the values to plantdate |
---|
3935 | ! values should be given to all PFTs |
---|
3936 | DO ib = 1, npts |
---|
3937 | ! examing all sub_point we found |
---|
3938 | fopt = COUNT(sub_area(ib,:)>zero) |
---|
3939 | |
---|
3940 | ! confirm that we found some points |
---|
3941 | IF ( fopt .EQ. 0) THEN |
---|
3942 | nbexp = nbexp + 1 |
---|
3943 | manage_all(iv_manag,ib,ivgt,it) = val_exp |
---|
3944 | ELSE |
---|
3945 | DO ilf = 1,fopt |
---|
3946 | ! !Not to get lat and lon in wrong order |
---|
3947 | temp_data(ilf,ivgt) = manage_mat_all(iv_manag,sub_index(ib,ilf,1),sub_index(ib,ilf,2),ivgt,it) |
---|
3948 | ENDDO |
---|
3949 | |
---|
3950 | sgn = zero |
---|
3951 | sum_float = zero |
---|
3952 | DO ilf = 1,fopt |
---|
3953 | ! average the data weighted by area ! better to |
---|
3954 | ! multiply |
---|
3955 | ! PFT HERE |
---|
3956 | ! need to add management specific judgem |
---|
3957 | sum_float = sum_float + temp_data(ilf,ivgt)*sub_area(ib,ilf) |
---|
3958 | sgn = sgn + sub_area(ib,ilf) |
---|
3959 | ENDDO |
---|
3960 | |
---|
3961 | ! Normalize the surface |
---|
3962 | ! sgn can be a scaler, however, to prepare it for future |
---|
3963 | ! incorporation of fraction |
---|
3964 | ! I make it a vector with nvm values which are equal to |
---|
3965 | ! each |
---|
3966 | ! other |
---|
3967 | IF ( sgn .LT. min_sechiba) THEN |
---|
3968 | nbexp = nbexp + 1 |
---|
3969 | manage_all(iv_manag,ib,ivgt,it) = val_exp ! plantdate_default(ivgt) |
---|
3970 | ELSE |
---|
3971 | ! ANINT is used for plant date integer |
---|
3972 | ! BUT not for grassland management input |
---|
3973 | !manage(ib,ivgt,it) = ANINT(sum_float/sgn) |
---|
3974 | manage_all(iv_manag,ib,ivgt,it) = sum_float/sgn |
---|
3975 | ENDIF |
---|
3976 | |
---|
3977 | ENDIF |
---|
3978 | |
---|
3979 | ENDDO ! ib |
---|
3980 | WRITE(numout,*) 'fopt subarea',fopt!,sub_area |
---|
3981 | |
---|
3982 | IF ( nbexp .GT. 0) THEN |
---|
3983 | WRITE(numout,*) 'slowproc_ManageInput : exp_val was applied in', nbexp, 'grid(s)' |
---|
3984 | WRITE(numout,*) 'slowproc_ManageInput : These are either coastal points or having missing data' |
---|
3985 | ENDIF |
---|
3986 | !JC keep the sub_area sub_index till all variables read |
---|
3987 | ! DEALLOCATE (sub_area) |
---|
3988 | ! DEALLOCATE (sub_index) |
---|
3989 | ! DEALLOCATE (temp_data) |
---|
3990 | ! WRITE(numout,*) 'Planting Date of Site 1 veget ',ivgt,' : |
---|
3991 | ! ',plantdate(1,ivgt,icyc) |
---|
3992 | ! ENDIF |
---|
3993 | ENDDO |
---|
3994 | ! End of Veget cycle |
---|
3995 | ENDDO |
---|
3996 | ! End of Time Axis cycle |
---|
3997 | ENDDO |
---|
3998 | ! End of variables |
---|
3999 | ! gmjc |
---|
4000 | DEALLOCATE (sub_area) |
---|
4001 | DEALLOCATE (sub_index) |
---|
4002 | DEALLOCATE (temp_data) |
---|
4003 | |
---|
4004 | DEALLOCATE (lat_rel) |
---|
4005 | DEALLOCATE (lon_rel) |
---|
4006 | DEALLOCATE (mask) |
---|
4007 | ! gmjc multivariables |
---|
4008 | manage1(:,:,:) = manage_all(1,:,:,:) |
---|
4009 | manage2(:,:,:) = manage_all(2,:,:,:) |
---|
4010 | manage3(:,:,:) = manage_all(3,:,:,:) |
---|
4011 | manage4(:,:,:) = manage_all(4,:,:,:) |
---|
4012 | manage5(:,:,:) = manage_all(5,:,:,:) |
---|
4013 | manage6(:,:,:) = manage_all(6,:,:,:) |
---|
4014 | DEALLOCATE (manage_mat1) |
---|
4015 | DEALLOCATE (manage_mat2) |
---|
4016 | DEALLOCATE (manage_mat3) |
---|
4017 | DEALLOCATE (manage_mat4) |
---|
4018 | DEALLOCATE (manage_mat5) |
---|
4019 | DEALLOCATE (manage_mat6) |
---|
4020 | DEALLOCATE (manage_mat_all) |
---|
4021 | DEALLOCATE (manage_all) |
---|
4022 | |
---|
4023 | WRITE (numout,*) 'Output Management Date:' |
---|
4024 | WRITE (numout,*) 'time_step 1:' |
---|
4025 | WRITE (numout,*) manage1(1,:,1), manage2(1,:,1), manage3(1,:,1), & |
---|
4026 | manage4(1,:,1), manage5(1,:,1), manage6(1,:,1) |
---|
4027 | IF (tml>1) THEN |
---|
4028 | WRITE (numout,*) 'time_step 2:' |
---|
4029 | WRITE (numout,*) manage1(1,:,2) |
---|
4030 | ENDIF |
---|
4031 | WRITE (numout,*) '***END of DEBUG INFO slowproc_ManageInput***' |
---|
4032 | RETURN |
---|
4033 | |
---|
4034 | END SUBROUTINE slowproc_GRM_ManageInput |
---|
4035 | ! End of Edition by Xuhui, Mar. 16th 2011 |
---|
4036 | |
---|
4037 | END MODULE grassland_management |
---|