-
Notifications
You must be signed in to change notification settings - Fork 1
/
GROW.f90
182 lines (182 loc) · 8.4 KB
/
GROW.f90
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
!======================================================================!
SUBROUTINE GROW
!----------------------------------------------------------------------!
USE DOUBLE
USE CONTROL
USE PARAMS
USE STATE
USE VARIABLES
!----------------------------------------------------------------------!
IMPLICIT NONE
!----------------------------------------------------------------------!
! Radial length growth (µm day-1).
!----------------------------------------------------------------------!
REAL(DP), DIMENSION (nfi, ncells_max) :: dL
!----------------------------------------------------------------------!
! Potential primary wall-mass growth with unlimiting
! carbohydrates (mg day-1).
!----------------------------------------------------------------------!
REAL(DP) :: dMp
!----------------------------------------------------------------------!
! Cell-cell carbohydrate flux to test SUC solution (mg day-1).
!----------------------------------------------------------------------!
REAL(DP) :: flux
!----------------------------------------------------------------------!
! Cumulative carbohydrate flux to test SUC solution (mg day-1).
!----------------------------------------------------------------------!
REAL(DP) :: rflux
!----------------------------------------------------------------------!
! Temperature-limited rate of cell radial length
! growth (µm-1 µm-1 day-1).
!----------------------------------------------------------------------!
REAL(DP) :: r
REAL(DP) :: Vc ! Cell volume (ml cell-1)
REAL(DP) :: Vl ! Lumen volume (ml cell-1)
REAL(DP) :: Vw ! Wall volume (ml cell-1)
!----------------------------------------------------------------------!
! Set all length and C-unlimited mass increments to 0.
!----------------------------------------------------------------------!
dL (:,:) = 0.0_DP
dM_max (:,:) = 0.0_DP
!----------------------------------------------------------------------!
! For Figure 2.
!----------------------------------------------------------------------!
!IF (kyr == 1995) T = T + 2.0_DP
!----------------------------------------------------------------------!
! Radial length growth requires non-dormancy.
!----------------------------------------------------------------------!
IF (.NOT. (dorm)) THEN
!---------------------------------------------------------------------!
! Temperature-limited rate of cell radial length
! growth (µm-1 µm-1 day-1).
!---------------------------------------------------------------------!
!T = T - 2.0_DP
r = r0 * EXP (-Ea / (kb * T)) / EXP (-Ea / (kb * (tf + 10.0_DP)))
!T = T + 2.0_DP
!---------------------------------------------------------------------!
! Loop over cells to compute radial and C-unlimited primary wall
! growth increments.
!---------------------------------------------------------------------!
DO fi = 1, nfi
DO ic = 1, ncells (fi)
!-------------------------------------------------------------------!
! For Figure 3.
!-------------------------------------------------------------------!
!IF ((kyr == 1995) .AND. (D (fi,ic) <= pz)) THEN
!IF ((kyr == 1995) .AND. (D (fi,ic) > pz)) THEN
! T = T + 2.0_DP
! r = r0 * EXP (-Ea / (kb * T)) / EXP (-Ea / (kb * (tf + 10.0_DP)))
! T = T - 2.0_DP
!ELSE
! r = r0 * EXP (-Ea / (kb * T)) / EXP (-Ea / (kb * (tf + 10.0_DP)))
!END IF
!-------------------------------------------------------------------!
! Check if cell is in enlargement or proliferation zone.
!-------------------------------------------------------------------!
IF (D (fi,ic) <= ez) THEN
!------------------------------------------------------------------!
! Cell radial length increment (µm µm-1 day-1).
!------------------------------------------------------------------!
dL (fi,ic) = L (fi,ic) * (EXP (rasym (fi,ic) * r) - 1.0_DP)
!------------------------------------------------------------------!
! Total cell volume (ml cell-1).
!------------------------------------------------------------------!
Vc = tal * ttl * L (fi,ic) / 1.0D12
!------------------------------------------------------------------!
! Lumen volume (ml cell-1).
!------------------------------------------------------------------!
Vl = (tal - 2.0_DP * t_pw) * (ttl - 2.0_DP * t_pw) * &
(L (fi,ic) - 2.0_DP * t_pw) / 1.D12
!------------------------------------------------------------------!
! Potential rate of primary cell-wall growth (mg cell-1 day-1).
!------------------------------------------------------------------!
dMp = Vl * m0 * EXP (-Eaw / (kb * T)) / &
EXP (-Eaw / (kb * (tf + 10.0_DP)))
!------------------------------------------------------------------!
! The maximum possible wall volume based on primary wall
! thickness (mg cell-1).
!------------------------------------------------------------------!
Vw = Vc - Vl
!------------------------------------------------------------------!
! Restrict wall mass growth with unlimiting carbohydrates to value
! obtained at the primary wall thickness (mg cell-1 day-1).
!------------------------------------------------------------------!
dM_max (fi,ic) = MIN (dMp, rho_w * Vw - M (fi,ic))
dM_max (fi,ic) = MAX (0.0_DP, dM_max (fi,ic))
!-------------------------------------------------------------------!
END IF
END DO ! ic
END DO ! fi
END IF ! .NOT. (dorm)
!----------------------------------------------------------------------!
! Loop over cells to compute potential secondary wall growth.
!----------------------------------------------------------------------!
DO fi = 1, nfi
DO ic = 1, ncells (fi)
!--------------------------------------------------------------------!
! Check cell is in wall thickening zone.
!--------------------------------------------------------------------!
IF ((D (fi,ic) > ez) .AND. (D (fi,ic) <= tz)) THEN
!-------------------------------------------------------------------!
! Total cell volume (ml cell-1).
!------------------------------------------------------------------!
Vc = tal * ttl * L (fi,ic) / 1.0D12
!------------------------------------------------------------------!
! Wall volume (ml cell-1).
!------------------------------------------------------------------!
Vw = M (fi,ic) / rho_w
!------------------------------------------------------------------!
! Lumen volume (ml).
!------------------------------------------------------------------!
Vl = Vc - Vw
!------------------------------------------------------------------!
! Wall mass growth with unlimiting carbohydrates (mg cell-1 day-1).
!------------------------------------------------------------------!
dM_max (fi,ic) = Vl * m0 * EXP (-Eaw / (kb * T)) / &
EXP (-Eaw / (kb * (tf + 10.0_DP)))
!--------------------------------------------------------------------!
END IF ! Wall-thickening zone.
!--------------------------------------------------------------------!
END DO ! ic
END DO ! fi
!----------------------------------------------------------------------!
! Compute equilibrium carbohydrate concentrations in each cell.
!----------------------------------------------------------------------!
SUC (:,:) = 0.0_DP
CALL CARB
!----------------------------------------------------------------------!
! Following for fort.97_sS. Also comment-out test at end.
!----------------------------------------------------------------------!
!dM = dM_max
!----------------------------------------------------------------------!
! Increment cell radial lengths and wall masses.
!----------------------------------------------------------------------!
DO fi = 1, nfi
DO ic = 1, ncells (fi)
L (fi,ic) = L (fi,ic) + dL (fi,ic)
M (fi,ic) = M (fi,ic) + dM (fi,ic)
END DO
END DO
!----------------------------------------------------------------------!
! Test carbohydrate distribution solution.
!----------------------------------------------------------------------!
IF (kday == 250) THEN
!IF (kday == 2500) THEN ! For saturating carbohydrates.
DO fi = 1, nfi
rflux = 0.0_DP
DO ic = ncells (fi), 2, -1
IF (dM(fi,ic) > 0.0_DP) THEN
flux = (SUC (fi, ic-1) - SUC (fi,ic)) / res - rflux
rflux = rflux + flux
IF (ABS (dM(fi,ic) - flux) > 1.D-5) THEN
WRITE (*,*) 'Problem with flux'
WRITE (*,*) fi,ic,SUC(fi,ic),dM(fi,ic),flux,D(fi,ic),tz
STOP
END IF
END IF
END DO
END DO
END IF
!----------------------------------------------------------------------!
END SUBROUTINE GROW
!======================================================================!