forked from adfriend45/RINGS_v3
-
Notifications
You must be signed in to change notification settings - Fork 0
/
INIT.f90
124 lines (124 loc) · 5.45 KB
/
INIT.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
!======================================================================!
SUBROUTINE INIT
!----------------------------------------------------------------------!
USE DOUBLE
USE CONTROL
USE PARAMS
USE ENVIRON
USE STATE
!----------------------------------------------------------------------!
IMPLICIT NONE
!----------------------------------------------------------------------!
REAL(DP) :: Za ! Gaussian random variable around 0 (z)
REAL(DP) :: Z ! Gaussian random variable around 0 (z)
REAL(DP) :: L1
REAL(DP) :: L2
REAL(DP) :: ab
REAL(DP) :: Vc ! Volume of cell (ml)
REAL(DP) :: Vl ! Volume of lumen (ml)
REAL(DP) :: Vw ! Volume of cell wall (ml)
!----------------------------------------------------------------------!
! Set minimum distance of proliferation zone edge from phloem (µm)
!----------------------------------------------------------------------!
pz_min = pz_a + pz_b * dlength (231)
!----------------------------------------------------------------------!
CALL RANDOM_SEED()
!----------------------------------------------------------------------!
! Initialise cells.
!----------------------------------------------------------------------!
! Loop over radial files.
!----------------------------------------------------------------------!
DO fi = 1, nfi
!---------------------------------------------------------------------!
! Put in lots of cells to start with.
!---------------------------------------------------------------------!
ncells (fi) = 100
!---------------------------------------------------------------------!
DO ic = 1, ncells (fi)
!--------------------------------------------------------------------!
! Za is noise on cell radial length at birth (scalar).
!--------------------------------------------------------------------!
CALL GAUSS (Za, sigma_a)
!-------------------------------------------------------------------!
! Radial lengths of two sister daughters (µm).
!--------------------------------------------------------------------!
L1 = mu_b * (1.0_DP + Za)
L2 = 2.0_dp * mu_b - L1
!--------------------------------------------------------------------!
! Birth asymmetry (scalar).
!--------------------------------------------------------------------!
ab = (L1 - L2) / (L1 + L2)
!--------------------------------------------------------------------!
! Dependence of rate of enlargement on relative birth size (scalar).
!--------------------------------------------------------------------!
rasym (fi,ic) = 1.0_DP - gasym * ab
!--------------------------------------------------------------------!
! Z is noise on cell radial length at division (scalar)
!--------------------------------------------------------------------!
CALL GAUSS (Z, sigma)
!--------------------------------------------------------------------!
! Radial length at division (µm).
!--------------------------------------------------------------------!
I (fi,ic) = (fd * L1 + mu_b * (2.0_DP - fd + Z))
I (fi,ic) = MAX (0.01_DP, I (fi,ic))
!-------------------------------------------------------------------!
L (fi,ic) = L1
!--------------------------------------------------------------------!
! Cell volume (ml cell-1).
!--------------------------------------------------------------------!
Vc = tal * ttl * L(fi,ic) / 1.D12
!--------------------------------------------------------------------!
! 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
!--------------------------------------------------------------------!
! Wall volume (ml cell-1).
!--------------------------------------------------------------------!
Vw = Vc - Vl
!--------------------------------------------------------------------!
! Wall mass (μg[DM] cell-1).
!--------------------------------------------------------------------!
M (fi,ic) = rho_w * Vw ! mg[DM] cell-1
!--------------------------------------------------------------------!
END DO ! ic = 1, ncells (fi)
END DO ! fi = 1, nfi
!----------------------------------------------------------------------!
! Compute distance of each cell centre from phloem on DOY=1 (μm).
!----------------------------------------------------------------------!
kday = 1
pz = pz_a + pz_b * dlength (kday)
pz = MAX (pz_min, pz)
CALL DIST
!----------------------------------------------------------------------!
! Limit ncells in each radial file to only those in pz.
!----------------------------------------------------------------------!
DO fi = 1, nfi
ic = 1
DO WHILE (D (fi,ic) <= pz)
ic = ic + 1
END DO
ncells (fi) = ic - 1
END DO ! fi
!----------------------------------------------------------------------!
! Domancy state.
!----------------------------------------------------------------------!
dorm = .TRUE.
!----------------------------------------------------------------------!
! Phenology variables.
!----------------------------------------------------------------------!
cd = 0
dd = 0.0_DP
!----------------------------------------------------------------------!
! Skip climate years if syr > 1901.
!----------------------------------------------------------------------!
DO kyr = 1901, syr-1
DO kday = 1, ndays
DO kt = 1, 4
READ (11,*)
END DO ! kt = 1, 4
END DO
END DO
!----------------------------------------------------------------------!
END SUBROUTINE INIT
!======================================================================!