1 | ! ================================================================================================================================= |
---|
2 | ! MODULE : grassland_fertilisation |
---|
3 | ! |
---|
4 | ! CONTACT : orchidee-help _at_ ipsl.jussieu.fr |
---|
5 | ! |
---|
6 | ! LICENCE : IPSL (2006) |
---|
7 | ! This software is governed by the CeCILL licence see |
---|
8 | ! ORCHIDEE/ORCHIDEE_CeCILL.LIC |
---|
9 | ! |
---|
10 | !>\BRIEF This module execute grassland fertilization process, |
---|
11 | !! calculate carbon/nitrogen in fertilizer (organic/mineral), |
---|
12 | !! spatialize the fertilizer into corresponding grid |
---|
13 | !! |
---|
14 | !!\n DESCRIPTION : None |
---|
15 | !! |
---|
16 | !! RECENT CHANGE(S) : None |
---|
17 | !! |
---|
18 | !! REFERENCE(S) : None |
---|
19 | !! |
---|
20 | !! \n |
---|
21 | !_ |
---|
22 | !================================================================================================================================ |
---|
23 | MODULE grassland_fertilisation |
---|
24 | |
---|
25 | USE grassland_fonctions |
---|
26 | USE grassland_constantes |
---|
27 | USE pft_parameters |
---|
28 | USE constantes |
---|
29 | USE ioipsl |
---|
30 | |
---|
31 | IMPLICIT NONE |
---|
32 | REAL(r_std ), PARAMETER :: c2Nsolidmanure = 15.0 |
---|
33 | REAL(r_std ), PARAMETER :: c2Nslurry = 10.0 |
---|
34 | ! Nitrogen flux from slurry and manure to strcutural SOM pool (kg N m-2 d-1) |
---|
35 | REAL(r_std ), ALLOCATABLE, SAVE, DIMENSION(:,:) :: fnOrganicFertstruct |
---|
36 | ! flag for verify that without twice fertilisation at same time |
---|
37 | LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tfert_verif |
---|
38 | LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tfert_verif2 ! idem |
---|
39 | LOGICAL , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tfert_verif3 ! idem |
---|
40 | |
---|
41 | |
---|
42 | CONTAINS |
---|
43 | |
---|
44 | ! two function of fertilization |
---|
45 | ! one is for each time |
---|
46 | ! the other one is for strategy spatialization of fertilization in management |
---|
47 | |
---|
48 | |
---|
49 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
50 | !!!!!! FERTILISATION a chaque pas de temps |
---|
51 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
52 | |
---|
53 | SUBROUTINE fertilisation_pas_temps(& |
---|
54 | npts , & |
---|
55 | fertcount , & |
---|
56 | dt , & |
---|
57 | tjulian , & |
---|
58 | deltat , & |
---|
59 | tfert , & |
---|
60 | Nliquidmanure , & |
---|
61 | Nslurry , & |
---|
62 | Nsolidmanure , & |
---|
63 | fcOrganicFertmetabolic , & |
---|
64 | fcOrganicFertstruct , & |
---|
65 | fnOrganicFerturine , & |
---|
66 | fnOrganicFertmetabolic , & |
---|
67 | c2nratiostruct , & |
---|
68 | Fert_on) |
---|
69 | |
---|
70 | INTEGER(i_std) , INTENT(in) :: npts |
---|
71 | ! Number of spatial points |
---|
72 | INTEGER(i_std), DIMENSION(npts,nvm) , INTENT(inout) :: fertcount |
---|
73 | ! counter for fertilizer application (-) |
---|
74 | REAL(r_std) , INTENT(in) :: dt |
---|
75 | INTEGER(i_std) , INTENT(in) :: tjulian |
---|
76 | ! Julian day (-) |
---|
77 | REAL(r_std) , INTENT(in) :: deltat |
---|
78 | REAL(r_std), DIMENSION(npts,nvm, nfert) , INTENT(in) :: tfert |
---|
79 | ! zeitpunkt der duengung h (1,..,nfert) (d) |
---|
80 | REAL(r_std), DIMENSION(npts,nvm, nfert) , INTENT(in) :: Nliquidmanure |
---|
81 | ! Nitrogen in liquid manure (kg N m-2) (lisier) |
---|
82 | REAL(r_std), DIMENSION(npts,nvm, nfert) , INTENT(in) :: Nslurry |
---|
83 | ! Nitrogen in slurry (kg N m-2) (boues) |
---|
84 | REAL(r_std), DIMENSION(npts,nvm, nfert) , INTENT(in) :: Nsolidmanure |
---|
85 | ! Nitrogen in solid manure (kg N m-2) |
---|
86 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: fcOrganicFertmetabolic |
---|
87 | ! Carbon flux from slurry and manure to metabolic SOM pool (kg c m-2 d-1) |
---|
88 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: fcOrganicFertstruct |
---|
89 | ! Carbon flux from slurry and manure to structural SOM pool (kg c m-2 d-1) |
---|
90 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: fnOrganicFerturine |
---|
91 | ! Nitrogen flux from slurry and liquid manure (kg N m-2 d-1) |
---|
92 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: fnOrganicFertmetabolic |
---|
93 | ! Nitrogen flux from Organic ferilization to metabolic SOM pool (kg N m-2 d-1) |
---|
94 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(in) :: c2nratiostruct |
---|
95 | |
---|
96 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(inout) :: Fert_on |
---|
97 | ! variables locales |
---|
98 | INTEGER :: i,j |
---|
99 | REAL(r_std), DIMENSION(npts,nvm) :: fnfert_resultat1 |
---|
100 | REAL(r_std), DIMENSION(npts,nvm) :: fnfert_resultat2 |
---|
101 | REAL(r_std), DIMENSION(npts,nvm) :: fnfert_resultat3 |
---|
102 | |
---|
103 | fnfert_resultat1 = 0.0 |
---|
104 | fnfert_resultat2 = 0.0 |
---|
105 | fnfert_resultat3 = 0.0 |
---|
106 | |
---|
107 | !fertilization |
---|
108 | !application rates |
---|
109 | fcOrganicFertmetabolic(:,:) = 0.0 |
---|
110 | fcOrganicFertstruct(:,:) = 0.0 |
---|
111 | fnOrganicFerturine(:,:) = 0.0 |
---|
112 | fnOrganicFertmetabolic(:,:) = 0.0 |
---|
113 | fnOrganicFertstruct(:,:) = 0.0 |
---|
114 | ! engrais de ferme ! valeu estimated based on fertilisation |
---|
115 | ! in chambers ms 1999 |
---|
116 | DO j = 2, nvm |
---|
117 | DO i= 1, npts |
---|
118 | IF (fertcount(i,j) .GT. 0) THEN |
---|
119 | CALL fnfert(1, fnfert_resultat1(i,j), tjulian, deltat, & |
---|
120 | tfert(i,j,fertcount(i,j)), tapplvg, Nliquidmanure(i,j,fertcount(i,j))) |
---|
121 | CALL fnfert(1, fnfert_resultat2(i,j), tjulian, deltat, & |
---|
122 | tfert(i,j,fertcount(i,j)), tapplka, Nslurry(i,j,fertcount(i,j))) |
---|
123 | CALL fnfert(1, fnfert_resultat3(i,j), tjulian, deltat, & |
---|
124 | tfert(i,j,fertcount(i,j)), tapplmist, Nsolidmanure(i,j,fertcount(i,j))) |
---|
125 | |
---|
126 | fcOrganicFertmetabolic(i,j) = & |
---|
127 | fvgcmetabolic * 15.0 * fnfert_resultat1(i,j) + & |
---|
128 | fkacmetabolic * 15.0 * fnfert_resultat2(i,j) + & |
---|
129 | fmistcmetabolic * c2Nsolidmanure * fnfert_resultat3(i,j) |
---|
130 | fcOrganicFertstruct(i,j) = & |
---|
131 | (1.0 - fvgcmetabolic) * 15.0 * fnfert_resultat1(i,j) + & |
---|
132 | (1.0 - fkacmetabolic) * 15.0 * fnfert_resultat2(i,j) + & |
---|
133 | (1.0 - fmistcmetabolic) * c2Nsolidmanure *fnfert_resultat3(i,j) |
---|
134 | |
---|
135 | fnOrganicFerturine(i,j) = fvgnurine*fnfert_resultat1(i,j) + fkanurine*fnfert_resultat2(i,j) |
---|
136 | |
---|
137 | fnOrganicFertmetabolic(i,j) = & |
---|
138 | (1.0 - fvgnurine)*fnfert_resultat1(i,j) + & |
---|
139 | (1.0 - fkanurine)*fnfert_resultat2(i,j) + & |
---|
140 | fnfert_resultat3(i,j) - fcOrganicFertstruct(i,j)/c2nratiostruct(i,j) !ms 1999 |
---|
141 | |
---|
142 | fnOrganicFertstruct(i,j) = fcOrganicFertstruct(i,j)/c2nratiostruct(i,j) |
---|
143 | Fert_on(i,j) = (fnOrganicFerturine(i,j) + fnOrganicFertmetabolic(i,j) + & |
---|
144 | fnOrganicFertmetabolic(i,j)) |
---|
145 | |
---|
146 | ELSE |
---|
147 | fcOrganicFertmetabolic(i,j) = 0.0 |
---|
148 | fcOrganicFertstruct(i,j) = 0.0 |
---|
149 | fnOrganicFerturine(i,j) = 0.0 |
---|
150 | fnOrganicFertmetabolic(i,j) = 0.0 |
---|
151 | fnOrganicFertstruct(i,j) = 0.0 |
---|
152 | Fert_on(i,j) = 0.0 |
---|
153 | ENDIF |
---|
154 | END DO ! i npts |
---|
155 | END DO ! j nvm |
---|
156 | |
---|
157 | END SUBROUTINE fertilisation_pas_temps |
---|
158 | |
---|
159 | |
---|
160 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
161 | !!!!!! FNFERT |
---|
162 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
163 | |
---|
164 | SUBROUTINE Fnfert(& |
---|
165 | npts , & |
---|
166 | Fnfertform , & |
---|
167 | tjulianform , & |
---|
168 | deltatform , & |
---|
169 | tfertform , & |
---|
170 | tapplform , & |
---|
171 | Nfertform) |
---|
172 | |
---|
173 | INTEGER (i_std) , INTENT(in) :: npts |
---|
174 | INTEGER(i_std) , INTENT(in) :: tjulianform |
---|
175 | REAL(r_std) , INTENT(in) :: deltatform |
---|
176 | REAL(r_std) , INTENT(in) :: tapplform |
---|
177 | REAL(r_std), DIMENSION(npts), INTENT(in) :: tfertform |
---|
178 | REAL(r_std), DIMENSION(npts), INTENT(in) :: Nfertform |
---|
179 | REAL(r_std), DIMENSION(npts), INTENT(out) :: Fnfertform |
---|
180 | |
---|
181 | ! variables locales : |
---|
182 | INTEGER(i_std) :: i |
---|
183 | |
---|
184 | |
---|
185 | IF (deltatform .EQ. 0.0) THEN |
---|
186 | Fnfertform(:) = 0.0 |
---|
187 | ELSE |
---|
188 | WHERE ((tjulianform + deltatform) .LE. tfertform(:)) |
---|
189 | |
---|
190 | Fnfertform(:) = 0.0 |
---|
191 | |
---|
192 | ELSEWHERE ((tjulianform .LE. tfertform(:)) .AND. ((tjulianform + deltatform) .GT. tfertform(:))) |
---|
193 | |
---|
194 | Fnfertform(:) = & |
---|
195 | Nfertform(:)*(MIN((tjulianform + deltatform - tfertform(:)), tapplform)) / & |
---|
196 | deltatform/tapplform |
---|
197 | |
---|
198 | ELSEWHERE (tjulianform .LT. (tfertform(:) + tapplform)) |
---|
199 | |
---|
200 | Fnfertform(:) = & |
---|
201 | Nfertform(:)*(MIN((tfertform(:) + tapplform - tjulianform),deltatform)) / & |
---|
202 | deltatform/tapplform |
---|
203 | |
---|
204 | ELSEWHERE |
---|
205 | |
---|
206 | Fnfertform(:) = 0.0 |
---|
207 | END WHERE |
---|
208 | ENDIF |
---|
209 | |
---|
210 | END SUBROUTINE Fnfert |
---|
211 | |
---|
212 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
213 | !!!!!! SPATIALISATION DE LA FERTILISATION GEREE PAR MANAGEMENT |
---|
214 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
215 | |
---|
216 | SUBROUTINE Fertilisation_spa(& |
---|
217 | npts , & |
---|
218 | flag_fertilisation , & |
---|
219 | fertcount_start , & |
---|
220 | tjulian , & |
---|
221 | tfert , & |
---|
222 | nfertnittotprevyear , & |
---|
223 | nfertammtotprevyear , & |
---|
224 | nfertnit , & |
---|
225 | nfertamm , & |
---|
226 | fertcount , & |
---|
227 | nfertammtot , & |
---|
228 | nfertnittot , & |
---|
229 | nfertammtotyear , & |
---|
230 | nfertnittotyear , & |
---|
231 | controle_azote_sum , & |
---|
232 | controle_azote_sum_mem) |
---|
233 | |
---|
234 | INTEGER (i_std) , INTENT(in) :: npts |
---|
235 | INTEGER(i_std) , DIMENSION(npts,nvm) , INTENT(in) :: flag_fertilisation |
---|
236 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(inout) :: nfertnittotprevyear |
---|
237 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(inout) :: nfertammtotprevyear |
---|
238 | REAL(r_std), DIMENSION(npts,nvm,nfert), INTENT(in) :: nfertnit |
---|
239 | REAL(r_std), DIMENSION(npts,nvm,nfert), INTENT(in) :: nfertamm |
---|
240 | INTEGER(i_std), DIMENSION(npts,nvm) , INTENT(inout) :: fertcount |
---|
241 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(inout) :: nfertammtot |
---|
242 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(inout) :: nfertnittot |
---|
243 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: nfertammtotyear |
---|
244 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: nfertnittotyear |
---|
245 | INTEGER , DIMENSION(npts,nvm) , INTENT(in) :: fertcount_start |
---|
246 | INTEGER(i_std) , INTENT(in) :: tjulian ! Julian day (-) |
---|
247 | REAL(r_std), DIMENSION(npts,nvm,nfert), INTENT(in) :: tfert |
---|
248 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(inout) :: controle_azote_sum |
---|
249 | REAL(r_std), DIMENSION(npts,nvm) , INTENT(out) :: controle_azote_sum_mem |
---|
250 | |
---|
251 | INTEGER(i_std) :: i,j |
---|
252 | |
---|
253 | |
---|
254 | IF (blabla_pasim) PRINT *, 'PASIM main grassland : call fertilisation_spa' |
---|
255 | |
---|
256 | DO j = 2, nvm |
---|
257 | |
---|
258 | DO i=1,npts |
---|
259 | |
---|
260 | IF (flag_fertilisation(i,j) .EQ. 1) THEN |
---|
261 | !counter for fertilizer application |
---|
262 | fertcount(i,j) = fertcount(i,j) + 1 |
---|
263 | |
---|
264 | !mineral fertilization |
---|
265 | nfertammtot(i,j) = nfertammtot(i,j) + nfertamm(i,j,fertcount(i,j)) |
---|
266 | nfertnittot(i,j) = nfertnittot(i,j) + nfertnit(i,j,fertcount(i,j)) |
---|
267 | |
---|
268 | nfertammtotyear(i,j) = nfertammtot(i,j) - nfertammtotprevyear(i,j) |
---|
269 | nfertnittotyear(i,j) = nfertnittot(i,j) - nfertnittotprevyear(i,j) |
---|
270 | |
---|
271 | END IF |
---|
272 | END DO |
---|
273 | END DO |
---|
274 | !*****RUN NONLIMITANT |
---|
275 | IF (f_nonlimitant .EQ. 1.) THEN |
---|
276 | DO j = 2, nvm |
---|
277 | DO i=1,npts |
---|
278 | IF (flag_fertilisation(i,j) .EQ. 1) THEN |
---|
279 | |
---|
280 | controle_azote_sum_mem(i,j) = controle_azote_sum(i,j) |
---|
281 | |
---|
282 | IF ((tjulian .GE. tfert(i,j,fertcount_start(i,j))) .AND. & |
---|
283 | (tjulian .LE. tfert(i,j,fertcount_start(i,j))+0.9) .AND. & |
---|
284 | (.NOT. (tfert_verif3(i,j,fertcount_start(i,j))) )) THEN |
---|
285 | |
---|
286 | tfert_verif3(i,j,fertcount_start(i,j))= .TRUE. |
---|
287 | controle_azote_sum(i,j) = 0. |
---|
288 | |
---|
289 | ENDIF |
---|
290 | END IF |
---|
291 | END DO |
---|
292 | END DO |
---|
293 | ENDIF |
---|
294 | |
---|
295 | END SUBROUTINE Fertilisation_spa |
---|
296 | |
---|
297 | END MODULE grassland_fertilisation |
---|