Content-Id: <Pine.LNX.4.63.0807281221500.2942@ajax.its.yale.edu>
10 ' biow602.bas
20 ' to calculate living biomass, corrects for dbh 9.5 - 9.9 problem by
30 ' doubling count for trees 10.0 to 10.4 dbh.
40 DIM OTHER(16) , XFILE$(4,2) , SP$(17) , SPP$(17)
50 XFILE$(1,1)="biomassl.ten" : XFILE$(1,2)="byplotl.ten"
60 XFILE$(2,1)="biomassd.ten" : XFILE$(2,2)="byplotd.ten"
70 XFILE$(3,1)="biomassl.two" : XFILE$(3,2)="byplotl.two"
80 XFILE$(4,1)="biomassd.two" : XFILE$(4,2)="byplotd.two"
90 DIM PV(14,9,2,3), HT(14,3,3), MASS(15,10,11), NPLOT(10), PLTCT(10)
100 SP$(1)="ACSA":SP$(2)="FAGR":SP$(3)="BEAL":SP$(4)="FRAM":SP$(5)="ACSP"
110 SP$(6)="ACPE":SP$(7)="PRPE":SP$(8)="PRVI":SP$(9)="ABBA":SP$(10)="PIRU"
120 SP$(11)="BEPA":SP$(12)="SOAM":SP$(13)="ACRU":SP$(14)="TSCA":SP$(15)="TOTL"
125 SP$(16)= "POTR":SP$(17)="PRSE"
130 SPP$(1)="sm":SPP$(2)="be":SPP$(3)="yb":SPP$(4)="ash":SPP$(5)="Mtm"
140 SPP$(6)="stm":SPP$(7)="pc":SPP$(8)="cc":SPP$(9)="fir":SPP$(10)="sp"
150 SPP$(11)="wb":SPP$(12)="Mta":SPP$(13)="rm":SPP$(14)="hem":SPP$(15)="uk"
155 SPP$(16)="ta":SPP$(17)="bc"
160 '
170 DIM SAPHT$(3) : SAPHT$(1)="Sapwood by eq ="  : SAPHT$(2)="heartwood by eq="
180 SAPHT$(3)=" bole wood wt from bole wood eq ="
190 INPUT " Type  0 to run trees >10 cm or 1 to run 2-9 cm trees  ", TWO
200 INPUT " Type 0 for live trees and 45 for dead trees ",  DED
210 CLS
220 OPEN "pv65eq.dat" FOR INPUT AS #1
230 IF TWO = 0 AND DED = 0 THEN A$ = XFILE$(1,1) : B$=XFILE$(1,2) : PRINT " It thinks you are running live trees >= 10 cm dbh "
240 IF TWO = 0 AND DED = 45 THEN A$ = XFILE$(2,1)  : B$=XFILE$(2,2) : PRINT " It thinks you are running dead trees >= 10 cm dbh "
250 IF TWO = 1 AND DED = 0  THEN A$ = XFILE$(3,1) : B$=XFILE$(3,2) : PRINT " IT THINKS YOU ARE RUNNING LIVE TREES 2-9 CM DBH"
260 IF TWO = 1 AND DED = 45 THEN A$= XFILE$(4,1) : B$=XFILE$(4,2)  : PRINT " It thinks you are running dead trees 2-9 cm dbh "
270 '
280 PRINT "Assigned output files watershed summaries and data by species by plot = "
290 PRINT
300 PRINT "Files are respectively = ";  A$; "  "; B$
310 OPEN   A$   FOR OUTPUT AS #2
320 OPEN   B$   FOR OUTPUT AS #3
330 PRINT " Press F5 to continue " : STOP
340 '
350 FOR M = 1 TO 3
360 LINE INPUT #1, TITLE1$ : PRINT TITLE1$
370 LINE INPUT #1, TITLE1$ : PRINT TITLE1$
380 INPUT #1, NSP, NVARB
390 PRINT NSP; NVARB
400 INPUT #1, TITLE$ : PRINT TITLE$
410 FOR I = 1 TO 14
420 FOR J = 1 TO 2
430 INPUT #1, SP
440 PRINT SP;
450 FOR K = 1 TO 2
460 INPUT #1, PV(I,K,J,M)
470 '
480 PRINT USING " ##.####"; PV(I,K,J,M);
490 NEXT K
500 PRINT
510 NEXT J
520 FOR J = 1 TO 2
530 INPUT #1, SP
540 PRINT SP;
550 FOR K = 3 TO 9
560 INPUT #1, PV(I,K,J,M)
570 PRINT USING " ##.####"; PV(I,K,J,M);
580 NEXT K
590 LINE INPUT #1, REST$ : PRINT " "; REST$
600 NEXT J
610 NEXT I
620 NEXT M
630 CLOSE #1
640 OPEN "ht96eqw6.dat" FOR INPUT AS #1
650 FOR M = 1 TO 3
660 LINE  INPUT #1, TITLE$ : PRINT TITLE$
670 INPUT #1, NSP
680 FOR K = 1 TO 14
690 INPUT #1, SP
700 INPUT #1, HT(K,1,M), HT(K,2,M), HT(K,3,M)  : LINE INPUT #1, TITLE$
710 PRINT SP;
720 PRINT USING " ##.####"; HT(K,1,M); HT(K,2,M);HT(K,3,M);  : PRINT "  ";  TITLE$
730 NEXT K
740   STOP
750 NEXT M
760 CLOSE #1
770 '
780   OPEN "w602.dat" FOR INPUT AS #1
790 LINE INPUT #1, TITLE2$ : PRINT TITLE2$
800   INPUT #1, PLOT, CD, ICE, LONG : PRINT " Starting plot = "; PLOT; CD; ICE, LONG
805 NNN = NNN + 1
810 ' STOP
820 '
830            IF PLOT = 0 THEN GOTO 2710
840 TEST = 0
850 IF CD = 3 THEN CD = 2
860 IF CD = 5 THEN CD = 4
870 TOTWT = 0 : TT = 0
880 TOTD = 0
890 ROOTS=0
900 F = CD
910 F = F + 3
920 IF CD > 1 THEN TT = 9
930 NPLOT(F) = NPLOT(F) + 1
940 NPLOT(10) = NPLOT(10) + 1
950           PRINT " Plot = "; PLOT; " Fifth code + 3 = "; F
960           T = 2
970           IF PLOT < 87 THEN T = 1
980           IF PLOT > 158 THEN T = 3
990           NPLOT(T) = NPLOT(T) + 1
1000           NPLOT(TT) = NPLOT(TT) + 1
1010           PLTCT(T) = PLTCT(T) + 1
1020           PLTCT(TT) = PLTCT(TT) + 1
1030           PLTCT(10) = PLTCT(10) + 1
1040           PLTCT(F) = PLTCT(F) + 1
1050 '
1060 N = 1
1070 INPUT #1 , SP1$
1080 ' PRINT PLOT; SP1$
1090 IF SP1$ = "0" THEN GOTO 2510
1100 FOR SP = 1 TO 17
1110 IF SPP$(SP) = SP1$ THEN GOTO 1140
1120 NEXT SP
1130 PRINT " Species not found = "; SP1$
1135 STOP
1140 '
1150 IF SP > 14 THEN SP = 1   ' makes unknown snags, black cherry and aspens into sugar maples
1160 INPUT #1, TAG
1170 IF TAG < 0 THEN N = TAG*(-1)
1180 FOR K = 1 TO N
1190 IF N > 1 THEN INPUT #1, TAG
1200 INPUT #1,      ICEE, DBH, VIG
1210 INPUT #1, REST$
1215 'IF REST$ <> "z" THEN PRINT REST$ : STOP
1220 '
1230 '
1240 IF SP > 14 THEN SP = 1  '  for dead only make > 15 = sugar maple
1250 '
1260  PRINT PLOT; SP1$; TAG; DBH; VIG; REST$
1263 IF DBH > 70 OR DBH < 0 THEN STOP
1264 IF PLOT > 208 THEN STOP
1265 IF NNN <> PLOT THEN STOP
1270 ' STOP
1280 ' This run is for all species the same as noted on line above
1290 ' INPUT #1, TAG, DBH, VIG
1300 '
1310 ' INPUT #1, DBH
1320 'IF DBH = 0 THEN GOTO 1020
1330 ' INPUT #1, VIG
1340 ' A = 15.1267 : B = .0022
1350 ' IF SP = 1 THEN   A = 21.3238 : B = .0008
1360 ' IF SP = 2 THEN   A = 15.1268 : B = .0022
1370 ' IF SP = 3 THEN   A = 17.1521 : B = .0008
1380 ' IF SP = 9 THEN    B = .028676
1390 ' IF SP = 10 THEN   B = .01305
1400 ' IF SP = 11 THEN  A = 16.6154  : B = .0013
1410 C = 1
1420 IF TWO = 1 AND  DBH >= 2  AND DBH <  2.5 THEN C = 2
1430 IF TWO = 0 AND  DBH >= 10 AND DBH < 10.5 THEN C = 2
1440 IF TWO = 1 AND DBH >= 9.5 THEN GOTO 1560
1450  '  DIA = DBH
1460   ' BA = ((DIA/2)^2)*3.14159
1470   '     IF SP = 9 OR SP = 10 THEN Y =  B*BA
1480  '      IF SP = 9 OR SP = 10 THEN GOTO 1500
1490  '  Y = A * (1 - 2.71^(-B*BA))
1500  '  BAX = BA - Y
1510  '  R = SQR(BAX/3.14159)
1520 ' PRINT " Old dbh = "; DBH
1530 '  DBH = DIA - (DIA-R*2)
1540  ' PRINT " New dbh = "; DBH
1550 ' IF SP = 15 AND VIG > 3 THEN PRINT PLOT; SP; DBH; VIG : STOP
1560 '
1570 IF TWO = 0 AND  DBH <  10   THEN GOTO 2450
1580 IF TWO = 1 AND  DBH >= 9.5   THEN GOTO 2450
1590 '
1600 IF DED = 0 AND  VIG  > 3 THEN GOTO 2450
1610 IF DED = 45 AND  VIG < 4 THEN GOTO 2450
1620 '
1630 'C = 1
1640 'IF TWO = 1 AND  DBH >= 2  AND DBH <  2.6 THEN C = 2
1650 'IF TWO = 0 AND  DBH >= 10 AND DBH < 10.6 THEN C = 2
1660 '
1670 FACTOR = 1
1680 IF TWO = 1 THEN FACTOR = (25*25)/(LONG*3)
1690 '
1700 IF C = 2 THEN PRINT SP; DBH; VIG
1710 IF SP <> 9 THEN GOTO 1760          ' special case for fit - linear
1720 HTT = HT(SP,1,T) + HT(SP,2,T)*DBH
1730 IF HTT > 20 THEN PRINT " plot, fir, dbh, ht ="; PLOT; DBH; HTT  : STOP
1740 GOTO 1780
1750 '
1760  HT1 = HT(SP,2,T)*(1-2.718^-(HT(SP,3,T)*DBH))
1770  HTT = HT(SP,1,T) + HT1
1780 IF HTT > 30 THEN  PRINT SP; DBH; HT1; HT2; HTT : STOP
1790 '
1800 IF HTT > 30 OR HTT < 1.37 THEN PRINT PLOT; SP; DBH; HTT: STOP
1810 HTT =  HTT*100
1820 PV = .5* 3.14159 * ((DBH/2)^2) * HTT
1830 FOR J = 1 TO 9
1840 WTLOG = PV(SP,J,1,T) + PV(SP,J,2,T)*(LOG(PV)/LOG(10))
1850 WT = ((10^WTLOG)/1000000!) * C * FACTOR
1860 ' IF J > 2 AND J < 9 THEN TOTWT = TOTWT + WT : OTHER(SP)=OTHER(SP) + WT
1870 'IF J < 4 AND DBH > 30 THEN PRINT  SP; J; SAPHT$(J); WT
1880 IF J < 3  THEN AA = AA + WT
1890 'IF J = 3 AND DBH > 30 THEN PRINT USING "##.#### "; AA; AA-WT; (AA/WT)*100
1900 IF J = 2  THEN SAP = AA - WT : HW = WT
1910 'IF J = 2 AND DBH > 30 THEN PRINT USING "##.#### "; SAP; HW
1920 IF J = 2 THEN SAPP=  SAP/AA     : HWW=  HW/AA
1930 'IF J = 2 AND DBH > 30 THEN PRINT USING "###.## "; SAPP; HWW
1940 IF J = 3 THEN SAPWOOD = WT*SAPP     : HEART = WT*HWW
1950 'IF J = 3 AND DBH > 30 THEN PRINT " wt of all bole wood = "; WT
1960 'IF J = 3 AND DBH > 30 THEN PRINT " wt of sapwood = "; SAPWOOD
1970 'IF J = 3 AND DBH > 30 THEN PRINT " wt of heartwood ="; HEART
1980 'IF J = 3 AND DBH > 30 THEN PRINT " % sap and % heart = "; SAPP*100; HWW*100
1990 'IF J = 3 AND DBH > 30 THEN PRINT
2000 IF J = 3 THEN AA=0
2010 FACT = 1
2020 DWOOD = 1
2030 IF DED = 0 THEN GOTO 2180
2040 FACT = 0
2050 '
2060 IF VIG = 4 THEN WT = WT * .7283 : DWOOD = .7283
2070 IF VIG = 5 THEN WT = WT * .5683 : DWOOD = .5683*.666
2080 '
2090 IF VIG = 5 THEN GOTO 2140
2100 IF J < 5 THEN FACT = 1
2110 IF J = 5 THEN FACT = .333
2120 IF J = 8 THEN FACT = .333
2130 GOTO 2180
2140 IF J = 3 THEN FACT = .666
2150 IF J = 4 THEN FACT = .5
2160 IF J = 8 THEN FACT = .25
2170 ' note that in these summaries the "wood" is based on the total eq not
2180 ' the sum of the sap + heart wood equations
2190 ' IF J = 1 THEN wt = hw
2200   IF J < 3 THEN GOTO 2270
2210 MASS(SP,J,T) = MASS(SP,J,T) + WT*FACT
2220 MASS(SP,J,TT) = MASS(SP,J,TT) + WT*FACT
2230 MASS(SP,J,F) = MASS(SP,J,F) + WT*FACT
2240 MASS(SP,J,10) = MASS(SP,J,10) + WT*FACT
2250 IF J > 2 AND J < 9 THEN TOTD = TOTD + WT*FACT
2260 IF J = 8           THEN ROOTS= ROOTS+ WT*FACT
2270 IF J = 9 THEN GOTO 2440
2280 IF J < 3 THEN GOTO 2440
2290 IF J > 2 AND J < 9 THEN TOTWT = TOTWT + WT*FACT : OTHER(SP)=OTHER(SP) + WT*FACT
2300 MASS(SP,10,T) = MASS(SP,10,T) + WT*FACT
2310 MASS(SP,10,TT) = MASS(SP,10,TT) + WT*FACT
2320 MASS(SP,10,F) = MASS(SP,10,F) + WT*FACT
2330 MASS(SP,10,10) = MASS(SP,10,10) + WT*FACT
2340 IF J > 2 AND J < 9 THEN TOTD = TOTD + WT*FACT
2350 IF J = 8           THEN ROOTS= ROOTS + WT*FACT
2360 IF J = 3 THEN MASS(SP,1,T) = MASS(SP,1,T) + SAPWOOD*DWOOD
2370 IF J = 3 THEN MASS(SP,1,TT) = MASS(SP,1,TT) + SAPWOOD*DWOOD
2380 IF J = 3 THEN MASS(SP,2,T) = MASS(SP,2,T) + HEART*DWOOD
2390 IF J = 3 THEN MASS(SP,2,TT) = MASS(SP,2,TT) + HEART*DWOOD
2400 IF J = 3 THEN MASS(SP,1,F) = MASS(SP,1,F) + SAPWOOD*DWOOD
2410 IF J = 3 THEN MASS(SP,2,F) = MASS(SP,2,F) + HEART*DWOOD
2420 IF J = 3 THEN MASS(SP,1,10) = MASS(SP,1,10) + SAPWOOD*DWOOD
2430 IF J = 3 THEN MASS(SP,2,10) = MASS(SP,2,10) + HEART*DWOOD
2440 NEXT J
2450 '
2455 IF TEST = 1 THEN GOTO 2470
2460 NEXT K
2470 '
2480 IF TEST = 1 THEN GOTO 2570
2490 GOTO 1050
2500 ' PRINT
2510 '
2520 IF TEST = 0 THEN INPUT #1, XYZ : TEST = 1
2530 'INPUT #1, XYZ
2540 '  STOP
2550 INPUT #1, SP
2560 IF SP = 0 THEN GOTO 2640
2570 INPUT #1, DBH
2580 IF DBH < 0 THEN GOTO 2570   '   disregards multiple stems for small trees
2590 IF DBH = 0 THEN GOTO 2550
2600 INPUT #1, VIG
2610 IF TWO = 1 THEN  PRINT " Small="; PLOT; SP; DBH; VIG
2620 IF TWO = 1 THEN GOTO 1410
2630 GOTO 2570
2640 TSUM=OTHER(4)*16+OTHER(5)*16+OTHER(6)*16+OTHER(7)*16+OTHER(8)*16+OTHER(12)*16+OTHER(13)*16+OTHER(14)*16
2650   PRINT PLOT; CD; : PRINT USING " ###.##";  OTHER(1)*16; OTHER(2)*16; OTHER(3)*16; OTHER(9)*16; OTHER(10)*16; OTHER(11)*16; TSUM;  TOTWT*16
2660   PRINT #3, PLOT; CD; : PRINT #3, USING " ###.##";  OTHER(1)*16; OTHER(2)*16; OTHER(3)*16; OTHER(9)*16; OTHER(10)*16; OTHER(11)*16; TSUM;  TOTWT*16
2670  '
2680 FOR MM = 1 TO 15 : OTHER(MM) = 0 : NEXT MM
2690 ' STOP
2700 GOTO 800
2710 FOR T = 1 TO 10
2720 XXX = 1
2730 IF TWO = 0 THEN GOTO 2770
2740    XXX = PLTCT(T)/NPLOT(T)
2750 PRINT " Number of small plots = "; PLTCT(T)
2760 STOP
2770 FFF = (NPLOT(T)/16)*XXX
2780 PRINT " Watershed unit = "; T
2790 PRINT #2, " Watershed unit = "; T
2800 PRINT TITLE2$
2810 PRINT #2, TITLE2$
2820 PRINT     " Summary of biomass by plant part and species "
2830 PRINT #2, " Summary of biomass by plant part and species "
2840 IF DED = 0 THEN PRINT #2, " Live trees ";
2850 IF DED = 0 THEN PRINT " Live trees ";
2860 IF DED = 45 THEN PRINT #2, " Dead trees ";
2870 IF DED = 45 THEN PRINT " Dead trees ";
2880 IF TWO = 1 THEN PRINT #2, " Trees >= 1.5  and < 9.5 cm dbh "
2890 IF TWO = 1 THEN PRINT " Trees >= 1.5  and < 9.5 cm dbh "
2900 IF TWO = 0 THEN PRINT #2, " Trees >= 9.5 cm dbh "
2910 IF TWO = 0 THEN PRINT " Trees >= 9.5  cm dbh "
2920 PRINT " Sp. SW   HW  WW     bark   branch   br.dead   leaf/tw   root   total  sum"
2930 PRINT #2, " Sp.  SW  HW  WW     bark   branch   br.dead   leaf/tw   root   total  sum"
2940 FOR I = 1 TO 15
2950 PRINT SP$(I);
2960 PRINT #2, SP$(I);
2970 FOR K = 1 TO 10
2980 PRINT     USING " ###.##"; MASS(I,K,T)/FFF;
2990 PRINT #2, USING " ###.##"; MASS(I,K,T)/FFF;
3000 MASS(15,K,T) = MASS(15,K,T) + MASS(I,K,T)
3010 NEXT K
3020 PRINT
3030 PRINT #2,
3040 NEXT I
3050 PRINT NPLOT(T);  " = Number of plots   "
3060 PRINT #2, NPLOT(T); " = Number of plots   "
3070 PRINT     : PRINT
3080 PRINT #2, : PRINT #2,
3090   STOP
3100 NEXT T
