-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathreadpcom.f90
94 lines (81 loc) · 3.23 KB
/
readpcom.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
subroutine readpcom
use input_file_module
use maximum_data_module
use plant_data_module
implicit none
character (len=80) :: titldum ! |title of file
character (len=80) :: header ! |header of file
character (len=13) :: file ! |
character (len=13) :: name ! |
integer :: eof ! |end of file
logical :: i_exist !none |check to determine if file exists
integer :: mcom ! |
integer :: icom !none |counter
integer :: imax !none |counter
integer :: numb !none |end of loop
integer :: ii !none |counter
integer :: mpcom !none |end of loop
integer :: iplt !none |counter
integer :: ipldb !none |counter
mcom = 0
eof = 0
imax = 0
!! Open plant community data file
inquire (file=in_init%plant, exist=i_exist)
if (.not. i_exist .or. in_init%plant == "null") then
allocate (pcomdb(0:0))
allocate (pcomdb(0)%pl(0:0))
db_mx%plantcom = mcom + 1
else
do
open (113,file=in_init%plant)
read (113,*,iostat=eof) titldum
if (eof < 0) exit
read (113,*,iostat=eof) header
if (eof < 0) exit
do while (eof == 0)
read (113,*,iostat=eof) name, numb
if (eof < 0) exit
do ii = 1, numb
read (113,*,iostat=eof) name
if (eof < 0) exit
end do
if (eof < 0) exit
imax = imax + 1
end do
allocate (pcomdb(0:imax))
rewind (113)
read (113,*,iostat=eof) titldum
if (eof < 0) exit
read (113,*,iostat=eof) header
if (eof < 0) exit
do icom = 1, imax
! loop through all plant communities
read (113,*,iostat=eof) pcomdb(icom)%name, pcomdb(icom)%plants_com, pcomdb(icom)%rot_yr_ini
if (eof < 0) exit
mpcom = pcomdb(icom)%plants_com
allocate (pcomdb(icom)%pl(mpcom))
do iplt = 1, mpcom
read (113,*,iostat=eof) pcomdb(icom)%pl(iplt)%cpnm, pcomdb(icom)%pl(iplt)%igro, &
pcomdb(icom)%pl(iplt)%lai, pcomdb(icom)%pl(iplt)%bioms, pcomdb(icom)%pl(iplt)%phuacc, &
pcomdb(icom)%pl(iplt)%pop, pcomdb(icom)%pl(iplt)%fr_yrmat, pcomdb(icom)%pl(iplt)%rsdin
if (eof < 0) exit
do ipldb = 1, db_mx%plantparm
if (pcomdb(icom)%pl(iplt)%cpnm == pldb(ipldb)%plantnm) then
pcomdb(icom)%pl(iplt)%db_num = ipldb
exit
end if
end do
if (pcomdb(icom)%pl(iplt)%db_num == 0) then
write (9001,*) " plant com", icom, &
" plant numb", iplt, pcomdb(icom)%pl(iplt)%cpnm, " not found in plants.plt database"
end if
if (eof < 0) exit
end do
end do
end do
end if
db_mx%plantcom = imax
close (113)
return
end subroutine readpcom