forked from hamannj/DFSIM
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathsubroutines.for
3020 lines (3005 loc) · 216 KB
/
subroutines.for
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
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
SUBROUTINE HEADER HDR 5
C HDR 10
C COMPUTE CONDITIONS IMPLIED BY CONTROL DECK AND PRINT HEADINGS HDR 15
C FOR 1.6-INCH YIELD TABLE HDR 20
C HDR 25
DIMENSION AGEF(16), AGET(16), ARG(16), DR(16), FNLBS(16), GRESD(16HDR 30
$), H40(16), HY40(16), ITITLE(20), LIUT(16), OBSAGE(31), PNIT(16), HDR 35
$PNITF(16), RAN(76), TTN(16), D(16,4), GA(16,4), OBSHTS(2,31), HDR 40
$ TARESD(16), TA(16,4), VA(16,4) HDR 45
DIMENSION D56(16), D76(16), DC56(16), DC76(16), G56(16), G76(16), HDR 50
$GC56(16), GC76(16), VA56(16), VA456(16), VA76(16), VA476(16), HDR 55
$ VAA56(16), VAA456(16), VAA76(16), VAA476(16), VAC56(16), VAC456 HDR 60
$(16), VAC76(16), VAC476(16), SVC456(16), SVC476(16) HDR 65
COMMON AGE,AGEF,AGET,AHARR,AHARV,ARG,ASYMP,BAB,BAC,BAPA,CAI,CT1,D,HDR 70
$DDMRT,DLIM,DMTMIN,DNOW,DR,FCTA,FERTEF,FNLBS,GA,GRESD,H40,HAT,HPCT,HDR 75
$HS,HTHARV,HY40,ICT1,IDR,IOBS,IORG,IPAGE,IQ,IRD,ITHN,ITITLE,IUT,IZ,HDR 80
$JRD,LINE,LIUT,LTREE,NRA,OBSAGE,OBSHTS,TARESD,PCT,PCTA,PNIT,PNITF, HDR 85
$RAN,SAGE,SBA,SCUTVA,SDIA,SGMORT,SI,SNMORT,STA,SVMORT,TA,TTN,VA, HDR 90
$VGNOW,VNOW,XMAI16,XMAI56,XMAI76,XNUM,XNUMR,ISTOP,RATMAI, HDR 95
$rdasymp,isv
COMMON D56,D76,DC56,DC76,G56,G76,GC56,GC76,VA56,VA456,VA76,VA476, HDR 100
$VAA56,VAA456,VAA76,VAA476,VAC56,VAC456,VAC76,VAC476,SVC456,SVC476 HDR 105
COMMON CTAS,DC,DH,EXIST,FCT,FERTAS,FERTCT,FIH,IHEAD,FIY,GCLIM,GLIMHDR 110
$,HFCT,IGS,IMV,NCT,SCTHT,SCUT45,SCUT47,SCUTBA,SCUTTA,TAST,TI,AGEADDHDR 115
COMMON /CHAR/ CTITLE,vers
CHARACTER CTITLE*80,vers*8
INTEGER CTAS,EXIST,FERTAS,FERTCT,SCTHT HDR 120
common year,month,day,hour,minute,second,i100th
integer*2 year,month,day,hour,minute,second,i100th
data ix /0/
if (ix.eq.1) WRITE (6,10) HDR 125
10 FORMAT (1H1) HDR 130
ix = 1
C HDR 135
C HEADING WRITE STATEMENT FOR STANDS 1.6 INCHES PLUS. HDR 140
C STANDS 1.6 INCHES PLUS HDR 145
C HDR 150
WRITE (6,20) month,day,year,hour,minute,second,
$ VERS,IPAGE,CTITLE,rdasymp/0.94,SI HDR 155
20 FORMAT (68x,i2.2,1h-,i2.2,1h-,i4.4,/69x,i2.2,1h:,i2.2,1h:,i2.2/
$ 29X,20HD F S I M VERSION ,a8,12X,6H PAGE ,I2,
$/1X,A/,30x, HDR 156
$20H MANAGED YIELD TABLE/32X,16H FOR DOUGLAS-FIR/32X,16H 1.6 INCHESHDR 165
$ PLUS/25x,31h ASYMPTOTIC RELATIVE DENSITY = ,F5.1//25X,14H SITE INHDR 166
$DEX = ,F5.0,14H (50 YEARS BH)/) HDR 170
LINE = 8 HDR 175
IPAGE = IPAGE+1 HDR 180
IF (IHEAD.NE.0) GO TO 660 HDR 185
IHEAD = 1 HDR 190
X = 0.0 HDR 195
C HDR 200
C WRITE CONTROL CARD INITIALIZATION CONDITIONS HDR 205
C HDR 210
IF (IORG.GT.0) GO TO 40 HDR 215
WRITE (6,30) HDR 220
30 FORMAT (16X,25HSTAND ORIGIN --- NATURAL.) HDR 225
LINE = LINE+1 HDR 230
GO TO 60 HDR 235
C HDR 240
40 CONTINUE HDR 245
X = TAST HDR 255
IF (PCT.GT.0.0.AND.SAGE.GT.0.0.AND.PCT.GT.SAGE) X = STA HDR 260
WRITE (6,50) X HDR 265
50 FORMAT (16X,28HSTAND ORIGIN --- PLANTED TO ,F5.0,16H TREES PER ACRHDR 270
$E.) HDR 275
LINE = LINE+1 HDR 280
60 CONTINUE HDR 285
IF (PCTA.EQ.0.0) GO TO 80 HDR 290
IF (SAGE.GT.0.0.AND.SAGE.GE.PCT.OR.SAGE.LE.0.0) ITHN = 1 HDR 300
X = TAST HDR 305
IF (SAGE.GT.0.0.AND.SAGE.EQ.PCT) X = STA HDR 310
WRITE (6,70) PCT,X HDR 315
70 FORMAT (16X,44HSTAND WILL BE PRECOMMERCIALLY THINNED AT AGE,F5.0, HDR 320
$4H TO ,F5.0,7H TREES /16X,9HPER ACRE.) HDR 325
LINE = LINE+2 HDR 330
80 CONTINUE HDR 335
IF (IUT.GT.0) GO TO 250 HDR 340
IF (FCT.LE.0.0) GO TO 100 HDR 345
WRITE (6,90) FCT HDR 350
90 FORMAT (16X,42HFIRST COMMERCIAL THINNING IS WANTED AT AGE,F5.0) HDR 355
LINE = LINE+1 HDR 360
100 CONTINUE HDR 365
IF (TI.LE.0.0) GO TO 120
WRITE (6,110) TI HDR 375
110 FORMAT (16X,24HTHE THINNING INTERVAL IS,F5.0,7H YEARS.) HDR 380
LINE = LINE+1 HDR 385
120 CONTINUE HDR 390
IF (DH.LE.0.0) GO TO 140
WRITE (6,130) DH HDR 425
130 FORMAT (16X,24HTHE THINNING INTERVAL IS,F5.0,23H FEET OF HEIGHT GRHDR 430
$OWTH.) HDR 435
LINE = LINE+1 HDR 440
140 CONTINUE HDR 445
IF (NCT.LE.0) GO TO 160 HDR 450
WRITE (6,150) NCT HDR 455
150 FORMAT (16X,47HTHE NUMBER OF COMMERCIAL THINNINGS SPECIFIED IS,I3,HDR 460
$1H.) HDR 465
LINE = LINE+1 HDR 470
160 CONTINUE HDR 475
IF (NCT.LE.0) NCT = 15 HDR 480
IF (CTAS.NE.1) GO TO 180 HDR 485
WRITE (6,170) (AGET(II),II=1,NCT) HDR 490
170 FORMAT (16X,57HCOMMERCIAL THINNINGS ARE SCHEDULED AT THE FOLLOWINGHDR 495
$ AGES:/16X,10F6.0/16X,10F6.0) HDR 500
LINE = LINE+3 HDR 505
180 CONTINUE HDR 510
IF (SCTHT.NE.1) GO TO 200 HDR 515
WRITE (6,190) (HY40(II),II=1,NCT) HDR 520
190 FORMAT (16X,56HCOMMERCIAL THINNINGS WILL BE MADE WHEN THE STAND ATHDR 525
$TAINS/16X,22HTHE FOLLOWING HEIGHTS:/16X,10F6.0/16X,10F6.0) HDR 530
LINE = LINE+5 HDR 535
200 CONTINUE HDR 540
IF (FIY.LE.0.0) GO TO 220 HDR 545
WRITE (6,210) FIY HDR 550
210 FORMAT (16X,55HTHE FINAL INTERVAL BETWEEN THE LAST COMMERCIAL THINHDR 555
$NING/16X,22HAND THE HARVEST CUT IS,F5.0,7H YEARS.) HDR 560
LINE = LINE+2 HDR 565
220 CONTINUE HDR 570
IF (FIH.LE.0.0) GO TO 240 HDR 575
WRITE (6,230) FIH HDR 580
230 FORMAT (16X,55HTHE FINAL INTERVAL BETWEEN THE LAST COMMERCIAL THINHDR 585
$NING/16X,22HAND THE HARVEST CUT IS,F6.1,23H FEET OF HEIGHT GROWTH.HDR 590
$) HDR 595
LINE = LINE+2 HDR 600
240 CONTINUE HDR 605
250 CONTINUE HDR 610
IF (AHARR.GT.0.0.OR.HTHARV.GT.0.0) GO TO 280 HDR 615
IF (FCT.LE.0.0.AND.HY40(1).LE.0.0) GO TO 260 HDR 620
IF (TI.GT.0.0.AND.FIY.GT.0.0) AHARR = NCT*TI+FCT+FIY HDR 625
IF (TI.GT.0.0.AND.FIY.LE.0.0) AHARR = (NCT+1.0)*TI+FCT HDR 630
IF (AHARR.GT.0.0) GO TO 270 HDR 635
HFCT = 0.0 HDR 640
IF (FCTA.GT.0.0) HFCT = HEIGHT(SI,FCTA,IOBS,OBSAGE,OBSHTS) HDR 645
IF (HY40(1).GT.HFCT) HFCT = HY40(1) HDR 650
IF (DH.GT.0.0.AND.FIH.GT.0.0) HTHARV = NCT*DH+HFCT+FIH HDR 655
IF (DH.GT.0.0.AND.FIH.LE.0.0) HTHARV = (NCT+1.0)*DH+HFCT HDR 660
IF (HTHARV.GT.0.0) GO TO 280 HDR 665
260 CONTINUE HDR 670
AHARR = 100.0 HDR 675
270 CONTINUE HDR 680
AHARV = BHAGE(AHARR,SI) HDR 685
280 CONTINUE HDR 690
IF (AHARR.LE.0.0) GO TO 310 HDR 695
WRITE (6,290) AHARR HDR 700
290 FORMAT (16X,39HTHE SCHEDULED AGE AT THE HARVEST CUT IS,F5.0) HDR 705
LINE = LINE+1 HDR 710
IF (AHARR.LE.100.0) GO TO 310 HDR 715
WRITE (6,300) HDR 720
300 FORMAT (/1X,39(2H**)/79H WARNING -- STAND STATISTICS BEYOND 100 YEHDR 725
$ARS ARE GROSS EXTRAPOLATIONS OF MODEL/1X,39(2H**)/) HDR 730
LINE = LINE+4 HDR 735
310 CONTINUE HDR 740
IF (HTHARV.LE.0.0) GO TO 340 HDR 745
WRITE (6,320) HTHARV HDR 750
320 FORMAT (16X,42HTHE SCHEDULED HEIGHT AT THE HARVEST CUT IS,F6.0, HDR 755
$6H FEET.) HDR 760
LINE = LINE+1 HDR 765
BHA = BHAGE(100.0,SI) HDR 770
HARVH = HEIGHT(SI,BHA,IOBS,OBSAGE,OBSHTS) HDR 775
IF (HTHARV.LE.HARVH) GO TO 340 HDR 780
WRITE (6,330) HARVH,SI HDR 785
330 FORMAT (/1X,39(2H**)/35H WARNING -- STAND STATISTICS BEYOND,F6.1, HDR 790
$20H FEET FOR SITE INDEX,F5.0,10H ARE GROSS/25H EXTRAPOLATIONS OF MHDR 795
$ODEL./1X,39(2H**)/) HDR 800
LINE = LINE+5 HDR 805
340 CONTINUE HDR 810
IF (LTREE.EQ.1.AND.IGS.EQ.1) GO TO 370 HDR 815
IF (IDR.LE.0.OR.IUT.GE.1) GO TO 370 HDR 820
DO 350 I=1,NCT HDR 825
IF (I.EQ.1) GO TO 350 HDR 830
IF (DR(I).LE.0.0) DR(I) = DR(I-1) HDR 835
350 CONTINUE HDR 840
WRITE (6,360) (DR(II),II=1,NCT) HDR 845
360 FORMAT (16X,59HCOMMERCIAL THINNING WILL BE DONE ACCORDING TO THE FHDR 850
$OLLOWING/16X,52HUSER SUPPLIED DIAMETER CUT / DIAMETER BEFORE RATIOHDR 855
$S:/16X,10F6.2/16X,10F6.2) HDR 860
LINE = LINE+4+(NCT-1)/10 HDR 865
370 CONTINUE HDR 870
IF (IGS.LE.0.OR.IUT.GE.1) GO TO 400 HDR 875
DO 380 I=1,NCT HDR 880
IF (I.EQ.1) GO TO 380 HDR 885
IF (GRESD(I).LE.0.0) GRESD(I) = GRESD(I-1) HDR 890
380 CONTINUE HDR 895
WRITE (6,390) (GRESD(II),II=1,NCT) HDR 900
390 FORMAT (16X,59HCOMMERCIAL THINNING WILL BE DONE ACCORDING TO THE FHDR 905
$OLLOWING/16X,36HUSER SUPPLIED RESIDUAL BASAL AREAS: /16X,10F6.0/ HDR 910
$16X,10F6.0) HDR 915
LINE = LINE+4+(NCT-1)/10 HDR 920
400 CONTINUE HDR 925
IF (LTREE.LE.0.OR.IUT.GE.1) GO TO 420 HDR 930
WRITE (6,410) (TARESD(I),I=1,NCT) HDR 935
410 FORMAT (16X,59HCOMMERCIAL THINNING WILL BE DONE ACCORDING TO THE FHDR 940
$OLLOWING/16X,39HUSER SUPPLIED RESIDUAL NUMBER OF TREES:/16X,10F6.0HDR 945
$/16X,10F6.0) HDR 950
LINE = LINE+4+(NCT-1)/10 HDR 955
420 CONTINUE HDR 960
IF (FERTCT.LE.0) GO TO 470 HDR 965
IF (IUT.GT.0) GO TO 440 HDR 970
WRITE (6,430) HDR 975
430 FORMAT (16X,52HTHE STAND WILL BE FERTILIZED AT COMMERCIAL THINNINGHDR 980
$S/16X,47HWITH THE FOLLOWING POUNDS OF NITROGEN PER ACRE://20X, HDR 985
$32HTHINNING POUNDS OF NITROGEN) HDR 990
LINE = LINE+4 HDR 995
440 CONTINUE HDR1000
M = 0 HDR1001
DO 460 II=1,NCT HDR1005
IF (AGET(II).GT.0.0) AGEF(II) = AGET(II) HDR1010
WRITE (6,450) II,PNIT(II) HDR1015
450 FORMAT (23X,I2,15X,F4.0) HDR1020
IF(PNIT(II).GT.0.0) M = M + 1 HDR1021
LINE = LINE+1 HDR1025
460 CONTINUE HDR1030
IF(M.GT.3) WRITE(6,445) HDR1031
445 FORMAT(1X,39(2H**)/79H WARNING -- FREQUENT REPEATED FERTILIZATIONSHDR1032
1 ARE GROSS EXTRAPOLATIONS OF MODEL./1X,39(2H**)) HDR1033
LINE = LINE + 3 HDR1034
470 CONTINUE HDR1035
IF (FERTAS.LE.0) GO TO 510 HDR1040
WRITE (6,480) HDR1045
480 FORMAT (16X,40HTHE STAND WILL BE FERTILIZED AS FOLLOWS://20X, HDR1050
$33HSTAND AGE POUNDS OF NITROGEN) HDR1055
LINE = LINE+3 HDR1060
M = 0 HDR1061
DO 500 II=1,15 HDR1065
IF (AGEF(II).LE.0.0.OR.PNIT(II).LE.0.0) GO TO 500 HDR1070
WRITE (6,490) AGEF(II),PNIT(II) HDR1075
490 FORMAT (23X,F4.0,14X,F4.0) HDR1080
M = M + 1 HDR1081
LINE = LINE+1 HDR1085
500 CONTINUE HDR1090
IF(M.GT.3) WRITE(6,445) HDR1091
LINE = LINE + 3 HDR1092
510 CONTINUE HDR1095
IF (NRA.LE.0.0) GO TO 530 HDR1100
WRITE (6,520) HDR1105
520 FORMAT (16X,63HTHE OUTPUT TABLE WILL HAVE REPORT AGES OTHER THAN CHDR1110
$UTTING AGES.) HDR1115
LINE = LINE+1 HDR1120
530 CONTINUE HDR1125
IF (GCLIM.LE.0.0) GCLIM = 20.0 HDR1130
IF (DLIM.LE.0.0) DLIM = 8.00 HDR1135
C HDR1140
C COMPUTE MINIMUM QUADRATIC MEAN STAND DIAMETER FOR FIRST HDR1145
C COMMERCIAL THINNING HDR1150
C HDR1155
DC = DLIM/1.05 HDR1160
IF (FCT.LE.0.0.AND.IDR.LE.0.AND.AGET(1).LE.0.0.AND.HY40(1).LE.0.0)HDR1165
$ DC = 9.0 HDR1170
IF (IORG.EQ.1.OR.PCTA.GT.0.0) DC = DLIM HDR1175
IF (DR(1).GE.0.8.AND.DR(1).LE.1.15.OR.IDR.EQ.2) DC = DLIM/DR(1) HDR1180
IF (GLIM.LE.0.0) GLIM = 100.0 HDR1185
IF (IUT.GT.0) GO TO 570 HDR1190
WRITE (6,540) DLIM HDR1195
540 FORMAT (16X,61HTHE AVERAGE DIAMETER OF ALL CUT TREES AT COMMERCIALHDR1200
$ THINNINGS/16X,16HMUST BE AT LEAST,F6.2,8H INCHES.) HDR1205
IF (IGS.LE.0) WRITE (6,550) GCLIM HDR1210
550 FORMAT (16X,55HTHE BASAL AREA CUT AT EACH COMMERCIAL THINNING MUSTHDR1215
$ BE /16X,9HAT LEAST ,F3.0,22H SQUARE FEET PER ACRE.) HDR1220
WRITE (6,560) GLIM HDR1225
560 FORMAT (16X,60HTHE BASAL AREA PER ACRE OF ALL TREES 5.6 INCHES PLUHDR1230
$S MUST BE/16X,8HAT LEAST,F7.1,40H SQUARE FEET BEFORE THE FIRST COMHDR1235
$MERCIAL/16X,19HTHINNING CAN OCCUR.) HDR1240
LINE = LINE+8 HDR1245
IF (IGS.GE.1) LINE = LINE-2 HDR1250
570 CONTINUE HDR1255
IF (SAGE.LE.0.0) GO TO 590 HDR1260
WRITE (6,580) SAGE,STA,SBA,SDIA HDR1265
580 FORMAT (16X,40HEXISTING STAND STATISTICS SPECIFIED ARE:/20X, HDR1270
$10HTOTAL AGE=,F5.0/20X,15HTREES PER ACRE=,F7.0/20X,20HBASAL AREA PHDR1275
$ER ACRE=,F7.1/20X,24HQUADRATIC MEAN DIAMETER=,F6.2) HDR1280
LINE = LINE+5 HDR1285
590 CONTINUE HDR1290
IF (IUT.LE.0) GO TO 610 HDR1295
WRITE (6,600) HDR1300
600 FORMAT (16X,34HNO COMMERCIAL THINNING TO BE DONE.) HDR1305
LINE = LINE+1 HDR1310
610 CONTINUE HDR1315
IF (ISTOP.EQ.1) GO TO 690 HDR1320
IF (IOBS.EQ.1.OR.IOBS.GT.30) GO TO 690 HDR1325
IF (IOBS.LE.0) GO TO 630 HDR1330
WRITE (6,620) (OBSAGE(I),OBSHTS(1,I),OBSHTS(2,I),I=2,IOBS) HDR1335
620 FORMAT (/16X,39HUSER SPECIFIED OBSERVED HEIGHTS FOLLOW://2X,4(4X, HDR1340
$14HOBS HT HT)/4X,4(2X,16HAGE BEFORE AFTER)//8(4X,12F6.1/)) HDR1345
LINE = LINE+5+IOBS/4 HDR1350
630 CONTINUE HDR1355
WRITE (6,640) HDR1360
640 FORMAT (//) HDR1365
LINE = LINE+2 HDR1370
IF (IOBS.LE.0) GO TO 660 HDR1375
DO 650 I=2,IOBS HDR1380
OBSAGE(I) = BHAGE(OBSAGE(I),SI) HDR1385
IF (OBSHTS(2,I).LE.0.0) OBSHTS(2,I) = OBSHTS(1,I) HDR1390
650 CONTINUE HDR1395
OBSAGE(1) = 0.0 HDR1396
OBSHTS(1,1) = 4.5 HDR1397
OBSHTS(2,1) = 4.5 HDR1398
660 CONTINUE HDR1400
WRITE (6,670) HDR1405
C2345678901234567890123456789012345678901234567890123456789012345678901234567890
670 FORMAT(74H TOT BH BASAL TREES CVTS CAI *MAI HDR1410
1 CVTS* **MAI CV4**/74H AGE AGE HT40 DBH AREA/A PER PER HDR1415
2 NET GROSS NET ****NET****/73H YRS YRS FEET INCH SQ FT HDR1420
3ACRE ACRE CVTS 1.6+ 1.6+ 5.6+ 7.6+/) HDR1425
C2345678901234567890123456789012345678901234567890123456789012345678901234567890
LINE = LINE+4 HDR1430
IF (X.GE.300.0.OR.TAST.LE.0.0.OR.IPAGE.GT.2) RETURN HDR1435
WRITE (6,680) HDR1440
680 FORMAT (1X,39(2H**)/76H WARNING -- STANDS PLANTED OR PRECOMMERCIALHDR1445
$LY THINNED TO LESS THAN 300 STEMS/51H PER ACRE ARE QUESTIONABLE EXHDR1450
$TRAPOLATIONS OF MODEL./1X,39(2H**)) HDR1455
LINE = LINE+4 HDR1460
RETURN HDR1465
690 CONTINUE HDR1470
IF (IOBS.EQ.2) WRITE (6,700) HDR1475
700 FORMAT (//74H A MINIMUM OF TWO OBSERVATION PERIODS REQUIRED FOR USHDR1480
$ER SPECIFIED HEIGHTS./19H CORRECT AND RERUN.) HDR1485
IF (IOBS.GT.31) WRITE (6,710) HDR1490
710 FORMAT (//75H A MAXIMUN OF 30 OBSERVATION PERIODS IS ALLOWED FOR UHDR1495
$SER SPECIFIED HEIGHTS./19H CORRECT AND RERUN.) HDR1500
IF (IOBS.EQ.1.OR.IOBS.GT.30) RETURN HDR1505
ISTOP = 3 HDR1510
WRITE (6,720) HDR1515
720 FORMAT (//73H STANDS PLANTED OR PRECOMMERCIALLY THINNED TO LESS THHDR1520
$AN 75 STEMS PER ACRE/47H CANNOT BE SIMULATED. YIELD TABLE NOT PRODHDR1525
$UCED.//) HDR1530
RETURN HDR1535
END HDR1540-
SUBROUTINE XFERT(AGENOW) XFR 5
C XFR 10
C NITROGEN FERTILIZER EFFECT ROUTINE XFR 15
C XFR 20
DIMENSION AGEF(16), AGET(16), ARG(16), DR(16), FNLBS(16), GRESD(16XFR 25
$), H40(16), HY40(16), ITITLE(20), LIUT(16), OBSAGE(31), PNIT(16), XFR 30
$PNITF(16), RAN(76), TTN(16), D(16,4), GA(16,4), OBSHTS(2,31), XFR 35
$ TARESD(16), TA(16,4), VA(16,4) XFR 40
DIMENSION D56(16), D76(16), DC56(16), DC76(16), G56(16), G76(16), XFR 45
$GC56(16), GC76(16), VA56(16), VA456(16), VA76(16), VA476(16), XFR 50
$ VAA56(16), VAA456(16), VAA76(16), VAA476(16), VAC56(16), VAC456 XFR 55
$(16), VAC76(16), VAC476(16), SVC456(16), SVC476(16) XFR 60
DIMENSION AGEFF(16) XFR 65
COMMON AGE,AGEF,AGET,AHARR,AHARV,ARG,ASYMP,BAB,BAC,BAPA,CAI,CT1,D,XFR 70
$DDMRT,DLIM,DMTMIN,DNOW,DR,FCTA,FERTEF,FNLBS,GA,GRESD,H40,HAT,HPCT,XFR 75
$HS,HTHARV,HY40,ICT1,IDR,IOBS,IORG,IPAGE,IQ,IRD,ITHN,ITITLE,IUT,IZ,XFR 80
$JRD,LINE,LIUT,LTREE,NRA,OBSAGE,OBSHTS,TARESD,PCT,PCTA,PNIT,PNITF, XFR 85
$RAN,SAGE,SBA,SCUTVA,SDIA,SGMORT,SI,SNMORT,STA,SVMORT,TA,TTN,VA, XFR 90
$VGNOW,VNOW,XMAI16,XMAI56,XMAI76,XNUM,XNUMR,ISTOP,RATMAI, XFR 95
$rdasymp,isv
COMMON D56,D76,DC56,DC76,G56,G76,GC56,GC76,VA56,VA456,VA76,VA476, XFR 100
$VAA56,VAA456,VAA76,VAA476,VAC56,VAC456,VAC76,VAC476,SVC456,SVC476 XFR 105
COMMON CTAS,DC,DH,EXIST,FCT,FERTAS,FERTCT,FIH,IHEAD,FIY,GCLIM,GLIMXFR 110
$,HFCT,IGS,IMV,NCT,SCTHT,SCUT45,SCUT47,SCUTBA,SCUTTA,TAST,TI,AGEADDXFR 115
COMMON /CHAR/ CTITLE,vers
CHARACTER CTITLE*80,vers*8
COMMON /ECONO/ A,B,C,COSTAB,ECO,EUNITS,FC,FCI,FHRC,FHRCI,
$HAULC1,HC,HCI,IFER,
$LCI,LCM,LDF,LDI,LOGC1,LOGCF(12,12),LOGCI(12,12),
$LOGDF(12),LOGDI(12),LOGVF(12),LOGVI(12),LVF,LVI,
$MAH,NETRV1,OAHC,OAHCI,OATC,OTHRC1,OVHC,OVHCI,
$OVTC,PCTC,PCTCI,PNW1,PNW2,PNDVL1,PONDVL(8,2),PONTAB,
$PVI,R,RCI,REGENC,SEV,TRUED,TYHV,VOLM,FAGE(16,2),CNIT(16,2)
$ ,DNR,VDEAD,CVDEAD,VOLUME,CUMVOL,FALL,IMORT,CMORT
INTEGER CTAS,EXIST,FERTAS,FERTCT,SCTHT XFR 120
C XFR 125
C ************ DEFINITION OF IMPORTANT XFERT VARIABLES ************ XFR 130
C XFR 135
C EEEEEEEEEE
C SEE SUBROUTINE ECON FOR DEFINITION OF IMPORTANT ECON VARIABLES
C EEEEEEEEEE
C AGECK = TOTAL STAND AGE AT MIDPOINT OF GROWTH PERIOD XFR 140
C AGEDIF = ELAPSED TIME IN YEARS FOR MOST RECENT NITROGEN XFR 145
C FERTILIZER APPLICATION XFR 150
C AGEF = ARRAY OF STAND AGES FOR FERTILIZER APPLICATIONS IN XFR 155
C ASCENDING ORDER XFR 160
C AGEFF = ARRAY OF STAND AGES FOR FERTILIZER APPLICATIONS IN XFR 165
C DESCENDING ORDER XFR 170
C AGENOW = BREAST HEIGHT STAND AGE AT MIDPOINT OF GROWTH PERIOD XFR 175
C FERTEF = EFFECT OF NITROGEN FERTILIZER FOR XFR 180
C MOST RECENT APPLICATION XFR 185
C FERTXX = VARIABLE FOR FERTILIZER EFFECT OF XFR 190
C MOST RECENT APPLICATION XFR 195
C PNIT = ARRAY OF EFFECTIVE NITROGEN DOSAGES IN POUNDS PER ACRE XFR 200
C FOR EACH FERTILIZER APPLICATION IN ASCENDING ORDER XFR 205
C PNITF = ARRAY OF EFFECTIVE NITROGEN DOSAGES IN POUNDS PER ACRE XFR 210
C FOR EACH FERTILIZER APPLICATION IN DESCENDING ORDER XFR 215
C SI = SITE INDEX (50-YEAR B H BASE AGE) XFR 220
C ***************************************************************** XFR 225
C XFR 230
IF (FERTCT.LE.0.AND.FERTAS.LE.0) GO TO 40 XFR 235
DO 10 II=1,15 XFR 240
AGEFF(16-II) = AGEF(II) XFR 245
PNITF(16-II) = PNIT(II) XFR 250
10 CONTINUE XFR 255
FERTXX = 0.0 XFR 260
AGECK = TOAGE(AGENOW,SI) XFR 265
DO 20 II=1,15 XFR 270
IF (AGEFF(II).LE.0.0) GO TO 20 XFR 275
IF (AGEFF(II).GT.AGECK) GO TO 20 XFR 280
AGEDIF = AGECK-AGEFF(II) XFR 285
C
C EEEEEEEEEE
IF (AGEDIF.GT.1.0) GO TO 35
C ACCUMULATE AGES FOR FERT COST
DO 15 J=1,15
IF (FAGE(J,1).GT.0.0) GO TO 15
FAGE(J,1)=AGEFF(II)
FAGE(J,2)=PNITF(II)
GO TO 17
15 CONTINUE
17 CONTINUE
C EEEEEEEEEE
C
35 CONTINUE
FERT = (PNITF(II)*(AGEDIF*EXP(-AGEDIF/(4.7188-.01667*SI)))**3) XFR 290
IF (FERT.GT.FERTXX) FERTXX = FERT XFR 295
C XFR 300
20 CONTINUE XFR 305
30 CONTINUE XFR 310
if (fertxx.le.1.0e-10) fertxx = 0.0
IF (FERTXX.EQ.0.0) GO TO 40 XFR 315
FERTEF = (ALOG(FERTXX+1.))**2/SI XFR 320
GO TO 50 XFR 325
C XFR 330
40 CONTINUE XFR 335
FERTEF = 0.0 XFR 340
50 CONTINUE XFR 345
RETURN XFR 350
END XFR 355-
SUBROUTINE JUVGRO JUV 5
C JUV 10
C JUVENILE STAND GROWTH ROUTINE. GROW STAND TO 5.55-INCHES DBH. JUV 15
C JUV 20
C IUIN IS INPUT FILE - TAPE5
C IUOUT IS OUTPUT - TAPE6
C
DIMENSION AGEF(16), AGET(16), ARG(16), DR(16), FNLBS(16), GRESD(16JUV 25
$), H40(16), HY40(16), ITITLE(20), LIUT(16), OBSAGE(31), PNIT(16), JUV 30
$PNITF(16), RAN(76), TTN(16), D(16,4), GA(16,4), OBSHTS(2,31), JUV 35
$ TARESD(16), TA(16,4), VA(16,4) JUV 40
DIMENSION D56(16), D76(16), DC56(16), DC76(16), G56(16), G76(16), JUV 45
$GC56(16), GC76(16), VA56(16), VA456(16), VA76(16), VA476(16), JUV 50
$ VAA56(16), VAA456(16), VAA76(16), VAA476(16), VAC56(16), VAC456 JUV 55
$(16), VAC76(16), VAC476(16), SVC456(16), SVC476(16) JUV 60
COMMON AGE,AGEF,AGET,AHARR,AHARV,ARG,ASYMP,BAB,BAC,BAPA,CAI,CT1,D,JUV 65
$DDMRT,DLIM,DMTMIN,DNOW,DR,FCTA,FERTEF,FNLBS,GA,GRESD,H40,HAT,HPCT,JUV 70
$HS,HTHARV,HY40,ICT1,IDR,IOBS,IORG,IPAGE,IQ,IRD,ITHN,ITITLE,IUT,IZ,JUV 75
$JRD,LINE,LIUT,LTREE,NRA,OBSAGE,OBSHTS,TARESD,PCT,PCTA,PNIT,PNITF, JUV 80
$RAN,SAGE,SBA,SCUTVA,SDIA,SGMORT,SI,SNMORT,STA,SVMORT,TA,TTN,VA, JUV 85
$VGNOW,VNOW,XMAI16,XMAI56,XMAI76,XNUM,XNUMR,ISTOP,RATMAI, JUV 90
$rdasymp,isv
COMMON D56,D76,DC56,DC76,G56,G76,GC56,GC76,VA56,VA456,VA76,VA476, JUV 95
$VAA56,VAA456,VAA76,VAA476,VAC56,VAC456,VAC76,VAC476,SVC456,SVC476 JUV 100
COMMON CTAS,DC,DH,EXIST,FCT,FERTAS,FERTCT,FIH,IHEAD,FIY,GCLIM,GLIMJUV 105
$,HFCT,IGS,IMV,NCT,SCTHT,SCUT45,SCUT47,SCUTBA,SCUTTA,TAST,TI,AGEADDJUV 110
COMMON /ECONO/ A,B,C,COSTAB,ECO,EUNITS,FC,FCI,FHRC,FHRCI,
1 HAULC1,HC,HCI,IFER,
2 LCI,LCM,LDF,LDI,LOGC1,LOGCF(12,12),LOGCI(12,12),
3 LOGDF(12),LOGDI(12),LOGVF(12),LOGVI(12),LVF,LVI,
4 MAH,NETRV1,OAHC,OAHCI,OATC,OTHRC1,OVHC,OVHCI,
5 OVTC,PCTC,PCTCI,PNW1,PNW2,PNDVL1,PONDVL(8,2),PONTAB,
6 PVI,R,RCI,REGENC,SEV,TRUED,TYHV,VOLM,FAGE(16,2),CNIT(16,2)
$ ,DNR,VDEAD,CVDEAD,VOLUME,CUMVOL,FALL,IMORT,CMORT
COMMON /CHAR/ CTITLE,vers
CHARACTER CTITLE*80,vers*8
REAL LOGC,LOGCI,LOGDI,LOGVI,LOGCF,LOGDF,LOGVF,LCI,LCM,LOGC1,
1 LOGC2,MAH,NETRV1,NETRV2
INTEGER COSTAB,PONTAB,ECO,EUNITS,TYHV
INTEGER CTAS,EXIST,FERTAS,FERTCT,SCTHT JUV 115
C JUV 120
C ************ DEFINITION OF IMPORTANT JUVGRO VARIABLES *********** JUV 125
C JUV 130
C AGE = BREAST HEIGHT STAND AGE JUV 135
C AGEADD = LENGTH OF GROWTH PERIOD JUV 140
C AGECK = TOTAL STAND AGE JUV 145
C AGEFF = BREAST HEIGHT STAND AGE AT TIME OF FIRST NITROGEN JUV 150
C FERTILIZER APPLICATION JUV 155
C AGEMID = BREAST HEIGHT STAND AGE AT MIDPOINT OF GROWTH PERIOD JUV 160
C AF = BREAST HEIGHT STAND AGE AT TIME OF FIRST JUV 165
C NITROGEN FERTILIZER APPLICATION JUV 170
C AHARV = BREAST HEIGHT STAND AGE AT HARVEST CUT JUV 175
C BAPA = BASAL AREA PER ACRE IN TREES 1.6-INCHES + DBH JUV 180
C CAI = CUBIC-FOOT VOLUME (TOTAL STEM) PER ACRE NET CURRENT JUV 185
C ANNUAL INCREMENT IN TREES 1.6-INCHES + DBH JUV 190
C D1 = QUADRATIC MEAN STAND DIAMETER OF TREES 1.6-INCHES + DBH JUV 195
C 'NORMAL' STAND AT BEGINNING OF SIMULATION JUV 200
C DEODG = QUADRATIC MEAN STAND DIAMETER OF 'NORMAL' STAND AT JUV 205
C BEGINNING OF SIMULATION DIVIDED BY QUADRATIC STAND JUV 210
C DIAMETER OF EXISTING STAND AT BEGINNING OF SIMULATIOJUV 215
C DDH = STAND TOP HEIGHT INCREMENT SINCE BEGINNING OF SIMULATION JUV 220
C DNOW = QUADRATIC MEAN STAND DIAMETER OF TREES 1.6-INCHES + DBH JUV 225
C FERT = NITROGEN FERTILIZER EFFECTIVE DOSAGE IN POUNDS PER ACRE JUV 230
C AT TIME OF FIRST APPLICATION JUV 235
C H1 = STAND TOP HEIGHT JUV 240
C H2 = STAND TOP HEIGHT 1 YEAR HENCE JUV 245
C HAFF = STAND TOP HEIGHT AT TIME OF FIRST NITROGEN FERTILIZER JUV 250
C APPLICATION JUV 255
C HAT = STAND TOP HEIGHT AFTER PRECOMMERCIAL THINNING JUV 260
C HPCT = STAND TOP HEIGHT AFTER PRECOMMERCIAL THINNING JUV 265
C HR = STAND TOP HEIGHT AT BEGINNING OF SIMULATION JUV 270
C HS = STAND TOP HEIGHT PASSED TO DFSIM JUV 275
C HTADD = STAND TOP HEIGHT INCREMENT JUV 280
C HTHARV = STAND TOP HEIGHT AT HARVEST CUT JUV 285
C HTL = LOREY?S HEIGHT JUV 290
C IORG = STAND ORIGIN JUV 295
C IQ = INDEX FOR REPORT AGES ARRAY JUV 300
C ITHN = INDICATOR SWITCH FOR THINNING DONE JUV 305
C PCT = TOTAL STAND AGE AT PRECOMMERCIAL THINNING JUV 310
C PCTA = BREAST HEIGHT STAND AGE AT PRECOMMERCIAL THINNING JUV 315
C RD = RELATIVE DENSITY JUV 320
C RDECAY = ADJUSTMENT FACTOR FOR 'NON-NORMAL' EXISTING STAND JUV 325
C QUADRATIC MEAN STAND DIAMETER. ADJUSTS DIAMETERS JUV 330
C TOWARD 'NORMAL' OVER A 40-FOOT HEIGHT GROWTH PERIOD JUV 335
C SBA = EXISTING STAND BASAL AREA PER ACRE IN TREES 1.6-INCHES + JUV 340
C DBH JUV 345
C SDIA = EXISTING STAND QUADRATIC MEAN STAND DIAMETER OF TREES JUV 350
C 1.6-INCHES + DBH JUV 355
C STA = EXISTING STAND NUMBER OF TREES PER ACRE 1.6-INCHES + DBH JUV 360
C VGR = CUBIC-FOOT VOLUME (TOTAL STEM) / BASAL AREA RATIO JUV 365
C VNOW = CUBIC-FOOT VOLUME (TOTAL STEM) PER ACRE IN TREES 1.6- JUV 370
C INCHES + DBH JUV 375
C VSAVE = CUBIC-FOOT VOLUME (TOTAL STEM) PER ACRE IN TREES 1.6- JUV 380
C INCHES + DBH 1 YEAR AGO JUV 385
C XMAI16 = CUBIC-FOOT VOLUME (TOTAL STEM) PER ACRE NET MEAN ANNUAL JUV 390
C INCREMENT IN TREE 1.6-INCHES + DBH JUV 395
C XN1 = NUMBER OF TREES PER ACRE AT STAND TOP HEIGHT H1 JUV 400
C XN2 = NUMBER OF TREES PER ACRE AT STAND TOP HEIGHT H2 JUV 405
C XNUM = NUMBER OF TREES PER ACRE PASSED TO DFSIM JUV 410
C XNUM1 = 'NORMAL' NUMBER OF TREES PER ACRE AT STAND TOP HEIGHT H1 JUV 415
C XNUM2 = 'NORMAL' NUMBER OF TREES PER ACRE AT STAND TOP HEIGHT H2 JUV 420
C XNUMR = NUMBER OF ESTABLISHED SEEDLINGS PER ACRE AFTER PLANTING OJUV 425
C NUMBER OF RESIDUAL TREES PER ACRE AFTER PRECOMMERCIAJUV 430
C THINNING JUV 435
C ***************************************************************** JUV 440
C
C EEEEEEEEEE
C SEE SUBROUTINE ECON FOR DEFINITIONS OF IMPORTANT ECON VARIABLES
C EEEEEEEEEE
IUIN=3
IUOUT=6
C JUV 445
H1 = 0.0 JUV 450
XN1 = STA JUV 455
DNOW = SDIA JUV 460
BAPA = SBA JUV 465
VSAVE = 0.0 JUV 470
HF = 0.0 JUV 475
FERT = 0.0 JUV 480
AGEFF = BHAGE(AGEF(1),SI) JUV 485
IF (AGEFF.LE.0.0) AGEFF = 0.0 JUV 490
AGE = BHAGE(SAGE,SI) JUV 495
IF (AGE.LE.0.0) AGE = 0.0 JUV 500
IAGE = AGE+.5 JUV 505
AGE = IAGE JUV 510
XN2 = STA JUV 515
XNUM1 = STA JUV 520
XNUM2 = STA JUV 525
H2 = 0.0 JUV 530
HAT = 0.0 JUV 535
HAFF = 0.0 JUV 540
IF (AGE.LE.0.0) GO TO 240 JUV 545
IF (AGEF(1).LE.0.0) GO TO 20 JUV 550
C JUV 555
C GROW FERTILIZED STAND FROM EARLIEST AGE TO CURRENT AGE JUV 560
C JUV 565
EAGE = SAGE JUV 570
IF (PCT.GT.0.0.AND.PCT.LT.EAGE) EAGE = PCT JUV 575
IF (AGEF(1).GT.0.0.AND.AGEF(1).LT.EAGE) EAGE = AGEF(1) JUV 580
IF (EAGE.EQ.SAGE) GO TO 20 JUV 585
IF (AGEFF.GE.AGE.AND.PCTA.LE.0.0) GO TO 230 JUV 590
AGEMID = BHAGE(EAGE,SI) JUV 595
H1 = HEIGHT(SI,AGEMID,IOBS,OBSAGE,OBSHTS) JUV 600
10 CONTINUE JUV 605
AGEMID = AGEMID+AGEADD/2.0 JUV 610
CALL XFERT (AGEMID) JUV 615
AGEMID = AGEMID-AGEADD/2.0 JUV 620
IF (PCTA.EQ.AGEMID) HAT = H1 JUV 625
HTADD = HTGROW(SI,AGEMID,AGEADD,FERTEF,IOBS,OBSAGE,OBSHTS) JUV 630
H1 = H1+HTADD JUV 635
AGEMID = AGEMID+AGEADD JUV 640
IF (AGEMID.LT.AGE) GO TO 10 JUV 645
IF (PCTA.LE.0.0) GO TO 230 JUV 650
IF (HAT.LE.0.0) GO TO 30 JUV 655
ITHN = 1 JUV 660
TTN(1) = 1.0 JUV 665
C
C EEEEEEEEEE
C CALCULATE P-THIN COST
IF (PCT.LT.SAGE) GO TO 30
YAGE=PCT-SAGE
IF (YAGE.GE.50) YAGE=50
PNW2=PNW2-PCTC*(1+PCTCI)**50/(1+R)**PCT
PNW1=PNW1-PCTC*(1+PCTCI)**YAGE/(1+R)**(PCT-SAGE)
C EEEEEEEEEE
GO TO 30 JUV 670
C JUV 675
C EXISTING UNFERTILIZED STAND JUV 680
C JUV 685
20 IF (PCTA.LE.0.0) GO TO 230 JUV 690
C JUV 695
C EXISTING UNFERTILIZED PRECOMMERCIALLY THINNED STAND JUV 700
C JUV 705
IF (PCTA.GT.AGE) GO TO 30 JUV 710
TTN(1) = 1.0 JUV 715
ITHN = 1 JUV 720
HAT = HEIGHT(SI,PCTA,IOBS,OBSAGE,OBSHTS) JUV 725
C
C EEEEEEEEEE
C CALCULATE P-THIN COST
IF (PCT.LT.SAGE) GO TO 30
YAGE=PCT-SAGE
IF (YAGE.GE.50) YAGE=50
PNW2=PNW2-PCTC*(1+PCTCI)**50/(1+R)**PCT
PNW1=PNW1-PCTC*(1+PCTCI)**YAGE/(1+R)**(PCT-SAGE)
C EEEEEEEEEE
C JUV 730
C GROW STAND TO 5.55-INCHES + DBH JUV 735
C JUV 740
30 IF (H1.LE.0.0) H1 = HEIGHT(SI,AGE,IOBS,OBSAGE,OBSHTS) JUV 745
IF (AGEFF.GT.AGE.OR.AGEFF.LE.0.0) GO TO 40 JUV 750
HF = HEIGHT(SI,AGEFF,IOBS,OBSAGE,OBSHTS) JUV 755
FERT = PNIT(1) JUV 760
40 CONTINUE JUV 765
D1 = DIAMJ(H1,XN1,TTN(1),HAT,FERT,HF) JUV 770
IF (DNOW.LE.0.0) DNOW = D1 JUV 775
IF (BAPA.LE.0.0) BAPA = 0.005454154*DNOW*DNOW*XN1 JUV 780
DEODG = DNOW/D1 JUV 785
HR = H1 JUV 790
IF (PCTA.LE.AGE.AND.PCTA.GT.0.0) ITHN = 1 JUV 795
AGEMID = AGE JUV 800
H2 = H1 JUV 805
IF (DEODG.GT.0.77.AND.DEODG.LT.1.30) GO TO 60 JUV 810
WRITE (IUOUT,50) JUV 815
50 FORMAT (1X,39(2H**)/75H WARNING -- EXISTING STAND DIAMETER AT BEGIJUV 820
$NNING OF SIMULATION IS THREE (3)/47H OR MORE STANDARD ERRORS FROM JUV 825
$REGIONAL AVERAGE./1X,39(2H**)) JUV 830
LINE = LINE+4 JUV 835
60 CONTINUE JUV 840
IF (IORG.EQ.1.OR.PCT.GT.0.0) GO TO 80 JUV 845
XTREE = TRENUM(H1) JUV 850
XT = XTREE*0.5 JUV 855
YT = XTREE*1.5 JUV 860
IF (XN1.GE.XT.AND.XN1.LE.YT) GO TO 80 JUV 865
WRITE (IUOUT,70) JUV 870
70 FORMAT (1X,39(2H**)/58H WARNING -- EXISTING NATURAL STAND INITIAL JUV 875
$NUMBER OF TREES/76H EXCEEDS + OR - 50 PERCENT OF 'NORMAL'. QUESTIOJUV 880
$NABLE EXTRAPOLATION OF MODEL./1X,39(2H**)) JUV 885
LINE = LINE+4 JUV 890
80 CONTINUE JUV 895
AGEMID = AGEMID+AGEADD/2.0 JUV 900
CALL XFERT (AGEMID) JUV 905
AGEMID = AGEMID-AGEADD/2.0 JUV 910
HTADD = HTGROW(SI,AGE,AGEADD,FERTEF,IOBS,OBSAGE,OBSHTS) JUV 915
H2 = H2+HTADD JUV 920
AGEMID = AGEMID+AGEADD JUV 925
IF (AGEMID.LT.(AGE+1.0)) GO TO 60 JUV 930
XNUM1 = TRENUM(H1) JUV 935
IF (RAN(1).LE.0.0) GO TO 100 JUV 940
IF (IQ.GT.0) GO TO 100 JUV 945
AGECK = TOAGE(AGE,SI) JUV 950
DO 90 IQ=1,76 JUV 955
IF (RAN(IQ).GE.AGECK) GO TO 100 JUV 960
90 CONTINUE JUV 965
C JUV 970
C BEGIN JUVENILE GROWTH LOOP JUV 975
C JUV 980
100 CONTINUE JUV 985
rd = bapa / sqrt(dnow) temp
IAGE = AGE+.5 JUV 990
ARG(1) = SORG(IORG,H1) JUV 995
TTN(1) = THN(ITHN,H1,HAT) JUV1000
VGR = VGRAT(DNOW,H1,AGE,TTN(1),ARG(1),BAPA) JUV1005
VNOW = BAPA*VGR JUV1010
CAI = VNOW-VSAVE JUV1015
IF (VSAVE.LE.0.005) CAI = 0.0 JUV1020
c HTL = HTLOR(DNOW,VNOW,BAPA,XN1,H1) JUV1025
AGECK = TOAGE(AGE,SI) JUV1030
XMAI16 = VNOW/AGECK JUV1035
VSAVE = VNOW JUV1040
AGE = IAGE JUV1045
IF (IQ.LE.0.AND.NRA.EQ.0) GO TO 130 JUV1050
IF (NRA.GE.77) GO TO 110 JUV1055
IF (AGECK.EQ.RAN(IQ)) GO TO 110 JUV1060
GO TO 130 JUV1065
C JUV1070
110 CONTINUE JUV1075
IQ = IQ+1 JUV1080
IF (LINE.GE.53) CALL HEADER JUV1085
JAGECK = AGECK + 0.5 JUV1086
JAGE = AGE + 0.5 JUV1087
WRITE (IUOUT,120) JAGECK,JAGE,H1,DNOW,BAPA,XN1,VNOW,CAI,XMAI16 JUV1090
120 FORMAT (1X,I3,1X,I3,F7.1, F7.2,F7.1,F7.0,F7.0,F6.0,6X,F6.0) JUV1095
LINE = LINE+1 JUV1100
130 CONTINUE JUV1105
IF (AGE.GE.AHARV.AND.AHARV.GT.0.0) GO TO 290 JUV1110
IF (H1.GE.HTHARV.AND.HTHARV.GT.0.0) GO TO 290 JUV1115
IF (DNOW.GT.5.55) GO TO 290 JUV1120
IF (IORG.GE.1.AND.STA.EQ.XN1.AND.H2.GE.38.8) XNUM1 = TRENUM(H1) JUV1125
AGE = AGE+1.0 JUV1130
XNUM2 = TRENUM(H2) JUV1135
IF (IORG.GE.1.AND.H2.LT.38.8.OR.ITHN.EQ.1.AND.H2.LT.38.8) JUV1140
$ GO TO 140 JUV1145
IF (XN1.LT.XNUM2) GO TO 140 JUV1150
C JUV1155
C ADJUST FOR 'NON-NORMAL' NUMBER OF TREES IN EXISTING STAND JUV1160
C JUV1165
XN2 = ADJNUM(XNUM2,XNUM1,XN1,H1,H2) JUV1170
140 CONTINUE JUV1175
IF (IORG.LE.0.AND.ITHN.EQ.0) GO TO 150 JUV1180
IF (XN2.GT.XNUM2.AND.H2.GT.38.8) GO TO 150 JUV1185
RD = BAPA/SQRT(DNOW) JUV1190
C JUV1195
C PLANTATION AND PRECOMMERCIALLY THINNED STAND MORTALITY BEGINS JUV1200
C WHEN RELATIVE DENSITY REACHES 20.0 JUV1205
C JUV1210
IF (RD.LT.20.0) GO TO 150 JUV1215
IF (RD.GE.45.0) RD = 45.0 JUV1220
XN2 = XN2-0.005*XN2*(1.0-(1.0-(RD-20.0)/25.0)**2.5) JUV1225
150 CONTINUE JUV1230
AGECK = TOAGE(AGE,SI) JUV1235
IF (AGEFF.NE.AGE) GO TO 160 JUV1240
HF = H2 JUV1245
FERT = PNIT(1) JUV1250
160 CONTINUE JUV1255
DNOW = DIAMJ(H2,XN2,TTN(1),HAT,FERT,HF) JUV1260
C JUV1265
C 'NON-NORMAL' DIAMETER IN EXISTING STANDS APPROACHES 'NORMAL' JUV1270
C JUV1275
DDH = H2-HR JUV1280
IF (DDH.GT.40.0) DDH = 40.0 JUV1285
RDECAY = DEODG-(DEODG-1.0)/40.0*DDH JUV1290
DNOW = DNOW*RDECAY JUV1295
BAPA = .005454154*DNOW*DNOW*XN2 JUV1300
H1 = H2 JUV1305
XN1 = XN2 JUV1310
XNUM1 = XNUM2 JUV1315
170 CONTINUE JUV1320
AGEMID = AGEMID+AGEADD/2.0 JUV1325
CALL XFERT (AGEMID) JUV1330
AGEMID = AGEMID-AGEADD/2.0 JUV1335
HTADD = HTGROW(SI,AGE,AGEADD,FERTEF,IOBS,OBSAGE,OBSHTS) JUV1340
H2 = H2+HTADD JUV1345
AGEMID = AGEMID+AGEADD JUV1350
IF (AGEMID.LT.(AGE+1.0)) GO TO 170 JUV1355
IF (PCTA.EQ.AGE) GO TO 180 JUV1360
GO TO 100 JUV1365
C JUV1370
C EXISTING STAND GROWN TO PCTA. DO PRECOMMERCIAL THINNING JUV1375
C JUV1380
180 CONTINUE JUV1385
IF (XNUMR.GE.XN2) GO TO 210 JUV1390
XN1 = XNUMR JUV1395
XN2 = XNUMR JUV1400
XNUM1 = XNUMR JUV1405
XNUM2 = XNUMR JUV1410
TTN(1) = 1.0 JUV1415
ITHN = 1 JUV1420
C
C EEEEEEEEEE
C CALCULATE P-THIN COST
IF (PCT.LT.SAGE) GO TO 185
YAGE=PCT-SAGE
IF (YAGE.GE.50) YAGE=50
PNW2=PNW2-PCTC*(1+PCTCI)**50/(1+R)**AGECK
PNW1=PNW1-PCTC*(1+PCTCI)**YAGE/(1+R)**(AGECK-SAGE)
185 CONTINUE
C EEEEEEEEEE
C
WRITE (IUOUT,190) AGECK,XN1 JUV1425
190 FORMAT (//36H PRECOMMERCIAL THINNING DONE AT AGE ,F3.0,29H RESIDUAJUV1430
$L NUMBER OF TREES IS ,F5.0//) JUV1435
LINE = LINE+5 JUV1440
HAT = H1 JUV1445
IF (AGEFF.NE.AGE) GO TO 200 JUV1450
HF = H1 JUV1455
FERT = PNIT(1) JUV1460
200 CONTINUE JUV1465
DNOW = DIAMJ(H1,XN1,TTN(1),HAT,FERT,HF) JUV1470
DDH = H1-HR JUV1475
IF (DDH.GT.40.0) DDH = 40.0 JUV1480
RDECAY = DEODG-(DEODG-1.0)/40.0*DDH JUV1485
DNOW = DNOW*RDECAY JUV1490
BAPA = 0.005454154*DNOW*DNOW*XN2 JUV1495
GO TO 100 JUV1500
C JUV1505
210 CONTINUE JUV1510
WRITE (IUOUT,220) AGECK JUV1515
220 FORMAT (1X,79(1H*)/6X,62HWARNING -- RESIDUAL TREES AFTER PRECOMMERJUV1520
$CIAL THINNING AT AGE ,F3.0/6X,59HEXCEEDS EXISTING TREES. NO PRECOMJUV1525
$MERCIAL THINNING WAS DONE./1X,79(1H*)) JUV1530
LINE = LINE+4 JUV1535
PCTA = 0.0 JUV1540
PCT = 0.0 JUV1545
XNUMR = 0.0 JUV1550
ITHN = 0 JUV1555
TTN(1) = 0.0 JUV1560
GO TO 100 JUV1565
C JUV1570
230 CONTINUE JUV1575
PCTA = 0.0 JUV1580
PCT = 0.0 JUV1585
XNUMR = 0.0 JUV1590
ITHN = 0 JUV1595
TTN(1) = 0.0 JUV1600
GO TO 30 JUV1605
C JUV1610
240 CONTINUE JUV1615
C JUV1620
C REGIONAL 'AVERAGE' STAND INITIALIZATION JUV1625
C JUV1630
H1 = 40.0 JUV1635
IF (IORG.EQ.1) H1 = 25.0 JUV1640
AGE = AGEJUV(SI,H1,IOBS,OBSAGE,OBSHTS) JUV1645
IAGE = AGE+.5 JUV1650
AGE = IAGE JUV1655
IF (PCTA.GT.0.0.AND.PCTA.LT.AGE) AGE = PCTA JUV1660
EAGE = TOAGE(AGE,SI) JUV1665
IF (AGEF(1).GT.0.0.AND.AGEF(1).LT.EAGE) EAGE = AGEF(1) JUV1670
AGEMID = BHAGE(EAGE,SI) JUV1675
H1 = HEIGHT(SI,AGEMID,IOBS,OBSAGE,OBSHTS) JUV1680
IF (AGEF(1).EQ.EAGE) HF = H1 JUV1685
IF (PCT.EQ.EAGE) GO TO 260 JUV1690
250 CONTINUE JUV1695
IF (AGEMID.GE.AGE) GO TO 260 JUV1700
AGEMID = AGEMID+AGEADD/2.0 JUV1705
CALL XFERT (AGEMID) JUV1710
AGEMID = AGEMID-AGEADD/2.0 JUV1715
HTADD = HTGROW(SI,AGEMID,AGEADD,FERTEF,IOBS,OBSAGE,OBSHTS) JUV1720
H1 = H1+HTADD JUV1725
AGEMID = AGEMID+AGEADD JUV1730
GO TO 250 JUV1735
C JUV1740
260 CONTINUE JUV1745
IF (XNUMR.LE.0.0) XN1 = TRENUM(H1) JUV1750
IF (XNUMR.GT.0.0) XN1 = XNUMR JUV1755
IF (PCTA.LE.0.0) GO TO 270 JUV1760
ITHN = 1 JUV1765
TTN(1) = 1.0 JUV1770
HAT = H1 JUV1775
C
C EEEEEEEEEE
C CALCULATE P-THIN COST
IF (PCT.LT.SAGE) GO TO 270
YAGE=PCT-SAGE
IF (YAGE.GE.50) YAGE=50
PNW2=PNW2-PCTC*(1+PCTCI)**50/(1+R)**PCT
PNW1=PNW1-PCTC*(1+PCTCI)**YAGE/(1+R)**(PCT-SAGE)
C EEEEEEEEEE
270 CONTINUE JUV1780
IF (AGEFF.GT.AGE.OR.AGEFF.LE.0.0) GO TO 280 JUV1785
FERT = PNIT(1) JUV1790
280 CONTINUE JUV1795
DNOW = DIAMJ(H1,XN1,TTN(1),HAT,FERT,HF) JUV1800
BAPA = .005454154*DNOW*DNOW*XN1 JUV1805
AGECK = TOAGE(AGE,SI) JUV1810
XNUM1 = XN1 JUV1815
XNUM2 = XN1 JUV1820
XN2 = XN1 JUV1825
GO TO 30 JUV1830
C JUV1835
290 CONTINUE JUV1840
HPCT = HAT JUV1845
HS = H1 JUV1850
XNUM = XN1 JUV1855
RETURN JUV1860
END JUV1865-
SUBROUTINE GROWTH GRO 5
C GRO 10
C MAIN STAND GROWTH ROUTINE. GROW STAND FROM 5.55-INCHES DBH. GRO 15
C THIS SUBROUTINE IS EXECUTED ONCE FOR EACH YEAR OF GROWTH AFTER GRO 20
C STAND REACHES 5.55-INCHES DBH UNTIL HARVEST CUT. GRO 25
C GRO 30
DIMENSION AGEF(16), AGET(16), ARG(16), DR(16), FNLBS(16), GRESD(16GRO 35
$), H40(16), HY40(16), ITITLE(20), LIUT(16), OBSAGE(31), PNIT(16), GRO 40
$PNITF(16), RAN(76), TTN(16), D(16,4), GA(16,4), OBSHTS(2,31), GRO 45
$ TARESD(16), TA(16,4), VA(16,4) GRO 50
DIMENSION D56(16), D76(16), DC56(16), DC76(16), G56(16), G76(16), GRO 55
$GC56(16), GC76(16), VA56(16), VA456(16), VA76(16), VA476(16), GRO 60
$ VAA56(16), VAA456(16), VAA76(16), VAA476(16), VAC56(16), VAC456 GRO 65
$(16), VAC76(16), VAC476(16), SVC456(16), SVC476(16) GRO 70
COMMON AGE,AGEF,AGET,AHARR,AHARV,ARG,ASYMP,BAB,BAC,BAPA,CAI,CT1,D,GRO 75
$DDMRT,DLIM,DMTMIN,DNOW,DR,FCTA,FERTEF,FNLBS,GA,GRESD,H40,HAT,HPCT,GRO 80
$HS,HTHARV,HY40,ICT1,IDR,IOBS,IORG,IPAGE,IQ,IRD,ITHN,ITITLE,IUT,IZ,GRO 85
$JRD,LINE,LIUT,LTREE,NRA,OBSAGE,OBSHTS,TARESD,PCT,PCTA,PNIT,PNITF, GRO 90
$RAN,SAGE,SBA,SCUTVA,SDIA,SGMORT,SI,SNMORT,STA,SVMORT,TA,TTN,VA, GRO 95
$VGNOW,VNOW,XMAI16,XMAI56,XMAI76,XNUM,XNUMR,ISTOP,RATMAI, GRO 100
$rdasymp,isv
COMMON D56,D76,DC56,DC76,G56,G76,GC56,GC76,VA56,VA456,VA76,VA476, GRO 105
$VAA56,VAA456,VAA76,VAA476,VAC56,VAC456,VAC76,VAC476,SVC456,SVC476 GRO 110
COMMON CTAS,DC,DH,EXIST,FCT,FERTAS,FERTCT,FIH,IHEAD,FIY,GCLIM,GLIMGRO 115
$,HFCT,IGS,IMV,NCT,SCTHT,SCUT45,SCUT47,SCUTBA,SCUTTA,TAST,TI,AGEADDGRO 120
COMMON/EMORT/MORTE(16,4),DMORT,GMORT,TAMORT,VMORTE
COMMON /CHAR/ CTITLE,vers
CHARACTER CTITLE*80,vers*8
REAL MORTE
INTEGER CTAS,EXIST,FERTAS,FERTCT,SCTHT GRO 125
C GRO 130
C ************ DEFINITION OF IMPORTANT GROWTH VARIABLES *********** GRO 135
C GRO 140
C A12 = BREAST HEIGHT STAND AGE AT END OF GROWTH PERIOD GRO 145
C A14 = BREAST HEIGHT STAND AGE AT MIDPOINT OF GROWTH PERIOD GRO 150
C AGE = BREAST HEIGHT STAND AGE GRO 155
C AGEADD = LENGTH OF GROWTH PERIOD GRO 160
C AGECK = TOTAL STAND AGE GRO 165
C AGENXT = BREAST HEIGHT STAND AGE AT END OF 2 GROWTH PERIODS, GRO 170
C EACH PERIOD OF LENGTH AGEADD GRO 175
C BAB = BASAL AREA PER ACRE BEFORE MOST RECENT THINNING GRO 180
C BAC = BASAL AREA PER ACRE CUT MOST RECENT THINNING GRO 185
C BAGADD = BASAL AREA PER ACRE GROSS (NET + MORTALITY) INCREMENT GRO 190
C BALIM = MINIMUM BASAL AREA PER ACRE MORTALITY GRO 195
C BANADD = BASAL AREA PER ACRE NET INCREMENT GRO 200
C BAPA = BASAL AREA PER ACRE GRO 205
C CAI = CUBIC-FOOT VOLUME (TOTAL STEM) PER ACRE NET CURRENT GRO 210
C ANNUAL INCREMENT GRO 215
C D12 = ESTIMATE OF QUADRATIC MEAN STAND DIAMETER AT END OF GRO 220
C GROWTH PERIOD GRO 225
C D14 = ESTIMATE OF QUADRATIC MEAN STAND DIAMETER AT MIDPOINT GRO 230
C OF GROWTH PERIOD GRO 235
C DADD = QUADRATIC MEAN STAND DIAMETER NET INCREMENT GRO 240
c db4 = Quadratic mean stand diameter at end previous growth
c period
c dinc1 = Quadratic mean stand diameter net increment last growth
c period
c dinc2 = Quadratic mean stand diameter net increment current
c growth period
C DMORT = QUADRATIC MEAN DIAMETER MORTALITY GRO 245
C DMR = RATIO OF MORTALITY QUADRATIC MEAN DIAMETER TO LIVE STAND GRO 250
C QUADRATIC MEAN STAND DIAMETER AT END OF GROWTH GRO 255
C PERIOD GRO 260
C DMTLL = LOWER LIMIT QUADRATIC MEAN DIAMETER OF MORTALITY FOR LOW GRO 265
C DENSITY STANDS GRO 270
C DMTMIN = MINIMUM QUADRATIC MEAN DIAMETER OF MORTALITY GRO 275
C DNEXT = ESTIMATE OF QUADRATIC MEAN STAND DIAMETER AT END OF GRO 280
C GROWTH PERIOD GRO 285
C DNOW = QUADRATIC MEAN STAND DIAMETER GRO 290
C G12 = ESTIMATE OF BASAL AREA PER ACRE AT END OF GROWTH PERIOD GRO 295
C G14 = ESTIMATE OF BASAL AREA PER ACRE AT MIDPOINT OF GROWTH GRO 300
C PERIOD GRO 305
c gb4 = Basal area per acre at end previous growth period
C GEST = ESTIMATE OF BASAL AREA PER ACRE AT END OF GROWTH PERIOD GRO 310
C GESTT = GROSS (NET + MORTALITY) BASAL AREA PER ACRE AT END OF GRO 315
C GROWTH PERIOD GRO 320
c ginc1 = Basal area per acre net increment last growth period.
c ginc2 = Basal area per acre net increment current growth period.
C GMORT = ESTIMATE OF MORTALITY BASAL AREA PER ACRE GRO 325
C H12 = STAND TOP HEIGHT AT END OF GROWTH PERIOD GRO 330
C H14 = STAND TOP HEIGHT AT MIDPOINT OF GROWTH PERIOD GRO 335
C HAT = STAND TOP HEIGHT AFTER MOST RECENT THINNING GRO 340
C HEST = STAND TOP HEIGHT AT END OF GROWTH PERIOD GRO 345
C HS = STAND TOP HEIGHT GRO 350
C HTADD = STAND TOP HEIGHT INCREMENT GRO 355
C HTL = LOREY'S HEIGHT GRO 360
C HTONE = STAND TOP HEIGHT INCREMENT FOR 1/AGEADD-GROWTH PERIODS GRO 365
C IQ = INDEX FOR REPORT AGES ARRAY GRO 370
C IZ = INDEX FOR PLANTATION AND THINNING DECAY ARRAYS GRO 375
c rd1st = Relative density at BH age 84
c rdb4 = Relative density at end previous growth period
C SAGE = EXISTING STAND TOTAL STAND AGE GRO 380
C SGMORT = CUMULATIVE SUM OF BASAL AREA PER ACRE MORTALITY GRO 385
C SI = SITE INDEX (50-YEAR B H BASE AGE) GRO 390
C SNMORT = CUMULATIVE SUM OF NUMBER OF TREES PER ACRE MORTALITY GRO 395
C SVMORT = CUMULATIVE SUM OF CUBIC-FOOT VOLUME (TOTAL STEM) PER GRO 400
C ACRE MORTALITY GRO 405
C TAMORT = ESTIMATE OF NUMBER OF TREES PER ACRE MORTALITY GRO 410
C TANEXT = ESTIMATE OF NUMBER LIVE TREES PER ACRE AT END OF GROWTH GRO 415
C PERIOD GRO 420
C VEST = ESTIMATE OF CUBIC-FOOT VOLUME (TOTAL STEM) PER ACRE GRO 425
C AT END OF GROWTH PERIOD GRO 430
C VESTT = GROSS (NET + MORTALITY) CUBIC-FOOT VOLUME (TOTAL STEM) GRO 435
C PER ACRE AT END OF GROWTH PERIOD GRO 440
C VGNOW = CUBIC-FOOT VOLUME (TOTAL STEM) / BASAL AREA RATIO FOR GRO 445
C LIVE TREES GRO 450
C VMORTE = CUBIC-FOOT VOLUME (TOTAL STEM) PER ACRE GRO 455
C MORTALITY TREES GRO 460
C VNOW = CUBIC-FOOT VOLUME (TOTAL STEM) PER ACRE GRO 465
C VOLGR = CUBIC-FOOT VOLUME (TOTAL STEM) PER ACRE GROSS (NET + GRO 470
C MORTALITY) INCREMENT GRO 475
C VOLNT = CUBIC-FOOT VOLUME (TOTAL STEM) PER ACRE NET INCREMENT GRO 480
C VSAVE = CUBIC-FOOT VOLUME (TOTAL STEM) PER ACRE AT BEGINNING OF GRO 485
C GROWTH PERIOD GRO 490
C XMAI16 = CUBIC-FOOT VOLUME (TOTAL STEM) PER ACRE NET MEAN GRO 495
C ANNUAL INCREMENT IN TREES 1.6-INCHES + DBH GRO 500
C XMAI56 = CUBIC-FOOT VOLUME (4-INCH TOP) PER ACRE NET MEAN ANNUAL GRO 505
C INCREMENT IN TREES 5.6-INCHES + DBH GRO 510
C XMAI76 = CUBIC-FOOT VOLUME (4-INCH TOP) PER ACRE NET MEAN ANNUAL GRO 515
C INCREMENT IN TREES 7.6-INCHES + DBH GRO 520
C XNUM = NUMBER OF LIVE TREES PER ACRE GRO 525
C ***************************************************************** GRO 530
C GRO 535
C EEEEEEEEEE
C SEE SUBROUTINE ECON FOR DEFINITIONS OF IMPORTANT ECONOMICS VARIABLES
C EEEEEEEEEE
C
if (age.gt.83.0) dinc1 = dadd
if (age.gt.83.0) ginc1 = banadd
if (age.eq.83.0) rd1st = bapa/sqrt(dnow)
if (age.eq.83.0) rdslope = rd1st - rdb4
rdb4 = bapa/sqrt(dnow)
IF (BAB.LE.0.0) BAB = BAPA GRO 540
IF (IZ.LE.1) BALIM = 0.0 GRO 545
I = IZ GRO 550