source: branches/publications/ORCHIDEE_gmd_mict_peat_ch4/src_stomate/grassland_fertilisation.f90 @ 7346

Last change on this file since 7346 was 3771, checked in by albert.jornet, 8 years ago

Merge: new Grassland Management Module (GRM) from revision [3759/perso/jinfeng.chang/ORCHIDEE-MICT/ORCHIDEE/ORCHIDEE]. Done by Jinfeng.
File size: 11.5 KB
Line 
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!================================================================================================================================
23MODULE 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
42CONTAINS
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
297END MODULE grassland_fertilisation
Note: See TracBrowser for help on using the repository browser.