-
Notifications
You must be signed in to change notification settings - Fork 29
/
Copy pathforkod.f
217 lines (204 loc) · 7.32 KB
/
forkod.f
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
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
SUBROUTINE FORKOD
IMPLICIT NONE
C----------
C NE $Id$
C----------
C
C TRANSLATES FOREST CODE INTO A SUBSCRIPT, IFOR, AND IF
C KODFOR IS ZERO, THE ROUTINE RETURNS THE DEFAULT CODE.
C
COMMONS
C
C
INCLUDE 'PRGPRM.F77'
C
C
INCLUDE 'PLOT.F77'
C
C
INCLUDE 'CONTRL.F77'
C
C
COMMONS
C
C ------------------------
C NATIONAL FORESTS:
C 914 = WAYNE
C 922 = WHITE MOUNTAIN
C 919 = ALLEGHENY
C 920 = GREEN MTN - FINGER LAKES
C 921 = MONONGAHELA
C 911 = OLD WAYNE-HOOSIER (MAP TO WAYNE)
C 930 = FINGER LAKES (MAP TO GREEN MTN - FINGER LAKES)
C ------------------------
C RESERVATION PSUEDO CODES:
C 8200 = PASSAMAQUODDY RESERVATION (MAPPED TO 922 WHITE MOUNTAIN)
C 8201 = PENOBSCOT OFF-RESERVATION TL (MAPPED TO 922 WHITE MOUNTAIN)
C 8202 = HOULTON MALISEET RESERVATION (MAPPED TO 922 WHITE MOUNTAIN)
C 8203 = MASHANTUCKET PEQUOT RES (MAPPED TO 922 WHITE MOUNTAIN)
C 8204 = PAUCATUCK EASTERN PEQUOT RES (MAPPED TO 922 WHITE MOUNTAIN)
C 8206 = NARRAGANSETT RESERVATION (MAPPED TO 922 WHITE MOUNTAIN)
C 8208 = WAMPANOAG-AQUINNAH TL (MAPPED TO 922 WHITE MOUNTAIN)
C 8209 = AROOSTOOK BAND OF MICMAC TL (MAPPED TO 922 WHITE MOUNTAIN)
C 8211 = MOHEGAN RESERVATION (MAPPED TO 922 WHITE MOUNTAIN)
C 8214 = CAYUGA NATION TDSA (MAPPED TO 930 FINGER LAKES)
C 8215 = ONONDAGA NATION RESERVATION (MAPPED TO 930 FINGER LAKES)
C 8216 = TONAWANDA RESERVATION (MAPPED TO 930 FINGER LAKES)
C 8217 = TUSCARORA NATION RESERVATION (MAPPED TO 930 FINGER LAKES)
C 8218 = ONEIDA NATION RESERVATION (MAPPED TO 930 FINGER LAKES)
C ------------------------
INTEGER JFOR(7),KFOR(7),NUMFOR,I
LOGICAL USEIGL, FORFOUND
DATA JFOR/914,922,919,920,921,911,930/
DATA NUMFOR/7/
DATA KFOR/7*1/
USEIGL = .TRUE.
FORFOUND = .FALSE.
SELECT CASE (KODFOR)
C CROSSWALK FOR RESERVATION PSUEDO CODES & LOCATION CODE
CASE (8200)
WRITE(JOSTND,60)
60 FORMAT(/,'********',T12,'PASSAMAQUODDY RESERVATION (8200) ',
& 'BEING MAPPED TO WHITE MOUNTAIN NF (922) FOR FURTHER ',
& 'PROCESSING.')
IFOR = 2
CASE (8201)
WRITE(JOSTND,61)
61 FORMAT(/,'********',T12,'PENOBSCOT OFF-RESERVATION TL (8201)',
& ' BEING MAPPED TO WHITE MOUNTAIN NF (922) FOR FURTHER ',
& 'PROCESSING.')
IFOR = 2
CASE (8202)
WRITE(JOSTND,62)
62 FORMAT(/,'********',T12,'HOULTON MALISEET RESERVATION (8202)',
& ' BEING MAPPED TO WHITE MOUNTAIN NF (922) FOR FURTHER ',
& 'PROCESSING.')
IFOR = 2
CASE (8203)
WRITE(JOSTND,63)
63 FORMAT(/,'********',T12,'MASHANTUCKET PEQUOT RES (8203) ',
& 'BEING MAPPED TO WHITE MOUNTAIN NF (922) FOR FURTHER ',
& 'PROCESSING.')
IFOR = 2
CASE (8204)
WRITE(JOSTND,64)
64 FORMAT(/,'********',T12,'PAUCATUCK EASTERN PEQUOT RES (8204)',
& ' BEING MAPPED TO WHITE MOUNTAIN NF (922) FOR FURTHER ',
& 'PROCESSING.')
IFOR = 2
CASE (8206)
WRITE(JOSTND,65)
65 FORMAT(/,'********',T12,'NARRAGANSETT RESERVATION (8206) ',
& 'BEING MAPPED TO WHITE MOUNTAIN NF (922) FOR FURTHER ',
& 'PROCESSING.')
IFOR = 2
CASE (8208)
WRITE(JOSTND,66)
66 FORMAT(/,'********',T12,'WAMPANOAG-AQUINNAH TL (8208) BEING ',
& 'MAPPED TO WHITE MOUNTAIN NF (922) FOR FURTHER PROCESSING.')
IFOR = 2
CASE (8209)
WRITE(JOSTND,67)
67 FORMAT(/,'********',T12,'AROOSTOOK BAND OF MICMAC TL (8209) ',
& 'BEING MAPPED TO WHITE MOUNTAIN NF (922) FOR FURTHER ',
& 'PROCESSING.')
IFOR = 2
CASE (8211)
WRITE(JOSTND,68)
68 FORMAT(/,'********',T12,'MOHEGAN RESERVATION (8211) BEING ',
& 'MAPPED TO WHITE MOUNTAIN NF (922) FOR FURTHER PROCESSING.')
IFOR = 2
CASE (8214)
WRITE(JOSTND,69)
69 FORMAT(/,'********',T12,'CAYUGA NATION TDSA (8214) BEING ',
& 'MAPPED TO FINGER LAKES NF (930) FOR FURTHER PROCESSING.')
IFOR = 7
CASE (8215)
WRITE(JOSTND,70)
70 FORMAT(/,'********',T12,'ONONDAGA NATION RESERVATION (8215) ',
& 'BEING MAPPED TO FINGER LAKES NF (930) FOR FURTHER ',
& 'PROCESSING.')
IFOR = 7
CASE (8216)
WRITE(JOSTND,71)
71 FORMAT(/,'********',T12,'TONAWANDA RESERVATION (8216) BEING ',
& 'MAPPED TO FINGER LAKES NF (930) FOR FURTHER PROCESSING.')
IFOR = 7
CASE (8217)
WRITE(JOSTND,72)
72 FORMAT(/,'********',T12,'TUSCARORA NATION RESERVATION (8217)',
& ' BEING MAPPED TO FINGER LAKES NF (930) FOR FURTHER ',
& 'PROCESSING.')
IFOR = 7
CASE (8218)
WRITE(JOSTND,73)
73 FORMAT(/,'********',T12,'ONEIDA NATION RESERVATION (8218) ',
& 'BEING MAPPED TO FINGER LAKES NF (930) FOR FURTHER ',
& 'PROCESSING.')
IFOR = 7
C END CROSSWALK FOR RESERVATION PSUEDO CODES & LOCATION CODE
CASE DEFAULT
C CONFIRMS THAT KODFOR IS AN ACCEPTED FVS LOCATION CODE
C FOR THIS VARIANT FOUND IN DATA ARRAY JFOR
DO 10 I=1,NUMFOR
IF (KODFOR .EQ. JFOR(I)) THEN
IFOR = I
FORFOUND = .TRUE.
EXIT
ENDIF
10 CONTINUE
C LOCATION CODE ERROR TRAP
IF (.NOT. FORFOUND) THEN
CALL ERRGRO (.TRUE.,3)
WRITE(JOSTND,11) JFOR(IFOR)
11 FORMAT(/,'********',T12,'FOREST CODE USED IN THIS ',
& 'PROJECTION IS',I4)
USEIGL = .FALSE.
ENDIF
END SELECT
C FOREST MAPPING CORRECTION
SELECT CASE (IFOR)
CASE (6)
WRITE(JOSTND,21)
21 FORMAT(/,'********',T12,'WAYNE-HOOSIER NF (911) BEING ',
& 'MAPPED TO WAYNE (914) FOR FURTHER PROCESSING.')
IFOR = 1
CASE (7)
WRITE(JOSTND,22)
22 FORMAT(/,'********',T12,'FINGER LAKES NF (930) BEING MAPPED ',
& 'TO GREEN MTN-FINGER LAKES (920) FOR FURTHER PROCESSING.')
IFOR = 4
END SELECT
C----------
C SET DEFAULT TLAT, TLONG, AND ELEVATION VALUES, BY FOREST
C----------
SELECT CASE(IFOR)
CASE(1)
IF(TLAT.EQ.0) TLAT=39.33
IF(TLONG.EQ.0)TLONG=82.10
IF(ELEV.EQ.0) ELEV=9.
CASE(3)
IF(TLAT.EQ.0) TLAT=41.84
IF(TLONG.EQ.0)TLONG=79.15
IF(ELEV.EQ.0) ELEV=17.
CASE(4)
IF(TLAT.EQ.0) TLAT=43.61
IF(TLONG.EQ.0)TLONG=72.97
IF(ELEV.EQ.0) ELEV=19.
CASE(5)
IF(TLAT.EQ.0) TLAT=38.93
IF(TLONG.EQ.0)TLONG=79.85
IF(ELEV.EQ.0) ELEV=30.
CASE(2)
IF(TLAT.EQ.0) TLAT=43.53
IF(TLONG.EQ.0)TLONG=71.47
IF(ELEV.EQ.0) ELEV=20.
END SELECT
C SET THE IGL VARIABLE ONLY IF DEFAULT FOREST IS USED
C GEOGRAPHIC LOCATION CODE: 1=NORTH, 2=CENTRAL, 3=SOUTH
C USED TO SET SOME EQUATIONS IN REGENERATION AND PERHAPS
C HEIGHT-DIAMETER IN DIFFERENT VARIANTS.
IF (USEIGL) IGL = KFOR(IFOR)
KODFOR=JFOR(IFOR)
RETURN
END