source: tags/ORCHIDEE/src_stomate/stomate_resp.f90 @ 6

Last change on this file since 6 was 6, checked in by orchidee, 14 years ago

import first tag equivalent to CVS orchidee_1_9_5 + OOL_1_9_5
File size: 7.4 KB
Line 
1!$Header: /home/ssipsl/CVSREP/ORCHIDEE/src_stomate/stomate_resp.f90,v 1.7 2009/01/06 17:18:32 ssipsl Exp $
2!IPSL (2006)
3! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
4 
5  !  calculate maintenance respiration on an hourly time step (NV 14/5/2002)
6MODULE stomate_resp
7  ! modules used:
8  USE stomate_constants
9  USE constantes_veg
10
11  IMPLICIT NONE
12
13  ! private & public routines
14
15  PRIVATE
16  PUBLIC maint_respiration,maint_respiration_clear
17
18  ! first call
19  LOGICAL, SAVE                                              :: firstcall = .TRUE.
20
21CONTAINS
22
23  SUBROUTINE maint_respiration_clear
24    firstcall=.TRUE.
25  END SUBROUTINE maint_respiration_clear
26
27  SUBROUTINE maint_respiration ( npts,dt,lai, t2m,tlong_ref,stempdiag,height,veget_max,&
28       rprof,biomass,resp_maint_part_radia)
29
30    !
31    ! 0 declarations
32    !
33
34    ! 0.1 input
35
36    ! Domain size
37    INTEGER(i_std), INTENT(in)                                        :: npts
38    ! time step (seconds)
39    REAL(r_std), INTENT(in)                                     :: dt
40    ! 2 m air temperature (K)
41    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: t2m
42    ! 2 m air temperature (K)
43    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: tlong_ref
44    ! Soil temperature
45    REAL(r_std),DIMENSION (npts,nbdl), INTENT (in)              :: stempdiag
46    ! height of vegetation (m)
47    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: height
48    ! "maximal" coverage fraction of a PFT (LAI -> infinity) on nat/agri ground
49    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: veget_max
50    ! root depth (m)
51    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: rprof
52    ! biomass (gC/m**2)
53    REAL(r_std),DIMENSION(npts,nvm,nparts),INTENT(in)          :: biomass 
54    ! 0.2 modified fields
55
56
57    ! 0.3 output
58
59    ! maintenance respiration of different parts (gC/dt/m**2 of total ground)
60    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(out)             :: resp_maint_part_radia
61    ! 0.4 local
62
63    ! leaf area index
64    REAL(r_std), DIMENSION(npts,nvm)                           :: lai
65    ! soil levels (m)
66    REAL(r_std), SAVE, DIMENSION(0:nbdl)                        :: z_soil
67    ! root temperature (convolution of root and soil temperature profiles)
68    REAL(r_std), DIMENSION(npts,nvm)                           :: t_root
69    ! maintenance respiration coefficients at 0 deg C (g/g d**-1)
70    REAL(r_std), DIMENSION(npts,nvm,nparts)                    :: coeff_maint
71    ! temperature which is pertinent for maintenance respiration (K)
72    REAL(r_std), DIMENSION(npts,nparts)                         :: t_maint
73    ! integration constant for root profile
74    REAL(r_std), DIMENSION(npts)                                :: rpc
75    ! temperature which is pertinent for maintenance respiration (K)
76    REAL(r_std), DIMENSION(npts,nparts)                         :: t_maint_radia
77    ! long term annual mean temperature, C
78    REAL(r_std), DIMENSION(npts)                                :: tl
79    ! slope of maintenance respiration coefficient (1/K)
80    REAL(r_std), DIMENSION(npts)                                :: slope
81    ! Index
82    INTEGER(i_std)                                              :: i,j,k,l,m
83
84    !
85    !
86    ! 2 define maintenance respiration coefficients
87    !
88    IF (bavard.GE.3) WRITE(numout,*) 'Entering respiration'
89    !
90    ! 1 Initializations
91    !
92    IF ( firstcall ) THEN
93
94       ! 1.1.1 soil levels
95
96       z_soil(0) = 0.
97       z_soil(1:nbdl) = diaglev(1:nbdl)
98
99       ! 1.1.2 messages
100
101       WRITE(numout,*) 'respiration:'
102
103       firstcall = .FALSE.
104
105    ENDIF
106
107    !
108
109    !
110    ! 1 do initialisation
111    !
112
113
114    DO j = 2,nvm
115
116       ! 1.3.1 rpc is an integration constant such that the integral of the root profile is 1.
117       rpc(:) = 1. / ( 1. - EXP( -z_soil(nbdl) / rprof(:,j) ) )
118
119       ! 1.3.2 integrate over the nbdl levels
120
121       t_root(:,j) = 0.0
122
123       DO l = 1, nbdl
124
125          t_root(:,j) = &
126               t_root(:,j) + stempdiag(:,l) * rpc(:) * &
127               ( EXP( -z_soil(l-1)/rprof(:,j) ) - EXP( -z_soil(l)/rprof(:,j) ) )
128
129       ENDDO
130
131    ENDDO
132
133    DO j = 2,nvm
134
135       !
136       ! 2.1 temperature which is taken for the plant part we are talking about
137       !
138
139       ! 2.1.1 parts above the ground
140
141       t_maint_radia(:,ileaf) = t2m(:)
142       t_maint_radia(:,isapabove) = t2m(:)
143       t_maint_radia(:,ifruit) = t2m(:)
144
145       ! 2.1.2 parts below the ground
146
147       t_maint_radia(:,isapbelow) = t_root(:,j)
148       t_maint_radia(:,iroot) = t_root(:,j)
149
150       ! 2.1.3 heartwood: does not respire. Any temperature
151
152       t_maint_radia(:,iheartbelow) = t_root(:,j)
153       t_maint_radia(:,iheartabove) = t2m(:)
154
155       ! 2.1.4 reserve: above the ground for trees, below for grasses
156
157       IF ( tree(j) ) THEN
158          t_maint_radia(:,icarbres) = t2m(:)
159       ELSE
160          t_maint_radia(:,icarbres) = t_root(:,j)
161       ENDIF
162
163       !
164       ! 2.2 calculate coefficient
165       !
166
167       tl(:) = tlong_ref(:) - ZeroCelsius
168       slope(:) = maint_resp_slope(j,1) + tl(:) * maint_resp_slope(j,2) + &
169            tl(:)*tl(:) * maint_resp_slope(j,3)
170
171       DO k = 1, nparts
172
173          coeff_maint(:,j,k) = &
174               MAX( (coeff_maint_zero(j,k)*dt/one_day) * &
175               ( 1. + slope(:) * (t_maint_radia(:,k)-ZeroCelsius) ), 0._r_std )
176
177       ENDDO
178
179    ENDDO
180
181    !
182    ! 3 calculate maintenance respiration.
183    !
184
185
186    lai(:,ibare_sechiba) = zero
187    resp_maint_part_radia(:,ibare_sechiba,:) = zero
188    !
189    DO j = 2,nvm
190       !
191       ! 3.1 maintenance respiration of the different plant parts
192       !
193       lai(:,j) = biomass(:,j,ileaf) * sla(j)
194
195       DO k = 1, nparts
196
197          IF ( k .EQ. ileaf ) THEN
198
199             ! Leaves: respiration depends on leaf mass AND LAI.
200!!$                WHERE ( (biomass(:,j,ileaf) > min_stomate) .AND. (lai(:,j) > 0.0) .AND. (lai(:,j) < val_exp) )
201!!$                resp_maint_part_radia(:,j,k) = coeff_maint(:,j,k) * biomass(:,j,k) * &
202!!$                        ( .3*lai(:,j) + 1.4*(1.-exp(-.5*lai(:,j))) ) / lai(:,j)
203!!$             ELSEWHERE
204!!$                resp_maint_part_radia(:,j,k) = 0.0
205!!$             ENDWHERE
206             DO i = 1, npts
207                IF ( (biomass(i,j,ileaf) > min_stomate) .AND. (lai(i,j) > min_stomate) ) THEN
208!!$                         IF (lai(i,j) < 100._r_std) THEN
209!!$                            resp_maint_part_radia(i,j,k) = coeff_maint(i,j,k) * biomass(i,j,k) * &
210!!$                                 ( .3*lai(i,j) + 1.4*(1.-exp(-.5*lai(i,j))) ) / lai(i,j)
211!!$                         ELSE
212!!$                            resp_maint_part_radia(i,j,k) = coeff_maint(i,j,k) * biomass(i,j,k) * &
213!!$                                 ( .3*lai(i,j) + 1.4 ) / lai(i,j)
214!!$                         ENDIF
215                   resp_maint_part_radia(i,j,k) = coeff_maint(i,j,k) * biomass(i,j,k) * &
216                        ( .3*lai(i,j) + 1.4*(1.-exp(-.5*lai(i,j))) ) / lai(i,j)
217                ELSE
218                   resp_maint_part_radia(i,j,k) = zero
219                ENDIF
220             ENDDO
221          ELSE
222
223             resp_maint_part_radia(:,j,k) = coeff_maint(:,j,k) * biomass(:,j,k)
224
225          ENDIF
226
227       ENDDO
228
229       !
230       ! 3.2 Total maintenance respiration of the plant
231       !     VPP killer:
232       !     resp_maint(:,j) = SUM( resp_maint_part(:,:), DIM=2 )
233       !
234
235    ENDDO
236
237
238    IF (bavard.GE.4) WRITE(numout,*) 'Leaving respiration'
239
240  END SUBROUTINE maint_respiration
241
242END MODULE stomate_resp
Note: See TracBrowser for help on using the repository browser.