Context Navigation

source: branches/ORCHIDEE_EXT/ORCHIDEE/src_stomate/stomate_season.f90 @ 257

Last change on this file since 257 was 257, checked in by didier.solyga, 13 years ago
Externalized version merged with the trunk
File size: 31.8 KB

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