Context Navigation

source: tags/ORCHIDEE_1_9_6/ORCHIDEE/src_stomate/stomate_season.f90 @ 3850

Last change on this file since 3850 was 720, checked in by didier.solyga, 12 years ago
Add svn headers for all modules. Improve documentation of the parameters. Replace two values by the corresponding parameters.
Property svn:keywords set to `HeadURL Date Author Revision`
File size: 31.6 KB

Line
1	! Calculate long-term meteorological parameters from daily temperatures
2	! and precipitations (essentially for phenology)
3	!
4	!< $HeadURL$
5	!< $Date$
6	!< $Author$
7	!< $Revision$
8	! IPSL (2006)
9	! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
10	!
11	MODULE stomate_season
12
13	! modules used:
14
15	USE ioipsl
16	USE stomate_data
17	USE constantes
18	USE pft_parameters
19
20	IMPLICIT NONE
21
22	! private & public routines
23
24	PRIVATE
25	PUBLIC season,season_clear
26
27	! first call
28	LOGICAL, SAVE :: firstcall = .TRUE.
29
30	CONTAINS
31
32
33	SUBROUTINE season_clear
34	firstcall=.TRUE.
35	END SUBROUTINE season_clear
36
37	SUBROUTINE season (npts, dt, EndOfYear, veget, veget_max, &
38	moiavail_daily, t2m_daily, tsoil_daily, soilhum_daily, &
39	precip_daily, npp_daily, biomass, turnover_daily, gpp_daily, when_growthinit, &
40	maxmoiavail_lastyear, maxmoiavail_thisyear, &
41	minmoiavail_lastyear, minmoiavail_thisyear, &
42	maxgppweek_lastyear, maxgppweek_thisyear, &
43	gdd0_lastyear, gdd0_thisyear, &
44	precip_lastyear, precip_thisyear, &
45	lm_lastyearmax, lm_thisyearmax, &
46	maxfpc_lastyear, maxfpc_thisyear, &
47	moiavail_month, moiavail_week, t2m_longterm, tlong_ref, t2m_month, t2m_week, &
48	tsoil_month, soilhum_month, &
49	npp_longterm, turnover_longterm, gpp_week, &
50	gdd_m5_dormance, gdd_midwinter, ncd_dormance, ngd_minus5, time_lowgpp, &
51	time_hum_min, hum_min_dormance, herbivores)
52
53	!
54	! 0 declarations
55	!
56
57	! 0.1 input
58
59	! Domain size
60	INTEGER(i_std), INTENT(in) :: npts
61	! time step in days
62	REAL(r_std), INTENT(in) :: dt
63	! update yearly variables?
64	LOGICAL, INTENT(in) :: EndOfYear
65	! coverage fraction of a PFT. Here: fraction of total ground.
66	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget
67	! "maximal" coverage fraction of a PFT (for LAI -> infinity)
68	! Here: fraction of total ground.
69	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: veget_max
70	! Daily moisture availability
71	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: moiavail_daily
72	! Daily 2 meter temperature (K)
73	REAL(r_std), DIMENSION(npts), INTENT(in) :: t2m_daily
74	! Daily soil temperature (K)
75	REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: tsoil_daily
76	! Daily soil humidity
77	REAL(r_std), DIMENSION(npts,nbdl), INTENT(in) :: soilhum_daily
78	! Daily mean precipitation (mm/day)
79	REAL(r_std), DIMENSION(npts), INTENT(in) :: precip_daily
80	! daily net primary productivity (gC/m**2/day)
81	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: npp_daily
82	! biomass (gC/(m**2 of ground))
83	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in) :: biomass
84	! Turnover rates (gC/m**2/day)
85	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in) :: turnover_daily
86	! daily gross primary productivity (Here: gC/(m**2 of total ground)/day)
87	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: gpp_daily
88	! how many days ago was the beginning of the growing season
89	REAL(r_std), DIMENSION(npts,nvm), INTENT(in) :: when_growthinit
90
91	! 0.2 modified fields
92
93	! last year's maximum moisture availability
94	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: maxmoiavail_lastyear
95	! this year's maximum moisture availability
96	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: maxmoiavail_thisyear
97	! last year's minimum moisture availability
98	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: minmoiavail_lastyear
99	! this year's minimum moisture availability
100	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: minmoiavail_thisyear
101	! last year's maximum weekly GPP
102	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: maxgppweek_lastyear
103	! this year's maximum weekly GPP
104	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: maxgppweek_thisyear
105	! last year's annual GDD0
106	REAL(r_std), DIMENSION(npts), INTENT(inout) :: gdd0_lastyear
107	! this year's annual GDD0
108	REAL(r_std), DIMENSION(npts), INTENT(inout) :: gdd0_thisyear
109	! last year's annual precipitation (mm/year)
110	REAL(r_std), DIMENSION(npts), INTENT(inout) :: precip_lastyear
111	! this year's annual precipitation (mm/year)
112	REAL(r_std), DIMENSION(npts), INTENT(inout) :: precip_thisyear
113	! last year's maximum leaf mass, for each PFT (gC/m**2)
114	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lm_lastyearmax
115	! this year's maximum leaf mass, for each PFT (gC/m**2)
116	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: lm_thisyearmax
117	! last year's maximum fpc for each PFT, on ground
118	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: maxfpc_lastyear
119	! this year's maximum fpc for each PFT, on ground
120	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: maxfpc_thisyear
121	! "monthly" moisture availability
122	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: moiavail_month
123	! "weekly" moisture availability
124	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: moiavail_week
125	! "long term" 2-meter temperatures (K)
126	REAL(r_std), DIMENSION(npts), INTENT(inout) :: t2m_longterm
127	! "long term" refernce 2-meter temperatures (K)
128	REAL(r_std), DIMENSION(npts), INTENT(inout) :: tlong_ref
129	! "monthly" 2-meter temperatures (K)
130	REAL(r_std), DIMENSION(npts), INTENT(inout) :: t2m_month
131	! "weekly" 2-meter temperatures (K)
132	REAL(r_std), DIMENSION(npts), INTENT(inout) :: t2m_week
133	! "monthly" soil temperatures (K)
134	REAL(r_std), DIMENSION(npts,nbdl), INTENT(inout) :: tsoil_month
135	! "monthly" soil humidity
136	REAL(r_std), DIMENSION(npts,nbdl), INTENT(inout) :: soilhum_month
137	! "long term" net primary productivity (gC/m**2/year)
138	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: npp_longterm
139	! "long term" turnover rate (gC/m**2/year)
140	REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout) :: turnover_longterm
141	! "weekly" GPP (gC/day/(m**2 covered)
142	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: gpp_week
143	! growing degree days, threshold -5 deg. C
144	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: gdd_m5_dormance
145	! growing degree days since midwinter
146	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: gdd_midwinter
147	! number of chilling days since leaves were lost
148	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ncd_dormance
149	! number of growing days
150	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: ngd_minus5
151	! duration of dormance (d)
152	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: time_lowgpp
153	! time elapsed since strongest moisture availability (d)
154	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: time_hum_min
155	! minimum moisture during dormance
156	REAL(r_std), DIMENSION(npts,nvm), INTENT(inout) :: hum_min_dormance
157
158	! 0.3 output (diagnostic)
159
160	! time constant of probability of a leaf to be eaten by a herbivore (days)
161	REAL(r_std), DIMENSION(npts,nvm), INTENT(out) :: herbivores
162
163	! 0.4 local
164
165	! indices
166	INTEGER(i_std) :: j
167	! maximum ncd (d) (to avoid floating point underflows)
168	REAL(r_std) :: ncd_max
169	! sum of natural fpcs
170	REAL(r_std), DIMENSION(npts) :: sumfpc_nat
171	! 01/03/2011 NVuichard, NViovy and DS : correcting herbivores : now weighttot
172	! nlflong_nat, green_age are pft-dependants
173	! weights
174	REAL(r_std), DIMENSION(npts,nvm) :: weighttot
175	! natural long-term leaf NPP ( gC/m**2/year)
176	REAL(r_std), DIMENSION(npts,nvm) :: nlflong_nat
177	! residence time of green tissue (years)
178	REAL(r_std), DIMENSION(npts,nvm) :: green_age
179	! herbivore consumption (gC/m**2/day)
180	REAL(r_std), DIMENSION(npts) :: consumption
181	! fraction of each gridcell occupied by natural vegetation
182	REAL(r_std), DIMENSION(npts) :: fracnat
183
184	! =========================================================================
185
186	IF (bavard.GE.3) WRITE(numout,*) 'Entering season'
187
188	!
189	! 1 Initializations
190	!
191	ncd_max = ncd_max_year * one_year
192
193	IF ( firstcall ) THEN
194
195	!
196	! 1.1 messages
197	!
198
199	IF ( bavard .GE. 1 ) THEN
200
201	WRITE(numout,*) 'season: '
202
203	WRITE(numout,*) ' > rapport maximal GPP/GGP_max pour dormance: ',gppfrac_dormance
204
205	WRITE(numout,*) ' > maximum possible ncd (d): ',ncd_max
206
207	WRITE(numout,*) ' > herbivore consumption C (gC/m2/day) as a function of NPP (gC/m2/d):'
208	WRITE(numout,) ' C=',hvc1,' NPP^',hvc2
209	WRITE(numout,) ' > for herbivores, suppose that ',leaf_frac_hvc100., &
210	'% of NPP is allocated to leaves'
211
212
213	ENDIF
214
215	!
216	! 1.2 Check whether longer-term meteorological parameters are initialized
217	! to zero
218	!
219
220	! 1.2.1 moisture availabilities
221
222	! 1.2.1.1 "monthly"
223	!MM PAS PARALLELISE!!
224	IF ( ABS( SUM( moiavail_month(:,2:nvm) ) ) .LT. min_stomate ) THEN
225
226	! in this case, set them it today's moisture availability
227	WRITE(numout,*) 'Warning! We have to initialize the ''monthly'' moisture availabilities.'
228	moiavail_month(:,:) = moiavail_daily(:,:)
229
230	ENDIF
231
232	! 1.2.1.2 "weekly"
233
234	IF ( ABS( SUM( moiavail_week(:,2:nvm) ) ) .LT. min_stomate ) THEN
235
236	! in this case, set them it today's moisture availability
237	WRITE(numout,*) 'Warning! We have to initialize the ''weekly'' moisture availabilities.'
238	moiavail_week(:,:) = moiavail_daily(:,:)
239
240	ENDIF
241
242	! 1.2.2 2-meter temperatures
243
244	! 1.2.2.1 "long term"
245
246	IF ( ABS( SUM( t2m_longterm(:) ) ) .LT. min_stomate ) THEN
247
248	! in this case, set them to today's temperature
249	WRITE(numout,*) 'Warning! We have to initialize the ''long term'' 2m temperatures.'
250	t2m_longterm(:) = t2m_daily(:)
251
252	ENDIF
253
254	! 1.2.2.2 "monthly"
255
256	IF ( ABS( SUM( t2m_month(:) ) ) .LT. min_stomate ) THEN
257
258	! in this case, set them to today's temperature
259	WRITE(numout,*) 'Warning! We have to initialize the ''monthly'' 2m temperatures.'
260	t2m_month(:) = t2m_daily(:)
261
262	ENDIF
263
264	! 1.2.2.3 "weekly"
265
266	IF ( ABS( SUM( t2m_week(:) ) ) .LT. min_stomate ) THEN
267
268	! in this case, set them to today's temperature
269	WRITE(numout,*) 'Warning! We have to initialize the ''weekly'' 2m temperatures.'
270	t2m_week(:) = t2m_daily(:)
271
272	ENDIF
273
274	! 1.2.3 "monthly" soil temperatures
275	!MM PAS PARALLELISE!!
276	IF ( ABS( SUM( tsoil_month(:,:) ) ) .LT. min_stomate ) THEN
277
278	! in this case, set them to today's temperature
279	WRITE(numout,*) 'Warning!'// &
280	' We have to initialize the ''monthly'' soil temperatures.'
281	tsoil_month(:,:) = tsoil_daily(:,:)
282
283	ENDIF
284
285	! 1.2.4 "monthly" soil humidity
286	IF ( ABS( SUM( soilhum_month(:,:) ) ) .LT. min_stomate ) THEN
287
288	! in this case, set them to today's humidity
289	WRITE(numout,*) 'Warning!'// &
290	' We have to initialize the ''monthly'' soil humidity.'
291	soilhum_month(:,:) = soilhum_daily(:,:)
292
293	ENDIF
294
295	! 1.2.5 growing degree days, threshold -5 deg C
296	IF ( ABS( SUM( gdd_m5_dormance(:,2:nvm) ) ) .LT. min_stomate ) THEN
297	WRITE(numout,*) 'Warning! Growing degree days (-5 deg) are initialized to ''undef''.'
298	gdd_m5_dormance(:,:) = undef
299	ENDIF
300
301	! 1.2.6 growing degree days since midwinter
302	IF ( ABS( SUM( gdd_midwinter(:,2:nvm) ) ) .LT. min_stomate ) THEN
303	WRITE(numout,*) 'Warning! Growing degree days since midwinter' // &
304	' are initialized to ''undef''.'
305	gdd_midwinter(:,:) = undef
306	ENDIF
307
308	! 1.2.7 number of chilling days since leaves were lost
309	IF ( ABS( SUM( ncd_dormance(:,2:nvm) ) ) .LT. min_stomate ) THEN
310	WRITE(numout,*) 'Warning! Number of chilling days is initialized to ''undef''.'
311	ncd_dormance(:,:) = undef
312	ENDIF
313
314	! 1.2.8 number of growing days, threshold -5 deg C
315	IF ( ABS( SUM( ngd_minus5(:,2:nvm) ) ) .LT. min_stomate ) THEN
316	WRITE(numout,*) 'Warning! Number of growing days (-5 deg) is initialized to 0.'
317	ENDIF
318
319	! 1.2.9 "long term" npp
320	IF ( ABS( SUM( npp_longterm(:,2:nvm) ) ) .LT. min_stomate ) THEN
321	WRITE(numout,*) 'Warning! Long term NPP is initialized to 0.'
322	ENDIF
323
324	! 1.2.10 "long term" turnover
325	IF ( ABS( SUM( turnover_longterm(:,2:nvm,:) ) ) .LT. min_stomate ) THEN
326	WRITE(numout,*) 'Warning! Long term turnover is initialized to 0.'
327	ENDIF
328
329	! 1.2.11 "weekly" GPP
330	IF ( ABS( SUM( gpp_week(:,2:nvm) ) ) .LT. min_stomate ) THEN
331	WRITE(numout,*) 'Warning! Weekly GPP is initialized to 0.'
332	ENDIF
333
334	! 1.2.12 minimum moisture availabilities
335	IF ( ABS( SUM( minmoiavail_thisyear(:,2:nvm) ) ) .LT. min_stomate ) THEN
336
337	! in this case, set them to a very high value
338	WRITE(numout,*) 'Warning! We have to initialize this year''s minimum '// &
339	'moisture availabilities.'
340	minmoiavail_thisyear(:,:) = large_value
341
342	ENDIF
343
344	!
345	! 1.3 reset flag
346	!
347
348	firstcall = .FALSE.
349
350	ENDIF
351
352	!
353	! 2 moisture availabilities
354	!
355
356	!
357	! 2.1 "monthly"
358	!
359
360	moiavail_month = ( moiavail_month * ( tau_hum_month - dt ) + &
361	moiavail_daily * dt ) / tau_hum_month
362
363	DO j = 2,nvm
364	WHERE ( ABS(moiavail_month(:,j)) .LT. EPSILON(zero) )
365	moiavail_month(:,j) = zero
366	ENDWHERE
367	ENDDO
368
369	!
370	! 2.2 "weekly"
371	!
372
373	moiavail_week = ( moiavail_week * ( tau_hum_week - dt ) + &
374	moiavail_daily * dt ) / tau_hum_week
375
376	DO j = 2,nvm
377	WHERE ( ABS(moiavail_week(:,j)) .LT. EPSILON(zero) )
378	moiavail_week(:,j) = zero
379	ENDWHERE
380	ENDDO
381
382	!
383	! 3 2-meter temperatures
384	!
385
386	!
387	! 3.1 "long term"
388	!
389
390	t2m_longterm = ( t2m_longterm * ( tau_longterm - dt ) + &
391	t2m_daily * dt ) / tau_longterm
392
393	WHERE ( ABS(t2m_longterm(:)) .LT. EPSILON(zero) )
394	t2m_longterm(:) = zero
395	ENDWHERE
396
397	CALL histwrite (hist_id_stomate, 'T2M_LONGTERM', itime, &
398	t2m_longterm, npts, hori_index)
399	!
400	! 3.2 "long term reference"
401	! This temperature is used for recalculating PFT-specific parameters such as
402	! critical photosynthesis temperatures of critical GDDs for phenology. This
403	! means that if the reference temperature varies, the PFTs adapt to them.
404	! Therefore the reference temperature can vary only if the vegetation is not
405	! static.
406	!
407
408	!!$ IF (control%ok_dgvm) THEN
409	tlong_ref(:) = MAX( tlong_ref_min, MIN( tlong_ref_max, t2m_longterm(:) ) )
410	!!$ ENDIF
411	!
412	! 3.3 "monthly"
413	!
414
415	t2m_month = ( t2m_month * ( tau_t2m_month - dt ) + &
416	t2m_daily * dt ) / tau_t2m_month
417
418	WHERE ( ABS(t2m_month(:)) .LT. EPSILON(zero) )
419	t2m_month(:) = zero
420	ENDWHERE
421
422	!
423	! 3.4 "weekly"
424	!
425
426	t2m_week = ( t2m_week * ( tau_t2m_week - dt ) + &
427	t2m_daily * dt ) / tau_t2m_week
428
429	WHERE ( ABS(t2m_week(:)) .LT. EPSILON(zero) )
430	t2m_week(:) = zero
431	ENDWHERE
432
433	!
434	! 4 ''monthly'' soil temperatures
435	!
436
437	tsoil_month = ( tsoil_month * ( tau_tsoil_month - dt ) + &
438	tsoil_daily(:,:) * dt ) / tau_tsoil_month
439
440	WHERE ( ABS(tsoil_month(:,:)) .LT. EPSILON(zero) )
441	tsoil_month(:,:) = zero
442	ENDWHERE
443
444	!
445	! 5 ''monthly'' soil humidity
446	!
447
448	soilhum_month = ( soilhum_month * ( tau_soilhum_month - dt ) + &
449	soilhum_daily * dt ) / tau_soilhum_month
450
451	WHERE ( ABS(soilhum_month(:,:)) .LT. EPSILON(zero) )
452	soilhum_month(:,:) = zero
453	ENDWHERE
454
455	!
456	! 6 dormance (d)
457	! when gpp is low, increase dormance time. Otherwise, set it to zero.
458	! NV: special case (3rd condition): plant is accumulating carbohydrates
459	! and does never use them. In this case, we allow the plant to
460	! detect a beginning of the growing season by declaring it dormant
461	!
462	!NVMODIF
463	DO j = 2,nvm
464	WHERE ( ( gpp_week(:,j) .LT. min_gpp_allowed ) .OR. &
465	( gpp_week(:,j) .LT. gppfrac_dormance * maxgppweek_lastyear(:,j) ) .OR. &
466	( ( when_growthinit(:,j) .GT. 2.*one_year ) .AND. &
467	( biomass(:,j,icarbres) .GT. biomass(:,j,ileaf)*4. ) ) )
468	! WHERE ( ( gpp_week(:,j) .EQ. zero ) .OR. &
469	! ( gpp_week(:,j) .LT. gppfrac_dormance * maxgppweek_lastyear(:,j) ) .OR. &
470	! ( ( when_growthinit(:,j) .GT. 2.*one_year ) .AND. &
471	! ( biomass(:,j,icarbres) .GT. biomass(:,j,ileaf)*4. ) ) )
472
473	time_lowgpp(:,j) = time_lowgpp(:,j) + dt
474
475	ELSEWHERE
476
477	time_lowgpp(:,j) = zero
478
479	ENDWHERE
480	ENDDO
481
482	!
483	! 7 growing degree days, threshold -5 deg C
484	!
485
486	DO j = 2,nvm
487
488	! only for PFTs for which critical gdd is defined
489	! gdd_m5_dormance is set to 0 at the end of the growing season. It is set to undef
490	! at the beginning of the growing season.
491
492	IF ( ALL(pheno_gdd_crit(j,:) .NE. undef) ) THEN
493
494	!
495	! 7.1 set to zero if undef and no gpp
496	!
497
498	WHERE ( ( time_lowgpp(:,j) .GT. zero ) .AND. ( gdd_m5_dormance(:,j) .EQ. undef ) )
499
500	gdd_m5_dormance(:,j) = zero
501
502	ENDWHERE
503
504	!
505	! 7.2 set to undef if there is gpp
506	!
507
508	WHERE ( time_lowgpp(:,j) .EQ. zero )
509
510	gdd_m5_dormance(:,j) = undef
511
512	ENDWHERE
513
514	!
515	! 7.3 normal update where gdd_m5_dormance is defined
516	!
517
518	WHERE ( ( t2m_daily(:) .GT. ( ZeroCelsius - gdd_threshold ) ) .AND. &
519	( gdd_m5_dormance(:,j) .NE. undef ) )
520	gdd_m5_dormance(:,j) = gdd_m5_dormance(:,j) + &
521	dt * ( t2m_daily(:) - ( ZeroCelsius - gdd_threshold ) )
522	ENDWHERE
523
524	WHERE ( gdd_m5_dormance(:,j) .NE. undef )
525	gdd_m5_dormance(:,j) = gdd_m5_dormance(:,j) * &
526	( tau_gdd - dt ) / tau_gdd
527	ENDWHERE
528
529	ENDIF
530
531	ENDDO
532
533	DO j = 2,nvm
534	WHERE ( ABS(gdd_m5_dormance(:,j)) .LT. EPSILON(zero) )
535	gdd_m5_dormance(:,j) = zero
536	ENDWHERE
537	ENDDO
538
539	!
540	! 8 growing degree days since midwinter
541	!
542
543	DO j = 2,nvm
544
545	! only for PFTs for which ncdgdd_crittemp is defined
546
547	IF ( ncdgdd_temp(j) .NE. undef ) THEN
548
549	!
550	! 8.1 set to 0 if undef and if we detect "midwinter"
551	!
552
553	WHERE ( ( gdd_midwinter(:,j) .EQ. undef ) .AND. &
554	( t2m_month(:) .LT. t2m_week(:) ) .AND. &
555	( t2m_month(:) .LT. t2m_longterm(:) ) )
556
557	gdd_midwinter(:,j) = zero
558
559	ENDWHERE
560
561	!
562	! 8.2 set to undef if we detect "midsummer"
563	!
564
565	WHERE ( ( t2m_month(:) .GT. t2m_week(:) ) .AND. &
566	( t2m_month(:) .GT. t2m_longterm(:) ) )
567
568	gdd_midwinter(:,j) = undef
569
570	ENDWHERE
571
572	!
573	! 8.3 normal update
574	!
575
576	WHERE ( ( gdd_midwinter(:,j) .NE. undef ) .AND. &
577	( t2m_daily(:) .GT. ncdgdd_temp(j)+ZeroCelsius ) )
578
579	gdd_midwinter(:,j) = &
580	gdd_midwinter(:,j) + &
581	dt * ( t2m_daily(:) - ( ncdgdd_temp(j)+ZeroCelsius ) )
582
583	ENDWHERE
584
585	ENDIF
586
587	ENDDO
588
589	!
590	! 9 number of chilling days since leaves were lost
591	!
592
593	DO j = 2,nvm
594
595	IF ( ncdgdd_temp(j) .NE. undef ) THEN
596
597	!
598	! 9.1 set to zero if undef and no gpp
599	!
600
601	WHERE ( ( time_lowgpp(:,j) .GT. zero ) .AND. ( ncd_dormance(:,j) .EQ. undef ) )
602
603	ncd_dormance(:,j) = zero
604
605	ENDWHERE
606
607	!
608	! 9.2 set to undef if there is gpp
609	!
610
611	WHERE ( time_lowgpp(:,j) .EQ. zero )
612
613	ncd_dormance(:,j) = undef
614
615	ENDWHERE
616
617	!
618	! 9.3 normal update where ncd_dormance is defined
619	!
620
621	WHERE ( ( ncd_dormance(:,j) .NE. undef ) .AND. &
622	( t2m_daily(:) .LE. ncdgdd_temp(j)+ZeroCelsius ) )
623
624	ncd_dormance(:,j) = MIN( ncd_dormance(:,j) + dt, ncd_max )
625
626	ENDWHERE
627
628	ENDIF
629
630	ENDDO
631
632	!
633	! 10 number of growing days, threshold -5 deg C
634	!
635
636	DO j = 2,nvm
637
638	!
639	! 10.1 Where there is GPP, set ngd to 0
640	! This means that we only take into account ngds when the leaves are off
641	!
642
643	WHERE ( time_lowgpp(:,j) .LT. min_stomate )
644	ngd_minus5(:,j) = zero
645	ENDWHERE
646
647	!
648	! 10.2 normal update
649	!
650
651	WHERE ( t2m_daily(:) .GT. (ZeroCelsius - gdd_threshold) )
652	ngd_minus5(:,j) = ngd_minus5(:,j) + dt
653	ENDWHERE
654
655	ngd_minus5(:,j) = ngd_minus5(:,j) * ( tau_ngd - dt ) / tau_ngd
656
657	ENDDO
658
659	DO j = 2,nvm
660	WHERE ( ABS(ngd_minus5(:,j)) .LT. EPSILON(zero) )
661	ngd_minus5(:,j) = zero
662	ENDWHERE
663	ENDDO
664	!
665	! 11 minimum humidity since dormance began and time elapsed since this minimum
666	!
667
668	DO j = 2,nvm
669
670	IF ( hum_min_time(j) .NE. undef ) THEN
671
672	!
673	! 11.1 initialize if undef and no gpp
674	!
675
676	WHERE ( ( time_lowgpp(:,j) .GT. zero ) .AND. &
677	( ( time_hum_min(:,j) .EQ. undef ) .OR. ( hum_min_dormance(:,j) .EQ. undef ) ) )
678
679	time_hum_min(:,j) = zero
680	hum_min_dormance(:,j) = moiavail_month(:,j)
681
682	ENDWHERE
683
684	!
685	! 11.2 set to undef where there is gpp
686	!
687
688	WHERE ( time_lowgpp(:,j) .EQ. zero )
689
690	time_hum_min(:,j) = undef
691	hum_min_dormance(:,j) = undef
692
693	ENDWHERE
694
695	!
696	! 11.3 normal update where time_hum_min and hum_min_dormance are defined
697	!
698
699	! 11.3.1 increase time counter
700
701	WHERE ( ( time_hum_min(:,j) .NE. undef ) .AND. &
702	( hum_min_dormance(:,j) .NE. undef ) )
703
704	time_hum_min(:,j) = time_hum_min(:,j) + dt
705
706	ENDWHERE
707
708	! 11.3.2 set time to zero if minimum is reached
709
710	WHERE ( ( time_hum_min(:,j) .NE. undef ) .AND. &
711	( hum_min_dormance(:,j) .NE. undef ) .AND. &
712	( moiavail_month(:,j) .LE. hum_min_dormance(:,j) ) )
713
714	hum_min_dormance(:,j) = moiavail_month(:,j)
715	time_hum_min(:,j) = zero
716
717	ENDWHERE
718
719	ENDIF
720
721	ENDDO
722
723	!
724	! 12 "long term" NPP. npp_daily in gC/m2/day, npp_longterm in gC/m2/year.
725	!
726
727	npp_longterm = ( npp_longterm * ( tau_longterm - dt ) + &
728	(npp_dailyone_year) dt ) / &
729	tau_longterm
730
731	DO j = 2,nvm
732	WHERE ( ABS(npp_longterm(:,j)) .LT. EPSILON(zero) )
733	npp_longterm(:,j) = zero
734	ENDWHERE
735	ENDDO
736
737	!
738	! 13 "long term" turnover rates, in gC/m**2/year.
739	!
740
741	turnover_longterm = ( turnover_longterm * ( tau_longterm - dt ) + &
742	(turnover_dailyone_year) dt ) / &
743	tau_longterm
744
745	DO j = 2,nvm
746	WHERE ( ABS(turnover_longterm(:,j,:)) .LT. EPSILON(zero) )
747	turnover_longterm(:,j,:) = zero
748	ENDWHERE
749	ENDDO
750
751	!
752	! 14 "weekly" GPP, in gC/(m**2 covered)/day (!)
753	! i.e. divide daily gpp (in gC/m**2 of total ground/day) by vegetation fraction
754	! (m2 covered/m2 of total ground)
755	!
756
757	WHERE ( veget_max .GT. zero )
758
759	gpp_week = ( gpp_week * ( tau_gpp_week - dt ) + &
760	gpp_daily * dt ) / tau_gpp_week
761
762	ELSEWHERE
763
764	gpp_week = zero
765
766	ENDWHERE
767
768	DO j = 2,nvm
769	WHERE ( ABS(gpp_week(:,j)) .LT. EPSILON(zero) )
770	gpp_week(:,j) = zero
771	ENDWHERE
772	ENDDO
773
774	!
775	! 15 maximum and minimum moisture availabilities
776	!
777
778	WHERE ( moiavail_daily .GT. maxmoiavail_thisyear )
779	maxmoiavail_thisyear = moiavail_daily
780	ENDWHERE
781
782	WHERE ( moiavail_daily .LT. minmoiavail_thisyear )
783	minmoiavail_thisyear = moiavail_daily
784	ENDWHERE
785
786	!
787	! 16 annual maximum weekly GPP
788	!
789
790	WHERE ( gpp_week .GT. maxgppweek_thisyear )
791	maxgppweek_thisyear = gpp_week
792	ENDWHERE
793
794	!
795	! 17 annual GDD0
796	!
797
798	WHERE ( t2m_daily .GT. ZeroCelsius )
799	gdd0_thisyear = gdd0_thisyear + dt * ( t2m_daily - ZeroCelsius )
800	ENDWHERE
801
802	!
803	! 18 annual precipitation
804	!
805
806	precip_thisyear = precip_thisyear + dt * precip_daily
807
808	!
809	! 19 annual maximum leaf mass
810	! If STOMATE is not activated, this corresponds to the maximum possible
811	! LAI of the PFT
812	!
813
814	IF(control%ok_dgvm ) THEN
815
816	fracnat(:) = un
817	DO j = 2,nvm
818	IF ( .NOT. natural(j) ) THEN
819	fracnat(:) = fracnat(:) - veget_max(:,j)
820	ENDIF
821	ENDDO
822
823	ENDIF
824
825	IF ( control%ok_stomate ) THEN
826	IF(control%ok_dgvm ) THEN
827	DO j=2,nvm
828
829	IF ( natural(j) .AND. control%ok_dgvm ) THEN
830
831	WHERE ( fracnat(:) .GT. min_stomate .AND. biomass(:,j,ileaf).GT. lm_lastyearmax(:,j)*0.75 )
832	maxfpc_lastyear(:,j) = ( maxfpc_lastyear(:,j) * ( one_year/leaflife_tab(j)- dt ) + &
833	veget(:,j) / fracnat(:) * dt ) / (one_year/leaflife_tab(j))
834	ENDWHERE
835	maxfpc_thisyear(:,j) = maxfpc_lastyear(:,j) ! just to initialise value
836
837	ENDIF
838
839	!NV : correct initialization
840	!!$ WHERE(biomass(:,j,ileaf).GT. lm_lastyearmax(:,j)*0.75)
841	!!$ lm_lastyearmax(:,j) = ( lm_lastyearmax(:,j) * ( one_year/leaflife_tab(j)- dt ) + &
842	!!$ biomass(:,j,ileaf) * dt ) / (one_year/leaflife_tab(j))
843	!!$ ENDWHERE
844	!!$ lm_thisyearmax(:,j)=lm_lastyearmax(:,j) ! just to initialise value
845	WHERE (lm_thisyearmax(:,j) .GT. min_stomate)
846	WHERE(biomass(:,j,ileaf).GT. lm_thisyearmax(:,j)*0.75)
847	lm_thisyearmax(:,j) = ( lm_thisyearmax(:,j) * ( one_year/leaflife_tab(j)- dt ) + &
848	biomass(:,j,ileaf) * dt ) / (one_year/leaflife_tab(j))
849	ENDWHERE
850	ELSEWHERE
851	lm_thisyearmax(:,j) =biomass(:,j,ileaf)
852	ENDWHERE
853
854	ENDDO
855
856	ELSE
857
858	DO j = 2,nvm
859	WHERE ( biomass(:,j,ileaf) .GT. lm_thisyearmax(:,j) )
860	lm_thisyearmax(:,j) = biomass(:,j,ileaf)
861	ENDWHERE
862	ENDDO
863
864	ENDIF
865	ELSE
866
867	DO j = 2,nvm
868	lm_thisyearmax(:,j) = lai_max(j) / sla(j)
869	ENDDO
870
871	ENDIF
872
873	!
874	! 20 annual maximum fpc for each PFT
875	! "veget" is defined as fraction of total ground. Therefore, maxfpc_thisyear has
876	! the same unit.
877	!
878
879	WHERE ( veget(:,:) .GT. maxfpc_thisyear(:,:) )
880	maxfpc_thisyear(:,:) = veget(:,:)
881	ENDWHERE
882
883	!
884	! 21 Every year, replace last year's maximum and minimum moisture availability,
885	! annual GDD0, annual precipitation, annual max weekly GPP, and maximum leaf mass
886
887	IF ( EndOfYear ) THEN
888
889	!
890	! 21.1 replace old values
891	!
892	!NVMODIF
893	maxmoiavail_lastyear(:,:) = (maxmoiavail_lastyear(:,:)*(tau_climatology-1)+ maxmoiavail_thisyear(:,:))/tau_climatology
894	minmoiavail_lastyear(:,:) = (minmoiavail_lastyear(:,:)*(tau_climatology-1)+ minmoiavail_thisyear(:,:))/tau_climatology
895	maxgppweek_lastyear(:,:) =( maxgppweek_lastyear(:,:)*(tau_climatology-1)+ maxgppweek_thisyear(:,:))/tau_climatology
896	! maxmoiavail_lastyear(:,:) = maxmoiavail_thisyear(:,:)
897	! minmoiavail_lastyear(:,:) = minmoiavail_thisyear(:,:)
898	! maxgppweek_lastyear(:,:) = maxgppweek_thisyear(:,:)
899
900	gdd0_lastyear(:) = gdd0_thisyear(:)
901
902	precip_lastyear(:) = precip_thisyear(:)
903
904	lm_lastyearmax(:,:) = lm_thisyearmax(:,:)
905
906	maxfpc_lastyear(:,:) = maxfpc_thisyear(:,:)
907
908	!
909	! 21.2 reset new values
910	!
911
912	maxmoiavail_thisyear(:,:) = zero
913	minmoiavail_thisyear(:,:) = large_value
914
915	maxgppweek_thisyear(:,:) = zero
916
917	gdd0_thisyear(:) = zero
918
919	precip_thisyear(:) = zero
920
921	lm_thisyearmax(:,:) = zero
922
923	maxfpc_thisyear(:,:) = zero
924
925	!
926	! 21.3 Special treatment for maxfpc.
927	!
928
929	!
930	! 21.3.1 Only take into account natural PFTs
931	!
932
933	DO j = 2,nvm
934	IF ( .NOT. natural(j) ) THEN
935	maxfpc_lastyear(:,j) = zero
936	ENDIF
937	ENDDO
938
939	! 21.3.2 In Stomate, veget is defined as a fraction of ground, not as a fraction
940	! of total ground. maxfpc_lastyear will be compared to veget in lpj_light.
941	! Therefore, we have to transform maxfpc_lastyear.
942
943
944	! 21.3.3 The sum of the maxfpc_lastyear for natural PFT must not exceed fpc_crit (=.95).
945	! However, it can slightly exceed this value as not all PFTs reach their maximum
946	! fpc at the same time. Therefore, if sum(maxfpc_lastyear) for the natural PFTs
947	! exceeds fpc_crit, we scale the values of maxfpc_lastyear so that the sum is
948	! fpc_crit.
949
950	!!$ ! calculate the sum of maxfpc_lastyear
951	!!$ sumfpc_nat(:) = zero
952	!!$ DO j = 2,nvm
953	!!$ sumfpc_nat(:) = sumfpc_nat(:) + maxfpc_lastyear(:,j)
954	!!$ ENDDO
955	!!$
956	!!$ ! scale so that the new sum is fpc_crit
957	!!$ DO j = 2,nvm
958	!!$ WHERE ( sumfpc_nat(:) .GT. fpc_crit )
959	!!$ maxfpc_lastyear(:,j) = maxfpc_lastyear(:,j) * (fpc_crit/sumfpc_nat(:))
960	!!$ ENDWHERE
961	!!$ ENDDO
962
963	ENDIF ! EndOfYear
964
965	!
966	! 22 diagnose herbivore activity, determined through as probability for a leaf to be
967	! eaten in a day
968	! Follows McNaughton et al., Nat 341, 142-144, 1989.
969	!
970
971	!
972	! 22.1 first calculate mean long-term leaf NPP in grid box, mean residence
973	! time (years) of green tissue (i.e. tissue that will be eaten by
974	! herbivores) (crudely approximated: 6 months for seasonal and 2 years
975	! for evergreen) and mean length of growing season (6 months for
976	! seasonal and 1 year for evergreen).
977	!
978
979	nlflong_nat(:,:) = zero
980	weighttot(:,:) = zero
981	green_age(:,:) = zero
982	!
983	DO j = 2,nvm
984	!
985	IF ( natural(j) ) THEN
986	!
987	weighttot(:,j) = lm_lastyearmax(:,j)
988	nlflong_nat(:,j) = npp_longterm(:,j) * leaf_frac_hvc
989	!
990	IF ( pheno_model(j) .EQ. 'none' ) THEN
991	green_age(:,j) = green_age_ever * lm_lastyearmax(:,j)
992	ELSE
993	green_age(:,j) = green_age_dec * lm_lastyearmax(:,j)
994	ENDIF
995	!
996	ENDIF
997	!
998	ENDDO
999	!
1000	WHERE ( weighttot(:,:) .GT. zero )
1001	green_age(:,:) = green_age(:,:) / weighttot(:,:)
1002	ELSEWHERE
1003	green_age(:,:) = un
1004	ENDWHERE
1005
1006	!
1007	! 22.2 McNaughton et al. give herbivore consumption as a function of annual leaf NPP.
1008	! The annual leaf NPP can give us an idea about the edible biomass:
1009	!
1010
1011	DO j = 2,nvm
1012	!
1013	IF ( natural(j) ) THEN
1014	!
1015	WHERE ( nlflong_nat(:,j) .GT. zero )
1016	consumption(:) = hvc1 * nlflong_nat(:,j) ** hvc2
1017	herbivores(:,j) = one_year * green_age(:,j) * nlflong_nat(:,j) / consumption(:)
1018	ELSEWHERE
1019	herbivores(:,j) = 100000.
1020	ENDWHERE
1021	!
1022	ELSE
1023	!
1024	herbivores(:,j) = 100000.
1025	!
1026	ENDIF
1027	!
1028	ENDDO
1029	herbivores(:,ibare_sechiba) = zero
1030
1031	IF (bavard.GE.4) WRITE(numout,*) 'Leaving season'
1032
1033	END SUBROUTINE season
1034
1035	END MODULE stomate_season

Note: See TracBrowser for help on using the repository browser.

Download in other formats: