-
Notifications
You must be signed in to change notification settings - Fork 1
/
DIVIDE.f90
188 lines (188 loc) · 9.08 KB
/
DIVIDE.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
183
184
185
186
187
188
!======================================================================!
SUBROUTINE DIVIDE
!----------------------------------------------------------------------!
! Divide cells in pz.
!----------------------------------------------------------------------!
USE DOUBLE
USE CONTROL
USE PARAMS ! MODULE declaring model parameters.
USE STATE ! MODULE declaring model variables.
!----------------------------------------------------------------------!
IMPLICIT NONE
!----------------------------------------------------------------------!
! New number of cells in radial file (n).
!----------------------------------------------------------------------!
INTEGER :: nm
!----------------------------------------------------------------------!
REAL(DP), DIMENSION (ncells_max) :: Ln ! Radial cell length (µm)
REAL(DP), DIMENSION (ncells_max) :: Mn ! Cell DM (µg[DM])
REAL(DP), DIMENSION (ncells_max) :: rasymn ! Asymmetry on enlarg.
REAL(DP), DIMENSION (ncells_max) :: In ! Div. inhib. vol (µm^3)
!----------------------------------------------------------------------!
! Critical radial length for division (µm).
!----------------------------------------------------------------------!
REAL(DP) :: L_crit
!----------------------------------------------------------------------!
REAL(DP) :: Za ! Gaussian random variable around 0 (z)
REAL(DP) :: Z ! Gaussian random variable around 0 (z)
!----------------------------------------------------------------------!
! Random number (0-1).
!----------------------------------------------------------------------!
REAL(DP) :: ran
REAL(DP) :: L1, L2
!----------------------------------------------------------------------!
! Masses of new sister cells (mg cell-1).
!----------------------------------------------------------------------!
REAL(DP) :: M1, M2
REAL(DP) :: ab
!----------------------------------------------------------------------!
! Flag for xylem or phloem daughter of initial.
!----------------------------------------------------------------------!
LOGICAL :: xylem
!----------------------------------------------------------------------!
DO fi = 1, nfi
!---------------------------------------------------------------------!
! Initalise number of new cells.
!---------------------------------------------------------------------!
nm = 0
!---------------------------------------------------------------------!
! Loop over cells in initial file.
!---------------------------------------------------------------------!
DO ic = 1, ncells (fi)
!--------------------------------------------------------------------!
! Cell in pz?
!--------------------------------------------------------------------!
IF (D (fi,ic) <= pz) THEN
!-------------------------------------------------------------------!
! Critical radial length for division (µm).
!-------------------------------------------------------------------!
L_crit = I (fi,ic)
!-------------------------------------------------------------------!
! Reached radial length for division?
!-------------------------------------------------------------------!
IF (L (fi,ic) >= L_crit) THEN
!------------------------------------------------------------------!
! First cell in radial file is initial.
!------------------------------------------------------------------!
IF (ic == 1) THEN
!-----------------------------------------------------------------!
CALL RANDOM_NUMBER (ran)
!-----------------------------------------------------------------!
! Xylem mother?
!-----------------------------------------------------------------!
IF(ran >= f_phloem) THEN
xylem = .TRUE.
ELSE
xylem = .FALSE.
END IF
!-----------------------------------------------------------------!
END IF ! ic == 1
!------------------------------------------------------------------!
! Za is noise on division.
!------------------------------------------------------------------!
CALL GAUSS (Za,sigma_a)
Za = MIN ( 0.49_DP, Za)
Za = MAX (-0.49_DP, Za)
!------------------------------------------------------------------!
! Sizes of daughter cells (µm).
!------------------------------------------------------------------!
L1 = L (fi,ic) * (0.5_DP - Za)
L2 = L (fi,ic) * (0.5_DP + Za)
!------------------------------------------------------------------!
! Masses of daughter cells (mg cell-1).
!------------------------------------------------------------------!
M1 = M (fi,ic) * (0.5_DP - Za)
M2 = M (fi,ic) * (0.5_DP + Za)
!------------------------------------------------------------------!
! Daughter size asymmetry relative to cell L1 (-).
!------------------------------------------------------------------!
ab = (L1 - L2) / (L1 + L2)
!------------------------------------------------------------------!
! Dependence of rate of enlargement on relative
! birth size (scalar).
!------------------------------------------------------------------!
rasymn (ic+nm) = 1.0_DP - gasym * ab
!------------------------------------------------------------------!
! Assign new length and mass to new radial file.
!------------------------------------------------------------------!
Ln (ic+nm) = L1
Mn (ic+nm) = M1
!------------------------------------------------------------------!
! Noise on radial length at division (-).
!------------------------------------------------------------------!
CALL GAUSS (Z,sigma)
!------------------------------------------------------------------!
! Radial length at division of cell L1 (µm).
!------------------------------------------------------------------!
In (ic+nm) = fd * L1 +mu_b * (2.0_DP - fd + Z)
In (ic+nm) = MAX (0.01_DP, In (ic+nm))
!------------------------------------------------------------------!
! If cell L1 is a xylem mother and not the initial allocate cell L2
! to new radial file.
!------------------------------------------------------------------!
IF ((ic > 1) .OR. (xylem)) THEN
!-----------------------------------------------------------------!
! Increment number of new cells.
!-----------------------------------------------------------------!
nm = nm + 1
!-----------------------------------------------------------------!
! Dependence of rate of enlargement on relative
! birth size (scalar).
!-----------------------------------------------------------------!
rasymn (ic+nm) = 1.0_DP + gasym * ab
!-----------------------------------------------------------------!
! Length and mass of daughter cell L2.
!-----------------------------------------------------------------!
Ln (ic+nm) = L2
Mn (ic+nm) = M2
!-----------------------------------------------------------------!
! Noise on radial length at division (-).
!-----------------------------------------------------------------!
CALL GAUSS (Z,sigma)
!-----------------------------------------------------------------!
! Radial length at division of cell L2 (µm).
!-----------------------------------------------------------------!
In (ic+nm) =fd * L2 + mu_b * (2.0_DP - fd + Z)
In (ic+nm) = MAX (0.01_DP, In (ic+nm))
!-----------------------------------------------------------------!
END IF ! ic > 1 or xylem
!------------------------------------------------------------------!
ELSE
!------------------------------------------------------------------!
! No division, so add cell to new radial file.
!------------------------------------------------------------------!
Ln (ic + nm) = L (fi,ic)
Mn (ic + nm) = M (fi,ic)
In (ic + nm) = I (fi,ic)
rasymn (ic + nm) = rasym (fi,ic)
!-------------------------------------------------------------------!
END IF ! L (fi,ic) >= L_crit
ELSE
!-------------------------------------------------------------------!
! Not in pz, so add cell to new radial file.
!-------------------------------------------------------------------!
Ln (ic + nm) = L (fi,ic)
Mn (ic + nm) = M (fi,ic)
In (ic + nm) = I (fi,ic)
rasymn (ic + nm) = rasym (fi,ic)
!-------------------------------------------------------------------!
END IF ! D (fi,ic) <= pz
END DO ! ic
!---------------------------------------------------------------------!
! Assign new number of cells in file.
!---------------------------------------------------------------------!
ncells (fi) = MIN (ncells (fi) + nm, ncells_max/2)
!---------------------------------------------------------------------!
! Assign cells in new file to cells in old file.
!---------------------------------------------------------------------!
DO ic = 1, ncells (fi)
L (fi,ic) = Ln (ic)
M (fi,ic) = Mn (ic)
I (fi,ic) = In (ic)
rasym (fi,ic) = rasymn (ic)
END DO ! ic = 1, ncells (fi)
!---------------------------------------------------------------------!
END DO ! fi = 1, nfi
!----------------------------------------------------------------------!
END SUBROUTINE DIVIDE
!======================================================================!