Context Navigation

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

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

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

Download in other formats: