-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathBS_ROOTS.FOR
252 lines (209 loc) · 8.77 KB
/
BS_ROOTS.FOR
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
C======================================================================
C BS_ROOTGR, Subroutine
C
C Computes Daily Root Growth and Distribution
C----------------------------------------------------------------------
C Revision history
C
C 1. Written
C----------------------------------------------------------------------
C Called : Sugarbeet
C
C Calls : None
C----------------------------------------------------------------------
SUBROUTINE BS_ROOTGR (DYNAMIC,ISWNIT, !C
& CUMDEP,CUMDTT,DEPMAX,DLAYR,DTT,ESW,GRORT,ISTAGE, !I
% LL,DUL,NO3,NH4,NLAYR,PLTPOP,PORMIN,RLWR,SAT,SDEPTH, !I
% SHF,STGDOY,SW,SWFAC,YRDOY, !I
% RTDEP,RLV)
C----------------------------------------------------------------------
USE ModuleDefs
IMPLICIT NONE
SAVE
INTEGER DYNAMIC
REAL CUMDEP
REAL CUMDTT
REAL DEPMAX
REAL DLAYR(NL)
REAL DTT
REAL DUL(NL)
REAL ESW(NL)
REAL GRORT
INTEGER ISTAGE
CHARACTER ISWNIT*1
INTEGER L
INTEGER L1
REAL LL(NL)
REAL NH4(NL)
INTEGER NLAYR
REAL NO3(NL)
REAL PLTPOP
REAL PORMIN
REAL RLDF(NL)
REAL RLNEW
REAL RLV(NL)
REAL RLWR
REAL RNFAC
REAL RNLF
REAL RTDEP
REAL RTEXF
REAL RTSURV
REAL SDEPTH
REAL SHF(NL)
INTEGER STGDOY(20)
REAL SW(NL)
REAL SAT(NL)
REAL SWDF
REAL SWEXF
REAL SWFAC
REAL TRLDF
INTEGER YRDOY
C----------------------------------------------------------------------
C DYNAMIC = RUNINIT OR SEASINIT
C----------------------------------------------------------------------
IF(DYNAMIC.EQ.RUNINIT.OR.DYNAMIC.EQ.SEASINIT) THEN
DO L = 1, NL
RLV(L) = 0.0
ESW(L) = DUL(L)-LL(L)
RLDF(L) = 0.0
END DO
RTDEP = 0.0
RNLF = 0.0
RNFAC = 0.0
RLNEW = 0.0
C----------------------------------------------------------------------
C DYNAMIC = INTEGR
C----------------------------------------------------------------------
ELSEIF(DYNAMIC.EQ.INTEGR) THEN
IF(ISTAGE.EQ.7.OR.ISTAGE.EQ.8) RTDEP = SDEPTH
IF(ISTAGE.EQ.9) RTDEP = RTDEP + 0.15*DTT
IF(YRDOY.EQ.STGDOY(9)) THEN
CUMDEP = 0.0
DO L = 1, NLAYR
CUMDEP = CUMDEP + DLAYR(L)
RLV(L) = 0.20*PLTPOP/DLAYR (L)
IF (CUMDEP .GT. RTDEP) GO TO 100 ! Was EXIT
END DO
100 CONTINUE ! Sun Fix
RLV(L) = RLV(L)*(1.0-(CUMDEP-RTDEP)/DLAYR(L))
L1 = L + 1
IF (L1 .LT. NLAYR) THEN
DO L = L1, NLAYR
RLV(L) = 0.0
END DO
ENDIF
ENDIF
!----------------------------------------------------------------
! Grow Roots
!----------------------------------------------------------------
IF (GRORT.LE.0.0001) GOTO 999
!The small differences between root length/weight ratios used in earlier
!models were insignificant considering the uncertainty of the value
!and the uncertainty of loss of assimilate by exudation and respiration.
!A compromise value of 0.98 was choosen for all crops.
RLNEW = GRORT * RLWR * PLTPOP ! A compromise value -- JTR
CUMDEP = 0.0
RNFAC = 1.0
L = 0
DO WHILE ((CUMDEP .LT. RTDEP) .AND. (L .LT. NLAYR))
L = L + 1
CUMDEP = CUMDEP + DLAYR(L)
IF (SW(L)-LL(L) .LT. 0.25*ESW(L)) THEN
SWDF = 4.0*(SW(L)-LL(L))/ESW(L)
IF (SWDF .LT. 0.0) THEN
SWDF = 0.0
ENDIF
ELSE
SWDF = 1.0
ENDIF
!Made all crops so that RNFAC is constrained between 0.01 and 1.0;
!on page 94 of Jones & Kiniry book the minimum is 0.01. - WTB
IF (ISWNIT .NE. 'N') THEN
RNFAC = 1.0 - (1.17*EXP(-0.15*(NO3(L)+NH4(L))))
RNFAC = AMAX1 (RNFAC,0.01)
ENDIF
RLDF(L) = AMIN1(SWDF,RNFAC)*SHF(L)*DLAYR (L)
END DO
L1 = L
!The following changes were made to simplify the code and make the model
!more generic. It also takes into account some newer data provided by
!Julio Dardenelli of Argentina. For the first time the ceres model
!restricts the rate of downward movement of roots with the soil property
!-- root weighting factor -- to account for greater difficulty in growing
!downward in hard soil. Changes made by JTR 6/16/94.
c** wdb 10/22/03
RTEXF = 0.1
SWEXF = 1.0
IF (SAT(L)-SW(L) .LT. PORMIN) THEN
SWEXF = (SAT(L) - SW(L)) / PORMIN
SWEXF = MIN(SWEXF, 1.0)
ENDIF
RTSURV = MIN(1.0,(1.-RTEXF*(1.-SWEXF)))
c** wdb 10/22/03
IF (CUMDTT .LT. 275.0) THEN ! JTR 6/17/94
RTDEP = RTDEP + DTT*0.1*SQRT(SHF(L)*AMIN1(SWFAC*2.0,SWDF))
! RTDEP = RTDEP + DTT*0.1*SQRT(SHF(L)*AMIN1(SWFAC*2.0,SWDF,satfac))
ELSE
RTDEP = RTDEP + DTT*0.22*SQRT(SHF(L)*AMIN1(SWFAC*2.0,SWDF))
ENDIF
RTDEP = AMIN1 (RTDEP,DEPMAX)
RLDF(L1) = RLDF(L1)*(1.0-(CUMDEP-RTDEP)/DLAYR(L1))
TRLDF = 0.0
DO L = 1, L1
TRLDF = TRLDF + RLDF(L)
END DO
IF (TRLDF .GE. RLNEW*0.00001) THEN
RNLF = RLNEW/TRLDF
DO L = 1, L1
RLV(L) = RLV(L) + RLDF(L)*RNLF/DLAYR(L)-0.005*RLV(L)
!Round off to nearest 1/1000th place
RLV(L) = RLV(L) * RTSURV
RLV(L) = REAL(INT(RLV(L)*1000.))/1000.
RLV(L) = AMAX1 (RLV(L),0.0)
RLV(L) = AMIN1 (RLV(L),5.0)
END DO
ENDIF
C----------------------------------------------------------------------
C DYNAMIC = OUTPUT
C----------------------------------------------------------------------
ELSEIF(DYNAMIC.EQ.OUTPUT) THEN
! {no procedures to date}
ENDIF !Dynamic loop
999 CONTINUE
RETURN
END SUBROUTINE BS_ROOTGR
! CUMDEP !Cumulative depth of soil, cm
! CUMDTT !Cumulative daily thermal time after germination, C
! DEPMAX !Depth of soil, cm
! DLAYR(L) Soil thickness in layer L (cm)
! DTT !Growing degrees occurring today (Base 8C), C
! ESW(20) !Extractable water in soil layer L, cm
! GRORT !Root growth rate, g/plant/day
! ISTAGE !Crop growth stage (1-9)
!RISWNIT*1 !Switch indicating if soil nitrogen balance is on (Y/N)
! L !Loop counter
! L1 !Loop counter
! LL(20) !Volumetric lower limit of soil water in soil layer L, cm3/cm3
! NH4(20) !Ammonium in soil layer L, ppm
! NLAYR !Number of soil layers
! NO3(20) !Nitrate in soil layer L, ppm
! PLTPOP !Plant population, pl/m2
! RLDF(20) !A root length density factor for soil layer L used to calculate
! !new root growth distribution - unitless
! RLNEW !New root length to be added to the total root system length, cm. root cm2 ground
! RLV(20) !Root length density, cm root/cm3 soil
! RLWR !Root length to weight ratio, cm/g
! RNFAC !Zero to unity factor describing mineral N availability effect on
! !root growth in Layer L
! RNLF !Intermediate factor used to calculate distribution of new root
! !growth in the soil - unitless value between 0 and 1
! RTDEP !Rooting depth (cm), Initially set at emergence
! SDEPTH !Sowing depth, cm
! SHF(20) !Relative root distribution in soil layer L (0-1)
! STGDOY(20)!Year and day of year that a growth stage occurred on
! SW(20) !Volumetric soil water content of soil layer L, cm3/cm3
! SWDF !Soil water deficit factor for Layer L used to calculate root
! !growth and water uptake - unitless value between 0 and 1
! SWFAC !Soil water stress effect on growth (0-1), 1 is no stress, 0 is full stress
! TRLDF !An intermediate calculation used to calculate distribution of new root growth in soil
! YRDOY !Year and day of year