-
Notifications
You must be signed in to change notification settings - Fork 114
/
cci_lieberman.f90
190 lines (159 loc) · 10.1 KB
/
cci_lieberman.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
189
190
!==========================================================================================!
!==========================================================================================!
! Function cci.lieberman. !
! This function computes the crown closure index for each individual, following the !
! method presented by !
! !
! Lieberman, M., D. Lieberman, R. Peralta, G. S. Hartshorn, 1995: Canopy closure and !
! the distribution of tropical forest tree species at La Selva, Costa Rica. J. Trop. !
! Ecol., 11 (2), 161--177. !
!------------------------------------------------------------------------------------------!
subroutine cci_lieberman(nxyz,xyz,radius,closure,cci)
implicit none
!----- Variable declaration. -----------------------------------------------------------!
integer , intent(in) :: nxyz
real(kind=8), dimension(nxyz,3), intent(in) :: xyz
real(kind=8) , intent(in) :: radius
logical , intent(in) :: closure
real(kind=8), dimension(nxyz) , intent(out) :: cci
!----- Local variables. ----------------------------------------------------------------!
integer :: m
integer :: n
real(kind=8) :: dx
real(kind=8) :: dy
real(kind=8) :: dz
real(kind=8) :: dr
!---------------------------------------------------------------------------------------!
!----- Initialise cci. -----------------------------------------------------------------!
cci(:) = 0.d0
!---------------------------------------------------------------------------------------!
!---------------------------------------------------------------------------------------!
! Loop through each element, find CCI. !
!---------------------------------------------------------------------------------------!
oloop: do m=1,nxyz
!------------------------------------------------------------------------------------!
! Check every grid element. !
!------------------------------------------------------------------------------------!
iloop: do n=1,nxyz
!----- Find distances. -----------------------------------------------------------!
dx = xyz(n,1) - xyz(m,1)
dy = xyz(n,2) - xyz(m,2)
dz = xyz(n,3) - xyz(m,3)
dr = sqrt(dx*dx + dy*dy)
!---------------------------------------------------------------------------------!
!----- Check whether point is within radius. -------------------------------------!
if (dr > 0.d0 .and. dr <= radius) then
!----- Check whether it contributes to CCI or CII. ----------------------------!
if (closure .and. dz > 0.d0) then
cci(m) = cci(m) + dz / sqrt(dz*dz + dr*dr)
else if ((.not. closure) .and. dz < 0.d0) then
cci(m) = cci(m) - dz / sqrt(dz*dz + dr*dr)
end if
!------------------------------------------------------------------------------!
end if
!---------------------------------------------------------------------------------!
end do iloop
!------------------------------------------------------------------------------------!
end do oloop
!---------------------------------------------------------------------------------------!
return
end subroutine cci_lieberman
!==========================================================================================!
!==========================================================================================!
!==========================================================================================!
!==========================================================================================!
! Function cci_lieberman_mat. !
! This function is similar to the function above, except that the data are given in !
! matrix form. This allows the routine to run significantly faster. It also checks for !
! undefined numbers (and ignore them). !
! !
! Lieberman, M., D. Lieberman, R. Peralta, G. S. Hartshorn, 1995: Canopy closure and !
! the distribution of tropical forest tree species at La Selva, Costa Rica. J. Trop. !
! Ecol., 11 (2), 161--177. !
!------------------------------------------------------------------------------------------!
subroutine cci_lieberman_mat(nx,ny,z,dxy,radius,undef,closure,cci)
implicit none
!----- Variable declaration. -----------------------------------------------------------!
integer , intent(in) :: nx
integer , intent(in) :: ny
real(kind=8), dimension(nx,ny), intent(in) :: z
real(kind=8) , intent(in) :: dxy
real(kind=8) , intent(in) :: radius
real(kind=8) , intent(in) :: undef
logical , intent(in) :: closure
real(kind=8), dimension(nx,ny), intent(out) :: cci
!----- Local variables. ----------------------------------------------------------------!
integer :: x0
integer :: y0
integer :: xt
integer :: yt
integer :: x
integer :: y
integer :: off
real(kind=8) :: dx
real(kind=8) :: dy
real(kind=8) :: dz
real(kind=8) :: dr
!---------------------------------------------------------------------------------------!
!----- Initialise cci. -----------------------------------------------------------------!
where (z == undef)
cci = undef
elsewhere
cci = 0.d0
end where
!---------------------------------------------------------------------------------------!
!---------------------------------------------------------------------------------------!
! Find out the offset for the x and y window. !
!---------------------------------------------------------------------------------------!
off = ceiling(radius/dxy)
!---------------------------------------------------------------------------------------!
!---------------------------------------------------------------------------------------!
! Loop through each element, find CCI. !
!---------------------------------------------------------------------------------------!
y0loop: do y0=1,ny
x0loop: do x0=1,nx
!----- Skip point if z(x0,y0) is undefined. --------------------------------------!
if (z(x0,y0) == undef) cycle x0loop
!---------------------------------------------------------------------------------!
!---------------------------------------------------------------------------------!
! Loop through the window size, assume cyclic boundary conditions. !
!---------------------------------------------------------------------------------!
ytloop: do yt=y0-off,y0+off
!----- Find the actual x index to use. ----------------------------------------!
y = 1 + modulo(yt-1,ny)
!------------------------------------------------------------------------------!
xtloop: do xt=x0-off,x0+off
!----- Find the actual x index to use. -------------------------------------!
x = 1 + modulo(xt-1,nx)
!---------------------------------------------------------------------------!
!----- Skip point if z(x0,y0) is undefined. --------------------------------!
if (z(x,y) == undef) cycle xtloop
!---------------------------------------------------------------------------!
!----- Find distances. -----------------------------------------------------!
dx = abs(xt - x0) * dxy
dy = abs(yt - y0) * dxy
dz = z(x,y) - z(x0,y0)
dr = sqrt(dx*dx + dy*dy)
!---------------------------------------------------------------------------!
!----- Check whether point is within radius. -------------------------------!
if (dr > 0.d0 .and. dr <= radius) then
!----- Check whether it contributes to CCI or CII. ----------------------!
if (closure .and. dz > 0.d0) then
cci(x0,y0) = cci(x0,y0) + dz / sqrt(dz*dz + dr*dr)
else if ((.not. closure) .and. dz < 0.d0) then
cci(x0,y0) = cci(x0,y0) - dz / sqrt(dz*dz + dr*dr)
end if
!------------------------------------------------------------------------!
end if
!---------------------------------------------------------------------------!
end do xtloop
!------------------------------------------------------------------------------!
end do ytloop
!---------------------------------------------------------------------------------!
end do x0loop
!------------------------------------------------------------------------------------!
end do y0loop
!---------------------------------------------------------------------------------------!
return
end subroutine cci_lieberman_mat
!------------------------------------------------------------------------------------------!