Option Strict Off Option Explicit On Friend Class Form_meta Inherits System.Windows.Forms.Form Public objExcel As Microsoft.Office.Interop.Excel.Application Public objWorkbook As Microsoft.Office.Interop.Excel.Workbook Public objWorksheet As Microsoft.Office.Interop.Excel.Worksheet Public CostToGo(10, 1700, 2) As Single 'CostToGo(pricebreak,state,2) Public BARem_Split As Single Public RATIO As Single Public state_change(1700) As Integer 'state_change(states) Public MAXFUTNET(13) As Single 'MAXFUTNET(treatment) Public VOLUMES(1700, 48, 1123) As Single 'VOLUMES(states, decision, 659) Public Xmatrix(5, 1080, 21) As Single 'Xmatrix(treatments, states, terms) Public Xtransp(5, 21, 1080) As Single 'Xtransp(treatments, terms, states) Public XtranspX(5, 21, 21) As Single 'XtranspX(treatments, terms, terms) Public indx(13) As Single 'indx(treatments) Public indx_sum(6) As Single 'indx_sum(treatments) - sums up the number of states and acts as a pointer for States() Public Amatrix(5, 1080, 2160) As Single 'Amatrix(treatment, states, states*2) Public Atransp(5, 1080, 1080) As Single 'Amatrix(treatment, states, states) Public AtranspA(5, 1080, 2160) As Single ' AtranspA (treatment, states, states*2) Public Ymatrix(10, 5, 1080) As Single 'Ymatrix(curpricebrk, treatments, states) Public Tmatrix(1700, 48, 1080) As Single 'Tmatrix(state, decision, states) Public Tvalue(1500) As Single ' Tvalue(states for one treatment type) Public Weights(10, 5, 1080) As Single 'Weights(curpricebrk, treatment, states) Public Cmatrix(5, 1080, 1080) As Single 'Cmatrix(treatments, states, states) Public Bmatrix(10, 5, 21) As Single 'Bmatrix(curpricebrk, treatment, terms) Public decis(13, 48) As Single 'decis(treatments including regen, decision) Public States(2000, 6) As Single 'States(state, state variables + treatment) Public term(5) As Object 'term(treatment) Public TempCTG(2000, 10, 1700) As Single 'TempCTG(itercount,10,states) Public CTG(10, 13, 22, 5) As Single 'CTG(futurepricebrk, treatments, ages, density or stocking) Public Cval(5) As Single 'C(treatment) Public no_variabl(5) As Single 'number of state variables for different treatment types Public Sheet_names(5) As String 'Sheet_names(treatment) Public priceprob(10, 10) As Single 'priceprob(curpricebrk, futpricebrk) Public Prices(2, 10, 2) As Single 'Prices(species, #pricebreaks, MERVOL/BRDVOL) Public Probs(2160, 4) As Single 'Probs(states, probabilities of succumbing or not) Public DIAMETERS(3, 21, 2) As Single 'DIAMETERS(3 diam sizes, ages, species) Public BASAL_AREAS(3, 21, 2) As Single 'BASAL_AREAS(3 diam sizes, ages, species) Public TempDecision(10, 1700) As Integer 'TempDecision (pricebreak,states) temporary decision for comparison Public GNY_CTG(10) As Single Public TRT_FIT(3) As Single Public Dist(1080) As Single Public Dist_rank(1080) As Single Public MAX_STATE_VALUE(5, 5) As Single 'MAX_STATE_VALUE(TRT, VARIABLE) Public CTG_bound(1700, 48, 32) As Single 'CTG(bound(state,decision,32 closest states) Public state_status(1080, 2) As Single 'state_status(state,status or distance) Public status_min_distance(32, 2) As Single 'state_status(state,status or distance) Public MAXDIST, AHGT_H, DHGT_H, j, max_distance, max_CTG, min_CTG, num_weight, NEWAGE2, NEWDIAM_S2 As Single Public Eval, DIAM_H, BA_S, DIAM_S, DHGT_S, BA_H, AHGT_S, Avg_diam, NEWDIAM_H2, NEWPCT_S2 As Single Public BRDFREQ_S, MERDIAM_S, TFREQ_S, MERBA_S, MERFREQ_S, BRDBA_S, Cvalue, NEWCC2 As Single Public BRDBA_H, MERFREQ_H, MERBA_H, TFREQ_H, MERDIAM_H, BRDFREQ_H, MAX1, MAX2, MAX3, MAX4, MAX5 As Single Public MERVOL_S, BRDHGT_S, BRDDIAM_S, MERHGT_S, Stock, BRDVOL_S, cost_nat_regen As Single Public BRDVOL_H, BRDHGT_H, BRDDIAM_H, MERHGT_H, MERVOL_H, STOCKING, fill_plant_cost As Single Public NEWBA_H, NEWDIAM_S, NEWBA_S, NEWDIAM_H, COST, min_distance, ct_flat_cost As Single Public pricebreaks, itercount, TRT, z, THINTYP, SPECIES, State, decision, count_limit As Integer Public curpricebrk, RBF, NO_TRT, NEWTRT, i, status, pointer, ChangeCount As Integer Public SI_SW, HARVPRICE, plantcost_lt2500, plantcost_mt2500, SI_HW, BigM, CTG_value, difference, lower_error As Single Public SPACP_S, PCTPRICE, MINHGT_H, MINHGT_S, MAXHGT_PCT, BARem, SPAC_H, upper_error As Single Public CC, Initial_density, count_dec, PCT_S, PCT_H, Initial_PCT_S, AGE, Fraction_S As Single Public NEWAGE, NEWPCT_S, NEWSTOCKING, NEWCC, NO_NAT_STATES, NEWDENSITY As Single Public Regen_SW_perct As Single 'fraction of stand covered with softwood Public B20, B19, B18, B17, B16, B15, B14, B13, B12, B11, B10, B9, B8, B7 As Single Public B6, B5, B4, B3, B2, B1, B0, maxDiff, min_value, max_value As Single Public jjjjj, jjjj, jjj, jj, no_states, distance, minDiff, Temporary_BA_S, Temporary_BA_H As Single Public P, prNS, pr12, pr11, pr10, prSH, prSF, prIns, prHH, prHM, prHL, prFH, prFM, prFL As Single Public zzzzz, SumofDist, xx, VVVVV, N, TEMP1, rownumb, nn, m, pricebreak, k, kkkkk, kkkk As Single Public kkk, ProbInsects, Probhurraffects, Condprobhurr, Probhurr, Probfireburns, Condprobfire As Single Public size_fire, Probfire, prHighH, prMedH, prLowH, prHighF, prMedF, prLowF, interval_insect, area_wind As Single Public interval_hurr, number_fires, area_region, stdev2_H, stdev2_S, Price2_H, Price2_S, stdev1_H As Single Public stdev1_S, Price1_H, Price1_S, discountrate, totalnet, futurenet_12 As Single Public futurenet_11, futurenet_10, discount, Tempfutnet, FUTURENET, futpricebrk, TEMP, DENSITY As Single Public ECC, A, CURRENTNET, xxxx, curprice2_H, curprice1_H, curprice2_S, curprice1_S, zzzz, zzzzzz As Single Public SP_H, MAXN, MINN, MAXK, MINK, TEMPCC, START_AGE, NO_TREES_H, SD_H, TEMPBA_H, TEMPDIAM_H As Single Public TEMPBA_S, SD_S, D5IB, TMPBA, NO_TREES_S, DBHIB, FAGE_S, SP_S, TEMPDIAM_S, YTBH_H, SAGE_H As Single Public YTBH_S, SAGE_S, kk As Single Public NEWMAXTREES_H, NEWMAXTREES_S, Fraction_H, NEWBA_H_FULL, NEWBA_S_FULL, NEWMAX_TREES_H As Single Public NEWMAX_TREES_S, DIAMREM_H, BA_H_REM, DIAMREM_S, TREEBA_REMOVED, BA_S_REM, NEWTFREQ_S As Single Public NEWTFREQ_H, PCTCOST, CC_FACTOR, MAX_TREES_H, MAX_TREES_S, NEWTREE_BA_S, NEWTREE_BA_H As Single Public NEWAHGT_H, FAGE_H, NEWAHGT_S, NEWDHGT_S, NEWDHGT_H, TR, TYP, zzz, xxxxx, BA_S_FULL, MAXTREES_S As Single Public BA_H_FULL, MAXTREES_H, XXXXXX, zz, tmp, c, x, t, NormProb, state1, state2 As Single Public Approx_method As Object Public date1, date2 As Date Public dateint As Long Private Sub run_code_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles run_code.Click date1 = Date.Now NO_TRT = 5 'Number of treatment types in the model If Mult_Regr.Checked = False And Thin_plate.Checked = False And Quadric_0.Checked = False And Quadric_5.Checked = False And Inverse_quadric_mix.Checked = False And Inverse_quadric_5.Checked = False And Inverse_quadric_10.Checked = False And Inverse_quadric_15.Checked = False And Exponential_0001.Checked = False And Gaussian_01.Checked = False And DWI.Checked = False Then MsgBox("Please choose an approximation methodology before continuing.") GoTo 10001 End If Dialog_meta.Show() System.Windows.Forms.Application.DoEvents() 'Hide the form with all the user info Me.Hide() '--------------------------------------------------------------------------------------- 'Open Excel with all user info and wait for the user to check and confirm 'start of run Application() '-------------------------------------------------------------------------------- '*** INITIALIZE termES **** Initial() '-------------------------------------------------------------------------------- '*** CREATE STATES *** Create() 'Put all possible state decision combinations in an array before starting 'calculations of growth '---------------------------- ' Available treatment types ' 1 - Untreated natural ' 2 - pct natural ' 3 - Untreated plantation ' 4 - Treated plantation ' 5 - Treated natural ' 10 - Natural stand that hasn't regenerated for 1 period ' 11 - Natural stand that hasn't regenerated for 2 periods ' 12 - Natural stand that hasn't regenerated for 3 periods ' 13 - Natural stand that hasn't regenerated for 4 periods '---------------------------- Store() 'objExcel.Visible = False '------------------------------------------------------------------------------- ' Natural disasters ' ' Calculate the probability of succumbing to natural disasters ' of varying intensities Natural_Disasters() '------------------------------------------------------------------------------- '*** GNY PORTION OF PROGRAM *** 'This section will take all the states created above and grow them 5 years with all 'possible decisions and get the state that the stand will be in at the end of the 5 year 'period. The states created will be saved and used with the Value Iteration DP. GNY() objExcel.Visible = True '------------------------------------------------------------------------------- '*** CALCULATE CTG BOUNDS *** 'This section determines which states are in the neighbourhood surrounding the 'basis to be approximated : only for non-averager approximation architectures If DWI.Checked = False Then CTG_bounds() End If '------------------------------------------------------------------------------- '*** DO INITIAL APPROXIMATION OF CTG *** 'This section calculates an initial CTG value for each state. It is assumed that 'the minimum value for any stand is the value of the timber on the stand. Therefore, 'an initial CTG evaluation is done and these CTG values will be fit before the DP 'algorithm is launched. ' APPROX() '------------------------------------------------------------------------------- '*** CALCULATE WEIGHTS FOR DWI *** 'Calculate the weights associated with Distance Weighted Interpolation (if applicable) If DWI.Checked = True Then 'objExcel.Visible = True DWI_Weights() End If '------------------------------------------------------------------------------- '*** START DP (VALUE ITERATION) SECTION OF PROGRAM '**************************************************************************************** '* Dynamic Programming section '* '* Choose the highest CTG value for the applicable decisions at each state and current '* price break '* '**************************************************************************************** 'objWorksheet = objWorkbook.Worksheets("Basic") 'objWorksheet.Range("A50").Offset(0, 0)._Default = "State" 'objWorksheet.Range("A50").Offset(0, 1)._Default = "decision" 'objWorksheet.Range("A50").Offset(0, 2)._Default = "FUTURENET" 'objWorksheet.Range("A50").Offset(0, 3)._Default = "min_value" 'objWorksheet.Range("A50").Offset(0, 4)._Default = "max_value" count_limit = 0 itercount = 1 'Calculate the length of the set-up time in seconds date2 = Date.Now dateint = DateDiff(DateInterval.Second, date1, date2) objWorksheet = objWorkbook.Worksheets("Basic") With objWorksheet .Range("A45").Value = "Length of optimization in seconds" .Range("A45").Font.Bold = True .Range("A46").Value = dateint End With Startiters: For State = 1 To z TRT = States(State, 6) 'If itercount = 16 Then 'objExcel.Visible = True 'zzzz = 1 'End If For curpricebrk = 1 To pricebreaks TEMP = 0 CostToGo(curpricebrk, State, 1) = -0.001 CostToGo(curpricebrk, State, 2) = 0 curprice1_S = Prices(1, curpricebrk, 1) 'MERVOL prices softwood curprice1_H = Prices(1, curpricebrk, 2) 'BRDVOL prices softwood curprice2_S = Prices(2, curpricebrk, 1) 'MERVOL prices hardwood curprice2_H = Prices(2, curpricebrk, 2) 'BRDVOL prices hardwood For decision = 1 To 48 'If decision = 12 Then 'xxxx = 1 'End If If decis(TRT, decision) = 0 Then GoTo 21 ElseIf TRT = 1 And VOLUMES(State, decision, 1) = 1000 Then GoTo 21 End If ' Get CURRENTNET value or calculate it If TRT = 10 Or TRT = 11 Or TRT = 12 Or TRT = 13 Then 'new stand If decision = 1 Then CURRENTNET = 0 ElseIf decision = 4 Then CURRENTNET = -fill_plant_cost ElseIf decision = 5 Or decision = 6 Then CURRENTNET = -plantcost_lt2500 ElseIf decision = 7 Or decision = 8 Or decision = 9 Then CURRENTNET = -plantcost_mt2500 End If ElseIf TRT = 1 And decision = 1 Then CURRENTNET = 0 NEWTRT = 1 AGE = States(State, 1) If AGE < 95 Then NEWAGE = AGE + 5 STOCKING = States(State, 2) NEWSTOCKING = STOCKING Else NEWAGE = 1000 End If ElseIf TRT = 3 And decision = 2 Then CURRENTNET = 0 NEWTRT = 3 AGE = States(State, 1) If AGE < 95 Then NEWAGE = AGE + 5 DENSITY = States(State, 3) NEWDENSITY = DENSITY Else NEWAGE = 1000 End If Else MERVOL_S = VOLUMES(State, decision, 7) BRDVOL_S = VOLUMES(State, decision, 8) MERVOL_H = VOLUMES(State, decision, 9) BRDVOL_H = VOLUMES(State, decision, 10) COST = VOLUMES(State, decision, 11) CURRENTNET = curprice1_S * (MERVOL_S - BRDVOL_S) + curprice2_S * BRDVOL_S + curprice1_H * (MERVOL_H - BRDVOL_H) + curprice2_H * BRDVOL_H - COST NEWAGE = VOLUMES(State, decision, 1) NEWTRT = VOLUMES(State, decision, 6) If NEWTRT = 1 Then NEWSTOCKING = VOLUMES(State, decision, 2) ElseIf NEWTRT = 2 Then NEWDIAM_S = VOLUMES(State, decision, 2) NEWDIAM_H = VOLUMES(State, decision, 3) NEWPCT_S = VOLUMES(State, decision, 4) NEWCC = VOLUMES(State, decision, 5) ElseIf NEWTRT = 3 Then NEWDIAM_S = VOLUMES(State, decision, 2) NEWDENSITY = VOLUMES(State, decision, 3) ElseIf NEWTRT = 4 Then NEWDIAM_S = VOLUMES(State, decision, 2) NEWCC = VOLUMES(State, decision, 3) ElseIf NEWTRT = 5 Then NEWDIAM_S = VOLUMES(State, decision, 2) NEWDIAM_H = VOLUMES(State, decision, 3) NEWPCT_S = VOLUMES(State, decision, 4) NEWCC = VOLUMES(State, decision, 5) End If End If ' Calculate FUTURENET value If NEWAGE < 1000 Or (TRT = 10 Or TRT = 11 Or TRT = 12 Or TRT = 13) Then TEMP = 0 For futpricebrk = 1 To pricebreaks If TRT = 10 Or TRT = 11 Or TRT = 12 Or TRT = 13 Or NEWTRT = 10 Or NEWTRT = 11 Then NEWSTAND() ElseIf NEWTRT = 1 Then 'No fitting is done - value pulled from an array zz = NEWAGE / 5 zzz = (NEWSTOCKING - 0.5) / 0.25 FUTURENET = CTG(futpricebrk, 1, zz, zzz) ElseIf NEWTRT = 3 Then 'No fitting is done - value pulled from an array zz = NEWAGE / 5 zzz = (NEWDENSITY - 250) / 750 FUTURENET = CTG(futpricebrk, 3, zz, zzz) Else FUTUREVALUE() End If If FUTURENET < 0 Then FUTURENET = 0 End If Tempfutnet = FUTURENET NatDisast() TEMP = TEMP + (Tempfutnet * Probs(State, 4) + futurenet_10 + futurenet_11 + futurenet_12) * priceprob(curpricebrk, futpricebrk) Next futpricebrk totalnet = CURRENTNET + discount * TEMP 'If itercount = 300 And (State = 17 Or State = 18 Or State = 19 Or State = 20) Then 'count_limit = count_limit + 1 'objWorksheet.Range("a50").Offset(count_limit, 0)._Default = State 'objWorksheet.Range("a50").Offset(count_limit, 1)._Default = decision 'objWorksheet.Range("a50").Offset(count_limit, 2)._Default = CURRENTNET 'objWorksheet.Range("a50").Offset(count_limit, 3)._Default = TEMP 'objWorksheet.Range("a50").Offset(count_limit, 4)._Default = totalnet 'End If Else GoTo 21 ' This state/decision combo doesn't work End If If totalnet > CostToGo(curpricebrk, State, 1) Then CostToGo(curpricebrk, State, 1) = totalnet CostToGo(curpricebrk, State, 2) = decision 'best decision End If 21: Next decision If TRT = 10 Or TRT = 11 Or TRT = 12 Or TRT = 13 Then CTG(curpricebrk, TRT, 0, 0) = CostToGo(curpricebrk, State, 1) ElseIf TRT = 1 Then 'this value is saved in a array for TRT 1 to be retrieved later - no fitting is done zz = AGE / 5 zzz = (STOCKING - 0.5) / 0.25 CTG(curpricebrk, TRT, zz, zzz) = CostToGo(curpricebrk, State, 1) ElseIf TRT = 3 Then 'this value is saved in a array for TRT 3 to be retrieved later - no fitting is done zz = AGE / 5 zzz = (DENSITY - 250) / 750 CTG(curpricebrk, TRT, zz, zzz) = CostToGo(curpricebrk, State, 1) End If Next curpricebrk Next State 'END OF DP SECTION OF PROGRAM '--------------------------------------------------------------------------------- 'START OF THE APPROXIMATION SECTION OF THE PROGRAM 'The totalnet values calculated in the dynamic programming section are now used to 'calculate new values of the regression equation coefficients that will be used in 'the next iteration of the dynamic programming value iteration APPROX() 'THE NEXT SECTION CHECKS IF ANOTHER ITERATION WILL BE NECESSARY 'Print value of Bmatrix coefficients 'If itercount = 2 Then ' For i = 1 To 21 ' objWorksheet.Range("AD2").Offset(i - 1, 0) = Bmatrix(1, 2, i) ' Next i 'End If If itercount > 1 Then 'check every state to verify how much its Cost To Go function has changed - use all pricebreaks maxDiff = 0 minDiff = 1000000000 ChangeCount = 0 For i = 5 To z For j = 1 To pricebreaks zz = itercount - 1 TEMP = CostToGo(j, i, 1) - TempCTG(zz, j, i) TempCTG(itercount, j, i) = CostToGo(j, i, 1) If TEMP > maxDiff Then maxDiff = TEMP End If If TEMP < minDiff Then minDiff = TEMP End If zzz = CostToGo(j, i, 2) zzzz = TempDecision(j, i) If zzz <> zzzz Then ChangeCount = ChangeCount + 1 state_change(ChangeCount) = i End If TempDecision(j, i) = CostToGo(j, i, 2) Next j Next i End If lower_error = discount / (1 - discount) * minDiff upper_error = discount / (1 - discount) * maxDiff difference = upper_error - lower_error objWorksheet = objWorkbook.Worksheets("Basic") 'print current CostToGo value for a state objWorksheet.Range("M2").Offset(itercount, 0)._Default = itercount objWorksheet.Range("M2").Offset(itercount, 1)._Default = CostToGo(1, 23, 1) objWorksheet.Range("M2").Offset(itercount, 2)._Default = CostToGo(1, 23, 2) objWorksheet.Range("M2").Offset(itercount, 3)._Default = ChangeCount objWorksheet.Range("M2").Offset(itercount, 4)._Default = difference 'For i = 1 To ChangeCount 'objWorksheet.Range("M2").Offset(itercount, 5 + i)._Default = state_change(i) 'Next If (difference < 0.005 And itercount > 5) Or itercount > 2000 Then 'if the smallest difference of the Cost To Go function 'from the previous iteration to this iteration for all 'natural states is smaller than 0.1 and the number of 'iterations is greater than 5. Also if the number of iterations is greater than 100 '-------- Print results to spreadsheet ------------------------------------------ j = 0 jj = 0 jjj = 0 objWorksheet = objWorkbook.Worksheets("Decisiontrt1") For State = 1 To 4 j = j + 1 For curpricebrk = 1 To pricebreaks objWorksheet.Range("E56").Offset(j, curpricebrk - 1)._Default = CostToGo(curpricebrk, State, 2) objWorksheet.Range("E56").Offset(j, curpricebrk + pricebreaks + 1)._Default = CostToGo(curpricebrk, State, 1) Next curpricebrk Next State For State = 5 To z If States(State, 6) = 1 Then j = j + 1 ' Print best decision for all natural states objWorksheet = objWorkbook.Worksheets("Decisiontrt1") For curpricebrk = 1 To pricebreaks objWorksheet.Range("E56").Offset(j, curpricebrk - 1)._Default = CostToGo(curpricebrk, State, 2) objWorksheet.Range("E56").Offset(j, curpricebrk + pricebreaks + 1)._Default = CostToGo(curpricebrk, State, 1) Next curpricebrk ElseIf States(State, 6) = 2 Then jj = jj + 1 ' Print best decisions for all pre-commercially thinned states objWorksheet = objWorkbook.Worksheets("Decisiontrt2") For curpricebrk = 1 To pricebreaks objWorksheet.Range("H56").Offset(jj, curpricebrk - 1)._Default = CostToGo(curpricebrk, State, 2) objWorksheet.Range("H56").Offset(jj, curpricebrk + pricebreaks + 1)._Default = CostToGo(curpricebrk, State, 1) Next curpricebrk ElseIf States(State, 6) = 3 Then jjj = jjj + 1 ' Print best decisions for all untreated plantation stands objWorksheet = objWorkbook.Worksheets("Decisiontrt3") For curpricebrk = 1 To pricebreaks objWorksheet.Range("F56").Offset(jjj, curpricebrk - 1)._Default = CostToGo(curpricebrk, State, 2) objWorksheet.Range("F56").Offset(jjj, curpricebrk + pricebreaks + 1)._Default = CostToGo(curpricebrk, State, 1) Next curpricebrk ElseIf States(State, 6) = 4 Then jjjj = jjjj + 1 ' Print best decisions for all treated plantation stands objWorksheet = objWorkbook.Worksheets("Decisiontrt4") For curpricebrk = 1 To pricebreaks objWorksheet.Range("F56").Offset(jjjj, curpricebrk - 1)._Default = CostToGo(curpricebrk, State, 2) objWorksheet.Range("F56").Offset(jjjj, curpricebrk + pricebreaks + 1)._Default = CostToGo(curpricebrk, State, 1) Next curpricebrk ElseIf States(State, 6) = 5 Then jjjjj = jjjjj + 1 ' Print best decisions for all commercially thinned natural stands objWorksheet = objWorkbook.Worksheets("Decisiontrt5") For curpricebrk = 1 To pricebreaks objWorksheet.Range("H56").Offset(jjjjj, curpricebrk - 1)._Default = CostToGo(curpricebrk, State, 2) objWorksheet.Range("H56").Offset(jjjjj, curpricebrk + pricebreaks + 1)._Default = CostToGo(curpricebrk, State, 1) Next curpricebrk End If Next State If itercount > 2001 Then MsgBox("The maximum number of iterations has been reached without meeting the smallest difference criteria.") End If GoTo 10000 'end the procedure End If 'If the smallest difference criteria above has not been met, check if we have done enough 'iterations itercount = itercount + 1 If itercount < 2001 Then GoTo Startiters End If 10000: '**************************************** '* * '* Ending the optimization * '* * '**************************************** 'Calculate the length of the run in seconds date2 = Date.Now dateint = DateDiff(DateInterval.Second, date1, date2) objWorksheet = objWorkbook.Worksheets("Basic") With objWorksheet .Range("A45").Value = "Length of optimization in seconds" .Range("A45").Font.Bold = True .Range("A46").Value = dateint End With 'Turn back on alerts so user will be notified to save on exit. 'Make Excel visible to the user objExcel.Visible = True 'Turn the alerts back on so the user will be asked to save before closing Excel objExcel.DisplayAlerts = True objExcel.UserControl = True Me.Close() Dialog_meta.Close() 'Free up memory, otherwise there will be a memory leak. objWorksheet = Nothing objWorkbook = Nothing objExcel = Nothing 10001: End Sub Function Log10(ByRef X As Object) As Object Log10 = System.Math.Log(X) / System.Math.Log(10.0#) End Function Sub AVGHGT(ByRef SPECIES As Object, ByRef TYP As Object, ByRef DHGT As Object, ByRef AHGT As Object) If SPECIES = 1 Then AHGT = (-1.466091 + 0.861959 * (DHGT * 3.2808) + 0.00108537 * (DHGT * 3.2808) ^ 2) / 3.2808 Else If TYP = 0 Then 'natural untreated AHGT = 0.9654 * DHGT - 0.752 Else 'treated natural or plantation AHGT = 0.962 * DHGT - 0.3979 End If End If End Sub Sub DIAMN(ByRef SPECIES As Object, ByRef AHGT As Object, ByRef DIAM As Object) Dim L As Single Dim H As Single Dim g As Single Dim f As Single Dim E As Single Dim D As Single Dim C As Single Dim B As Single Dim A As Single If SPECIES = 1 Then A = 0.286385 B = 0.134989 C = 0.00137156 D = 0.0000546409 E = 0.000000820707 f = 0.00000000724082 g = 0.0000000000372075 H = 0.000000000000102997 L = 0.000000000000000118654 DIAM = (A + B * ((AHGT * 3.2808) - 4.5) - C * ((AHGT * 3.2808) - 4.5) ^ 2 + D * ((AHGT * 3.2808) - 4.5) ^ 3 - E * ((AHGT * 3.2808) - 4.5) ^ 4 + f * ((AHGT * 3.2808) - 4.5) ^ 5 - g * ((AHGT * 3.2808) - 4.5) ^ 6 + H * ((AHGT * 3.2808) - 4.5) ^ 7 - L * ((AHGT * 3.2808) - 4.5) ^ 8) * 2.54 Else DIAM = (0.3068 + 0.0004 * SI_HW) * AHGT ^ (1.6713 - 0.0171 * SI_HW) End If End Sub Sub DIAMP(ByRef SP As Object, ByRef SPECIES As Object, ByRef DIAM As Object, ByRef BA As Object, ByRef SI As Object, ByRef AGE As Object, ByRef NEWDIAM As Object) If SPECIES = 1 Then NEWDIAM = (0.016384 + 1.057711 * ((0.963860501 * (SP * 3.2808) + 0.063249499 * (SI * 3.2808) - 0.179264128) * (1 - System.Math.Exp(-0.029174191 * (AGE))) ^ 0.789203213)) * 2.54 Else NEWDIAM = DIAM + (0.6636 + 0.0971 * SI) * System.Math.Exp((-0.0625 + 0.0005 * SI) * BA) + 0.3062 End If End Sub Sub BAREA(ByRef TFREQ As Object, ByRef DIAM As Object, ByRef BA As Object) BA = TFREQ * 3.141592654 * (DIAM / 200) ^ 2 End Sub Sub DOMHGT(ByRef AGE As Object, ByRef SI_SW As Object, ByRef SI_HW As Object, ByRef DHGT_S As Object, ByRef DHGT_H As Object) If SI_SW > 0 Then DHGT_S = (4.5 + ((SI_SW * 3.2808) - 4.5) * ((1 - (System.Math.Exp(-0.019070142 * 50))) ^ (-3.063581805 * (SI_SW * 3.2808) ^ (-0.228589318))) * ((1 - (System.Math.Exp(-0.019070142 * AGE))) ^ (3.063581805 * (SI_SW * 3.2808) ^ (-0.228589318)))) / 3.2808 Else DHGT_S = 0 End If If SI_HW > 0 Then DHGT_H = SI_HW * ((1 - System.Math.Exp(-0.0192 * (50 + (10.5513 - 0.7565 * SI_HW + 0.0339 * SI_HW ^ 1.7826 + 1)))) ^ (-1.076)) * ((1 - System.Math.Exp(-0.0192 * (AGE + (10.5513 - 0.7565 * SI_HW + 0.0339 * SI_HW ^ 1.7826 + 1)))) ^ 1.076) Else DHGT_H = 0 End If End Sub Sub FAGE(ByRef DIAM As Object, ByRef SI As Object, ByRef SP As Object, ByRef FAGE As Object) Dim DBHIB As Single Dim E As Single Dim D As Single Dim C As Single Dim B As Single Dim A As Single A = 0.963860501 B = 0.063249499 C = -0.179264128 D = 0.789203213 E = -0.029174191 DBHIB = (DIAM / 2.54 - 0.016384) / 1.057711 FAGE = (System.Math.Log(1.0# - (DBHIB / (A * SP * 3.2808 + B * SI * 3.2808 + C)) ^ (1.0# / D))) / E End Sub Sub SDN(ByRef SPECIES As Object, ByRef DIAM As Object, ByRef SD As Object) If SPECIES = 1 Then SD = 30413.962 / ((DIAM / 2.54) ^ 1.834067) * 2.47105 Else SD = 10 ^ (5.1557 - 1.688 * Log10(DIAM) + 0.049) End If End Sub Sub SDP(ByRef SPECIES As Object, ByRef DIAM As Object, ByRef SD As Object) If State = 35 And decision = 34 Then xxxx = 1 End If If SPECIES = 1 Then SD = (10 ^ (4.62277 - 1.87401 * Log10(DIAM / 2.54))) * 2.47105 Else SD = 10 ^ (5.1557 - 1.688 * Log10(DIAM) + 0.049) End If End Sub Sub SAGE(ByRef SPECIES As Object, ByRef DHGT As Object, ByRef SI As Object, ByRef AGE As Object) Dim TEMP As Single If SPECIES = 1 Then TEMP = (DHGT * 3.2808 - 4.5) / ((SI * 3.2808 - 4.5) * (0.61461294 ^ (-3.063581805 * (SI * 3.2808) ^ -0.228589318))) AGE = (System.Math.Log(1 - TEMP ^ (1 / (3.063581805 * (SI * 3.2808) ^ -0.228589318)))) / -0.019070142 Else AGE = (System.Math.Log(1 - (DHGT / (SI * ((1 - System.Math.Exp(-0.0192 * (50 + (10.5513 - 0.7565 * SI + 0.0339 * SI ^ 1.7826 + 1)))) ^ -1.076))) ^ (1 / 1.076)) / -0.0192) - 10.5513 + 0.7565 * SI - 0.0339 * SI ^ 1.7826 - 1 End If End Sub Sub DIAM5SPL3_S(ByRef SP As Object, ByRef SI As Object, ByRef AGE As Object, ByRef NEWDIAM As Object) Dim g As Single Dim f As Single Dim E As Single Dim D As Single Dim C As Single Dim B As Single Dim A As Single 'diameter growth in 5 years for an untreated SW plantation stand with 'spacing less than 3 meters A = 0.016384 B = 1.057711 C = 0.963860501 D = 0.063249499 E = 0.179264128 f = 0.029174191 g = 0.789203213 NEWDIAM = (A + B * ((C * SP * 3.2808 + D * SI * 3.2808 - E) * (1 - System.Math.Exp(-f * (AGE + 5))) ^ g)) * 2.54 End Sub Sub DIAM5TSPL3_S(ByRef DIAM As Object, ByRef SPA As Object, ByRef SI As Object, ByRef NEWDIAM As Object) Dim g As Single Dim f As Single Dim F_AGE As Single Dim TEMP2 As Single Dim E As Single Dim D As Single Dim C As Single Dim B As Single Dim A As Single 'diameter growth in 5 years for a treated Softwood stand with 'spacing less than 3 meters (treated natural and treated plantation) A = 0.963860501 B = 0.063249499 C = -0.179264128 D = 0.789203213 E = -0.029174191 TEMP2 = (DIAM / 2.54) / (A * SPA * 3.2808 + B * SI * 3.2808 + C) F_AGE = (System.Math.Log(1 - (TEMP2 ^ (1 / D)))) / E A = 0.016384 B = 1.057711 C = 0.963860501 D = 0.063249499 E = 0.179264128 f = 0.029174191 g = 0.789203213 NEWDIAM = A + B * ((C * SPA * 3.2808 + D * SI * 3.2808 - E) * (1 - System.Math.Exp(-f * (F_AGE + 5))) ^ g) * 2.54 End Sub Sub DIAM5SPM3_S(ByRef DIAM As Object, ByRef TFREQ As Object, ByRef Fraction_S As Object, ByRef NEWDIAM As Object) Dim D5IB As Single Dim TMPBA As Single Dim DBHIB As Single Dim B3 As Single Dim B2 As Single Dim B1 As Single 'Diameter growth in 5 years for a Softwood stand with spacing 'more than 3 meters (natural and plantation (treated and untreated)) B1 = 0.02785202 B2 = -0.367548143 B3 = -0.005540854 DBHIB = (DIAM / 2.54 - 0.016384) / 1.057711 TMPBA = DBHIB ^ 2 * 0.005454 * (TFREQ / (Fraction_S * Stock)) / 2.47105 D5IB = (B1 * SI_SW * 3.2808 + B2) * System.Math.Exp(B3 * TMPBA) NEWDIAM = ((DBHIB + D5IB) * 1.057711 + 0.016384) * 2.54 End Sub Sub DIAM5T_H(ByRef SI As Object, ByRef BA As Object, ByRef DIAM As Object, ByRef NEWDIAM As Object) Dim D5 As Single Dim B4 As Single Dim B3 As Single Dim B2 As Single Dim B1 As Single 'Diameter growth in 5 years for a hardwood stand '(natural and plantation (treated)) B1 = 0.6636 B2 = 0.0971 B3 = -0.0625 B4 = 0.0005 D5 = (B1 + SI * B2) * System.Math.Exp((B3 + SI * B4) * BA) + 0.3062 NEWDIAM = D5 + DIAM End Sub Sub TFREQ(ByRef BA As Object, ByRef DIAM As Object, ByRef TFREQ As Object) If DIAM > 0 Then TFREQ = BA / (3.141592654 * (DIAM / 200) ^ 2) Else TFREQ = 0 End If End Sub Sub site_density(ByRef SPECIES As Object, ByRef DIAM As Object, ByRef TYP As Object, ByRef TFREQ As Object) Dim SD2 As Single Dim SD1 As Single Dim SD As Single If SPECIES = 1 Then If TYP = 0 Then 'Natural Call SDN(SPECIES, DIAM, SD) ElseIf TYP = 1 Then 'Treated natural or Plantation Call SDP(SPECIES, DIAM, SD) SD1 = SD Call SDN(SPECIES, DIAM, SD) SD2 = SD SD = (SD1 + SD2) / 2 End If Else Call SDN(SPECIES, DIAM, SD) End If If TFREQ > SD Then TFREQ = SD End If End Sub Sub Spac(ByRef BA As Object, ByRef DIAM As Object, ByRef FACTOR As Object, ByRef SPACP As Object) Dim TEMP As Object If FACTOR <= 0 Or BA = 0 Then SPACP = 0 Else TEMP = BA / (3.1415926 * (DIAM / 200) ^ 2) SPACP = System.Math.Sqrt(10000 * FACTOR * Stock) / System.Math.Sqrt(TEMP) End If End Sub Sub MBAREA(ByRef SPECIES As Object, ByRef DIAM As Object, ByRef BA As Object, ByRef MERBA As Object) Dim MTBARAT As Single Dim E As Single Dim f As Single Dim C As Single Dim B As Single Dim A As Single If SPECIES = 1 Then If DIAM >= 20.32 Then RATIO = 1 ElseIf DIAM <= 7.1 Then RATIO = 0 Else A = 0.82932659 B = 0.7183961 C = 0.10184704 f = 0.0054868242 E = 0.0000066210904 RATIO = -A + B * DIAM / 2.54 - C * (DIAM / 2.54) ^ 2 + f * (DIAM / 2.54) ^ 3 - E * (DIAM / 2.54) ^ 5 If RATIO > 1 Then RATIO = 1 ElseIf RATIO < 0.05 Then RATIO = 0 End If End If MERBA = RATIO * BA If MERBA < 0.1 Then MERBA = 0 End If Else If DIAM < 4.1 Then MERBA = 0 Else MTBARAT = (1 - System.Math.Exp(-0.374584768 * DIAM)) ^ 10.855823566 MERBA = MTBARAT * BA End If End If End Sub Sub MERDBH(ByRef SPECIES As Object, ByRef RATIO As Object, ByRef DIAM As Object, ByRef MERDIAM As Object) If SPECIES = 1 Then If RATIO >= 1 Then MERDIAM = DIAM ElseIf RATIO <= 0 Then MERDIAM = 0 ElseIf DIAM >= 20.32 Then MERDIAM = DIAM ElseIf DIAM <= 2.54 Then MERDIAM = 0 Else MERDIAM = (3.0746534 + 0.30615578 * DIAM / 2.54 + 0.040103103 * (DIAM / 2.54) ^ 2) * 2.54 End If Else If DIAM < 4.1 Then MERDIAM = 0 ElseIf DIAM < 25 Then MERDIAM = DIAM Else MERDIAM = 0.76293 * DIAM + 5.9041 End If End If End Sub Sub MERFRQ(ByRef MERDIAM As Object, ByRef MERBA As Object, ByRef TFREQ As Object, ByRef MERFREQ As Object) If MERDIAM <> 0 Then MERFREQ = MERBA / (3.141592654 * (MERDIAM / 200) ^ 2) Else MERFREQ = 0 End If If MERFREQ > TFREQ Then MERFREQ = TFREQ End If End Sub Sub BBAREA(ByRef MERBA As Object, ByRef MERDIAM As Object, ByRef MERFREQ As Object, ByRef BRDBA As Object) Dim BMBARAT As Single Dim X6 As Single Dim X5 As Single Dim X4 As Single Dim X3 As Single Dim X2 As Single Dim X1 As Single If SPECIES = 1 Then If MERBA <= 0 Then RATIO = 0 ElseIf MERFREQ <= 0 Then RATIO = 0 Else X1 = 1 / ((MERDIAM / 2.54) ^ 6) X2 = (MERDIAM / 2.54) ^ 10 X3 = 1 / ((MERDIAM / 2.54) ^ 5) X4 = (MERDIAM / 2.54) ^ 9 X5 = (MERDIAM / 2.54) ^ 2 X6 = 1 / ((MERDIAM / 2.54) ^ 10) RATIO = 1.0794209 + 21281.691 * X1 - 0.00000000000088421416 * X2 - 6064.0629 * X3 + 0.000000000011016046 * X4 - 0.00050860475 * X5 - 394808.99 * X6 End If BRDBA = RATIO * MERBA If BRDBA > MERBA Then BRDBA = MERBA ElseIf BRDBA <= 0 Then BRDBA = 0 End If Else If MERDIAM < 11 Then BRDBA = 0 Else BMBARAT = (1 - System.Math.Exp(-0.3994689 * MERDIAM)) ^ 143.75231029 BRDBA = MERBA * BMBARAT End If End If End Sub Sub BRDDBH(ByRef MERDIAM As Object, ByRef BRDBA As Object, ByRef BRDDIAM As Object) Dim X6 As Single Dim X5 As Single Dim X4 As Single Dim X3 As Single Dim X2 As Single Dim X1 As Single If SPECIES = 1 Then If MERDIAM > 25.4 Then BRDDIAM = MERDIAM ElseIf MERDIAM = 0 Then BRDDIAM = 0 Else X1 = 1 / (MERDIAM / 2.54) X2 = (MERDIAM / 2.54) ^ 10 X3 = (MERDIAM / 2.54) ^ 0.1 X4 = (MERDIAM / 2.54) ^ 0.5 X5 = 1 / (MERDIAM / 2.54) ^ 6 X6 = 1 / (MERDIAM / 2.54) ^ 10 RATIO = -8.5204673 + 7.0903534 * X1 - 1.2249943E-20 * X2 + 7.6542127 * X3 - 0.2563372 * X4 - 493.03614 * X5 + 55803.496 * X6 BRDDIAM = RATIO * MERDIAM End If If (BRDBA < 0 Or BRDDIAM < 14.22) Then BRDDIAM = 0 End If If (BRDDIAM < MERDIAM) Then BRDDIAM = MERDIAM End If Else If MERDIAM < 11 Then BRDDIAM = 0 ElseIf MERDIAM > 31 Then BRDDIAM = MERDIAM Else BRDDIAM = 0.832332 * MERDIAM + 5.214265 End If End If End Sub Sub BRDFRQ(ByRef MERDIAM As Object, ByRef MERFREQ As Object, ByRef BRDDIAM As Object, ByRef BRDBA As Object, ByRef BRDFREQ As Object) If SPECIES = 1 Then If (MERDIAM > 25.4) Then BRDFREQ = MERFREQ ElseIf (BRDDIAM < 12.7) Then BRDFREQ = 0 Else BRDFREQ = BRDBA / (3.141592654 * (BRDDIAM / 200) ^ 2) End If If (BRDFREQ > MERFREQ) Then BRDFREQ = MERFREQ End If Else If MERDIAM < 11 Then BRDFREQ = 0 Else BRDFREQ = BRDBA / (3.141592654 * (BRDDIAM / 200) ^ 2) End If End If End Sub Sub MERHEIGHT(ByRef DIAM As Object, ByRef MERBA As Object, ByRef BA As Object, ByRef AHGT As Object, ByRef MERHGT As Object) Dim MTHRAT As Single Dim i As Single Dim H As Single Dim g As Single Dim f As Single Dim E As Single Dim D As Single Dim C As Single Dim B As Single Dim A As Single If SPECIES = 1 Then RATIO = MERBA / BA If RATIO = 1 Or AHGT > 24.4 Then MERHGT = AHGT ElseIf RATIO = 0 Then MERHGT = 0 Else A = 15.277829 B = 1.4316388 C = 0.53584452 D = 185.70383 E = 0.00000046086744 f = 134.91889 g = 68.753896 H = 31.713797 i = 0.030025568 MERHGT = (-A + B * (AHGT * 3.2808) - C * (AHGT * 3.2808) * RATIO + D * RATIO ^ 4 + E * ((AHGT * 3.2808) / RATIO) ^ 3 - f * RATIO ^ 5 - g * RATIO ^ 2 + H * RATIO ^ 0.5 + i * (AHGT * 3.2808) / RATIO) / 3.2808 End If If MERHGT <> 0 Then If MERHGT < AHGT Then MERHGT = AHGT End If End If Else If DIAM < 4.1 Then MERHGT = 0 Else MTHRAT = (1 + System.Math.Exp(-0.197080469 * DIAM)) ^ 0.489554121 MERHGT = AHGT * MTHRAT End If End If End Sub Sub BRDHEIGHT(ByRef MERDIAM As Object, ByRef MERBA As Object, ByRef BRDBA As Object, ByRef MERHGT As Object, ByRef BRDHGT As Object) Dim BMHRAT As Single Dim f As Single Dim E As Single Dim D As Single Dim C As Single Dim B As Single Dim A As Single If SPECIES = 1 Then RATIO = 0 If MERBA > 0 Then RATIO = BRDBA / MERBA End If If RATIO <= 0 Then BRDHGT = 0 ElseIf RATIO > 1 Then BRDHGT = MERHGT ElseIf MERHGT = 0 Then BRDHGT = 0 Else A = 9.3709292 B = 0.046206221 C = 0.00074921477 D = 0.0000040028957 E = 2.8348874 f = 3.1858712 BRDHGT = (A + B * (MERHGT * 3.2808) ^ 2 - C * (MERHGT * 3.2808) ^ 3 + D * (MERHGT * 3.2808) ^ 4 - E * RATIO - f * RATIO ^ 5) / 3.2808 End If If BRDHGT < MERHGT Or MERHGT > 24.4 Then BRDHGT = MERHGT End If Else If MERDIAM < 11 Then BRDHGT = 0 Else BMHRAT = (1 + System.Math.Exp(-0.14338793 * MERDIAM)) ^ 0.377415145 BRDHGT = BMHRAT * MERHGT End If End If End Sub Sub VOLUME(ByRef SPECIES As Object, ByRef Stock As Object, ByRef MERHGT As Object, ByRef MERDIAM As Object, ByRef MERFREQ As Object, ByRef BRDHGT As Object, ByRef BRDDIAM As Object, ByRef BRDFREQ As Object, ByRef MERVOL As Object, ByRef BRDVOL As Object) Dim BV1 As Single Dim BVRAT As Single Dim X4 As Single Dim TV3 As Single Dim MV1 As Single Dim MVRAT As Single Dim X3 As Single Dim t As Single Dim S As Single Dim TV2 As Single Dim R3 As Single Dim R2 As Single Dim R1 As Single Dim B2 As Single Dim X As Single Dim B As Single Dim A As Single If SPECIES = 1 Then A = 1.226 B = 315.832 If MERHGT > 0 And MERDIAM > 0 Then X = ((3 / (MERDIAM / 2.54)) ^ 2) * (1 + (0.5 / (MERHGT * 3.2808))) ' This MERVOL is in cubic meters / hectare (factor = (cubic feet -> cubic meters) * (acres -> hectares) MERVOL = 0.069972228 * (MERFREQ * ((MERDIAM / 2.54) ^ 2 / (A + (B / (MERHGT * 3.2808)))) * (0.9604 - 0.166 * X - 0.7868 * X ^ 2)) If MERVOL < 0 Then MERVOL = 0 End If Else MERVOL = 0 End If If BRDHGT > 0 And BRDDIAM > 0 Then X = ((4 / (BRDDIAM / 2.54)) ^ 2) * (1 + (0.5 / (BRDHGT * 3.2808))) ' This BRDVOL is in cubic meters / hectare (factor = (fbm -> cubic meters) * (acres -> hectares) BRDVOL = 0.01396074 * (BRDFREQ * ((BRDDIAM / 2.54) ^ 2 / (A + (B / (BRDHGT * 3.2808)))) * (5.316 - 1.5928 * X - 4.3747 * X ^ 2)) If BRDVOL < 0 Then BRDVOL = 0 End If Else BRDVOL = 0 End If Else A = 1.046 B = 383.972 B2 = 0.145 R1 = 0.9057 R2 = -0.0708 R3 = -0.8375 If MERHGT > 0 And MERDIAM > 0 Then TV2 = (0.0043891 * MERDIAM ^ 2 * (1 - 0.04365 * B2) ^ 2) / (A + 0.3048 * B / MERHGT) S = 0.15 t = 7.0# X3 = (t ^ 2 / (MERDIAM ^ 2 * ((1 - 0.04365 * B2) ^ 2))) * (1 + S / MERHGT) MVRAT = R1 + R2 * X3 + R3 * X3 ^ 2 MV1 = TV2 * MVRAT MERVOL = MV1 * MERFREQ If MERVOL < 0 Then MERVOL = 0 End If Else MERVOL = 0 End If If BRDHGT > 0 And BRDDIAM > 0 Then TV3 = (0.0043891 * BRDDIAM ^ 2 * (1 - 0.04365 * B2) ^ 2) / (A + 0.3048 * B / BRDHGT) S = 0.15 t = 10.0# X4 = (t ^ 2 / (BRDDIAM ^ 2 * ((1 - 0.04365 * B2) ^ 2))) * (1 + S / BRDHGT) BVRAT = R1 + R2 * X4 + R3 * X4 ^ 2 BV1 = TV3 * BVRAT BRDVOL = BV1 * BRDFREQ If BRDVOL < 0 Then BRDVOL = 0 End If Else BRDVOL = 0 End If End If If BRDVOL > MERVOL Then BRDVOL = MERVOL End If End Sub Sub PMBAREA(ByRef DIAM As Object, ByRef BA As Object, ByRef MERBA As Object) If (DIAM < 7.11) Then RATIO = 0 Else RATIO = (1 - System.Math.Exp(-0.949286627 * ((DIAM / 2.54) - 2.4))) If (RATIO < 0) Then RATIO = 0 End If End If MERBA = RATIO * BA If (MERBA < 0.1) Then MERBA = 0 End If End Sub Sub PMERFRQ(ByRef DIAM As Object, ByRef TFREQ As Object, ByRef MERBA As Object, ByRef MERFREQ As Object) If (DIAM < 7.11) Then RATIO = 0 Else RATIO = (1 - System.Math.Exp(-0.505737453 * ((DIAM / 2.54) - 2.4))) ^ 1.272646184 End If MERFREQ = RATIO * TFREQ If (MERBA < 0.1) Then MERFREQ = 0 End If End Sub Sub PMERDBH(ByRef MERBA As Object, ByRef MERFREQ As Object, ByRef MERDIAM As Object) If MERFREQ < 1 Then MERDIAM = 0 Else MERDIAM = 200 * (MERBA / (MERFREQ * 3.141592654)) ^ 0.5 End If End Sub Sub PBBAREA(ByRef MERDIAM As Object, ByRef MERBA As Object, ByRef BRDBA As Object) RATIO = (1 - System.Math.Exp(-0.63777207 * ((MERDIAM / 2.54) - 4.368490128))) If (RATIO < 0) Then BRDBA = 0 Else BRDBA = RATIO * MERBA End If If (MERDIAM < 11.4) Then BRDBA = 0 End If End Sub Sub PBRDFRQ(ByRef MERDIAM As Object, ByRef MERFREQ As Object, ByRef BRDFREQ As Object) If (MERDIAM < 11.4) Then RATIO = 0 Else RATIO = (1 - System.Math.Exp(-0.395102665 * ((MERDIAM / 2.54) - 4.425711477))) End If If (RATIO < 0) Then RATIO = 0 End If BRDFREQ = RATIO * MERFREQ End Sub Sub PBRDDBH(ByRef BRDFREQ As Object, ByRef BRDBA As Object, ByRef BRDDIAM As Object) If BRDFREQ < 1 Then BRDDIAM = 0 Else BRDDIAM = 200 * (BRDBA / (BRDFREQ * 3.141592654)) ^ 0.5 End If End Sub Sub COMMTHIN(ByRef AGE As Object, ByRef DIAM_S As Object, ByRef DIAM_H As Object, ByRef BA_S As Object, ByRef BA_H As Object, ByRef BARem As Object, ByRef BARem_Split As Object, ByRef THINTYP As Object, ByRef NEWDIAM_S As Object, ByRef NEWDIAM_H As Object, ByRef NEWBA_S As Object, ByRef NEWBA_H As Object) Dim TD35Rem_H As Single Dim TD14Rem_H As Single Dim BARem_H As Single Dim TD35Rem_S As Single Dim TD14Rem_S As Single Dim TD35Rem_high As Single Dim TD35Rem_low As Single Dim TD14Rem_high As Single Dim TD14Rem_low As Single Dim BARem_S As Single 'Softwood If DIAM_S > 8.5 Then NEWBA_S = BA_S - ((BA_S + BA_H) * BARem / 100 * BARem_Split / 100) If NEWBA_S > 0 Then If BARem_Split > 0 Then BARem_S = ((BA_S + BA_H) * BARem / 100 * BARem_Split / 100) / BA_S If THINTYP = 1 Then 'THINNING FROM BELOW TD14Rem_low = 0.3527 TD14Rem_high = 1.8874 TD35Rem_low = 1.6969 TD35Rem_high = 9.4556 ElseIf THINTYP = 2 Then 'THINNING ACROSS THE DIAMETER DISTRIBUTION NEWDIAM_S = DIAM_S ElseIf THINTYP = 3 Then 'THINNING FROM ABOVE TD14Rem_low = 0.1947 TD14Rem_high = 1.5345 TD35Rem_low = 0.3254 TD35Rem_high = 2.9183 End If If THINTYP = 1 Then TD14Rem_S = (BARem_S - 0.05) / 0.35 * (TD14Rem_high - TD14Rem_low) + TD14Rem_low TD35Rem_S = (BARem_S - 0.05) / 0.35 * (TD35Rem_high - TD35Rem_low) + TD35Rem_low NEWDIAM_S = DIAM_S + (DIAM_S - 14) / 21 * (TD35Rem_S - TD14Rem_S) + TD14Rem_S ElseIf THINTYP = 3 Then TD14Rem_S = (BARem_S - 0.05) / 0.35 * (TD14Rem_high - TD14Rem_low) + TD14Rem_low TD35Rem_S = (BARem_S - 0.05) / 0.35 * (TD35Rem_high - TD35Rem_low) + TD35Rem_low NEWDIAM_S = DIAM_S - ((DIAM_S - 14) / 21 * (TD35Rem_S - TD14Rem_S) + TD14Rem_S) End If Else NEWDIAM_S = DIAM_S NEWBA_S = BA_S End If Else NEWDIAM_S = 0 NEWBA_S = 0 End If Else NEWDIAM_S = DIAM_S NEWBA_S = BA_S End If 'Hardwood If DIAM_H > 8.5 Then NEWBA_H = BA_H - ((BA_S + BA_H) * BARem / 100 * (1 - BARem_Split / 100)) If NEWBA_H > 0 Then If BARem_Split < 100 Then BARem_H = ((BA_S + BA_H) * BARem / 100 * (1 - BARem_Split / 100)) / BA_H If THINTYP = 1 Then 'thinning from below TD14Rem_low = 0.6675 TD14Rem_high = 2.3199 TD35Rem_low = 1.0476 TD35Rem_high = 8.0899 ElseIf THINTYP = 2 Then 'thinning across the diameter distribution NEWDIAM_H = DIAM_H ElseIf THINTYP = 3 Then 'thinning from above TD14Rem_low = 0.215 TD14Rem_high = 1.5243 TD35Rem_low = 0.3517 TD35Rem_high = 3.0908 End If If THINTYP = 1 Then TD14Rem_H = (BARem_H - 0.05) / 0.35 * (TD14Rem_high - TD14Rem_low) + TD14Rem_low TD35Rem_H = (BARem_H - 0.05) / 0.35 * (TD35Rem_high - TD35Rem_low) + TD35Rem_low NEWDIAM_H = DIAM_H + (DIAM_H - 14) / 21 * (TD35Rem_H - TD14Rem_H) + TD14Rem_H ElseIf THINTYP = 3 Then TD14Rem_H = (BARem_H - 0.05) / 0.35 * (TD14Rem_high - TD14Rem_low) + TD14Rem_low TD35Rem_H = (BARem_H - 0.05) / 0.35 * (TD35Rem_high - TD35Rem_low) + TD35Rem_low NEWDIAM_H = DIAM_H - ((DIAM_H - 14) / 21 * (TD35Rem_H - TD14Rem_H) + TD14Rem_H) End If Else NEWDIAM_H = DIAM_H NEWBA_H = BA_H End If Else NEWDIAM_H = 0 NEWBA_H = 0 End If Else NEWDIAM_H = DIAM_H NEWBA_H = BA_H End If End Sub Sub DIAMSPA(ByRef SPECIES As Object, ByRef SPA As Object, ByRef DIAM As Object, ByRef NEWDIAM As Object) If SPECIES = 1 Then NEWDIAM = (0.5 * (0.0597 * DIAM / 2.54 * SPA * 3.2808 + 0.218) + DIAM / 2.54) * 2.54 Else NEWDIAM = DIAM - 0.668 + 0.261 * DIAM + 0.456 * SPA End If End Sub Sub COSTHARV(ByRef MERDIAM_S As Object, ByRef MERVOL_S As Object, ByRef BRDVOL_S As Object, ByRef MERDIAM_H As Object, ByRef MERVOL_H As Object, ByRef BRDVOL_H As Object, ByRef HARVPRICE As Object, ByRef decision As Object, ByRef COST As Object) Dim FORWARDCOST As Single Dim HOURS_H As Single Dim PROD_H As Single Dim HARVCOST_H As Single Dim HOURS_S As Single Dim PROD_S As Single Dim HARVCOST_S As Single Dim PRODTIME As Single Dim TOTVOL_H As Single Dim TOTVOL_S As Single TOTVOL_S = MERVOL_S * 0.275896 'transformation from m^3 to cords TOTVOL_H = MERVOL_H * 0.275896 'transformation from m^3 to cords PRODTIME = 0.85 '% of productive time If TOTVOL_S = 0 Then HARVCOST_S = 0 Else PROD_S = (15.03 * (13.644 / (MERDIAM_S / 2.54)) ^ (-0.45)) / 2.3 'productivity of single grip harvester with softwood PROD_S = PROD_S * PRODTIME HOURS_S = TOTVOL_S / PROD_S HARVCOST_S = HOURS_S * HARVPRICE End If If TOTVOL_H = 0 Then HARVCOST_H = 0 Else PROD_H = (15.03 * (13.644 / (MERDIAM_H / 2.54)) ^ (-0.45)) * 1.22 / 2.3 'productivity of single grip harvester with hardwood PROD_H = PROD_H * PRODTIME HOURS_H = TOTVOL_H / PROD_H HARVCOST_H = HOURS_H * HARVPRICE End If 'Forwarder gives 3.43 cords/hr at 50% productive time and $/hour FORWARDCOST = (TOTVOL_S + TOTVOL_H) / (3.43 * 0.5) * HARVPRICE COST = HARVCOST_S + HARVCOST_H + FORWARDCOST If COST < 0 Then COST = 0 End If End Sub Sub Fire_L(ByRef AGE As Object, ByRef DIAM_S As Object, ByRef Avg_diam As Object, ByRef TRT As Object, ByRef prFL As Object) If TRT = 1 Then prFL = 1 - 0.0072 * AGE ElseIf TRT = 2 Then prFL = 1.016195 - 0.022513 * Avg_diam ElseIf TRT = 3 Then prFL = 1.006914 - 0.022097 * DIAM_S ElseIf TRT = 4 Then prFL = 1.025224 - 0.02303 * DIAM_S ElseIf TRT = 5 Then prFL = 1.01474 - 0.022459 * Avg_diam End If If prFL > 1 Then prFL = 1 ElseIf prFL < 0 Then prFL = 0 End If End Sub Sub Fire_M(ByRef AGE As Object, ByRef DIAM_S As Object, ByRef Avg_diam As Object, ByRef TRT As Object, ByRef prFM As Object) If TRT = 1 Then prFM = 1 - 0.0068 * AGE ElseIf TRT = 2 Then prFM = 1.015295 - 0.021262 * Avg_diam ElseIf TRT = 3 Then prFM = 1.00653 - 0.02087 * DIAM_S ElseIf TRT = 4 Then prFM = 1.023823 - 0.02175 * DIAM_S ElseIf TRT = 5 Then prFM = 1.013921 - 0.021212 * DIAM_S End If If prFM > 1 Then prFM = 1 ElseIf prFM < 0 Then prFM = 0 End If End Sub Sub Fire_H(ByRef AGE As Object, ByRef DIAM_S As Object, ByRef Avg_diam As Object, ByRef TRT As Object, ByRef prFH As Object) If TRT = 1 Then prFH = 1 - 0.0064 * AGE ElseIf TRT = 2 Then prFH = 1.014396 - 0.020011 * Avg_diam ElseIf TRT = 3 Then prFH = 1.006145 - 0.019642 * DIAM_S ElseIf TRT = 4 Then prFH = 1.022422 - 0.020471 * DIAM_S ElseIf TRT = 5 Then prFH = 1.013102 - 0.019964 * Avg_diam End If If prFH > 1 Then prFH = 1 ElseIf prFH < 0 Then prFH = 0 End If End Sub Sub Hurricane_L(ByRef AGE As Object, ByRef prHL As Object) prHL = 0.1 + 0.0072 * AGE If prHL > 1 Then prHL = 1 ElseIf prHL < 0 Then prHL = 0 End If End Sub Sub Hurricane_M(ByRef AGE As Object, ByRef prHM As Object) Dim prHL As Object prHL = 0.15 + 0.0068 * AGE If prHM > 1 Then prHM = 1 ElseIf prHM < 0 Then prHM = 0 End If End Sub Sub Hurricane_H(ByRef AGE As Object, ByRef prHH As Object) Dim prHL As Object prHL = 0.2 + 0.0064 * AGE If prHH > 1 Then prHH = 1 ElseIf prHH < 0 Then prHH = 0 End If End Sub Sub Insects(ByRef AGE As Object, ByRef DIAM_S As Object, ByRef Avg_diam As Object, ByRef TRT As Object, ByRef prIns As Object) If TRT = 1 Then prIns = 0.1 + 0.005 * AGE ElseIf TRT = 2 Then prIns = 0.084878 + 0.014955 * Avg_diam ElseIf TRT = 3 Then prIns = 0.090265 + 0.01484 * DIAM_S ElseIf TRT = 4 Then prIns = 0.076632 + 0.01541 * DIAM_S ElseIf TRT = 5 Then prIns = 0.084604 + 0.014977 * Avg_diam End If If prIns > 1 Then prIns = 1 ElseIf prIns < 0 Then prIns = 0 End If End Sub Private Sub StoreState() Dim sssss As Object '************************************************************ '* * '* Subroutine to store the states in an array * '* * '************************************************************ z = z + 1 If z = 826 Then sssss = 1 End If States(z, 1) = AGE States(z, 6) = TRT If TRT = 1 Then States(z, 2) = STOCKING ElseIf TRT = 3 Then States(z, 2) = DIAM_S States(z, 3) = Initial_density ElseIf TRT = 2 Or TRT = 5 Then If MAX_STATE_VALUE(TRT, 1) < AGE Then MAX_STATE_VALUE(TRT, 1) = AGE End If States(z, 2) = DIAM_S If MAX_STATE_VALUE(TRT, 2) < DIAM_S Then MAX_STATE_VALUE(TRT, 2) = DIAM_S End If States(z, 3) = DIAM_H If MAX_STATE_VALUE(TRT, 3) < DIAM_H Then MAX_STATE_VALUE(TRT, 3) = DIAM_H End If States(z, 4) = PCT_S If MAX_STATE_VALUE(TRT, 4) < PCT_S Then MAX_STATE_VALUE(TRT, 4) = PCT_S End If States(z, 5) = CC If MAX_STATE_VALUE(TRT, 5) < CC Then MAX_STATE_VALUE(TRT, 5) = CC End If ElseIf TRT = 4 Then If MAX_STATE_VALUE(TRT, 1) < AGE Then MAX_STATE_VALUE(TRT, 1) = AGE End If States(z, 2) = DIAM_S If MAX_STATE_VALUE(TRT, 2) < DIAM_S Then MAX_STATE_VALUE(TRT, 2) = DIAM_S End If States(z, 3) = CC If MAX_STATE_VALUE(TRT, 3) < CC Then MAX_STATE_VALUE(TRT, 3) = CC End If End If End Sub Private Sub StoreFinal() If State = 30 Then zzzzz = 1 End If '************************************************************************ '* * '* Subroutine to store the states and results of decisions * '* * '************************************************************************ If NEWTRT = 1 Then VOLUMES(State, decision, 2) = NEWSTOCKING ElseIf NEWTRT = 2 Or NEWTRT = 5 Then VOLUMES(State, decision, 2) = NEWDIAM_S VOLUMES(State, decision, 3) = NEWDIAM_H VOLUMES(State, decision, 4) = NEWPCT_S VOLUMES(State, decision, 5) = NEWCC ElseIf NEWTRT = 3 Then VOLUMES(State, decision, 2) = NEWDIAM_S VOLUMES(State, decision, 3) = NEWDENSITY ElseIf NEWTRT = 4 Then VOLUMES(State, decision, 2) = NEWDIAM_S VOLUMES(State, decision, 3) = NEWCC End If VOLUMES(State, decision, 1) = NEWAGE VOLUMES(State, decision, 6) = NEWTRT VOLUMES(State, decision, 7) = MERVOL_S VOLUMES(State, decision, 8) = BRDVOL_S VOLUMES(State, decision, 9) = MERVOL_H VOLUMES(State, decision, 10) = BRDVOL_H VOLUMES(State, decision, 11) = COST End Sub Private Sub VolumesN() Dim RATIO_H As Object Dim RATIO_S As Object '********************************************************************************* '* * '* Subroutine to calculate the volumes for a natural untreated stand * '* * '********************************************************************************* If SPECIES = 1 Then If BA_S > 0 Then Call MBAREA(SPECIES, DIAM_S, BA_S, MERBA_S) RATIO_S = MERBA_S / BA_S Call MERDBH(SPECIES, RATIO_S, DIAM_S, MERDIAM_S) Call MERFRQ(MERDIAM_S, MERBA_S, TFREQ_S, MERFREQ_S) Call BBAREA(MERBA_S, MERDIAM_S, MERFREQ_S, BRDBA_S) Call BRDDBH(MERDIAM_S, BRDBA_S, BRDDIAM_S) Call BRDFRQ(MERDIAM_S, MERFREQ_S, BRDDIAM_S, BRDBA_S, BRDFREQ_S) Call MERHEIGHT(DIAM_S, MERBA_S, BA_S, AHGT_S, MERHGT_S) Call BRDHEIGHT(MERDIAM_S, MERBA_S, BRDBA_S, MERHGT_S, BRDHGT_S) Call VOLUME(SPECIES, STOCKING, MERHGT_S, MERDIAM_S, MERFREQ_S, BRDHGT_S, BRDDIAM_S, BRDFREQ_S, MERVOL_S, BRDVOL_S) Else MERVOL_S = 0 BRDVOL_S = 0 End If Else If BA_H > 0 Then Call MBAREA(SPECIES, DIAM_H, BA_H, MERBA_H) RATIO_H = MERBA_H / BA_H Call MERDBH(SPECIES, RATIO_H, DIAM_H, MERDIAM_H) Call MERFRQ(MERDIAM_H, MERBA_H, TFREQ_H, MERFREQ_H) Call BBAREA(MERBA_H, MERDIAM_H, MERFREQ_H, BRDBA_H) Call BRDDBH(MERDIAM_H, BRDBA_H, BRDDIAM_H) Call BRDFRQ(MERDIAM_H, MERFREQ_H, BRDDIAM_H, BRDBA_H, BRDFREQ_H) Call MERHEIGHT(DIAM_H, MERBA_H, BA_H, AHGT_H, MERHGT_H) Call BRDHEIGHT(MERDIAM_H, MERBA_H, BRDBA_H, MERHGT_H, BRDHGT_H) Call VOLUME(SPECIES, STOCKING, MERHGT_H, MERDIAM_H, MERFREQ_H, BRDHGT_H, BRDDIAM_H, BRDFREQ_H, MERVOL_H, BRDVOL_H) Else MERVOL_H = 0 BRDVOL_H = 0 End If End If End Sub Private Sub VolumesP() '********************************************************************************************* '* * '* Subroutine to calculate the volumes for a treated natural or plantation stand * '* * '********************************************************************************************* If BA_S > 0 Then Call PMBAREA(DIAM_S, BA_S, MERBA_S) Call PMERFRQ(DIAM_S, TFREQ_S, MERBA_S, MERFREQ_S) Call PMERDBH(MERBA_S, MERFREQ_S, MERDIAM_S) Call PBBAREA(MERDIAM_S, MERBA_S, BRDBA_S) Call PBRDFRQ(MERDIAM_S, MERFREQ_S, BRDFREQ_S) Call PBRDDBH(BRDFREQ_S, BRDBA_S, BRDDIAM_S) Call AVGHGT(1, 1, DHGT_S, AHGT_S) Call MERHEIGHT(DIAM_S, MERBA_S, BA_S, AHGT_S, MERHGT_S) Call BRDHEIGHT(MERDIAM_S, MERBA_S, BRDBA_S, MERHGT_S, BRDHGT_S) Call VOLUME(1, STOCKING, MERHGT_S, MERDIAM_S, MERFREQ_S, BRDHGT_S, BRDDIAM_S, BRDFREQ_S, MERVOL_S, BRDVOL_S) Else MERVOL_S = 0 BRDVOL_S = 0 End If If BA_H > 0 Then Call PMBAREA(DIAM_H, BA_H, MERBA_H) Call PMERFRQ(DIAM_H, TFREQ_H, MERBA_H, MERFREQ_H) Call PMERDBH(MERBA_H, MERFREQ_H, MERDIAM_H) Call PBBAREA(MERDIAM_H, MERBA_H, BRDBA_H) Call PBRDFRQ(MERDIAM_H, MERFREQ_H, BRDFREQ_H) Call PBRDDBH(BRDFREQ_H, BRDBA_H, BRDDIAM_H) Call AVGHGT(2, 1, DHGT_H, AHGT_H) Call MERHEIGHT(DIAM_H, MERBA_H, BA_H, AHGT_H, MERHGT_H) Call BRDHEIGHT(MERDIAM_H, MERBA_H, BRDBA_H, MERHGT_H, BRDHGT_H) Call VOLUME(2, STOCKING, MERHGT_H, MERDIAM_H, MERFREQ_H, BRDHGT_H, BRDDIAM_H, BRDFREQ_H, MERVOL_H, BRDVOL_H) Else MERVOL_H = 0 BRDVOL_H = 0 End If End Sub Private Sub Treat1() '************************************************************************************ '* '* Subroutine for the natural stands '* '************************************************************************************ If State = 34 Then zzz = 1 End If COST = 0 NEWAGE = 0 AGE = States(State, 1) STOCKING = States(State, 2) YTBH_S = 44.07021 - 1.63556 * SI_SW * 3.28084 + 0.0222 * (SI_SW * 3.28084) ^ 2 - 0.000100987 * (SI_SW * 3.28084) ^ 3 If AGE > YTBH_S - 2 Then Call DOMHGT(AGE - YTBH_S, SI_SW, SI_HW, DHGT_S, DHGT_H) Call AVGHGT(1, 0, DHGT_S, AHGT_S) Call AVGHGT(2, 0, DHGT_H, AHGT_H) Call DIAMN(1, AHGT_S, DIAM_S) Call DIAMN(2, AHGT_H, DIAM_H) Call SDN(1, DIAM_S, SD_S) Call SDN(2, DIAM_H, SD_H) TFREQ_S = SD_S * Regen_SW_perct * STOCKING TFREQ_H = SD_H * (1 - Regen_SW_perct) * STOCKING BA_S = 3.1415927 * (DIAM_S / 200) ^ 2 * TFREQ_S BA_H = 3.1415927 * (DIAM_H / 200) ^ 2 * TFREQ_H Temporary_BA_S = BA_S Temporary_BA_H = BA_H Else DHGT_S = 0 DHGT_H = 0 End If TYP = 0 '*************************************************************** '* There are 48 possible decisions that can be taken '*************************************************************** If decision = 3 Then 'clear cut, let natural regen (no regen in first 5 year period) If AGE > YTBH_S - 2 Then SPECIES = 1 VolumesN() SPECIES = 2 VolumesN() Else NEWAGE = 1000 End If Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) 'cost of harvesting one hectare COST = COST + cost_nat_regen NEWAGE = 0 NEWTRT = 11 'Some advanced regeneration is hiding under the canopy of the stand StoreFinal() If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 8) = STOCKING objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If ElseIf decision = 4 Then 'clear cut, plant, no early competion control, grows as a 100% stocked natural stand If AGE > YTBH_S - 2 Then SPECIES = 1 VolumesN() SPECIES = 2 VolumesN() Else MERVOL_S = 0 BRDVOL_S = 0 End If Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) 'cost of harvesting one acre COST = COST + fill_plant_cost NEWAGE = 5 NEWSTOCKING = 1 NEWPCT_S = Regen_SW_perct NEWTRT = 1 If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 8) = STOCKING objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 22) = NEWPCT_S objWorksheet.Cells._Default(count_dec, 24) = NEWSTOCKING objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If StoreFinal() ElseIf decision = 5 Or decision = 6 Or decision = 7 Or decision = 8 Or decision = 9 Then 'clear cut, plant, do early competition control, grows as a plantation If AGE > YTBH_S - 2 Then SPECIES = 1 VolumesN() SPECIES = 2 VolumesN() Else MERVOL_S = 0 BRDVOL_S = 0 End If Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) 'cost of harvesting one acre If decision = 5 Or decision = 6 Then COST = COST + plantcost_lt2500 Else COST = COST + plantcost_mt2500 End If NEWAGE = 5 If decision = 5 Then NEWDENSITY = 1000 ElseIf decision = 6 Then NEWDENSITY = 1750 ElseIf decision = 7 Then NEWDENSITY = 2500 ElseIf decision = 8 Then NEWDENSITY = 3250 ElseIf decision = 9 Then NEWDENSITY = 4000 End If SP_S = 100 / System.Math.Sqrt(NEWDENSITY) If YTBH_S < 3 Then Call DIAMP(SP_S, 1, 0, 0, SI_SW, 3 - YTBH_S, NEWDIAM_S) Else NEWDIAM_S = 0 End If NEWTRT = 3 NEWSTOCKING = 1 If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 8) = STOCKING objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 17) = NEWDENSITY objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 24) = NEWSTOCKING objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If StoreFinal() ElseIf decision = 10 Then 'do a pre-commercial thinning and keep as a mixed wood If AGE > YTBH_S - 2 Then If (AHGT_S < 2 Or AHGT_S > 9.1) And (AHGT_H < 6 Or AHGT_H > 9.1) Then 'Cannot do PCT on this stand NEWAGE = 1000 'will do a search for this later when running model Else TR = 0 'Softwood If DIAM_S > 0 And TFREQ_S > 0 Then SP_S = (System.Math.Sqrt(10000 * Regen_SW_perct)) / System.Math.Sqrt(TFREQ_S) 'spacing before PCT Else SP_S = 0 End If If SP_S > 0 And SP_S < 2.1 Then SP_S = 2.1 TR = 1 'stand is being pre-commercially thinned Call DIAMSPA(1, SP_S, DIAM_S, TEMPDIAM_S) 'The stand does not grow for 2 years Call FAGE(TEMPDIAM_S, SI_SW, SP_S, FAGE_S) Call DIAMP(SP_S, 1, TEMPDIAM_S, 0, SI_SW, FAGE_S + 3, NEWDIAM_S) TFREQ_S = 10000 * Regen_SW_perct / (SP_S ^ 2) Call SDP(1, NEWDIAM_S, SD_S) If TFREQ_S > SD_S * Regen_SW_perct Then TFREQ_S = SD_S * Regen_SW_perct End If Call BAREA(TFREQ_S, NEWDIAM_S, NEWBA_S) ElseIf SP_S > 2.1 Then Call DOMHGT(AGE - YTBH_S + 3, SI_SW, SI_HW, NEWDHGT_S, NEWDHGT_H) Call AVGHGT(1, 0, NEWDHGT_S, NEWAHGT_S) Call DIAMN(1, NEWAHGT_S, NEWDIAM_S) TFREQ_S = 10000 * Regen_SW_perct / (SP_S ^ 2) Call SDN(1, NEWDIAM_S, SD_S) If TFREQ_S > SD_S * Regen_SW_perct Then TFREQ_S = SD_S * Regen_SW_perct End If Call BAREA(TFREQ_S, NEWDIAM_S, NEWBA_S) End If 'Hardwood If DIAM_H > 0 And TFREQ_H > 0 Then SP_H = (System.Math.Sqrt(10000 * (1 - Regen_SW_perct))) / System.Math.Sqrt(TFREQ_H) Else SP_H = 0 End If If SP_H > 0 And SP_H < 2.4 Then SP_H = 2.4 TR = 1 'stand is being pre-commercially thinned Call DIAMSPA(1, SP_H, DIAM_H, TEMPDIAM_H) 'The stand does not grow for 2 years Call FAGE(TEMPDIAM_H, SI_HW, SP_H, FAGE_H) Call DIAMP(SP_H, 1, TEMPDIAM_H, 0, SI_HW, FAGE_H + 3, NEWDIAM_H) TFREQ_H = 10000 * (1 - Regen_SW_perct) / (SP_H ^ 2) Call SDP(2, NEWDIAM_H, SD_H) If TFREQ_H > SD_H * (1 - Regen_SW_perct) Then TFREQ_H = SD_H * (1 - Regen_SW_perct) End If Call BAREA(TFREQ_H, NEWDIAM_H, NEWBA_H) ElseIf SP_H >= 2.4 Then Call DOMHGT(AGE - YTBH_S + 3, SI_SW, SI_HW, NEWDHGT_S, NEWDHGT_H) Call AVGHGT(2, 0, NEWDHGT_H, NEWAHGT_H) Call DIAMN(2, NEWAHGT_H, NEWDIAM_H) TFREQ_H = 10000 * (1 - Regen_SW_perct) / (SP_H ^ 2) Call SDN(2, NEWDIAM_H, SD_H) If TFREQ_H > SD_H * (1 - Regen_SW_perct) Then TFREQ_H = SD_H * (1 - Regen_SW_perct) End If Call BAREA(TFREQ_H, NEWDIAM_H, NEWBA_H) End If If (NEWBA_S + NEWBA_H) < 1.8 Then NEWAGE = 1000 End If End If If TR = 0 Then NEWAGE = 1000 Else If NEWAGE < 1000 Then MERVOL_S = 0 BRDVOL_S = 0 MERVOL_H = 0 BRDVOL_H = 0 NEWPCT_S = NEWBA_S / (NEWBA_S + NEWBA_H) If NEWPCT_S = 0 Then NEWDIAM_S = 0.05 NEWPCT_S = 0.001 ElseIf NEWPCT_S = 1 Then NEWDIAM_H = 0.05 NEWPCT_S = 0.9999 End If NEWTREE_BA_H = (NEWDIAM_H / 200) ^ 2 * 3.1415927 NEWTREE_BA_S = (NEWDIAM_S / 200) ^ 2 * 3.1415927 Call SDP(1, NEWDIAM_S, MAX_TREES_S) Call SDP(2, NEWDIAM_H, MAX_TREES_H) CC_FACTOR = (1 / (NEWTREE_BA_H * MAX_TREES_H)) * ((1 - NEWPCT_S) * NEWTREE_BA_S * MAX_TREES_S / NEWPCT_S) + 1 NEWCC = TFREQ_S / MAX_TREES_S * CC_FACTOR * 100 COST = PCTCOST NEWTRT = 2 NEWAGE = AGE + 5 End If End If Else NEWAGE = 1000 End If If RBF > 0 And RBF < 10 And NEWAGE < 1000 Then CreateTmatrix() End If If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 8) = STOCKING objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 20) = NEWDIAM_S objWorksheet.Cells._Default(count_dec, 21) = NEWDIAM_H objWorksheet.Cells._Default(count_dec, 22) = NEWPCT_S objWorksheet.Cells._Default(count_dec, 23) = NEWCC objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If StoreFinal() ElseIf decision = 11 Then 'pre-commercial thinning - eliminate softwood and space hardwood if needed 'When doing a PCT, we assume no diameter growth occurs in the 5 year period following treatment 'because of the trauma done to the land during treatment If AGE > YTBH_S - 2 Then If DIAM_H > 0 Then If (AHGT_S < 2 Or AHGT_S > 9.1) And (AHGT_H < 6 Or AHGT_H > 9.1) Then 'Cannot do PCT on this stand NEWAGE = 1000 'will do a search for this later when running model Else NEWDIAM_S = 0 NEWPCT_S = 0 SP_H = System.Math.Sqrt(10000) / System.Math.Sqrt(TFREQ_H) If SP_H < 2.4 Then SP_H = 2.4 Call DIAMSPA(2, SP_H, DIAM_H, TEMPDIAM_H) Call FAGE(TEMPDIAM_H, SI_HW, SP_H, FAGE_H) Call DIAMP(SP_H, 2, TEMPDIAM_H, 0, SI_HW, FAGE_H + 3, NEWDIAM_H) Else Call FAGE(DIAM_H, SI_HW, SP_H, FAGE_H) Call DIAMP(SP_H, 2, DIAM_H, 0, SI_HW, FAGE_H + 3, NEWDIAM_H) End If NEWTFREQ_H = 10000 / (SP_H ^ 2) If NEWTFREQ_H > TFREQ_H Then NEWTFREQ_H = TFREQ_H End If Call SDP(2, NEWDIAM_H, SD_H) If NEWTFREQ_H > SD_H Then NEWTFREQ_H = SD_H End If Call BAREA(NEWTFREQ_H, NEWDIAM_H, NEWBA_H) If NEWBA_H < 1.8 Then NEWAGE = 1000 End If End If If NEWAGE < 1000 Then MERVOL_S = 0 BRDVOL_S = 0 MERVOL_H = 0 BRDVOL_H = 0 NEWCC = NEWTFREQ_H / SD_H * 100 COST = PCTCOST NEWAGE = AGE + 5 NEWTRT = 2 End If Else NEWAGE = 1000 End If Else NEWAGE = 1000 End If If RBF > 0 And RBF < 10 And NEWAGE < 1000 Then CreateTmatrix() End If If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 8) = STOCKING objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 20) = NEWDIAM_S objWorksheet.Cells._Default(count_dec, 21) = NEWDIAM_H objWorksheet.Cells._Default(count_dec, 22) = NEWPCT_S objWorksheet.Cells._Default(count_dec, 23) = NEWCC objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If StoreFinal() ElseIf decision = 12 Then 'pre-commercial thinning - eliminate hardwood and space softwood if needed If AGE > YTBH_S - 2 Then If DIAM_S > 0 Then If (AHGT_S < 2 Or AHGT_S > 9.1) And (AHGT_H < 6 Or AHGT_H > 9.1) Then 'Cannot do PCT on this stand NEWAGE = 1000 'will do a search for this later when running model Else NEWDIAM_H = 0 NEWPCT_S = 1 SP_S = System.Math.Sqrt(10000 * STOCKING) / System.Math.Sqrt(TFREQ_S) If SP_S < 2.1 Then SP_S = 2.1 Call DIAMSPA(2, SP_S, DIAM_S, TEMPDIAM_S) Call FAGE(TEMPDIAM_S, SI_SW, SP_S, FAGE_S) Call DIAMP(SP_S, 1, TEMPDIAM_S, 0, SI_SW, FAGE_S + 3, NEWDIAM_S) 'no regeneration for 2 years after PCT Else Call FAGE(DIAM_S, SI_SW, SP_S, FAGE_S) Call DIAMP(SP_S, 1, DIAM_S, 0, SI_SW, FAGE_S + 3, NEWDIAM_S) 'no regeneration for 2 years after PCT End If NEWTFREQ_S = 10000 / (SP_S ^ 2) If NEWTFREQ_S > TFREQ_S Then NEWTFREQ_S = TFREQ_S End If Call SDP(1, NEWDIAM_S, SD_S) If NEWTFREQ_S > SD_S Then NEWTFREQ_S = SD_S End If Call BAREA(NEWTFREQ_S, NEWDIAM_S, NEWBA_S) If NEWBA_S < 1.8 Then NEWAGE = 1000 End If End If If NEWAGE < 1000 Then MERVOL_S = 0 BRDVOL_S = 0 MERVOL_H = 0 BRDVOL_H = 0 NEWCC = NEWTFREQ_S / SD_S * 100 COST = PCTCOST NEWAGE = AGE + 5 NEWTRT = 2 End If Else NEWAGE = 1000 End If Else NEWAGE = 1000 End If If RBF > 0 And RBF < 10 And NEWAGE < 1000 Then CreateTmatrix() End If If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 8) = STOCKING objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 20) = NEWDIAM_S objWorksheet.Cells._Default(count_dec, 21) = NEWDIAM_H objWorksheet.Cells._Default(count_dec, 22) = NEWPCT_S objWorksheet.Cells._Default(count_dec, 23) = NEWCC objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If StoreFinal() Else If AGE > YTBH_S - 2 Then If DIAM_S > 8.5 Or DIAM_H > 8.5 Then If decision = 13 Then BARem = 20 BARem_Split = 25 THINTYP = 1 ElseIf decision = 14 Then BARem = 20 BARem_Split = 50 THINTYP = 1 ElseIf decision = 15 Then BARem = 20 BARem_Split = 75 THINTYP = 1 ElseIf decision = 16 Then BARem = 30 BARem_Split = 25 THINTYP = 1 ElseIf decision = 17 Then BARem = 30 BARem_Split = 50 THINTYP = 1 ElseIf decision = 18 Then BARem = 30 BARem_Split = 75 THINTYP = 1 ElseIf decision = 19 Then BARem = 40 BARem_Split = 25 THINTYP = 1 ElseIf decision = 20 Then BARem = 40 BARem_Split = 50 THINTYP = 1 ElseIf decision = 21 Then BARem = 40 BARem_Split = 75 THINTYP = 1 ElseIf decision = 22 Then BARem = 20 BARem_Split = 25 THINTYP = 2 ElseIf decision = 23 Then BARem = 20 BARem_Split = 50 THINTYP = 2 ElseIf decision = 24 Then BARem = 20 BARem_Split = 75 THINTYP = 2 ElseIf decision = 25 Then BARem = 30 BARem_Split = 25 THINTYP = 2 ElseIf decision = 26 Then BARem = 30 BARem_Split = 50 THINTYP = 2 ElseIf decision = 27 Then BARem = 30 BARem_Split = 75 THINTYP = 2 ElseIf decision = 28 Then BARem = 40 BARem_Split = 25 THINTYP = 2 ElseIf decision = 29 Then BARem = 40 BARem_Split = 50 THINTYP = 2 ElseIf decision = 30 Then BARem = 40 BARem_Split = 75 THINTYP = 2 ElseIf decision = 31 Then BARem = 20 BARem_Split = 25 THINTYP = 3 ElseIf decision = 32 Then BARem = 20 BARem_Split = 50 THINTYP = 3 ElseIf decision = 33 Then BARem = 20 BARem_Split = 75 THINTYP = 3 ElseIf decision = 34 Then BARem = 30 BARem_Split = 25 THINTYP = 3 ElseIf decision = 35 Then BARem = 30 BARem_Split = 50 THINTYP = 3 ElseIf decision = 36 Then BARem = 30 BARem_Split = 75 THINTYP = 3 ElseIf decision = 37 Then BARem = 40 BARem_Split = 25 THINTYP = 3 ElseIf decision = 38 Then BARem = 40 BARem_Split = 50 THINTYP = 3 ElseIf decision = 39 Then BARem = 40 BARem_Split = 75 THINTYP = 3 ElseIf decision = 40 Then BARem = 20 BARem_Split = 100 THINTYP = 1 ElseIf decision = 41 Then BARem = 30 BARem_Split = 100 THINTYP = 1 ElseIf decision = 42 Then BARem = 40 BARem_Split = 100 THINTYP = 1 ElseIf decision = 43 Then BARem = 20 BARem_Split = 100 THINTYP = 2 ElseIf decision = 44 Then BARem = 30 BARem_Split = 100 THINTYP = 2 ElseIf decision = 45 Then BARem = 40 BARem_Split = 100 THINTYP = 2 ElseIf decision = 46 Then BARem = 20 BARem_Split = 100 THINTYP = 3 ElseIf decision = 47 Then BARem = 30 BARem_Split = 100 THINTYP = 3 ElseIf decision = 48 Then BARem = 40 BARem_Split = 100 THINTYP = 3 End If If BA_S = 0 And BARem_Split > 0 Then NEWAGE = 1000 ElseIf BA_H = 0 And BARem_Split < 100 Then NEWAGE = 1000 End If If NEWAGE < 1000 Then If AGE = 35 Then XXXXXX = 1 End If Call COMMTHIN(AGE - YTBH_S, DIAM_S, DIAM_H, BA_S, BA_H, BARem, BARem_Split, THINTYP, NEWDIAM_S, NEWDIAM_H, NEWBA_S, NEWBA_H) 'commercial thinning TR = 0 BA_S_REM = BA_S - NEWBA_S ' amount of SW removed Call TFREQ(NEWBA_S, NEWDIAM_S, NEWTFREQ_S) 'This section calculates the diameter of the SW trees that were removed from the stand If BA_S_REM > BA_S Then BA_S_REM = BA_S End If If BA_S > 0 And DIAM_S > 8.5 And NEWAGE < 1000 And BARem_Split > 0 Then TR = 1 TREEBA_REMOVED = BA_S_REM / (TFREQ_S - NEWTFREQ_S) DIAMREM_S = 200 * System.Math.Sqrt(TREEBA_REMOVED / 3.1415927) TEMPDIAM_S = DIAM_S DIAM_S = DIAMREM_S BA_S = BA_S_REM Call TFREQ(BA_S, DIAM_S, TFREQ_S) 'need TFREQ for volume calculations SPECIES = 1 VolumesN() 'calculate the volume of wood removed DIAM_S = TEMPDIAM_S If MERVOL_S < 11.04 Then TR = 0 End If Else TR = 0 End If BA_H_REM = BA_H - NEWBA_H Call TFREQ(NEWBA_H, NEWDIAM_H, NEWTFREQ_H) 'This section calculates the diameter of the HW trees that were removed from the stand If BA_H_REM > BA_H Then BA_H_REM = BA_H End If If BA_H > 0 And DIAM_H > 8.5 And NEWDIAM_H < 1000 And BARem_Split < 100 Then TR = 1 TREEBA_REMOVED = BA_H_REM / (TFREQ_H - NEWTFREQ_H) DIAMREM_H = 200 * System.Math.Sqrt(TREEBA_REMOVED / 3.1415927) TEMPDIAM_H = DIAM_H DIAM_H = DIAMREM_H BA_H = BA_H_REM Call TFREQ(BA_H, DIAM_H, TFREQ_H) 'need TFREQ for volume calculations SPECIES = 2 VolumesN() 'calculate the volume of wood removed DIAM_H = TEMPDIAM_H If MERVOL_H < 12 Then 'not worth doing the thinning if the MERVOL too small TR = 0 End If Else TR = 0 End If If TR = 0 Then NEWAGE = 1000 End If Else TR = 0 End If 'Need to calculate new PCT_S and new CC after CT If NEWAGE < 1000 Then NEWPCT_S = NEWBA_S / (NEWBA_S + NEWBA_H) If NEWDIAM_S > 0 Then NEWTREE_BA_S = (NEWDIAM_S / 200) ^ 2 * 3.1415927 Call SDP(1, NEWDIAM_S, NEWMAX_TREES_S) End If If NEWDIAM_H > 0 Then NEWTREE_BA_H = (NEWDIAM_H / 200) ^ 2 * 3.1415927 Call SDP(2, NEWDIAM_H, NEWMAX_TREES_H) End If If NEWDIAM_S > 0 And NEWDIAM_H > 0 Then CC_FACTOR = (1 / (NEWTREE_BA_H * NEWMAX_TREES_H)) * ((1 - NEWPCT_S) * NEWTREE_BA_S * NEWMAX_TREES_S / NEWPCT_S) + 1 NEWCC = NEWTFREQ_S / NEWMAX_TREES_S * CC_FACTOR * 100 ElseIf NEWDIAM_S = 0 And NEWDIAM_H > 0 Then NEWCC = NEWTFREQ_H / NEWMAX_TREES_H * 100 ElseIf NEWDIAM_H = 0 And NEWDIAM_S > 0 Then NEWCC = NEWTFREQ_S / NEWMAX_TREES_S * 100 End If End If If TR = 1 Then 'COST of doing CT Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) COST = COST + ct_flat_cost End If 'Need to calculate new diameters, new PCT_S and NEWCC after 3 years of growth If NEWAGE < 1000 Then NEWBA_S_FULL = NEWTREE_BA_S * NEWMAX_TREES_S NEWBA_H_FULL = NEWTREE_BA_H * NEWMAX_TREES_H If NEWBA_H_FULL <= 0 And NEWPCT_S > 0 Then Fraction_S = 1 ElseIf NEWBA_H_FULL > 0 And NEWPCT_S <= 0 Then Fraction_S = 0 Else Fraction_S = 1 / ((1 / NEWBA_H_FULL) * ((NEWBA_S_FULL / NEWPCT_S) - NEWBA_S_FULL) + 1) End If If NEWDIAM_S > 0 Then NEWTFREQ_S = NEWBA_S / (3.1415927 * (NEWDIAM_S / 200) ^ 2) SP_S = System.Math.Sqrt(10000 * Fraction_S) / System.Math.Sqrt(NEWTFREQ_S) Call FAGE(NEWDIAM_S, SI_SW, SP_S, FAGE_S) Call DIAMP(SP_S, 1, NEWDIAM_S, 0, SI_SW, FAGE_S + 3, NEWDIAM_S) NEWBA_S = NEWTFREQ_S * 3.1415927 * (NEWDIAM_S / 200) ^ 2 Else NEWTFREQ_S = 0 NEWBA_S = 0 End If If NEWDIAM_H > 0 And Fraction_S < 1 Then Fraction_H = 1 - Fraction_S NEWTFREQ_H = NEWBA_H / (3.1415927 * (NEWDIAM_H / 200) ^ 2) SP_H = System.Math.Sqrt(10000 * Fraction_H) / System.Math.Sqrt(NEWTFREQ_H) Call FAGE(NEWDIAM_H, SI_HW, SP_H, FAGE_H) Call DIAMP(SP_H, 1, NEWDIAM_H, 0, SI_HW, FAGE_H + 3, NEWDIAM_H) NEWBA_H = NEWTFREQ_H * 3.1415927 * (NEWDIAM_H / 200) ^ 2 Else Fraction_H = 0 NEWTFREQ_H = 0 NEWBA_H = 0 End If NEWPCT_S = NEWBA_S / (NEWBA_S + NEWBA_H) If NEWDIAM_S > 0 Then NEWTREE_BA_S = 3.1415927 * (NEWDIAM_S / 200) ^ 2 Call SDP(1, NEWDIAM_S, NEWMAXTREES_S) End If If NEWDIAM_H > 0 Then NEWTREE_BA_H = 3.1415927 * (NEWDIAM_H / 200) ^ 2 Call SDP(2, NEWDIAM_H, NEWMAXTREES_H) End If If NEWDIAM_S > 0 And NEWDIAM_H > 0 Then CC_FACTOR = (1 / (NEWTREE_BA_H * NEWMAXTREES_H)) * ((1 - NEWPCT_S) * NEWTREE_BA_S * NEWMAXTREES_S / NEWPCT_S) + 1 NEWCC = NEWTFREQ_S / NEWMAXTREES_S * CC_FACTOR * 100 ElseIf NEWDIAM_S = 0 And NEWDIAM_H > 0 Then NEWCC = NEWTFREQ_H / NEWMAXTREES_H * 100 ElseIf NEWDIAM_H = 0 And NEWDIAM_S > 0 Then NEWCC = NEWTFREQ_S / NEWMAXTREES_S * 100 End If NEWTRT = 5 NEWAGE = AGE + 5 If NEWCC > 100 Then NEWCC = 100 ElseIf NEWCC < 40 Then NEWAGE = 1000 End If End If Else NEWAGE = 1000 End If Else NEWAGE = 1000 End If If RBF > 0 And RBF < 10 And NEWAGE < 1000 Then CreateTmatrix() End If If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 8) = STOCKING objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 12) = BARem objWorksheet.Cells._Default(count_dec, 13) = BARem_Split objWorksheet.Cells._Default(count_dec, 14) = THINTYP objWorksheet.Cells._Default(count_dec, 15) = BA_S_REM objWorksheet.Cells._Default(count_dec, 16) = BA_H_REM objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 20) = NEWDIAM_S objWorksheet.Cells._Default(count_dec, 21) = NEWDIAM_H objWorksheet.Cells._Default(count_dec, 22) = NEWPCT_S objWorksheet.Cells._Default(count_dec, 23) = NEWCC objWorksheet.Cells._Default(count_dec, 24) = NEWSTOCKING objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H objWorksheet.Cells._Default(count_dec, 29) = DIAMREM_S objWorksheet.Cells._Default(count_dec, 30) = DIAMREM_H objWorksheet.Cells._Default(count_dec, 31) = Temporary_BA_S objWorksheet.Cells._Default(count_dec, 32) = Temporary_BA_H End If StoreFinal() End If End Sub Private Sub Treat2() '************************************************************************************ '* '* Subroutine for the pre-commercially thinned stands '* '************************************************************************************ If State = 50 And decision = 12 Then XXXXXX = 1 End If AGE = States(State, 1) DIAM_S = States(State, 2) DIAM_H = States(State, 3) PCT_S = States(State, 4) CC = States(State, 5) STOCKING = 1 COST = 0 YTBH_S = 44.07021 - 1.63556 * SI_SW * 3.28084 + 0.0222 * (SI_SW * 3.28084) ^ 2 - 0.000100987 * (SI_SW * 3.28084) ^ 3 Call DOMHGT(AGE - YTBH_S, SI_SW, SI_HW, DHGT_S, DHGT_H) If PCT_S = 0 Then 'PRACTICALLY ZERO Fraction_S = 0 Call SDN(2, DIAM_H, MAXTREES_H) BA_H_FULL = MAXTREES_H * 3.1415927 * (DIAM_H / 200) ^ 2 Else If DIAM_S > 0 Then Call SDP(1, DIAM_S, MAXTREES_S) BA_S_FULL = MAXTREES_S * 3.1415927 * (DIAM_S / 200) ^ 2 Else BA_S_FULL = 0 End If If DIAM_H > 0 Then Call SDN(2, DIAM_H, MAXTREES_H) BA_H_FULL = MAXTREES_H * 3.1415927 * (DIAM_H / 200) ^ 2 Else BA_H_FULL = 0 End If If BA_H_FULL = 0 Then Fraction_S = 1 ElseIf PCT_S = 0 Then Fraction_S = 0 Else Fraction_S = 1 / ((1 / BA_H_FULL) * ((BA_S_FULL / PCT_S) - BA_S_FULL) + 1) End If End If If Fraction_S > 0 Then TFREQ_S = Fraction_S * MAXTREES_S * CC / 100 SP_S = System.Math.Sqrt(10000 * Fraction_S) / System.Math.Sqrt(TFREQ_S) BA_S = TFREQ_S * 3.1415927 * (DIAM_S / 200) ^ 2 Else TFREQ_S = 0 SP_S = 0 BA_S = 0 End If If (1 - Fraction_S) > 0 Then TFREQ_H = (1 - Fraction_S) * MAXTREES_H * CC / 100 SP_H = System.Math.Sqrt(10000 * (1 - Fraction_S)) / System.Math.Sqrt(TFREQ_H) BA_H = TFREQ_H * 3.1415927 * (DIAM_H / 200) ^ 2 Else TFREQ_H = 0 SP_H = 0 BA_H = 0 End If TYP = 1 '*************************************************************** '* There are 48 possible decisions that can be taken '*************************************************************** If decision = 2 Then 'do nothing, let grow and calculate the new dimensions in 5 years If AGE < 90 Then If PCT_S > 0 Then If SP_S < 3.1 Then Call FAGE(DIAM_S, SI_SW, SP_S, FAGE_S) Call DIAMP(SP_S, 1, DIAM_S, 0, SI_SW, FAGE_S + 5, NEWDIAM_S) Else B1 = 0.02785202 B2 = -0.367548143 B3 = -0.005540854 DBHIB = (DIAM_S / 2.54 - 0.016384) / 1.057711 TMPBA = DBHIB ^ 2 * 0.005454 * (MAXTREES_S * CC / 100) / 2.47105 D5IB = (B1 * SI_SW * 3.28084 + B2) * System.Math.Exp(B3 * TMPBA) NEWDIAM_S = ((DBHIB + D5IB) * 1.057711 + 0.016384) * 2.54 End If Else NEWDIAM_S = 0 NEWPCT_S = 0 End If If (1 - PCT_S) > 0 Then Call DIAMP(0, 2, DIAM_H, BA_H / ((1 - Fraction_S)), SI_HW, 0, NEWDIAM_H) Else NEWDIAM_H = 0 NEWPCT_S = 1 End If NEWAGE = AGE + 5 If NEWDIAM_S = 0 Then NEWTFREQ_S = 0 Else Call SDP(1, NEWDIAM_S, NEWMAXTREES_S) If TFREQ_S > NEWMAXTREES_S * Fraction_S Then NEWTFREQ_S = NEWMAXTREES_S * Fraction_S Else NEWTFREQ_S = TFREQ_S End If End If If NEWDIAM_H = 0 Then NEWTFREQ_H = 0 Else Call SDP(2, NEWDIAM_H, NEWMAXTREES_H) If TFREQ_H > NEWMAXTREES_H * (1 - Fraction_S) Then NEWTFREQ_H = NEWMAXTREES_H * (1 - Fraction_S) Else NEWTFREQ_H = TFREQ_H End If End If NEWBA_S = NEWTFREQ_S * 3.1415927 * (NEWDIAM_S / 200) ^ 2 NEWBA_H = NEWTFREQ_H * 3.1415927 * (NEWDIAM_H / 200) ^ 2 NEWPCT_S = NEWBA_S / (NEWBA_S + NEWBA_H) If NEWDIAM_S > 0 Then NEWTREE_BA_S = (NEWDIAM_S / 200) ^ 2 * 3.1415927 End If If NEWDIAM_H > 0 Then NEWTREE_BA_H = (NEWDIAM_H / 200) ^ 2 * 3.1415927 End If If NEWDIAM_S > 0 And NEWDIAM_H > 0 Then CC_FACTOR = (1 / (NEWTREE_BA_H * NEWMAXTREES_H)) * ((1 - NEWPCT_S) * NEWTREE_BA_S * NEWMAXTREES_S / NEWPCT_S) + 1 NEWCC = NEWTFREQ_S / NEWMAXTREES_S * CC_FACTOR * 100 ElseIf NEWDIAM_S = 0 And NEWDIAM_H > 0 Then NEWCC = NEWTFREQ_H / NEWMAXTREES_H * 100 ElseIf NEWDIAM_H = 0 And NEWDIAM_S > 0 Then NEWCC = NEWTFREQ_S / NEWMAXTREES_S * 100 End If COST = 0 MERVOL_S = 0 BRDVOL_S = 0 MERVOL_H = 0 BRDVOL_H = 0 NEWTRT = 2 If RBF > 0 And RBF < 10 And NEWAGE < 1000 Then CreateTmatrix() End If Else NEWAGE = 1000 End If StoreFinal() If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 5) = DIAM_H objWorksheet.Cells._Default(count_dec, 6) = PCT_S objWorksheet.Cells._Default(count_dec, 7) = CC objWorksheet.Cells._Default(count_dec, 8) = STOCKING objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 20) = NEWDIAM_S objWorksheet.Cells._Default(count_dec, 21) = NEWDIAM_H objWorksheet.Cells._Default(count_dec, 22) = NEWPCT_S objWorksheet.Cells._Default(count_dec, 23) = NEWCC objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If ElseIf decision = 3 Then 'clear cut, let natural regen (no garantee of regen in first 5 year period) SPECIES = 1 VolumesP() SPECIES = 2 VolumesP() Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) 'cost of harvesting one hectare COST = COST + cost_nat_regen NEWAGE = 0 NEWTRT = 11 'Some advanced regeneration is hiding under the canopy of the stand StoreFinal() If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 5) = DIAM_H objWorksheet.Cells._Default(count_dec, 6) = PCT_S objWorksheet.Cells._Default(count_dec, 7) = CC objWorksheet.Cells._Default(count_dec, 8) = STOCKING objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 20) = NEWDIAM_S objWorksheet.Cells._Default(count_dec, 21) = NEWDIAM_H objWorksheet.Cells._Default(count_dec, 22) = NEWPCT_S objWorksheet.Cells._Default(count_dec, 23) = NEWCC objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If ElseIf decision = 4 Then 'clear cut, plant, no early competion control, grows as a 100% stocked natural stand SPECIES = 1 VolumesP() SPECIES = 2 VolumesP() Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) 'cost of harvesting one acre COST = COST + fill_plant_cost NEWAGE = 5 NEWSTOCKING = 1 NEWPCT_S = Regen_SW_perct NEWTRT = 1 StoreFinal() If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 5) = DIAM_H objWorksheet.Cells._Default(count_dec, 6) = PCT_S objWorksheet.Cells._Default(count_dec, 7) = CC objWorksheet.Cells._Default(count_dec, 8) = STOCKING objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 20) = NEWDIAM_S objWorksheet.Cells._Default(count_dec, 21) = NEWDIAM_H objWorksheet.Cells._Default(count_dec, 22) = NEWPCT_S objWorksheet.Cells._Default(count_dec, 23) = NEWCC objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If ElseIf decision = 5 Or decision = 6 Or decision = 7 Or decision = 8 Or decision = 9 Then 'clear cut, plant, do early competition control, grows as a plantation SPECIES = 1 VolumesP() SPECIES = 2 VolumesP() Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) 'cost of harvesting one acre If decision = 5 Or decision = 6 Then COST = COST + plantcost_lt2500 Else COST = COST + plantcost_mt2500 End If NEWAGE = 5 If decision = 5 Then NEWDENSITY = 1000 ElseIf decision = 6 Then NEWDENSITY = 1750 ElseIf decision = 7 Then NEWDENSITY = 2500 ElseIf decision = 8 Then NEWDENSITY = 3250 ElseIf decision = 9 Then NEWDENSITY = 4000 End If YTBH_S = 44.07021 - 1.63556 * SI_SW + 0.0222 * SI_SW ^ 2 - 0.000100987 * SI_SW ^ 3 SP_S = 100 / System.Math.Sqrt(NEWDENSITY) If YTBH_S < 3 Then Call DIAMP(SP_S, 1, 0, 0, SI_SW, 3 - YTBH_S, NEWDIAM_S) Else NEWDIAM_S = 0 End If NEWTRT = 3 NEWSTOCKING = 1 StoreFinal() If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 5) = DIAM_H objWorksheet.Cells._Default(count_dec, 6) = PCT_S objWorksheet.Cells._Default(count_dec, 7) = CC objWorksheet.Cells._Default(count_dec, 8) = STOCKING objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 20) = NEWDIAM_S objWorksheet.Cells._Default(count_dec, 21) = NEWDIAM_H objWorksheet.Cells._Default(count_dec, 22) = NEWPCT_S objWorksheet.Cells._Default(count_dec, 23) = NEWCC objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If Else If AGE > YTBH_S - 2 Then If DIAM_S > 8.5 Or DIAM_H > 8.5 Then If decision = 13 Then BARem = 20 BARem_Split = 25 THINTYP = 1 ElseIf decision = 14 Then BARem = 20 BARem_Split = 50 THINTYP = 1 ElseIf decision = 15 Then BARem = 20 BARem_Split = 75 THINTYP = 1 ElseIf decision = 16 Then BARem = 30 BARem_Split = 25 THINTYP = 1 ElseIf decision = 17 Then BARem = 30 BARem_Split = 50 THINTYP = 1 ElseIf decision = 18 Then BARem = 30 BARem_Split = 75 THINTYP = 1 ElseIf decision = 19 Then BARem = 40 BARem_Split = 25 THINTYP = 1 ElseIf decision = 20 Then BARem = 40 BARem_Split = 50 THINTYP = 1 ElseIf decision = 21 Then BARem = 40 BARem_Split = 75 THINTYP = 1 ElseIf decision = 22 Then BARem = 20 BARem_Split = 25 THINTYP = 2 ElseIf decision = 23 Then BARem = 20 BARem_Split = 50 THINTYP = 2 ElseIf decision = 24 Then BARem = 20 BARem_Split = 75 THINTYP = 2 ElseIf decision = 25 Then BARem = 30 BARem_Split = 25 THINTYP = 2 ElseIf decision = 26 Then BARem = 30 BARem_Split = 50 THINTYP = 2 ElseIf decision = 27 Then BARem = 30 BARem_Split = 75 THINTYP = 2 ElseIf decision = 28 Then BARem = 40 BARem_Split = 25 THINTYP = 2 ElseIf decision = 29 Then BARem = 40 BARem_Split = 50 THINTYP = 2 ElseIf decision = 30 Then BARem = 40 BARem_Split = 75 THINTYP = 2 ElseIf decision = 31 Then BARem = 20 BARem_Split = 25 THINTYP = 3 ElseIf decision = 32 Then BARem = 20 BARem_Split = 50 THINTYP = 3 ElseIf decision = 33 Then BARem = 20 BARem_Split = 75 THINTYP = 3 ElseIf decision = 34 Then BARem = 30 BARem_Split = 25 THINTYP = 3 ElseIf decision = 35 Then BARem = 30 BARem_Split = 50 THINTYP = 3 ElseIf decision = 36 Then BARem = 30 BARem_Split = 75 THINTYP = 3 ElseIf decision = 37 Then BARem = 40 BARem_Split = 25 THINTYP = 3 ElseIf decision = 38 Then BARem = 40 BARem_Split = 50 THINTYP = 3 ElseIf decision = 39 Then BARem = 40 BARem_Split = 75 THINTYP = 3 ElseIf decision = 40 Then BARem = 20 BARem_Split = 100 THINTYP = 1 ElseIf decision = 41 Then BARem = 30 BARem_Split = 100 THINTYP = 1 ElseIf decision = 42 Then BARem = 40 BARem_Split = 100 THINTYP = 1 ElseIf decision = 43 Then BARem = 20 BARem_Split = 100 THINTYP = 2 ElseIf decision = 44 Then BARem = 30 BARem_Split = 100 THINTYP = 2 ElseIf decision = 45 Then BARem = 40 BARem_Split = 100 THINTYP = 2 ElseIf decision = 46 Then BARem = 20 BARem_Split = 100 THINTYP = 3 ElseIf decision = 47 Then BARem = 30 BARem_Split = 100 THINTYP = 3 ElseIf decision = 48 Then BARem = 40 BARem_Split = 100 THINTYP = 3 End If If BA_S = 0 And BARem_Split > 0 Then NEWAGE = 1000 ElseIf BA_H = 0 And BARem_Split < 100 Then NEWAGE = 1000 End If If NEWAGE < 1000 Then Call COMMTHIN(AGE - YTBH_S, DIAM_S, DIAM_H, BA_S, BA_H, BARem, BARem_Split, THINTYP, NEWDIAM_S, NEWDIAM_H, NEWBA_S, NEWBA_H) 'commercial thinning If NEWDIAM_H > 0 And NEWBA_H = 0 Then xxxxx = 1 End If TR = 0 BA_S_REM = BA_S - NEWBA_S ' amount of SW removed Call TFREQ(NEWBA_S, NEWDIAM_S, NEWTFREQ_S) 'This section calculates the diameter of the SW trees that were removed from the stand If BA_S_REM > BA_S Then BA_S_REM = BA_S End If If BA_S_REM > 0 And NEWAGE < 1000 Then TR = 1 TREEBA_REMOVED = BA_S_REM / (TFREQ_S - NEWTFREQ_S) DIAMREM_S = 200 * System.Math.Sqrt(TREEBA_REMOVED / 3.1415927) TEMPDIAM_S = DIAM_S DIAM_S = DIAMREM_S BA_S = BA_S_REM Call TFREQ(BA_S, DIAM_S, TFREQ_S) 'need TFREQ for volume calculations SPECIES = 1 VolumesN() 'calculate the volume of wood removed DIAM_S = TEMPDIAM_S If MERVOL_S < 11.04 Then TR = 0 End If Else TR = 0 End If BA_H_REM = BA_H - NEWBA_H Call TFREQ(NEWBA_H, NEWDIAM_H, NEWTFREQ_H) 'This section calculates the diameter of the HW trees that were removed from the stand If BA_H_REM > BA_H Then BA_H_REM = BA_H End If If BA_H_REM > 0 And NEWAGE < 1000 Then TR = 1 TREEBA_REMOVED = BA_H_REM / (TFREQ_H - NEWTFREQ_H) DIAMREM_H = 200 * System.Math.Sqrt(TREEBA_REMOVED / 3.1415927) TEMPDIAM_H = DIAM_H DIAM_H = DIAMREM_H BA_H = BA_H_REM Call TFREQ(BA_H, DIAM_H, TFREQ_H) 'need TFREQ for volume calculations SPECIES = 2 VolumesN() 'calculate the volume of wood removed DIAM_H = TEMPDIAM_H If MERVOL_H < 12 Then 'not worth doing the thinning if the MERVOL too small TR = 0 End If Else TR = 0 End If If TR = 0 Then NEWAGE = 1000 End If Else TR = 0 End If If TR = 1 Then 'COST of doing CT Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) COST = COST + ct_flat_cost End If 'Need to calculate new diameters, new PCT_S and NEWCC after 3 years of growth If NEWAGE < 1000 Then NEWPCT_S = NEWBA_S / (NEWBA_S + NEWBA_H) If NEWDIAM_S > 0 Then Call SDP(1, NEWDIAM_S, NEWMAX_TREES_S) End If If NEWDIAM_H > 0 Then Call SDP(2, NEWDIAM_H, NEWMAX_TREES_H) End If NEWTREE_BA_S = 3.1415927 * (NEWDIAM_S / 200) ^ 2 NEWTREE_BA_H = 3.1415927 * (NEWDIAM_H / 200) ^ 2 NEWBA_S_FULL = NEWTREE_BA_S * NEWMAX_TREES_S NEWBA_H_FULL = NEWTREE_BA_H * NEWMAX_TREES_H If NEWBA_H_FULL = 0 And NEWPCT_S > 0 Then Fraction_S = 1 ElseIf NEWBA_H_FULL > 0 And NEWPCT_S = 0 Then Fraction_S = 0 Else Fraction_S = 1 / ((1 / NEWBA_H_FULL) * ((NEWBA_S_FULL / NEWPCT_S) - NEWBA_S_FULL) + 1) End If If NEWDIAM_S > 0 Then NEWTFREQ_S = NEWBA_S / (3.1415927 * (NEWDIAM_S / 200) ^ 2) SP_S = System.Math.Sqrt(10000 * Fraction_S) / System.Math.Sqrt(NEWTFREQ_S) Call FAGE(NEWDIAM_S, SI_SW, SP_S, FAGE_S) Call DIAMP(SP_S, 1, NEWDIAM_S, 0, SI_SW, FAGE_S + 3, NEWDIAM_S) Call SDP(1, NEWDIAM_S, SD_S) If NEWTFREQ_S > SD_S * Fraction_S Then NEWTFREQ_S = SD_S * Fraction_S End If NEWBA_S = NEWTFREQ_S * 3.1415927 * (NEWDIAM_S / 200) ^ 2 Else NEWTFREQ_S = 0 NEWBA_S = 0 End If If NEWDIAM_H > 0 And Fraction_S < 1 Then NEWTFREQ_H = NEWBA_H / (3.1415927 * (NEWDIAM_H / 200) ^ 2) SP_H = System.Math.Sqrt(10000 * (1 - Fraction_S)) / System.Math.Sqrt(NEWTFREQ_H) Call FAGE(NEWDIAM_H, SI_HW, SP_H, FAGE_H) Call DIAMP(SP_H, 1, NEWDIAM_H, 0, SI_HW, FAGE_H + 3, NEWDIAM_H) Call SDP(2, NEWDIAM_H, SD_H) If NEWTFREQ_H > SD_H * (1 - Fraction_S) Then NEWTFREQ_H = SD_H * (1 - Fraction_S) End If NEWBA_H = NEWTFREQ_H * 3.1415927 * (NEWDIAM_H / 200) ^ 2 Else NEWTFREQ_H = 0 NEWBA_H = 0 End If NEWPCT_S = NEWBA_S / (NEWBA_S + NEWBA_H) If NEWDIAM_S > 0 Then NEWTREE_BA_S = 3.1415927 * (NEWDIAM_S / 200) ^ 2 Call SDP(1, NEWDIAM_S, NEWMAXTREES_S) End If If NEWDIAM_H > 0 Then NEWTREE_BA_H = 3.1415927 * (NEWDIAM_H / 200) ^ 2 Call SDP(2, NEWDIAM_H, NEWMAXTREES_H) End If If NEWDIAM_S > 0 And NEWDIAM_H > 0 Then CC_FACTOR = (1 / (NEWTREE_BA_H * NEWMAXTREES_H)) * ((1 - NEWPCT_S) * NEWTREE_BA_S * NEWMAXTREES_S / NEWPCT_S) + 1 NEWCC = NEWTFREQ_S / NEWMAXTREES_S * CC_FACTOR * 100 ElseIf NEWDIAM_S = 0 And NEWDIAM_H > 0 Then NEWCC = NEWTFREQ_H / NEWMAXTREES_H * 100 ElseIf NEWDIAM_H = 0 And NEWDIAM_S > 0 Then NEWCC = NEWTFREQ_S / NEWMAXTREES_S * 100 End If If NEWCC > 100 Then NEWCC = 100 ElseIf NEWCC < 40 Then NEWAGE = 1000 End If NEWTRT = 5 NEWAGE = AGE + 5 End If Else NEWAGE = 1000 End If Else NEWAGE = 1000 End If If RBF > 0 And RBF < 10 And NEWAGE < 1000 Then CreateTmatrix() End If StoreFinal() If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 5) = DIAM_H objWorksheet.Cells._Default(count_dec, 6) = PCT_S objWorksheet.Cells._Default(count_dec, 7) = CC objWorksheet.Cells._Default(count_dec, 8) = STOCKING objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 20) = NEWDIAM_S objWorksheet.Cells._Default(count_dec, 21) = NEWDIAM_H objWorksheet.Cells._Default(count_dec, 22) = NEWPCT_S objWorksheet.Cells._Default(count_dec, 23) = NEWCC objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H objWorksheet.Cells._Default(count_dec, 31) = Temporary_BA_S objWorksheet.Cells._Default(count_dec, 32) = Temporary_BA_H End If End If End Sub Private Sub Treat3() '************************************************************************************ '* '* Subroutine for non-commercially thinned plantations '* '************************************************************************************ If State = 403 Then XXXXXX = 1 End If AGE = States(State, 1) If AGE = 20 Then zzz = 1 End If DIAM_S = States(State, 2) DENSITY = States(State, 3) If DENSITY = 1750 Then zzzz = 1 End If STOCKING = 1 COST = 0 YTBH_S = 44.07021 - 1.63556 * SI_SW * 3.28084 + 0.0222 * (SI_SW * 3.28084) ^ 2 - 0.000100987 * (SI_SW * 3.28084) ^ 3 If AGE > YTBH_S + 2 Then Call DOMHGT(AGE, SI_SW, SI_HW, DHGT_S, DHGT_H) Call SDP(1, DIAM_S, MAXTREES_S) If DENSITY > MAXTREES_S Then TFREQ_S = MAXTREES_S Else TFREQ_S = DENSITY End If SP_S = 100 / System.Math.Sqrt(TFREQ_S) BA_S = TFREQ_S * 3.1415927 * (DIAM_S / 200) ^ 2 End If TYP = 1 '*************************************************************** '* There are 48 possible decisions that can be taken '*************************************************************** If decision = 2 Then 'do nothing, let grow and calculate the new dimensions in 5 years If AGE < 95 Then If AGE > YTBH_S + 2 Then If SP_S < 3.1 Then Call DIAMP(SP_S, 1, DIAM_S, 0, SI_SW, AGE - YTBH_S - 2, TEMP) Call DIAMP(SP_S, 1, DIAM_S, 0, SI_SW, AGE - YTBH_S + 3, TEMP1) NEWDIAM_S = DIAM_S + TEMP1 - TEMP Else B1 = 0.02785202 B2 = -0.367548143 B3 = -0.005540854 DBHIB = (DIAM_S / 2.54 - 0.016384) / 1.057711 TMPBA = DBHIB ^ 2 * 0.005454 * (TFREQ_S) / 2.47105 D5IB = (B1 * SI_SW * 3.28084 + B2) * System.Math.Exp(B3 * TMPBA) NEWDIAM_S = ((DBHIB + D5IB) * 1.057711 + 0.016384) * 2.54 End If Else NEWDIAM_S = 0 End If NEWAGE = AGE + 5 COST = 0 MERVOL_S = 0 BRDVOL_S = 0 MERVOL_H = 0 BRDVOL_H = 0 NEWTRT = 3 Else NEWAGE = 1000 End If If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 10) = DENSITY objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 20) = NEWDIAM_S objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If StoreFinal() ElseIf decision = 3 Then 'clear cut, let natural regen (no garantee of regen in first 5 year period) If DIAM_S > 0 Then SPECIES = 1 VolumesP() MERVOL_H = 0 BRDVOL_H = 0 Else MERVOL_S = 0 BRDVOL_S = 0 MERVOL_H = 0 BRDVOL_H = 0 End If Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) 'cost of harvesting one hectare COST = COST + cost_nat_regen NEWAGE = 10 NEWTRT = 11 'Some advanced regeneration is hiding under the canopy of the stand StoreFinal() If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 10) = DENSITY objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If ElseIf decision = 4 Then 'clear cut, plant, no early competion control, grows as a 100% stocked natural stand If DIAM_S > 0 Then SPECIES = 1 VolumesP() MERVOL_H = 0 BRDVOL_H = 0 Else MERVOL_S = 0 BRDVOL_S = 0 MERVOL_H = 0 BRDVOL_H = 0 End If Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) 'cost of harvesting one acre COST = COST + fill_plant_cost NEWAGE = 5 NEWSTOCKING = 1 NEWPCT_S = Regen_SW_perct NEWTRT = 1 If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 10) = DENSITY objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 22) = NEWPCT_S objWorksheet.Cells._Default(count_dec, 24) = NEWSTOCKING objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If StoreFinal() ElseIf decision = 5 Or decision = 6 Or decision = 7 Or decision = 8 Or decision = 9 Then 'clear cut, plant, do early competition control, grows as a plantation If DIAM_S > 0 Then SPECIES = 1 VolumesP() MERVOL_H = 0 BRDVOL_H = 0 Else MERVOL_S = 0 BRDVOL_S = 0 MERVOL_H = 0 BRDVOL_H = 0 End If Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) 'cost of harvesting one acre If decision = 5 Or decision = 6 Then COST = COST + plantcost_lt2500 Else COST = COST + plantcost_mt2500 End If NEWAGE = 5 If decision = 5 Then NEWDENSITY = 1000 ElseIf decision = 6 Then NEWDENSITY = 1750 ElseIf decision = 7 Then NEWDENSITY = 2500 ElseIf decision = 8 Then NEWDENSITY = 3250 ElseIf decision = 9 Then NEWDENSITY = 4000 End If YTBH_S = 44.07021 - 1.63556 * SI_SW + 0.0222 * SI_SW ^ 2 - 0.000100987 * SI_SW ^ 3 SP_S = 100 / System.Math.Sqrt(NEWDENSITY) If YTBH_S < 3 Then Call DIAMP(SP_S, 1, 0, 0, SI_SW, 3 - YTBH_S, NEWDIAM_S) Else NEWDIAM_S = 0 End If NEWTRT = 3 If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 10) = DENSITY objWorksheet.Cells._Default(count_dec, 17) = NEWDENSITY objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If StoreFinal() Else If AGE > YTBH_S - 2 Then If DIAM_S > 8.5 Or DIAM_H > 8.5 Then If decision = 13 Then BARem = 20 BARem_Split = 25 THINTYP = 1 ElseIf decision = 14 Then BARem = 20 BARem_Split = 50 THINTYP = 1 ElseIf decision = 15 Then BARem = 20 BARem_Split = 75 THINTYP = 1 ElseIf decision = 16 Then BARem = 30 BARem_Split = 25 THINTYP = 1 ElseIf decision = 17 Then BARem = 30 BARem_Split = 50 THINTYP = 1 ElseIf decision = 18 Then BARem = 30 BARem_Split = 75 THINTYP = 1 ElseIf decision = 19 Then BARem = 40 BARem_Split = 25 THINTYP = 1 ElseIf decision = 20 Then BARem = 40 BARem_Split = 50 THINTYP = 1 ElseIf decision = 21 Then BARem = 40 BARem_Split = 75 THINTYP = 1 ElseIf decision = 22 Then BARem = 20 BARem_Split = 25 THINTYP = 2 ElseIf decision = 23 Then BARem = 20 BARem_Split = 50 THINTYP = 2 ElseIf decision = 24 Then BARem = 20 BARem_Split = 75 THINTYP = 2 ElseIf decision = 25 Then BARem = 30 BARem_Split = 25 THINTYP = 2 ElseIf decision = 26 Then BARem = 30 BARem_Split = 50 THINTYP = 2 ElseIf decision = 27 Then BARem = 30 BARem_Split = 75 THINTYP = 2 ElseIf decision = 28 Then BARem = 40 BARem_Split = 25 THINTYP = 2 ElseIf decision = 29 Then BARem = 40 BARem_Split = 50 THINTYP = 2 ElseIf decision = 30 Then BARem = 40 BARem_Split = 75 THINTYP = 2 ElseIf decision = 31 Then BARem = 20 BARem_Split = 25 THINTYP = 3 ElseIf decision = 32 Then BARem = 20 BARem_Split = 50 THINTYP = 3 ElseIf decision = 33 Then BARem = 20 BARem_Split = 75 THINTYP = 3 ElseIf decision = 34 Then BARem = 30 BARem_Split = 25 THINTYP = 3 ElseIf decision = 35 Then BARem = 30 BARem_Split = 50 THINTYP = 3 ElseIf decision = 36 Then BARem = 30 BARem_Split = 75 THINTYP = 3 ElseIf decision = 37 Then BARem = 40 BARem_Split = 25 THINTYP = 3 ElseIf decision = 38 Then BARem = 40 BARem_Split = 50 THINTYP = 3 ElseIf decision = 39 Then BARem = 40 BARem_Split = 75 THINTYP = 3 ElseIf decision = 40 Then BARem = 20 BARem_Split = 100 THINTYP = 1 ElseIf decision = 41 Then BARem = 30 BARem_Split = 100 THINTYP = 1 ElseIf decision = 42 Then BARem = 40 BARem_Split = 100 THINTYP = 1 ElseIf decision = 43 Then BARem = 20 BARem_Split = 100 THINTYP = 2 ElseIf decision = 44 Then BARem = 30 BARem_Split = 100 THINTYP = 2 ElseIf decision = 45 Then BARem = 40 BARem_Split = 100 THINTYP = 2 ElseIf decision = 46 Then BARem = 20 BARem_Split = 100 THINTYP = 3 ElseIf decision = 47 Then BARem = 30 BARem_Split = 100 THINTYP = 3 ElseIf decision = 48 Then BARem = 40 BARem_Split = 100 THINTYP = 3 End If If BA_S = 0 And BARem_Split > 0 Then NEWAGE = 1000 ElseIf BA_H = 0 And BARem_Split < 100 Then NEWAGE = 1000 End If If NEWAGE < 1000 Then Call COMMTHIN(AGE - YTBH_S, DIAM_S, DIAM_H, BA_S, 0, BARem, BARem_Split, THINTYP, NEWDIAM_S, NEWDIAM_H, NEWBA_S, NEWBA_H) 'commercial thinning TR = 0 BA_S_REM = BA_S - NEWBA_S ' amount of SW removed Call TFREQ(NEWBA_S, NEWDIAM_S, NEWTFREQ_S) 'This section calculates the diameter of the SW trees that were removed from the stand If BA_S_REM > BA_S Then BA_S_REM = BA_S End If If BA_S > 0 And DIAM_S > 8.5 And NEWAGE < 1000 And BARem_Split > 0 Then TR = 1 TREEBA_REMOVED = BA_S_REM / (TFREQ_S - NEWTFREQ_S) DIAMREM_S = 200 * System.Math.Sqrt(TREEBA_REMOVED / 3.1415927) TEMPDIAM_S = DIAM_S DIAM_S = DIAMREM_S BA_S = BA_S_REM Call TFREQ(BA_S, DIAM_S, TFREQ_S) 'need TFREQ for volume calculations SPECIES = 1 VolumesP() 'calculate the volume of wood removed DIAM_S = TEMPDIAM_S If MERVOL_S < 11.04 Then TR = 0 End If Else TR = 0 End If If TR = 0 Then NEWAGE = 1000 End If Else TR = 0 End If If TR = 1 Then 'COST of doing CT Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, 0, 0, 0, HARVPRICE, decision, COST) COST = COST + ct_flat_cost End If 'Need to calculate new diameters, new PCT_S and NEWCC after 3 years of growth If NEWAGE < 1000 Then NEWTFREQ_S = NEWBA_S / (3.1415927 * (NEWDIAM_S / 200) ^ 2) SP_S = System.Math.Sqrt(10000) / System.Math.Sqrt(NEWTFREQ_S) Call FAGE(NEWDIAM_S, SI_SW, SP_S, FAGE_S) Call DIAMP(SP_S, 1, NEWDIAM_S, 0, SI_SW, FAGE_S + 3, NEWDIAM_S) Call SDP(1, NEWDIAM_S, SD_S) If NEWTFREQ_S > SD_S Then NEWTFREQ_S = SD_S End If Call SDP(1, NEWDIAM_S, NEWMAXTREES_S) NEWCC = NEWTFREQ_S / NEWMAXTREES_S * 100 NEWTRT = 4 NEWAGE = AGE + 5 If NEWCC > 100 Then NEWCC = 100 ElseIf NEWCC < 40 Then NEWAGE = 1000 End If End If Else NEWAGE = 1000 End If Else NEWAGE = 1000 End If If RBF > 0 And RBF < 10 And NEWAGE < 1000 Then CreateTmatrix() End If StoreFinal() If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 10) = DENSITY objWorksheet.Cells._Default(count_dec, 12) = BARem objWorksheet.Cells._Default(count_dec, 13) = BARem_Split objWorksheet.Cells._Default(count_dec, 14) = THINTYP objWorksheet.Cells._Default(count_dec, 15) = BA_S_REM objWorksheet.Cells._Default(count_dec, 16) = BA_H_REM objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 20) = NEWDIAM_S objWorksheet.Cells._Default(count_dec, 23) = NEWCC objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H objWorksheet.Cells._Default(count_dec, 29) = DIAMREM_S objWorksheet.Cells._Default(count_dec, 30) = DIAMREM_H objWorksheet.Cells._Default(count_dec, 31) = Temporary_BA_S objWorksheet.Cells._Default(count_dec, 32) = Temporary_BA_H End If End If End Sub Private Sub Treat4() '************************************************************************************ '* '* Subroutine for commercially thinned plantations '* '************************************************************************************ If State = 735 And decision = 30 Then XXXXXX = 1 End If AGE = States(State, 1) DIAM_S = States(State, 2) CC = States(State, 3) STOCKING = 1 COST = 0 YTBH_S = 44.07021 - 1.63556 * SI_SW * 3.28084 + 0.0222 * (SI_SW * 3.28084) ^ 2 - 0.000100987 * (SI_SW * 3.28084) ^ 3 If AGE > YTBH_S + 2 Then Call DOMHGT(AGE - YTBH_S, SI_SW, SI_HW, DHGT_S, DHGT_H) Else DHGT_S = 0 DHGT_H = 0 End If Call SDP(1, DIAM_S, MAXTREES_S) TFREQ_S = MAXTREES_S * CC / 100 SP_S = System.Math.Sqrt(10000) / System.Math.Sqrt(TFREQ_S) BA_S = TFREQ_S * 3.1415927 * (DIAM_S / 200) ^ 2 TYP = 1 '*************************************************************** '* There are 48 possible decisions that can be taken '*************************************************************** If decision = 2 Then 'do nothing, let grow and calculate the new dimensions in 5 years If AGE < 100 Then If SP_S < 3.1 Then Call FAGE(DIAM_S, SI_SW, SP_S, FAGE_S) Call DIAMP(SP_S, 1, DIAM_S, 0, SI_SW, FAGE_S + 5, NEWDIAM_S) Else B1 = 0.02785202 B2 = -0.367548143 B3 = -0.005540854 DBHIB = (DIAM_S / 2.54 - 0.016384) / 1.057711 TMPBA = DBHIB ^ 2 * 0.005454 * (MAXTREES_S * CC / 100) / 2.47105 D5IB = (B1 * SI_SW * 3.28084 + B2) * System.Math.Exp(B3 * TMPBA) NEWDIAM_S = ((DBHIB + D5IB) * 1.057711 + 0.016384) * 2.54 End If NEWAGE = AGE + 5 Call SDP(1, NEWDIAM_S, NEWMAXTREES_S) If TFREQ_S > NEWMAXTREES_S Then NEWTFREQ_S = NEWMAXTREES_S Else NEWTFREQ_S = TFREQ_S End If NEWCC = NEWTFREQ_S / NEWMAXTREES_S * 100 COST = 0 MERVOL_S = 0 BRDVOL_S = 0 MERVOL_H = 0 BRDVOL_H = 0 NEWTRT = 4 If RBF > 0 And RBF < 10 And NEWAGE < 1000 Then CreateTmatrix() End If Else NEWAGE = 1000 End If If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 7) = CC objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 20) = NEWDIAM_S objWorksheet.Cells._Default(count_dec, 23) = NEWCC objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If StoreFinal() ElseIf decision = 3 Then 'clear cut, let natural regen (no garantee of regen in first 5 year period) SPECIES = 1 VolumesP() SPECIES = 2 VolumesP() Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) 'cost of harvesting one hectare COST = COST + cost_nat_regen NEWAGE = 10 NEWTRT = 11 'Some advanced regeneration is hiding under the canopy of the stand StoreFinal() objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 7) = CC objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H ElseIf decision = 4 Then 'clear cut, plant, no early competion control, grows as a 100% stocked natural stand SPECIES = 1 VolumesP() SPECIES = 2 VolumesP() Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) 'cost of harvesting one acre COST = COST + fill_plant_cost NEWAGE = 5 NEWSTOCKING = 1 NEWTRT = 1 If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 7) = CC objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 24) = NEWSTOCKING objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If StoreFinal() ElseIf decision = 5 Or decision = 6 Or decision = 7 Or decision = 8 Or decision = 9 Then 'clear cut, plant, do early competition control, grows as a plantation SPECIES = 1 VolumesP() SPECIES = 2 VolumesP() Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) 'cost of harvesting one acre If decision = 5 Or decision = 6 Then COST = COST + plantcost_lt2500 Else COST = COST + plantcost_mt2500 End If NEWAGE = 5 If decision = 5 Then NEWDENSITY = 1000 ElseIf decision = 6 Then NEWDENSITY = 1750 ElseIf decision = 7 Then NEWDENSITY = 2500 ElseIf decision = 8 Then NEWDENSITY = 3250 ElseIf decision = 9 Then NEWDENSITY = 4000 End If YTBH_S = 44.07021 - 1.63556 * SI_SW + 0.0222 * SI_SW ^ 2 - 0.000100987 * SI_SW ^ 3 SP_S = 100 / System.Math.Sqrt(NEWDENSITY) If YTBH_S < 3 Then Call DIAMP(SP_S, 1, 0, 0, SI_SW, 3 - YTBH_S, NEWDIAM_S) Else NEWDIAM_S = 0 End If NEWTRT = 3 NEWSTOCKING = 1 If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 7) = CC objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 17) = NEWDENSITY objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 24) = NEWSTOCKING objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If StoreFinal() Else If AGE > YTBH_S - 2 And AGE < 100 Then If DIAM_S > 8.5 Or DIAM_H > 8.5 Then If decision = 13 Then BARem = 20 BARem_Split = 25 THINTYP = 1 ElseIf decision = 14 Then BARem = 20 BARem_Split = 50 THINTYP = 1 ElseIf decision = 15 Then BARem = 20 BARem_Split = 75 THINTYP = 1 ElseIf decision = 16 Then BARem = 30 BARem_Split = 25 THINTYP = 1 ElseIf decision = 17 Then BARem = 30 BARem_Split = 50 THINTYP = 1 ElseIf decision = 18 Then BARem = 30 BARem_Split = 75 THINTYP = 1 ElseIf decision = 19 Then BARem = 40 BARem_Split = 25 THINTYP = 1 ElseIf decision = 20 Then BARem = 40 BARem_Split = 50 THINTYP = 1 ElseIf decision = 21 Then BARem = 40 BARem_Split = 75 THINTYP = 1 ElseIf decision = 22 Then BARem = 20 BARem_Split = 25 THINTYP = 2 ElseIf decision = 23 Then BARem = 20 BARem_Split = 50 THINTYP = 2 ElseIf decision = 24 Then BARem = 20 BARem_Split = 75 THINTYP = 2 ElseIf decision = 25 Then BARem = 30 BARem_Split = 25 THINTYP = 2 ElseIf decision = 26 Then BARem = 30 BARem_Split = 50 THINTYP = 2 ElseIf decision = 27 Then BARem = 30 BARem_Split = 75 THINTYP = 2 ElseIf decision = 28 Then BARem = 40 BARem_Split = 25 THINTYP = 2 ElseIf decision = 29 Then BARem = 40 BARem_Split = 50 THINTYP = 2 ElseIf decision = 30 Then BARem = 40 BARem_Split = 75 THINTYP = 2 ElseIf decision = 31 Then BARem = 20 BARem_Split = 25 THINTYP = 3 ElseIf decision = 32 Then BARem = 20 BARem_Split = 50 THINTYP = 3 ElseIf decision = 33 Then BARem = 20 BARem_Split = 75 THINTYP = 3 ElseIf decision = 34 Then BARem = 30 BARem_Split = 25 THINTYP = 3 ElseIf decision = 35 Then BARem = 30 BARem_Split = 50 THINTYP = 3 ElseIf decision = 36 Then BARem = 30 BARem_Split = 75 THINTYP = 3 ElseIf decision = 37 Then BARem = 40 BARem_Split = 25 THINTYP = 3 ElseIf decision = 38 Then BARem = 40 BARem_Split = 50 THINTYP = 3 ElseIf decision = 39 Then BARem = 40 BARem_Split = 75 THINTYP = 3 ElseIf decision = 40 Then BARem = 20 BARem_Split = 100 THINTYP = 1 ElseIf decision = 41 Then BARem = 30 BARem_Split = 100 THINTYP = 1 ElseIf decision = 42 Then BARem = 40 BARem_Split = 100 THINTYP = 1 ElseIf decision = 43 Then BARem = 20 BARem_Split = 100 THINTYP = 2 ElseIf decision = 44 Then BARem = 30 BARem_Split = 100 THINTYP = 2 ElseIf decision = 45 Then BARem = 40 BARem_Split = 100 THINTYP = 2 ElseIf decision = 46 Then BARem = 20 BARem_Split = 100 THINTYP = 3 ElseIf decision = 47 Then BARem = 30 BARem_Split = 100 THINTYP = 3 ElseIf decision = 48 Then BARem = 40 BARem_Split = 100 THINTYP = 3 End If If BA_S = 0 And BARem_Split > 0 Then NEWAGE = 1000 ElseIf BA_H = 0 And BARem_Split < 100 Then NEWAGE = 1000 End If If NEWAGE < 1000 Then Call COMMTHIN(AGE - YTBH_S, DIAM_S, DIAM_H, BA_S, 0, BARem, BARem_Split, THINTYP, NEWDIAM_S, NEWDIAM_H, NEWBA_S, NEWBA_H) 'commercial thinning TR = 0 BA_S_REM = BA_S - NEWBA_S ' amount of SW removed Call TFREQ(NEWBA_S, NEWDIAM_S, NEWTFREQ_S) 'This section calculates the diameter of the SW trees that were removed from the stand If BA_S_REM > BA_S Then BA_S_REM = BA_S End If If BA_S > 0 And DIAM_S > 8.5 And NEWAGE < 1000 And BARem_Split > 0 Then TR = 1 TREEBA_REMOVED = BA_S_REM / (TFREQ_S - NEWTFREQ_S) DIAMREM_S = 200 * System.Math.Sqrt(TREEBA_REMOVED / 3.1415927) TEMPDIAM_S = DIAM_S DIAM_S = DIAMREM_S BA_S = BA_S_REM Call TFREQ(BA_S, DIAM_S, TFREQ_S) 'need TFREQ for volume calculations SPECIES = 1 VolumesP() 'calculate the volume of wood removed DIAM_S = TEMPDIAM_S If MERVOL_S < 11.04 Then TR = 0 End If End If If TR = 0 Then NEWAGE = 1000 End If Else TR = 0 End If If TR = 1 Then 'COST of doing CT Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, 0, 0, 0, HARVPRICE, decision, COST) COST = COST + ct_flat_cost End If 'Need to calculate new diameters, new PCT_S and NEWCC after 3 years of growth If NEWAGE < 1000 Then NEWTFREQ_S = NEWBA_S / (3.1415927 * (NEWDIAM_S / 200) ^ 2) SP_S = System.Math.Sqrt(10000) / System.Math.Sqrt(NEWTFREQ_S) Call FAGE(NEWDIAM_S, SI_SW, SP_S, FAGE_S) Call DIAMP(SP_S, 1, NEWDIAM_S, 0, SI_SW, FAGE_S + 3, NEWDIAM_S) Call SDP(1, NEWDIAM_S, SD_S) If NEWTFREQ_S > SD_S Then NEWTFREQ_S = SD_S End If Call SDP(1, NEWDIAM_S, NEWMAXTREES_S) NEWCC = NEWTFREQ_S / NEWMAXTREES_S * 100 NEWTRT = 4 NEWAGE = AGE + 5 If NEWCC > 100 Then NEWCC = 100 ElseIf NEWCC < 40 Then NEWAGE = 1000 End If End If Else NEWAGE = 1000 End If Else NEWAGE = 1000 End If If RBF > 0 And RBF < 10 And NEWAGE < 1000 Then CreateTmatrix() End If StoreFinal() If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 7) = CC objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 12) = BARem objWorksheet.Cells._Default(count_dec, 13) = BARem_Split objWorksheet.Cells._Default(count_dec, 14) = THINTYP objWorksheet.Cells._Default(count_dec, 15) = BA_S_REM objWorksheet.Cells._Default(count_dec, 16) = BA_H_REM objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 20) = NEWDIAM_S objWorksheet.Cells._Default(count_dec, 23) = NEWCC objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H objWorksheet.Cells._Default(count_dec, 29) = DIAMREM_S objWorksheet.Cells._Default(count_dec, 31) = Temporary_BA_S objWorksheet.Cells._Default(count_dec, 32) = Temporary_BA_H End If End If End Sub Private Sub Treat5() '************************************************************************************ '* '* Subroutine for the commercially thinned natural stands '* '************************************************************************************ If State = 619 And decision = 3 Then XXXXXX = 1 End If AGE = States(State, 1) DIAM_S = States(State, 2) DIAM_H = States(State, 3) PCT_S = States(State, 4) CC = States(State, 5) STOCKING = 1 COST = 0 YTBH_S = 44.07021 - 1.63556 * SI_SW * 3.28084 + 0.0222 * (SI_SW * 3.28084) ^ 2 - 0.000100987 * (SI_SW * 3.28084) ^ 3 Call DOMHGT(AGE - YTBH_S, SI_SW, SI_HW, DHGT_S, DHGT_H) If PCT_S = 0 Then 'PRACTICALLY ZERO Fraction_S = 0 Call SDN(2, DIAM_H, MAXTREES_H) BA_H_FULL = MAXTREES_H * 3.1415927 * (DIAM_H / 200) ^ 2 Else If DIAM_S > 0 Then Call SDP(1, DIAM_S, MAXTREES_S) BA_S_FULL = MAXTREES_S * 3.1415927 * (DIAM_S / 200) ^ 2 Else BA_S_FULL = 0 End If If DIAM_H > 0 Then Call SDN(2, DIAM_H, MAXTREES_H) BA_H_FULL = MAXTREES_H * 3.1415927 * (DIAM_H / 200) ^ 2 Else BA_H_FULL = 0 End If If BA_H_FULL = 0 Then Fraction_S = 1 ElseIf PCT_S = 0 Then Fraction_S = 0 Else Fraction_S = 1 / ((1 / BA_H_FULL) * ((BA_S_FULL / PCT_S) - BA_S_FULL) + 1) End If End If If Fraction_S > 0 Then TFREQ_S = Fraction_S * MAXTREES_S * CC / 100 SP_S = System.Math.Sqrt(10000 * Fraction_S) / System.Math.Sqrt(TFREQ_S) BA_S = TFREQ_S * 3.1415927 * (DIAM_S / 200) ^ 2 Else TFREQ_S = 0 SP_S = 0 BA_S = 0 End If If (1 - Fraction_S) > 0 Then TFREQ_H = (1 - Fraction_S) * MAXTREES_H * CC / 100 SP_H = System.Math.Sqrt(10000 * (1 - Fraction_S)) / System.Math.Sqrt(TFREQ_H) BA_H = TFREQ_H * 3.1415927 * (DIAM_H / 200) ^ 2 Else TFREQ_H = 0 SP_H = 0 BA_H = 0 End If TYP = 1 '*************************************************************** '* There are 48 possible decisions that can be taken '*************************************************************** If decision = 2 Then 'do nothing, let grow and calculate the new dimensions in 5 years If AGE < 100 Then If PCT_S > 0 Then If SP_S < 3.1 Then Call FAGE(DIAM_S, SI_SW, SP_S, FAGE_S) Call DIAMP(SP_S, 1, DIAM_S, 0, SI_SW, FAGE_S + 5, NEWDIAM_S) Else B1 = 0.02785202 B2 = -0.367548143 B3 = -0.005540854 DBHIB = (DIAM_S / 2.54 - 0.016384) / 1.057711 TMPBA = DBHIB ^ 2 * 0.005454 * (MAXTREES_S * CC / 100) / 2.47105 D5IB = (B1 * SI_SW * 3.28084 + B2) * System.Math.Exp(B3 * TMPBA) NEWDIAM_S = ((DBHIB + D5IB) * 1.057711 + 0.016384) * 2.54 End If Else NEWDIAM_S = 0 NEWPCT_S = 0 End If If (1 - PCT_S) > 0 Then Call DIAMP(0, 2, DIAM_H, BA_H / (1 - Fraction_S), SI_HW, 0, NEWDIAM_H) Else NEWDIAM_H = 0 NEWPCT_S = 1 End If NEWAGE = AGE + 5 If NEWDIAM_S = 0 Then NEWTFREQ_S = 0 Else Call SDP(1, NEWDIAM_S, NEWMAXTREES_S) If TFREQ_S > NEWMAXTREES_S * Fraction_S Then NEWTFREQ_S = NEWMAXTREES_S * Fraction_S Else NEWTFREQ_S = TFREQ_S End If End If If NEWDIAM_H = 0 Then NEWTFREQ_H = 0 Else Call SDP(2, NEWDIAM_H, NEWMAXTREES_H) If TFREQ_H > NEWMAXTREES_H * (1 - Fraction_S) Then NEWTFREQ_H = NEWMAXTREES_H * (1 - Fraction_S) Else NEWTFREQ_H = TFREQ_H End If End If NEWBA_S = NEWTFREQ_S * 3.1415927 * (NEWDIAM_S / 200) ^ 2 NEWBA_H = NEWTFREQ_H * 3.1415927 * (NEWDIAM_H / 200) ^ 2 NEWPCT_S = NEWBA_S / (NEWBA_S + NEWBA_H) If NEWDIAM_S > 0 Then NEWTREE_BA_S = (NEWDIAM_S / 200) ^ 2 * 3.1415927 End If If NEWDIAM_H > 0 Then NEWTREE_BA_H = (NEWDIAM_H / 200) ^ 2 * 3.1415927 End If If NEWDIAM_S > 0 And NEWDIAM_H > 0 Then CC_FACTOR = (1 / (NEWTREE_BA_H * NEWMAXTREES_H)) * ((1 - NEWPCT_S) * NEWTREE_BA_S * NEWMAXTREES_S / NEWPCT_S) + 1 NEWCC = NEWTFREQ_S / NEWMAXTREES_S * CC_FACTOR * 100 ElseIf NEWDIAM_S = 0 And NEWDIAM_H > 0 Then NEWCC = NEWTFREQ_H / NEWMAXTREES_H * 100 ElseIf NEWDIAM_H = 0 And NEWDIAM_S > 0 Then NEWCC = NEWTFREQ_S / NEWMAXTREES_S * 100 End If COST = 0 MERVOL_S = 0 BRDVOL_S = 0 MERVOL_H = 0 BRDVOL_H = 0 NEWTRT = 5 If RBF > 0 And RBF < 10 And NEWAGE < 1000 Then CreateTmatrix() End If Else NEWAGE = 1000 End If If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 5) = DIAM_H objWorksheet.Cells._Default(count_dec, 6) = PCT_S objWorksheet.Cells._Default(count_dec, 7) = CC objWorksheet.Cells._Default(count_dec, 8) = STOCKING objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 20) = NEWDIAM_S objWorksheet.Cells._Default(count_dec, 21) = NEWDIAM_H objWorksheet.Cells._Default(count_dec, 22) = NEWPCT_S objWorksheet.Cells._Default(count_dec, 23) = NEWCC objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If StoreFinal() ElseIf decision = 3 Then 'clear cut, let natural regen (no garantee of regen in first 5 year period) SPECIES = 1 VolumesP() SPECIES = 2 VolumesP() Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) 'cost of harvesting one hectare COST = COST + cost_nat_regen NEWAGE = 10 NEWTRT = 11 'Some advanced regeneration is hiding under the canopy of the stand StoreFinal() If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 5) = DIAM_H objWorksheet.Cells._Default(count_dec, 6) = PCT_S objWorksheet.Cells._Default(count_dec, 7) = CC objWorksheet.Cells._Default(count_dec, 8) = STOCKING objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If ElseIf decision = 4 Then 'clear cut, plant, no early competion control, grows as a 100% stocked natural stand SPECIES = 1 VolumesP() SPECIES = 2 VolumesP() Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) 'cost of harvesting one acre COST = COST + fill_plant_cost NEWAGE = 5 NEWSTOCKING = 1 NEWPCT_S = Regen_SW_perct NEWTRT = 1 objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 5) = DIAM_H objWorksheet.Cells._Default(count_dec, 6) = PCT_S objWorksheet.Cells._Default(count_dec, 7) = CC objWorksheet.Cells._Default(count_dec, 8) = STOCKING objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 22) = NEWPCT_S objWorksheet.Cells._Default(count_dec, 24) = NEWSTOCKING objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H StoreFinal() ElseIf decision = 5 Or decision = 6 Or decision = 7 Or decision = 8 Or decision = 9 Then 'clear cut, plant, do early competition control, grows as a plantation SPECIES = 1 VolumesP() SPECIES = 2 VolumesP() Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) 'cost of harvesting one acre If decision = 5 Or decision = 6 Then COST = COST + plantcost_lt2500 Else COST = COST + plantcost_mt2500 End If NEWAGE = 5 If decision = 5 Then NEWDENSITY = 1000 ElseIf decision = 6 Then NEWDENSITY = 1750 ElseIf decision = 7 Then NEWDENSITY = 2500 ElseIf decision = 8 Then NEWDENSITY = 3250 ElseIf decision = 9 Then NEWDENSITY = 4000 End If YTBH_S = 44.07021 - 1.63556 * SI_SW + 0.0222 * SI_SW ^ 2 - 0.000100987 * SI_SW ^ 3 SP_S = 100 / System.Math.Sqrt(NEWDENSITY) If YTBH_S < 3 Then Call DIAMP(SP_S, 1, 0, 0, SI_SW, 3 - YTBH_S, NEWDIAM_S) Else NEWDIAM_S = 0 End If NEWTRT = 3 If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 5) = DIAM_H objWorksheet.Cells._Default(count_dec, 6) = PCT_S objWorksheet.Cells._Default(count_dec, 7) = CC objWorksheet.Cells._Default(count_dec, 8) = STOCKING objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 17) = NEWDENSITY objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 22) = NEWPCT_S objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H End If StoreFinal() Else If AGE > YTBH_S - 2 And AGE < 100 Then If DIAM_S > 8.5 Or DIAM_H > 8.5 Then If decision = 13 Then BARem = 20 BARem_Split = 25 THINTYP = 1 ElseIf decision = 14 Then BARem = 20 BARem_Split = 50 THINTYP = 1 ElseIf decision = 15 Then BARem = 20 BARem_Split = 75 THINTYP = 1 ElseIf decision = 16 Then BARem = 30 BARem_Split = 25 THINTYP = 1 ElseIf decision = 17 Then BARem = 30 BARem_Split = 50 THINTYP = 1 ElseIf decision = 18 Then BARem = 30 BARem_Split = 75 THINTYP = 1 ElseIf decision = 19 Then BARem = 40 BARem_Split = 25 THINTYP = 1 ElseIf decision = 20 Then BARem = 40 BARem_Split = 50 THINTYP = 1 ElseIf decision = 21 Then BARem = 40 BARem_Split = 75 THINTYP = 1 ElseIf decision = 22 Then BARem = 20 BARem_Split = 25 THINTYP = 2 ElseIf decision = 23 Then BARem = 20 BARem_Split = 50 THINTYP = 2 ElseIf decision = 24 Then BARem = 20 BARem_Split = 75 THINTYP = 2 ElseIf decision = 25 Then BARem = 30 BARem_Split = 25 THINTYP = 2 ElseIf decision = 26 Then BARem = 30 BARem_Split = 50 THINTYP = 2 ElseIf decision = 27 Then BARem = 30 BARem_Split = 75 THINTYP = 2 ElseIf decision = 28 Then BARem = 40 BARem_Split = 25 THINTYP = 2 ElseIf decision = 29 Then BARem = 40 BARem_Split = 50 THINTYP = 2 ElseIf decision = 30 Then BARem = 40 BARem_Split = 75 THINTYP = 2 ElseIf decision = 31 Then BARem = 20 BARem_Split = 25 THINTYP = 3 ElseIf decision = 32 Then BARem = 20 BARem_Split = 50 THINTYP = 3 ElseIf decision = 33 Then BARem = 20 BARem_Split = 75 THINTYP = 3 ElseIf decision = 34 Then BARem = 30 BARem_Split = 25 THINTYP = 3 ElseIf decision = 35 Then BARem = 30 BARem_Split = 50 THINTYP = 3 ElseIf decision = 36 Then BARem = 30 BARem_Split = 75 THINTYP = 3 ElseIf decision = 37 Then BARem = 40 BARem_Split = 25 THINTYP = 3 ElseIf decision = 38 Then BARem = 40 BARem_Split = 50 THINTYP = 3 ElseIf decision = 39 Then BARem = 40 BARem_Split = 75 THINTYP = 3 ElseIf decision = 40 Then BARem = 20 BARem_Split = 100 THINTYP = 1 ElseIf decision = 41 Then BARem = 30 BARem_Split = 100 THINTYP = 1 ElseIf decision = 42 Then BARem = 40 BARem_Split = 100 THINTYP = 1 ElseIf decision = 43 Then BARem = 20 BARem_Split = 100 THINTYP = 2 ElseIf decision = 44 Then BARem = 30 BARem_Split = 100 THINTYP = 2 ElseIf decision = 45 Then BARem = 40 BARem_Split = 100 THINTYP = 2 ElseIf decision = 46 Then BARem = 20 BARem_Split = 100 THINTYP = 3 ElseIf decision = 47 Then BARem = 30 BARem_Split = 100 THINTYP = 3 ElseIf decision = 48 Then BARem = 40 BARem_Split = 100 THINTYP = 3 End If If BA_S = 0 And BARem_Split > 0 Then NEWAGE = 1000 ElseIf BA_H = 0 And BARem_Split < 100 Then NEWAGE = 1000 End If If NEWAGE < 1000 Then Call COMMTHIN(AGE - YTBH_S, DIAM_S, DIAM_H, BA_S, BA_H, BARem, BARem_Split, THINTYP, NEWDIAM_S, NEWDIAM_H, NEWBA_S, NEWBA_H) 'commercial thinning TR = 0 BA_S_REM = BA_S - NEWBA_S ' amount of SW removed Call TFREQ(NEWBA_S, NEWDIAM_S, NEWTFREQ_S) 'This section calculates the diameter of the SW trees that were removed from the stand If BA_S_REM > BA_S Then BA_S_REM = BA_S End If If BA_S > 0 And DIAM_S > 8.5 And NEWAGE < 1000 And BARem_Split > 0 Then TR = 1 TREEBA_REMOVED = BA_S_REM / (TFREQ_S - NEWTFREQ_S) DIAMREM_S = 200 * System.Math.Sqrt(TREEBA_REMOVED / 3.1415927) TEMPDIAM_S = DIAM_S DIAM_S = DIAMREM_S BA_S = BA_S_REM Call TFREQ(BA_S, DIAM_S, TFREQ_S) 'need TFREQ for volume calculations SPECIES = 1 VolumesN() 'calculate the volume of wood removed DIAM_S = TEMPDIAM_S If MERVOL_S < 11.04 Then TR = 0 End If End If BA_H_REM = BA_H - NEWBA_H Call TFREQ(NEWBA_H, NEWDIAM_H, NEWTFREQ_H) 'This section calculates the diameter of the HW trees that were removed from the stand If BA_H_REM > BA_H Then BA_H_REM = BA_H End If If BA_H > 0 And DIAM_H > 8.5 And NEWDIAM_H < 1000 And BARem_Split < 100 Then TR = 1 TREEBA_REMOVED = BA_H_REM / (TFREQ_H - NEWTFREQ_H) DIAMREM_H = 200 * System.Math.Sqrt(TREEBA_REMOVED / 3.1415927) TEMPDIAM_H = DIAM_H DIAM_H = DIAMREM_H BA_H = BA_H_REM Call TFREQ(BA_H, DIAM_H, TFREQ_H) 'need TFREQ for volume calculations SPECIES = 2 VolumesN() 'calculate the volume of wood removed DIAM_H = TEMPDIAM_H If MERVOL_H < 12 Then 'not worth doing the thinning if the MERVOL too small TR = 0 End If End If If TR = 0 Then NEWAGE = 1000 End If Else TR = 0 End If If TR = 1 Then 'COST of doing CT Call COSTHARV(MERDIAM_S, MERVOL_S, BRDVOL_S, MERDIAM_H, MERVOL_H, BRDVOL_H, HARVPRICE, decision, COST) COST = COST + ct_flat_cost End If 'Need to calculate new diameters, new PCT_S and NEWCC after 3 years of growth If NEWAGE < 1000 Then NEWPCT_S = NEWBA_S / (NEWBA_S + NEWBA_H) If NEWDIAM_S > 0 Then Call SDP(1, NEWDIAM_S, NEWMAX_TREES_S) End If If NEWDIAM_H > 0 Then Call SDP(2, NEWDIAM_H, NEWMAX_TREES_H) End If NEWTREE_BA_S = 3.1415927 * (NEWDIAM_S / 200) ^ 2 NEWTREE_BA_H = 3.1415927 * (NEWDIAM_H / 200) ^ 2 NEWBA_S_FULL = NEWTREE_BA_S * NEWMAX_TREES_S NEWBA_H_FULL = NEWTREE_BA_H * NEWMAX_TREES_H If NEWBA_H_FULL = 0 And NEWPCT_S > 0 Then Fraction_S = 1 ElseIf NEWBA_H_FULL > 0 And NEWPCT_S = 0 Then Fraction_S = 0 Else Fraction_S = 1 / ((1 / NEWBA_H_FULL) * ((NEWBA_S_FULL / NEWPCT_S) - NEWBA_S_FULL) + 1) End If If NEWDIAM_S > 0 Then NEWTFREQ_S = NEWBA_S / (3.1415927 * (NEWDIAM_S / 200) ^ 2) SP_S = System.Math.Sqrt(10000 * Fraction_S) / System.Math.Sqrt(NEWTFREQ_S) Call FAGE(NEWDIAM_S, SI_SW, SP_S, FAGE_S) Call DIAMP(SP_S, 1, NEWDIAM_S, 0, SI_SW, FAGE_S + 3, NEWDIAM_S) Call SDP(1, NEWDIAM_S, SD_S) If NEWTFREQ_S > SD_S * Fraction_S Then NEWTFREQ_S = SD_S * Fraction_S End If NEWBA_S = NEWTFREQ_S * 3.1415927 * (NEWDIAM_S / 200) ^ 2 Else NEWTFREQ_S = 0 NEWBA_S = 0 End If If NEWDIAM_H > 0 And Fraction_S < 1 Then NEWTFREQ_H = NEWBA_H / (3.1415927 * (NEWDIAM_H / 200) ^ 2) SP_H = System.Math.Sqrt(10000 * (1 - Fraction_S)) / System.Math.Sqrt(NEWTFREQ_H) Call FAGE(NEWDIAM_H, SI_HW, SP_H, FAGE_H) Call DIAMP(SP_H, 1, NEWDIAM_H, 0, SI_HW, FAGE_H + 3, NEWDIAM_H) Call SDP(2, NEWDIAM_H, SD_H) If NEWTFREQ_H > SD_H * (1 - Fraction_S) Then NEWTFREQ_H = SD_H * (1 - Fraction_S) End If NEWBA_H = NEWTFREQ_H * 3.1415927 * (NEWDIAM_H / 200) ^ 2 Else NEWTFREQ_H = 0 NEWBA_H = 0 End If NEWPCT_S = NEWBA_S / (NEWBA_S + NEWBA_H) If NEWDIAM_S > 0 Then NEWTREE_BA_S = 3.1415927 * (NEWDIAM_S / 200) ^ 2 Call SDP(1, NEWDIAM_S, NEWMAXTREES_S) End If If NEWDIAM_H > 0 Then NEWTREE_BA_H = 3.1415927 * (NEWDIAM_H / 200) ^ 2 Call SDP(2, NEWDIAM_H, NEWMAXTREES_H) End If If NEWDIAM_S > 0 And NEWDIAM_H > 0 Then CC_FACTOR = (1 / (NEWTREE_BA_H * NEWMAXTREES_H)) * ((1 - NEWPCT_S) * NEWTREE_BA_S * NEWMAXTREES_S / NEWPCT_S) + 1 NEWCC = NEWTFREQ_S / NEWMAXTREES_S * CC_FACTOR * 100 ElseIf NEWDIAM_S = 0 And NEWDIAM_H > 0 Then NEWCC = NEWTFREQ_H / NEWMAXTREES_H * 100 ElseIf NEWDIAM_H = 0 And NEWDIAM_S > 0 Then NEWCC = NEWTFREQ_S / NEWMAXTREES_S * 100 End If NEWTRT = 5 NEWAGE = AGE + 5 If NEWCC > 100 Then NEWCC = 100 ElseIf NEWCC < 40 Then NEWAGE = 1000 End If End If Else NEWAGE = 1000 End If Else NEWAGE = 1000 End If If RBF > 0 And RBF < 10 And NEWAGE < 1000 Then CreateTmatrix() End If StoreFinal() If GNY_stats.CheckState = 1 Then objWorksheet = objWorkbook.Sheets("Stats") objWorksheet.Cells._Default(count_dec, 1) = State objWorksheet.Cells._Default(count_dec, 2) = TRT objWorksheet.Cells._Default(count_dec, 3) = AGE objWorksheet.Cells._Default(count_dec, 4) = DIAM_S objWorksheet.Cells._Default(count_dec, 5) = DIAM_H objWorksheet.Cells._Default(count_dec, 6) = PCT_S objWorksheet.Cells._Default(count_dec, 7) = CC objWorksheet.Cells._Default(count_dec, 9) = decision objWorksheet.Cells._Default(count_dec, 12) = BARem objWorksheet.Cells._Default(count_dec, 13) = BARem_Split objWorksheet.Cells._Default(count_dec, 14) = THINTYP objWorksheet.Cells._Default(count_dec, 15) = BA_S_REM objWorksheet.Cells._Default(count_dec, 16) = BA_H_REM objWorksheet.Cells._Default(count_dec, 18) = NEWTRT objWorksheet.Cells._Default(count_dec, 19) = NEWAGE objWorksheet.Cells._Default(count_dec, 20) = NEWDIAM_S objWorksheet.Cells._Default(count_dec, 21) = NEWDIAM_H objWorksheet.Cells._Default(count_dec, 22) = NEWPCT_S objWorksheet.Cells._Default(count_dec, 23) = NEWCC objWorksheet.Cells._Default(count_dec, 25) = MERVOL_S objWorksheet.Cells._Default(count_dec, 26) = BRDVOL_S objWorksheet.Cells._Default(count_dec, 27) = MERVOL_H objWorksheet.Cells._Default(count_dec, 28) = BRDVOL_H objWorksheet.Cells._Default(count_dec, 29) = DIAMREM_S objWorksheet.Cells._Default(count_dec, 30) = DIAMREM_H objWorksheet.Cells._Default(count_dec, 31) = Temporary_BA_S objWorksheet.Cells._Default(count_dec, 32) = Temporary_BA_H End If End If End Sub Private Sub Application() '************************************************************************ '* * '* Subroutine to prepare Excel spreadsheet to do a full run and * '* produce results. It creates a workbook with a worksheet * '* for basic information and one for the results for every * '* treatment type * '* * '************************************************************************ 'Start the excel COM and make it invisible to the user. objExcel = CreateObject("Excel.Application") objExcel.Visible = False 'Turn off the alerts so the user doesn't have to confirm all my modifications. objExcel.DisplayAlerts = False 'Start a new workbook. objExcel.SheetsInNewWorkbook = 1 objWorkbook = ExcelGlobal_definst.Workbooks.Add("") 'Rename "sheet1" and add all the info from the form objWorksheet = objWorkbook.Sheets("sheet1") objWorksheet.Name = "Basic" With objWorksheet .Columns._Default("A").ColumnWidth = 12 .Range("A1").Value = "Model Parameters - META MODEL" .Range("A1").Font.Underline = True .Range("A1").Font.Bold = True .Range("A3").Value = discount_rate.Text .Range("B3").Value = "Annual discount rate" .Range("A4").Value = site_index_SW.Text .Range("B4").Value = "Site index SW (in meters at age 50)" .Range("A5").Value = site_index_HW.Text .Range("B5").Value = "Site index HW (in meters at age 50)" .Range("A6").Value = PCT_minhgt_H.Text .Range("B6").Value = "Minimum dominant stand height (hardwood) for doing a pre-commercial thinning" .Range("A7").Value = MAX_HGT_PCT.Text .Range("B7").Value = "Maximum average stand height for doing a pre-commercial thinning" .Range("A8").Value = Regen_SW_percent.Text .Range("B8").Value = "% of stand covered with softwood when a stand does naturally regenerate" .Range("A9").Value = stock_pct.Text .Range("B9").Value = "Natural stocking percentage of the forest" .Range("A10").Value = price_MERVOL_S.Text .Range("B10").Value = "Average selling price of softwood merchantable volume ($/m^3)" .Range("A11").Value = stdev_MERVOL_S.Text .Range("B11").Value = "Standard deviation of the Selling price of softwood merchantable volume ($/m^3)" .Range("A12").Value = price_BRDVOL_S.Text .Range("B12").Value = "Average selling price of softwood board volume ($/m^3)" .Range("A13").Value = stdev_BRDVOL_S.Text .Range("B13").Value = "Standard deviation of the Selling price of softwood board volume ($/m^3)" .Range("A14").Value = price_MERVOL_H.Text .Range("B14").Value = "Average selling price of hardwood merchantable volume ($/m^3)" .Range("A15").Value = stdev_MERVOL_H.Text .Range("B15").Value = "Standard deviation of selling price of hardwood merchantable volume ($/m^3)" .Range("A16").Value = price_BRDVOL_H.Text .Range("B16").Value = "Average selling price of hardwood board volume ($/m^3)" .Range("A17").Value = stdev_BRDVOL_H.Text .Range("B17").Value = "Standard deviation of selling price of hardwood board volume ($/m^3)" .Range("A18").Value = numofpricebreaks.Text .Range("B18").Value = "Number of price breaks" .Range("A19").Value = planting_cost_lt2500.Text .Range("B19").Value = "Cost of planting less than 2500 trees on one hectare ($)" .Range("A20").Value = planting_cost_mt2500.Text .Range("B20").Value = "Cost of planting 2500 or more trees on one hectare ($)" .Range("A21").Value = cost_natural_regen.Text .Range("B21").Value = "Cost of surveying one hectare of newly harvested land ($)" .Range("A22").Value = PCT_minhgt_S.Text .Range("B22").Value = "Minimum dominant stand height (softwood) for doing a pre-commercial thinning" .Range("A23").Value = cost_fill_plant.Text .Range("B23").Value = "Cost of doing fill planting on one hectare ($)" .Range("A24").Value = cost_PCT.Text .Range("B24").Value = "Cost of doing pre-commercial thinning on one hectare ($)" .Range("A25").Value = cost_CT.Text .Range("B25").Value = "Cost of one hour of labour for doing commercial thinning or final felling ($)" .Range("A26").Value = flat_cost_CT.Text .Range("B26").Value = "Flat cost of doing a commercial thinning on one hectare ($)" .Range("A3:A26").Borders.Weight = Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium .Range("A28").Value = "Natural disasters" .Range("A28").Font.Bold = True .Range("A29").Value = area_region_f.Text .Range("B29").Value = "Area of region (hectares)" .Range("A30").Value = number_fires_f.Text .Range("B30").Value = "Average number of fires per year" .Range("A31").Value = interval_hurr_f.Text .Range("B31").Value = "Return interval of major hurricanes (years)" .Range("A32").Value = area_wind_f.Text .Range("B32").Value = "Average area of wind (hectares)" .Range("A33").Value = interval_insect_f.Text .Range("B33").Value = "Return interval of major insect outbreaks (years)" .Range("A29:A33").Borders.Weight = Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium .Range("a38").Value = "Z-value" .Range("a39").Value = "Probs" .Range("a40").Value = "SW MERVOL" .Range("a41").Value = "HW MERVOL" .Range("a42").Value = "SW BRDVOL" .Range("a43").Value = "HW BRDVOL" .Range("b37").Value = "1" .Range("c37").Value = "2" .Range("d37").Value = "3" .Range("e37").Value = "4" .Range("f37").Value = "5" .Range("g37").Value = "6" .Range("h37").Value = "7" .Range("i37").Value = "8" .Range("j37").Value = "9" .Range("K37").Value = "10" '*** Z-value .Range("b38").Value = "=-4+8/$A$18" .Range("c38").Value = "=B38+8/$A$18" .Range("d38").Value = "=C38+8/$A$18" .Range("e38").Value = "=D38+8/$A$18" .Range("f38").Value = "=E38+8/$A$18" .Range("g38").Value = "=F38+8/$A$18" .Range("h38").Value = "=G38+8/$A$18" .Range("i38").Value = "=H38+8/$A$18" .Range("j38").Value = "=I38+8/$A$18" .Range("k38").Value = "=J38+8/$A$18" '*** Probs .Range("b39").Value = "=NORMSDIST(B38)" .Range("C39").Value = "=NORMSDIST(C38)-NORMSDIST(B38)" .Range("D39").Value = "=NORMSDIST(D38)-NORMSDIST(C38)" .Range("E39").Value = "=NORMSDIST(E38)-NORMSDIST(D38)" .Range("F39").Value = "=NORMSDIST(F38)-NORMSDIST(E38)" .Range("G39").Value = "=NORMSDIST(G38)-NORMSDIST(F38)" .Range("H39").Value = "=NORMSDIST(H38)-NORMSDIST(G38)" .Range("I39").Value = "=NORMSDIST(I38)-NORMSDIST(H38)" .Range("J39").Value = "=NORMSDIST(J38)-NORMSDIST(I38)" .Range("K39").Value = "=NORMSDIST(K38)-NORMSDIST(J38)" '*** Prices SW MERVOL .Range("b40").Value = "=$A$10+$A$11*(-3+3/$A$18)" .Range("c40").Value = "=$A$10+$A$11*(-3+3/$A$18+(C$37-1)*(6/$A$18))" .Range("d40").Value = "=$A$10+$A$11*(-3+3/$A$18+(d$37-1)*(6/$A$18))" .Range("e40").Value = "=$A$10+$A$11*(-3+3/$A$18+(e$37-1)*(6/$A$18))" .Range("f40").Value = "=$A$10+$A$11*(-3+3/$A$18+(f$37-1)*(6/$A$18))" .Range("g40").Value = "=$A$10+$A$11*(-3+3/$A$18+(g$37-1)*(6/$A$18))" .Range("h40").Value = "=$A$10+$A$11*(-3+3/$A$18+(h$37-1)*(6/$A$18))" .Range("i40").Value = "=$A$10+$A$11*(-3+3/$A$18+(i$37-1)*(6/$A$18))" .Range("j40").Value = "=$A$10+$A$11*(-3+3/$A$18+(j$37-1)*(6/$A$18))" .Range("k40").Value = "=$A$10+$A$11*(-3+3/$A$18+(k$37-1)*(6/$A$18))" '*** Prices HW MERVOL .Range("b41").Value = "=$A$14+$A$15*(-3+3/$A$18)" .Range("c41").Value = "=$A$14+$A$15*(-3+3/$A$18+(C$37-1)*(6/$A$18))" .Range("d41").Value = "=$A$14+$A$15*(-3+3/$A$18+(d$37-1)*(6/$A$18))" .Range("e41").Value = "=$A$14+$A$15*(-3+3/$A$18+(e$37-1)*(6/$A$18))" .Range("f41").Value = "=$A$14+$A$15*(-3+3/$A$18+(f$37-1)*(6/$A$18))" .Range("g41").Value = "=$A$14+$A$15*(-3+3/$A$18+(g$37-1)*(6/$A$18))" .Range("h41").Value = "=$A$14+$A$15*(-3+3/$A$18+(h$37-1)*(6/$A$18))" .Range("i41").Value = "=$A$14+$A$15*(-3+3/$A$18+(i$37-1)*(6/$A$18))" .Range("j41").Value = "=$A$14+$A$15*(-3+3/$A$18+(j$37-1)*(6/$A$18))" .Range("k41").Value = "=$A$14+$A$15*(-3+3/$A$18+(k$37-1)*(6/$A$18))" '*** Prices SW BRDVOL .Range("b42").Value = "=$A$12+$A$13*(-3+3/$A$18)" .Range("c42").Value = "=$A$12+$A$13*(-3+3/$A$18+(C$37-1)*(6/$A$18))" .Range("d42").Value = "=$A$12+$A$13*(-3+3/$A$18+(d$37-1)*(6/$A$18))" .Range("e42").Value = "=$A$12+$A$13*(-3+3/$A$18+(e$37-1)*(6/$A$18))" .Range("f42").Value = "=$A$12+$A$13*(-3+3/$A$18+(f$37-1)*(6/$A$18))" .Range("g42").Value = "=$A$12+$A$13*(-3+3/$A$18+(g$37-1)*(6/$A$18))" .Range("h42").Value = "=$A$12+$A$13*(-3+3/$A$18+(h$37-1)*(6/$A$18))" .Range("i42").Value = "=$A$12+$A$13*(-3+3/$A$18+(i$37-1)*(6/$A$18))" .Range("j42").Value = "=$A$12+$A$13*(-3+3/$A$18+(j$37-1)*(6/$A$18))" .Range("k42").Value = "=$A$12+$A$13*(-3+3/$A$18+(k$37-1)*(6/$A$18))" '*** Prices HW BRDVOL .Range("b43").Value = "=$A$16+$A$17*(-3+3/$A$18)" .Range("c43").Value = "=$A$16+$A$17*(-3+3/$A$18+(C$37-1)*(6/$A$18))" .Range("d43").Value = "=$A$16+$A$17*(-3+3/$A$18+(d$37-1)*(6/$A$18))" .Range("e43").Value = "=$A$16+$A$17*(-3+3/$A$18+(e$37-1)*(6/$A$18))" .Range("f43").Value = "=$A$16+$A$17*(-3+3/$A$18+(f$37-1)*(6/$A$18))" .Range("g43").Value = "=$A$16+$A$17*(-3+3/$A$18+(g$37-1)*(6/$A$18))" .Range("h43").Value = "=$A$16+$A$17*(-3+3/$A$18+(h$37-1)*(6/$A$18))" .Range("i43").Value = "=$A$16+$A$17*(-3+3/$A$18+(i$37-1)*(6/$A$18))" .Range("j43").Value = "=$A$16+$A$17*(-3+3/$A$18+(j$37-1)*(6/$A$18))" .Range("k43").Value = "=$A$16+$A$17*(-3+3/$A$18+(k$37-1)*(6/$A$18))" If Thin_plate.Checked = True Then RBF = 1 Approx_method = "RBF - Thin plate spline" ElseIf Quadric_0.Checked = True Then RBF = 2 Approx_method = "RBF - Quadric (C=0)" ElseIf Quadric_5.Checked = True Then RBF = 3 Approx_method = "RBF - Quadric (C=5)" ElseIf Inverse_quadric_mix.Checked = True Then RBF = 4 Approx_method = "RBF - Inverse Quadric (C=optimal mix)" Cval(1) = 1.78 Cval(2) = 1.3957 Cval(3) = 1.3949 ElseIf Inverse_quadric_5.Checked = True Then RBF = 5 Approx_method = "RBF - Inverse Quadric (C=5)" ElseIf Inverse_quadric_10.Checked = True Then RBF = 6 Approx_method = "RBF - Inverse Quadric (C=10)" ElseIf Inverse_quadric_15.Checked = True Then RBF = 7 Approx_method = "RBF - Inverse Quadric (C=1.4)" ElseIf Exponential_0001.Checked = True Then RBF = 8 Approx_method = "RBF - Exponential (C=0.001)" ElseIf Gaussian_01.Checked = True Then RBF = 9 Approx_method = "RBF - Gaussian (C=0.1)" ElseIf Mult_Regr.Checked = True Then RBF = 0 Approx_method = "Multiple Regression" ElseIf DWI.Checked = True Then RBF = 10 Approx_method = "Distance Weighted Interpolation" End If .Range("A34").Value = "Approximation methodology" .Range("A34").Font.Bold = True .Range("A35").Value = Approx_method .Range("M1").Value = "Iteration" .Range("N1").Value = "Cost To Go" .Columns._Default("N").ColumnWidth = 9.6 .Range("O1").Value = "Best Decision" .Columns._Default("O").ColumnWidth = 11.8 .Range("P1").Value = "Policy Changes" .Columns._Default("P").ColumnWidth = 14.4 .Range("Q1").Value = "Difference" .Columns._Default("Q").ColumnWidth = 9.3 .Range("M3:Q200").Borders.Weight = Microsoft.Office.Interop.Excel.XlBorderWeight.xlThin End With num_weight = num_weight_txt.Text discountrate = discount_rate.Text SI_SW = site_index_SW.Text SI_HW = site_index_HW.Text Price1_S = price_MERVOL_S.Text Price1_H = price_MERVOL_H.Text stdev1_S = stdev_MERVOL_S.Text stdev1_H = stdev_MERVOL_H.Text Price2_S = price_BRDVOL_S.Text Price2_H = price_BRDVOL_H.Text stdev2_S = stdev_BRDVOL_S.Text stdev2_H = stdev_BRDVOL_H.Text pricebreaks = numofpricebreaks.Text plantcost_lt2500 = planting_cost_lt2500.Text plantcost_mt2500 = planting_cost_mt2500.Text MINHGT_S = PCT_minhgt_S.Text MINHGT_H = PCT_minhgt_H.Text MAXHGT_PCT = MAX_HGT_PCT.Text ct_flat_cost = flat_cost_CT.Text fill_plant_cost = cost_fill_plant.Text PCTCOST = cost_PCT.Text HARVPRICE = cost_CT.Text cost_nat_regen = cost_natural_regen.Text Regen_SW_perct = Regen_SW_percent.Text Regen_SW_perct = Regen_SW_perct / 100 Stock = stock_pct.Text Stock = Stock / 100 area_region = area_region_f.Text number_fires = number_fires_f.Text interval_hurr = interval_hurr_f.Text area_wind = area_wind_f.Text interval_insect = interval_insect_f.Text 'Change the name of the 5 other worksheets and add results layout objWorksheet = objWorkbook.Worksheets.Add objWorksheet.Name = "Decisiontrt1" With objWorksheet .Columns.ColumnWidth = 4.9 .Cells._Default(1, 1) = "Available decisions" .Cells._Default(1, 1).Font.Bold = True .Range("A1:P1").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(2, 1) = "1 - Let grow" .Range("A2:P2").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(3, 1) = "3 - Clear cut and let regenerate naturally" .Range("A3:P3").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(4, 1) = "4 - Clear cut and plant without early competition control" .Range("A4:P4").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(5, 1) = "5 - Clear cut (or site prep) and plant 1000 trees/ha with 100% softwood" .Range("A5:P5").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(6, 1) = "6 - Clear cut (or site prep) and plant 1750 trees/ha with 100% softwood" .Range("A6:P6").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(7, 1) = "7 - Clear cut (or site prep) and plant 2500 trees/ha with 100% softwood" .Range("A7:P7").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(8, 1) = "8 - Clear cut (or site prep) and plant 3250 trees/ha with 100% softwood" .Range("A8:P8").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(9, 1) = "9 - Clear cut (or site prep) and plant 4000 trees/ha with 100% softwood""" .Cells._Default(10, 1) = "10 - Pre-Commercial thinning - keep mixed wood" .Range("A9:P9").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(11, 1) = "11 - Pre-Commercial thinning - eliminate softwood and space hardwood if needed" .Range("A10:P10").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(12, 1) = "12 - Pre-Commercial thinning - eliminate hardwood and space softwood if needed" .Range("A11:P11").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(13, 1) = "13 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 25% SW from below" .Range("A12:P12").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(14, 1) = "14 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 50% SW from below" .Range("A13:P13").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(15, 1) = "15 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 75% SW from below" .Range("A14:P14").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(16, 1) = "16 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 25% SW from below" .Range("A15:P15").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(17, 1) = "17 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 50% SW from below" .Range("A16:P16").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(18, 1) = "18 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 75% SW from below" .Range("A17:P17").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(19, 1) = "19 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 25% SW from below" .Range("A18:P18").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(20, 1) = "20 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 50% SW from below" .Range("A19:P19").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(21, 1) = "21 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 75% SW from below" .Range("A20:P20").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(22, 1) = "22 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 25% SW across the diameter distribution" .Range("A21:P21").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(23, 1) = "23 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 50% SW across the diameter distribution" .Range("A22:P22").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(24, 1) = "24 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 75% SW across the diameter distribution" .Range("A23:P23").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(25, 1) = "25 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 25% SW across the diameter distribution" .Range("A24:P24").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(26, 1) = "26 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 50% SW across the diameter distribution" .Range("A25:P25").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(27, 1) = "27 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 75% SW across the diameter distribution" .Range("A26:P26").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(28, 1) = "28 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 25% SW across the diameter distribution" .Range("A27:P27").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(29, 1) = "29 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 50% SW across the diameter distribution" .Range("A28:P28").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(30, 1) = "30 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 75% SW across the diameter distribution" .Range("A29:P29").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(31, 1) = "31 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 25% SW from above" .Range("A30:P30").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(32, 1) = "32 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 50% SW from above" .Range("A31:P31").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(33, 1) = "33 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 75% SW from above" .Range("A32:P32").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(34, 1) = "34 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 25% SW from above" .Range("A33:P33").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(35, 1) = "35 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 50% SW from above" .Range("A34:P34").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(36, 1) = "36 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 75% SW from above" .Range("A35:P35").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(37, 1) = "37 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 25% SW from above" .Range("A36:P36").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(38, 1) = "38 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 50% SW from above" .Range("A37:P37").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(39, 1) = "39 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 75% SW from above" .Range("A38:P38").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(40, 1) = "40 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 100% SW from below" .Range("A39:P39").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(41, 1) = "41 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 100% SW from below" .Range("A40:P40").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(42, 1) = "42 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 100% SW from below" .Range("A41:P41").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(43, 1) = "43 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 100% SW across the diameter distribution" .Range("A42:P42").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(44, 1) = "44 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 100% SW across the diameter distribution" .Range("A43:P43").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(45, 1) = "45 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 100% SW across the diameter distribution" .Range("A44:P44").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(46, 1) = "46 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 100% SW from above" .Range("A45:P45").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(47, 1) = "47 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 100% SW from above" .Range("A46:P46").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(48, 1) = "48 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 100% SW from above" .Range("A47:P47").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Range("A48:P48").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(51, 3) = "Prices" .Cells._Default(52, 3) = "MERVOL_S" .Cells._Default(53, 3) = "MERVOL_H" .Cells._Default(54, 3) = "BRDVOL_S" .Cells._Default(55, 3) = "BRDVOL_H" .Cells._Default(55, 1) = "AGE" .Cells._Default(55, 2) = "STOCKING" .Range("A55").Orientation = 90 .Range("b55").Orientation = 90 .Range("A50:A55").Merge() .Range("B50:B55").Merge() End With Sheet_names(2) = "Decisiontrt2" Sheet_names(3) = "Decisiontrt3" Sheet_names(4) = "Decisiontrt4" Sheet_names(5) = "Decisiontrt5" For i = 2 To 5 objWorksheet = objWorkbook.Worksheets.Add objWorksheet.Name = Sheet_names(i) With objWorksheet .Columns.ColumnWidth = 4.9 .Cells._Default(1, 1) = "Available decisions" .Cells._Default(1, 1).Font.Bold = True .Range("A1:P1").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(2, 1) = "2 - Let grow" .Range("A2:P2").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(3, 1) = "3 - Clear cut and let regenerate naturally" .Range("A3:P3").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(4, 1) = "4 - Clear cut and plant without early competition control" .Range("A4:P4").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(5, 1) = "5 - Clear cut (or site prep) and plant 1000 trees/ha with 100% softwood" .Range("A5:P5").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(6, 1) = "6 - Clear cut (or site prep) and plant 1750 trees/ha with 100% softwood" .Range("A6:P6").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(7, 1) = "7 - Clear cut (or site prep) and plant 2500 trees/ha with 100% softwood" .Range("A7:P7").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(8, 1) = "8 - Clear cut (or site prep) and plant 3250 trees/ha with 100% softwood" .Range("A8:P8").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(9, 1) = "9 - Clear cut (or site prep) and plant 4000 trees/ha with 100% softwood""" .Cells._Default(10, 1) = "10 - Pre-Commercial thinning - keep mixed wood" .Range("A9:P9").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(11, 1) = "11 - Pre-Commercial thinning - eliminate softwood and space hardwood if needed" .Range("A10:P10").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(12, 1) = "12 - Pre-Commercial thinning - eliminate hardwood and space softwood if needed" .Range("A11:P11").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(13, 1) = "13 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 25% SW from below" .Range("A12:P12").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(14, 1) = "14 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 50% SW from below" .Range("A13:P13").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(15, 1) = "15 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 75% SW from below" .Range("A14:P14").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(16, 1) = "16 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 25% SW from below" .Range("A15:P15").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(17, 1) = "17 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 50% SW from below" .Range("A16:P16").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(18, 1) = "18 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 75% SW from below" .Range("A17:P17").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(19, 1) = "19 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 25% SW from below" .Range("A18:P18").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(20, 1) = "20 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 50% SW from below" .Range("A19:P19").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(21, 1) = "21 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 75% SW from below" .Range("A20:P20").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(22, 1) = "22 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 25% SW across the diameter distribution" .Range("A21:P21").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(23, 1) = "23 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 50% SW across the diameter distribution" .Range("A22:P22").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(24, 1) = "24 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 75% SW across the diameter distribution" .Range("A23:P23").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(25, 1) = "25 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 25% SW across the diameter distribution" .Range("A24:P24").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(26, 1) = "26 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 50% SW across the diameter distribution" .Range("A25:P25").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(27, 1) = "27 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 75% SW across the diameter distribution" .Range("A26:P26").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(28, 1) = "28 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 25% SW across the diameter distribution" .Range("A27:P27").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(29, 1) = "29 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 50% SW across the diameter distribution" .Range("A28:P28").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(30, 1) = "30 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 75% SW across the diameter distribution" .Range("A29:P29").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(31, 1) = "31 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 25% SW from above" .Range("A30:P30").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(32, 1) = "32 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 50% SW from above" .Range("A31:P31").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(33, 1) = "33 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 75% SW from above" .Range("A32:P32").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(34, 1) = "34 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 25% SW from above" .Range("A33:P33").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(35, 1) = "35 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 50% SW from above" .Range("A34:P34").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(36, 1) = "36 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 75% SW from above" .Range("A35:P35").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(37, 1) = "37 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 25% SW from above" .Range("A36:P36").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(38, 1) = "38 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 50% SW from above" .Range("A37:P37").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(39, 1) = "39 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 75% SW from above" .Range("A38:P38").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(40, 1) = "40 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 100% SW from below" .Range("A39:P39").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(41, 1) = "41 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 100% SW from below" .Range("A40:P40").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(42, 1) = "42 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 100% SW from below" .Range("A41:P41").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(43, 1) = "43 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 100% SW across the diameter distribution" .Range("A42:P42").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(44, 1) = "44 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 100% SW across the diameter distribution" .Range("A43:P43").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(45, 1) = "45 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 100% SW across the diameter distribution" .Range("A44:P44").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(46, 1) = "46 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 100% SW from above" .Range("A45:P45").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(47, 1) = "47 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 100% SW from above" .Range("A46:P46").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Cells._Default(48, 1) = "48 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 100% SW from above" .Range("A47:P47").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) .Range("A48:P48").BorderAround(LineStyle:=Microsoft.Office.Interop.Excel.XlLineStyle.xlContinuous, Weight:=Microsoft.Office.Interop.Excel.XlBorderWeight.xlMedium) End With Next i objWorksheet = objWorkbook.Sheets("Decisiontrt2") With objWorksheet .Cells._Default(51, 1) = "AGE" .Cells._Default(51, 2) = "DIAM_S" .Cells._Default(51, 3) = "DIAM_H" .Cells._Default(51, 4) = "CC" .Cells._Default(51, 5) = "PCT_S" .Cells._Default(51, 6) = "Prices" .Cells._Default(52, 6) = "MERVOL_S" .Cells._Default(53, 6) = "MERVOL_H" .Cells._Default(54, 6) = "BRDVOL_S" .Cells._Default(55, 6) = "BRDVOL_H" .Range("A50:A55").Merge() .Range("B50:B55").Merge() .Range("C50:C55").Merge() .Range("D50:D55").Merge() .Range("E50:E55").Merge() ' .Range("A50:E50").Orientation = 90 End With objWorksheet = objWorkbook.Sheets("Decisiontrt3") With objWorksheet .Cells._Default(51, 1) = "AGE" .Cells._Default(51, 2) = "DIAM_S" .Cells._Default(51, 3) = "Initial_density" .Cells._Default(51, 4) = "Prices" .Cells._Default(52, 4) = "MERVOL_S" .Cells._Default(53, 4) = "BRDVOL_S" .Cells._Default(54, 4) = "MERVOL_H" .Cells._Default(55, 4) = "BRDVOL_H" .Range("A51:A55").Merge() .Range("B51:B55").Merge() .Range("C51:C55").Merge() '.Range("A51:C51").Orientation = 90 End With objWorksheet = objWorkbook.Sheets("Decisiontrt4") With objWorksheet .Cells._Default(51, 1) = "AGE" .Cells._Default(51, 2) = "DIAM_S" .Cells._Default(51, 3) = "CC" .Cells._Default(51, 4) = "Prices" .Cells._Default(52, 4) = "MERVOL_S" .Cells._Default(53, 4) = "BRDVOL_S" .Cells._Default(54, 4) = "MERVOL_H" .Cells._Default(55, 4) = "BRDVOL_H" .Range("A51:A55").Merge() .Range("B51:B55").Merge() .Range("C51:C55").Merge() '.Range("A51:C51").Orientation = 90 End With objWorksheet = objWorkbook.Sheets("Decisiontrt5") With objWorksheet .Cells._Default(51, 1) = "AGE" .Cells._Default(51, 2) = "DIAM_S" .Cells._Default(51, 3) = "DIAM_H" .Cells._Default(51, 4) = "CC" .Cells._Default(51, 5) = "PCT_S" .Cells._Default(51, 6) = "Prices" .Cells._Default(52, 6) = "MERVOL_S" .Cells._Default(53, 6) = "BRDVOL_S" .Cells._Default(54, 6) = "MERVOL_H" .Cells._Default(55, 6) = "BRDVOL_H" .Range("A51:A55").Merge() .Range("B51:B55").Merge() .Range("C51:C55").Merge() .Range("D51:D55").Merge() .Range("E51:E55").Merge() '.Range("A51:E51").Orientation = 90 End With objWorksheet = objWorkbook.Worksheets.Add objWorksheet.Name = "Stats" With objWorksheet .Columns.ColumnWidth = 11 .Cells._Default(1, 1) = "State" .Cells._Default(1, 2) = "TRT" .Cells._Default(1, 3) = "AGE" .Cells._Default(1, 4) = "DIAM_S" .Cells._Default(1, 5) = "DIAM_H" .Cells._Default(1, 6) = "PCT_S" .Cells._Default(1, 7) = "CC" .Cells._Default(1, 8) = "STOCKING" .Cells._Default(1, 9) = "DECISION" .Cells._Default(1, 10) = "" .Cells._Default(1, 11) = "" .Cells._Default(1, 12) = "BARem" .Cells._Default(1, 13) = "BARem_Split" .Cells._Default(1, 14) = "THINTYP" .Cells._Default(1, 15) = "BARem_S" .Cells._Default(1, 16) = "BARem_H" .Cells._Default(1, 17) = "NEWDENSITY" .Cells._Default(1, 18) = "NEWTRT" .Cells._Default(1, 19) = "NEWAGE" .Cells._Default(1, 20) = "NEWDIAM_S" .Cells._Default(1, 21) = "NEWDIAM_H" .Cells._Default(1, 22) = "NEWPCT_S" .Cells._Default(1, 23) = "NEWCC" .Cells._Default(1, 24) = "NEWSTOCKING" .Cells._Default(1, 25) = "MERVOL_S" .Cells._Default(1, 26) = "BRDVOL_S" .Cells._Default(1, 27) = "MERVOL_H" .Cells._Default(1, 28) = "BRDVOL_H" .Cells._Default(1, 29) = "DIAMREM_S" .Cells._Default(1, 30) = "DIAMREM_H" End With End Sub Private Sub Create() '**************************************************************** '* * '* Subroutine to create states to be used in simulation * '* * '* This subroutine creates all the states (natural and * '* plantation stands) that will be used in the DP and * '* multiple regression. * '* * '**************************************************************** '*** For the 0,0,0 state AGE = 0 TRT = 10 'stand that has not regenerated for 5 years StoreState() TRT = 11 'stand that has not regenerated for 10 years StoreState() TRT = 12 'stand that has not regenerated for 15 years StoreState() TRT = 13 'stand that has not regenerated for 20 years StoreState() '************************************************** '* Untreated natural stands '************************************************** k = 0 kk = 0 kkk = 0 kkkk = 0 kkkkk = 0 objWorksheet = objWorkbook.Sheets("Decisiontrt1") objWorksheet.Cells._Default(50, 10) = "Untreated Natural Stands" objWorksheet.Cells._Default(57, 1) = 0 objWorksheet.Cells._Default(57, 2) = "TRT=10" objWorksheet.Cells._Default(58, 1) = 0 objWorksheet.Cells._Default(58, 2) = "TRT=11" objWorksheet.Cells._Default(59, 1) = 0 objWorksheet.Cells._Default(59, 2) = "TRT=12" objWorksheet.Cells._Default(60, 1) = 0 objWorksheet.Cells._Default(60, 2) = "TRT=13" '************************************************** '* Untreated natural stands '************************************************** For STOCKING = 1 To Stock Step (Stock - 1) For AGE = 5 To 95 Step 5 TRT = 1 k = k + 1 StoreState() objWorksheet.Cells._Default(k + 60, 1) = AGE objWorksheet.Cells._Default(k + 60, 2) = STOCKING Next AGE Next STOCKING NO_NAT_STATES = k '************************************************* '* Precommercially thinned natural stand '************************************************* indx_sum(2) = z + 1 TRT = 2 SAGE_S = 0 zz = SI_SW * 3.28084 YTBH_S = 44.07021 - 1.63556 * zz + 0.0222 * zz * zz - 0.000100987 * zz * zz * zz 4: If (SAGE_S - YTBH_S) < 2 Then SAGE_S = SAGE_S + 5 GoTo 4 End If SAGE_H = 0 YTBH_H = 10.5513 - 0.7565 * SI_HW + 0.0339 * SI_HW ^ 1.7826 5: If (SAGE_H - YTBH_H) < 2 Then SAGE_H = SAGE_H + 5 GoTo 5 End If 'Mindiam calculations for both species based on a stand that has grown at full stocking until age 25 For AGE = 5 To 95 Step 5 Call DOMHGT(AGE, SI_SW, SI_HW, DHGT_S, DHGT_H) Call AVGHGT(1, 0, DHGT_S, AHGT_S) Call AVGHGT(2, 0, DHGT_H, AHGT_H) If AGE >= SAGE_S And Regen_SW_perct > 0 Then If AHGT_S < 9.1 Then Call DIAMN(1, AHGT_S, DIAM_S) ElseIf SP_S < 3.1 Then Call FAGE(TEMPDIAM_S, SI_SW, SP_S, FAGE_S) Call DIAMP(SP_S, 1, TEMPDIAM_S, 0, SI_SW, FAGE_S + 5, DIAM_S) Else B1 = 0.02785202 B2 = -0.367548143 B3 = -0.005540854 DBHIB = (TEMPDIAM_S / 2.54 - 0.016384) / 1.057711 TMPBA = DBHIB * DBHIB * 0.005454 * (NO_TREES_S / (Regen_SW_perct * Stock)) / 2.47105 D5IB = (B1 * SI_SW * 3.28084 + B2) * System.Math.Exp(B3 * TMPBA) DIAM_S = ((DBHIB + D5IB) * 1.057711 + 0.016384) * 2.54 End If Else DIAM_S = 0 End If If DIAM_S > 0 Then SD_S = 30413.962 / ((DIAM_S / 2.54) ^ 1.834067) * 2.47 If (10000 / 2.1 ^ 2) < SD_S Then NO_TREES_S = (10000 / 2.1 ^ 2) * Regen_SW_perct * Stock Else NO_TREES_S = SD_S * Regen_SW_perct * Stock End If Else NO_TREES_S = 0 End If If NO_TREES_S > 0 Then SP_S = System.Math.Sqrt(10000 * Stock * Regen_SW_perct) / (System.Math.Sqrt(NO_TREES_S)) Else SP_S = 0 End If TEMPBA_S = (DIAM_S / 200) ^ 2 * 3.1415927 * NO_TREES_S If AGE >= SAGE_H And (1 - Regen_SW_perct) > 0 Then If AHGT_H < 9.1 Then Call DIAMN(2, AHGT_H, DIAM_H) Else Call DIAMP(0, 2, TEMPDIAM_H, TEMPBA_H / ((1 - Regen_SW_perct) * Stock), SI_HW, 0, DIAM_H) End If Else DIAM_H = 0 End If If DIAM_H > 0 Then Call SDN(2, DIAM_H, SD_H) If (10000 / 2.4 ^ 2) < SD_H Then NO_TREES_H = (10000 / 2.4 ^ 2) * (1 - Regen_SW_perct) * Stock Else NO_TREES_H = SD_H * (1 - Regen_SW_perct) * Stock End If Else NO_TREES_H = 0 End If TEMPBA_H = (DIAM_H / 200) ^ 2 * 3.1415927 * NO_TREES_H DIAMETERS(1, AGE / 5, 1) = DIAM_S DIAMETERS(1, AGE / 5, 2) = DIAM_H TEMPDIAM_S = DIAM_S TEMPDIAM_H = DIAM_H Next AGE TEMPDIAM_S = 0 TEMPDIAM_H = 0 TEMPBA_S = 0 TEMPBA_H = 0 'Maxdiam calculations based on a stand that has been precommercially thinned as soon as possible and grows as such for 100 years For AGE = 5 To 95 Step 5 Call DOMHGT(AGE, SI_SW, SI_HW, DHGT_S, DHGT_H) Call AVGHGT(1, 0, DHGT_S, AHGT_S) Call AVGHGT(2, 0, DHGT_H, AHGT_H) If AGE >= SAGE_S And Regen_SW_perct > 0 Then If TEMPDIAM_S = 0 Or AHGT_S < 2 Then Call DIAMN(1, AHGT_S, DIAM_S) ElseIf SP_S < 3.1 Then Call FAGE(TEMPDIAM_S, SI_SW, SP_S, FAGE_S) Call DIAMP(SP_S, 1, TEMPDIAM_S, 0, SI_SW, FAGE_S + 5, DIAM_S) Else B1 = 0.02785202 B2 = -0.367548143 B3 = -0.005540854 DBHIB = (TEMPDIAM_S / 2.54 - 0.016384) / 1.057711 TMPBA = DBHIB ^ 2 * 0.005454 * (NO_TREES_S / (Regen_SW_perct * Stock)) / 2.47105 D5IB = (B1 * SI_SW * 3.28084 + B2) * System.Math.Exp(B3 * TMPBA) DIAM_S = ((DBHIB + D5IB) * 1.057711 + 0.016384) * 2.54 End If Else DIAM_S = 0 End If If DIAM_S > 0 Then SD_S = 30413.962 / ((DIAM_S / 2.54) ^ 1.834067) * 2.47 If (10000 / 2.1 ^ 2) < SD_S Then NO_TREES_S = 10000 / 2.1 ^ 2 * Regen_SW_perct * Stock Else NO_TREES_S = SD_S * Regen_SW_perct * Stock End If Else NO_TREES_S = 0 End If If NO_TREES_S > 0 Then SP_S = System.Math.Sqrt(10000 * Stock * Regen_SW_perct) / (System.Math.Sqrt(NO_TREES_S)) Else SP_S = 0 End If BA_S = (DIAM_S / 200) ^ 2 * 3.1415927 * NO_TREES_S If AGE >= SAGE_H And (1 - Regen_SW_perct) > 0 Then If TEMPDIAM_H = 0 Or AHGT_H < 6 Then Call DIAMN(2, AHGT_H, DIAM_H) Else Call DIAMP(0, 2, TEMPDIAM_H, TEMPBA_H / ((1 - Regen_SW_perct) * Stock), SI_HW, 0, DIAM_H) End If Else DIAM_H = 0 End If If DIAM_H > 0 Then Call SDN(2, DIAM_H, SD_H) If (10000 / 2.4 ^ 2) < SD_H Then NO_TREES_H = 10000 / 2.1 ^ 2 * (1 - Regen_SW_perct) * Stock Else NO_TREES_H = SD_H * (1 - Regen_SW_perct) * Stock End If Else NO_TREES_H = 0 End If BA_H = (DIAM_H / 200) ^ 2 * 3.1415927 * NO_TREES_H DIAMETERS(3, AGE / 5, 1) = DIAM_S DIAMETERS(3, AGE / 5, 2) = DIAM_H TEMPDIAM_S = DIAM_S TEMPDIAM_H = DIAM_H TEMPBA_S = BA_S TEMPBA_H = BA_H Next AGE For AGE = 5 To 95 Step 5 DIAMETERS(2, AGE / 5, 1) = (DIAMETERS(1, AGE / 5, 1) + DIAMETERS(3, AGE / 5, 1)) / 2 DIAMETERS(2, AGE / 5, 2) = (DIAMETERS(1, AGE / 5, 2) + DIAMETERS(3, AGE / 5, 2)) / 2 Next AGE If SAGE_S < SAGE_H Then START_AGE = SAGE_S Else START_AGE = SAGE_H End If objWorksheet = objWorkbook.Sheets("Decisiontrt2") objWorksheet.Cells._Default(50, 10) = "Pre-commercially thinned natural Stands" For TEMPCC = 40 To 100 Step 30 For tmp = 0 To 99 Step 33 If tmp = 99 Then tmp = 100 End If PCT_S = tmp / 100 For AGE = START_AGE To 95 Step 10 If AGE < 10 Then CC = TEMPCC / 7 ElseIf AGE < 20 Then CC = TEMPCC / 4.5 ElseIf AGE < 30 Then CC = TEMPCC / 2 ElseIf AGE < 40 Then CC = TEMPCC / 1.2 Else CC = TEMPCC End If If CC > 100 Then CC = 100 End If If System.Math.Abs(DIAMETERS(1, AGE / 5, 1) - DIAMETERS(3, AGE / 5, 1)) < 1 Then MINK = 2 MAXK = 2 Else MINK = 1 MAXK = 3 End If For P = MINK To MAXK Step 1 If System.Math.Abs(DIAMETERS(1, AGE / 5, 2) - DIAMETERS(3, AGE / 5, 2)) < 1 Then MINN = 2 MAXN = 2 Else MINN = 1 MAXN = 3 End If For N = MINN To MAXN Step 1 DIAM_S = DIAMETERS(P, AGE / 5, 1) DIAM_H = DIAMETERS(N, AGE / 5, 2) If DIAM_S = 0 And PCT_S > 0 And DIAM_H > 0 Then GoTo 100 ElseIf DIAM_S > 0 And PCT_S = 0 Then PCT_S = 0 DIAM_S = 0 P = 3 ElseIf DIAM_H > 0 And PCT_S = 1 Then DIAM_H = 0 N = 3 End If StoreState() kk = kk + 1 objWorksheet.Cells._Default(kk + 56, 1) = AGE objWorksheet.Cells._Default(kk + 56, 2) = DIAM_S objWorksheet.Cells._Default(kk + 56, 3) = DIAM_H objWorksheet.Cells._Default(kk + 56, 4) = CC objWorksheet.Cells._Default(kk + 56, 5) = PCT_S 100: Next N Next P Next AGE Next tmp Next TEMPCC '**************************************************** '* Untreated plantations '**************************************************** indx_sum(3) = z + 1 objWorksheet = objWorkbook.Sheets("Decisiontrt3") objWorksheet.Cells._Default(50, 10) = "Untreated plantations" TEMPDIAM_S = 0 TRT = 3 Initial_PCT_S = 1 For Initial_density = 1000 To 4000 Step 750 SAGE_S = 0 YTBH_S = 44.07021 - 1.63556 * SI_SW * 3.28084 + 0.0222 * (SI_SW * 3.28084) ^ 2 - 0.000100987 * (SI_SW * 3.28084) ^ 3 7: If (SAGE_S - YTBH_S) < 2 Then SAGE_S = SAGE_S + 5 GoTo 7 End If 'Mindiam calculations for both species based on a high density plantation that has grown 'at a high crown closer percentage since age 0 SP_S = 100 / System.Math.Sqrt(Initial_density) NO_TREES_S = Initial_density For AGE = 5 To 95 Step 5 If AGE >= SAGE_S Then If TEMPDIAM_S = 0 Then Call DIAMP(SP_S, 1, 0, 0, SI_SW, AGE - YTBH_S - 2, DIAM_S) ElseIf SP_S < 3.1 Then Call DIAMP(SP_S, 1, TEMPDIAM_S, 0, SI_SW, AGE - 5 - YTBH_S - 2, TEMP) Call DIAMP(SP_S, 1, TEMPDIAM_S, 0, SI_SW, AGE - 5 - YTBH_S + 3, TEMP1) DIAM_S = TEMPDIAM_S + TEMP1 - TEMP Else B1 = 0.02785202 B2 = -0.367548143 B3 = -0.005540854 DBHIB = (TEMPDIAM_S / 2.54 - 0.016384) / 1.057711 TMPBA = DBHIB ^ 2 * 0.005454 * (NO_TREES_S / Stock) / 2.47105 D5IB = (B1 * SI_SW * 3.28084 + B2) * System.Math.Exp(B3 * TMPBA) DIAM_S = ((DBHIB + D5IB) * 1.057711 + 0.016384) * 2.54 End If Else DIAM_S = 0 End If If DIAM_S > 0 Then SD_S = 30413.962 / ((DIAM_S / 2.54) ^ 1.834067) * 2.47 If NO_TREES_S > SD_S Then NO_TREES_S = SD_S End If End If SP_S = 100 / (System.Math.Sqrt(NO_TREES_S)) TEMPDIAM_S = DIAM_S kkk = kkk + 1 StoreState() objWorksheet.Cells._Default(kkk + 56, 1) = AGE objWorksheet.Cells._Default(kkk + 56, 2) = DIAM_S objWorksheet.Cells._Default(kkk + 56, 3) = Initial_density Next AGE TEMPDIAM_S = 0 TEMPBA_S = 0 Next Initial_density '************************************************* '* Commercially thinned plantations '************************************************* indx_sum(4) = z + 1 TRT = 4 Initial_PCT_S = 1 SAGE_S = 0 YTBH_S = 44.07021 - 1.63556 * SI_SW * 3.28084 + 0.0222 * (SI_SW * 3.28084) ^ 2 - 0.000100987 * (SI_SW * 3.28084) ^ 3 8: If (SAGE_S - YTBH_S) < 2 Then SAGE_S = SAGE_S + 5 GoTo 8 End If 'Mindiam calculations for both species based on a high density plantation that has grown 'at a high crown closer percentage since age 0 NO_TREES_S = 4000 * Initial_PCT_S SP_S = 100 / System.Math.Sqrt(4000) For AGE = 5 To 105 Step 5 If AGE >= SAGE_S And Initial_PCT_S > 0 Then If TEMPDIAM_S = 0 Then Call DIAMP(SP_S, 1, 0, 0, SI_SW, AGE - YTBH_S - 2, DIAM_S) ElseIf SP_S < 3.1 Then Call FAGE(TEMPDIAM_S, SI_SW, SP_S, FAGE_S) Call DIAMP(SP_S, 1, TEMPDIAM_S, 0, SI_SW, FAGE_S + 5, DIAM_S) Else B1 = 0.02785202 B2 = -0.367548143 B3 = -0.005540854 DBHIB = (TEMPDIAM_S / 2.54 - 0.016384) / 1.057711 TMPBA = DBHIB ^ 2 * 0.005454 * (NO_TREES_S / Stock) / 2.47105 D5IB = (B1 * SI_SW * 3.28084 + B2) * System.Math.Exp(B3 * TMPBA) DIAM_S = ((DBHIB + D5IB) * 1.057711 + 0.016384) * 2.54 End If Else DIAM_S = 0 End If If DIAM_S > 0 Then SD_S = 30413.962 / ((DIAM_S / 2.54) ^ 1.834067) * 2.47 If NO_TREES_S > SD_S * Initial_PCT_S Then NO_TREES_S = SD_S * Initial_PCT_S End If End If SP_S = System.Math.Sqrt(10000 * Initial_PCT_S) / (System.Math.Sqrt(NO_TREES_S)) TEMPBA_S = (DIAM_S / 200) ^ 2 * 3.1415927 * NO_TREES_S DIAMETERS(1, AGE / 5, 1) = DIAM_S TEMPDIAM_S = DIAM_S Next AGE TEMPDIAM_S = 0 TEMPBA_S = 0 'Maxiam calculations for both species based on a low density plantation that has grown 'at a low crown closer percentage since age 0 NO_TREES_S = 500 * Initial_PCT_S SP_S = 100 / System.Math.Sqrt(500) For AGE = 5 To 105 Step 5 If AGE >= SAGE_S And Initial_PCT_S > 0 Then If TEMPDIAM_S = 0 Then Call DIAMP(SP_S, 1, 0, 0, SI_SW, AGE - YTBH_S - 2, DIAM_S) ElseIf SP_S < 3.1 Then Call FAGE(TEMPDIAM_S, SI_SW, SP_S, FAGE_S) Call DIAMP(SP_S, 1, TEMPDIAM_S, 0, SI_SW, FAGE_S + 5, DIAM_S) Else B1 = 0.02785202 B2 = -0.367548143 B3 = -0.005540854 DBHIB = (TEMPDIAM_S / 2.54 - 0.016384) / 1.057711 TMPBA = DBHIB ^ 2 * 0.005454 * (NO_TREES_S / Stock) / 2.47105 D5IB = (B1 * SI_SW * 3.28084 + B2) * System.Math.Exp(B3 * TMPBA) DIAM_S = ((DBHIB + D5IB) * 1.057711 + 0.016384) * 2.54 End If Else DIAM_S = 0 End If If DIAM_S > 0 Then SD_S = 30413.962 / ((DIAM_S / 2.54) ^ 1.834067) * 2.47 If NO_TREES_S > SD_S * Initial_PCT_S Then NO_TREES_S = SD_S * Initial_PCT_S End If End If SP_S = System.Math.Sqrt(10000 * Initial_PCT_S) / (System.Math.Sqrt(NO_TREES_S)) TEMPBA_S = (DIAM_S / 200) ^ 2 * 3.1415927 * NO_TREES_S DIAMETERS(3, AGE / 5, 1) = DIAM_S TEMPDIAM_S = DIAM_S Next AGE For AGE = 5 To 105 Step 5 DIAMETERS(2, AGE / 5, 1) = (DIAMETERS(1, AGE / 5, 1) + DIAMETERS(3, AGE / 5, 1)) / 2 Next AGE START_AGE = SAGE_S objWorksheet = objWorkbook.Sheets("Decisiontrt4") objWorksheet.Cells._Default(50, 10) = "Commercially thinned plantations" DIAM_H = 0 For CC = 40 To 100 Step 15 PCT_S = 1 For AGE = START_AGE To 105 Step 10 If System.Math.Abs(DIAMETERS(1, AGE / 5, 1) - DIAMETERS(3, AGE / 5, 1)) < 0.25 Then MINK = 2 MAXK = 2 Else MINK = 1 MAXK = 3 End If For P = MINK To MAXK Step 1 MINN = 2 MAXN = 2 For N = MINN To MAXN Step 1 DIAM_S = DIAMETERS(P, AGE / 5, 1) If DIAM_S > 0 And PCT_S = 0 Then PCT_S = 0.001 DIAM_S = 0 P = 3 End If If DIAM_S = 0 And DIAM_H = 0 Then GoTo 101 End If StoreState() kkkk = kkkk + 1 objWorksheet.Cells._Default(kkkk + 56, 1) = AGE objWorksheet.Cells._Default(kkkk + 56, 2) = DIAM_S objWorksheet.Cells._Default(kkkk + 56, 3) = CC 101: Next N Next P Next AGE Next CC '******************************************************************* '* Commercially thinned natural stands (managed and unmanaged) '******************************************************************* indx_sum(5) = z + 1 TRT = 5 SAGE_S = 0 YTBH_S = 44.07021 - 1.63556 * SI_SW * 3.28084 + 0.0222 * (SI_SW * 3.28084) ^ 2 - 0.000100987 * (SI_SW * 3.28084) ^ 3 10: If (SAGE_S - YTBH_S) < 2 Then SAGE_S = SAGE_S + 5 GoTo 10 End If SAGE_H = 0 YTBH_H = 10.5513 - 0.7565 * SI_HW + 0.0339 * SI_HW ^ 1.7826 11: If (SAGE_H - YTBH_H) < 2 Then SAGE_H = SAGE_H + 5 GoTo 11 End If 'Mindiam calculations for both species based on a natural stand that has grown at 100% crown 'closer since age 0 For AGE = 5 To 105 Step 5 Call DOMHGT(AGE, SI_SW, SI_HW, DHGT_S, DHGT_H) Call AVGHGT(1, 0, DHGT_S, AHGT_S) Call AVGHGT(2, 0, DHGT_H, AHGT_H) If AGE >= SAGE_S And Regen_SW_perct > 0 Then Call DIAMN(1, AHGT_S, DIAM_S) Else DIAM_S = 0 End If If AGE >= SAGE_H And (1 - Regen_SW_perct) > 0 Then Call DIAMN(2, AHGT_H, DIAM_H) Else DIAM_H = 0 End If DIAMETERS(1, AGE / 5, 1) = DIAM_S DIAMETERS(1, AGE / 5, 2) = DIAM_H Next AGE TEMPDIAM_S = 0 TEMPDIAM_H = 0 TEMPBA_S = 0 TEMPBA_H = 0 'Maxdiam calculations for both species based on a plantation stand that has grown 'at a low crown closer percentage since age 0 - we use Regen_SW_percent for softwood 'percentage instead of Initial_PCT_S like we do in the CT plantation routine NO_TREES_S = 500 * Regen_SW_perct NO_TREES_H = 500 - NO_TREES_S SP_S = 100 / System.Math.Sqrt(500) SP_H = SP_S For AGE = 5 To 105 Step 5 If AGE >= SAGE_S And Regen_SW_perct > 0 Then If TEMPDIAM_S = 0 Then Call DIAMP(SP_S, 1, 0, 0, SI_SW, AGE - YTBH_S - 2, DIAM_S) ElseIf SP_S < 3.1 Then Call FAGE(TEMPDIAM_S, SI_SW, SP_S, FAGE_S) Call DIAMP(SP_S, 1, TEMPDIAM_S, 0, SI_SW, FAGE_S + 5, DIAM_S) Else B1 = 0.02785202 B2 = -0.367548143 B3 = -0.005540854 DBHIB = (TEMPDIAM_S / 2.54 - 0.016384) / 1.057711 TMPBA = DBHIB ^ 2 * 0.005454 * (NO_TREES_S / (Regen_SW_perct * Stock)) / 2.47105 D5IB = (B1 * SI_SW * 3.28084 + B2) * System.Math.Exp(B3 * TMPBA) DIAM_S = ((DBHIB + D5IB) * 1.057711 + 0.016384) * 2.54 End If Else DIAM_S = 0 End If If DIAM_S > 0 Then SD_S = 30413.962 / ((DIAM_S / 2.54) ^ 1.834067) * 2.47 If NO_TREES_S > SD_S * Regen_SW_perct * Stock Then NO_TREES_S = SD_S * Regen_SW_perct * Stock End If End If SP_S = System.Math.Sqrt(10000 * Regen_SW_perct * Stock) / (System.Math.Sqrt(NO_TREES_S)) TEMPBA_S = (DIAM_S / 200) ^ 2 * 3.1415927 * NO_TREES_S If AGE >= SAGE_H And (1 - Regen_SW_perct) > 0 Then If TEMPDIAM_H = 0 Then Call DIAMP(0, 2, 0, 0, SI_HW, 0, DIAM_H) Else Call DIAMP(0, 2, TEMPDIAM_H, TEMPBA_H / ((1 - Regen_SW_perct) * Stock), SI_HW, 0, DIAM_H) End If Else DIAM_H = 0 End If If DIAM_H > 0 Then Call SDN(2, DIAM_H, SD_H) If NO_TREES_H > SD_H * (1 - Regen_SW_perct) * Stock Then NO_TREES_H = SD_H * (1 - Regen_SW_perct) * Stock End If End If TEMPBA_H = (DIAM_H / 200) ^ 2 * 3.1415927 * NO_TREES_H DIAMETERS(3, AGE / 5, 1) = DIAM_S DIAMETERS(3, AGE / 5, 2) = DIAM_H TEMPDIAM_S = DIAM_S TEMPDIAM_H = DIAM_H Next AGE For AGE = 5 To 105 Step 5 DIAMETERS(2, AGE / 5, 1) = (DIAMETERS(1, AGE / 5, 1) + DIAMETERS(3, AGE / 5, 1)) / 2 DIAMETERS(2, AGE / 5, 2) = (DIAMETERS(1, AGE / 5, 2) + DIAMETERS(3, AGE / 5, 2)) / 2 Next AGE If SAGE_S < SAGE_H Then START_AGE = SAGE_S Else START_AGE = SAGE_H End If objWorksheet = objWorkbook.Sheets("Decisiontrt5") objWorksheet.Cells._Default(50, 10) = "Commercially thinned natural stands (managed and unmanaged)" For CC = 40 To 100 Step 15 For tmp = 0 To 99 Step 33 If tmp = 99 Then tmp = 100 End If PCT_S = tmp / 100 For AGE = START_AGE To 105 Step 10 If System.Math.Abs(DIAMETERS(1, AGE / 5, 1) - DIAMETERS(3, AGE / 5, 1)) < 1 Then MINK = 2 MAXK = 2 Else MINK = 1 MAXK = 3 End If If DIAMETERS(3, AGE / 5, 1) > 14 Or DIAMETERS(3, AGE / 5, 2) > 14 Then For P = MINK To MAXK Step 1 If System.Math.Abs(DIAMETERS(1, AGE / 5, 2) - DIAMETERS(3, AGE / 5, 2)) < 1 Then MINN = 2 MAXN = 2 Else MINN = 1 MAXN = 3 End If For N = MINN To MAXN Step 1 DIAM_S = DIAMETERS(P, AGE / 5, 1) DIAM_H = DIAMETERS(N, AGE / 5, 2) If DIAM_S = 0 And PCT_S > 0 Then PCT_S = 0 P = 3 ElseIf DIAM_S > 0 And PCT_S = 0 Then PCT_S = 0 DIAM_S = 0 P = 3 ElseIf DIAM_H > 0 And 1 - PCT_S = 0 Then DIAM_H = 0 PCT_S = 1 N = 3 ElseIf DIAM_H = 0 And 1 - PCT_S > 0 Then PCT_S = 1 N = 3 End If StoreState() If AGE = 45 Then zzzzz = 1 End If kkkkk = kkkkk + 1 objWorksheet.Cells._Default(kkkkk + 56, 1) = AGE objWorksheet.Cells._Default(kkkkk + 56, 2) = DIAM_S objWorksheet.Cells._Default(kkkkk + 56, 3) = DIAM_H objWorksheet.Cells._Default(kkkkk + 56, 4) = CC objWorksheet.Cells._Default(kkkkk + 56, 5) = PCT_S Next N Next P End If Next AGE Next tmp Next CC indx_sum(6) = z + 1 End Sub Private Sub APPROX() '******************************************************************************** '* * '* Approximation section * '* * '* This section can calculate the multiple regression coefficients of * '* equations using the states created in the Create section. These * '* equations can be used to give an approximation to the CTG * '* function. This section also contains all of the structure to evaluate * '* an approximation using one of a series of RBF functions. The user * '* choses which of these methods is to be used. * '* * '******************************************************************************** '*** Form the Ymatrix for all possible treatments For i = 1 To 13 indx(i) = 0 'vector that keeps track of the number of records for each treatment type Next i For i = 5 To z 'skip the 0,0,0 states If States(i, 6) = 4 Or States(i, 6) = 2 Or States(i, 6) = 5 Then indx(States(i, 6)) = indx(States(i, 6)) + 1 For curpricebrk = 1 To pricebreaks Ymatrix(curpricebrk, States(i, 6), indx(States(i, 6))) = CostToGo(curpricebrk, i, 1) Next curpricebrk End If Next i ' Print CTG values for the given iteration 'If itercount = 2 Then 'objWorksheet = objWorkbook.Sheets("Basic") 'objWorksheet.Range("X1").Offset(0, 0)._Default = "State" 'objWorksheet.Range("Y1").Offset(0, 0)._Default = "Var1" 'objWorksheet.Range("Z1").Offset(0, 0)._Default = "Var2" 'objWorksheet.Range("AA1").Offset(0, 0)._Default = "Var3" 'objWorksheet.Range("AB1").Offset(0, 0)._Default = "Var4" 'objWorksheet.Range("AC1").Offset(0, 0)._Default = "Var5" 'objWorksheet.Range("AD1").Offset(0, 0)._Default = "TRT" 'objWorksheet.Range("AE1").Offset(0, 0)._Default = "CTG" 'objWorksheet.Range("AF1").Offset(0, 0)._Default = "Decision" 'zz = 0 'For i = 1 To z 'If States(i, 6) = 2 Then 'zz = zz + 1 'objWorksheet.Range("X2").Offset(zz, 0)._Default = i 'objWorksheet.Range("Y2").Offset(zz, 0)._Default = States(i, 1) 'objWorksheet.Range("Z2").Offset(zz, 0)._Default = States(i, 2) 'objWorksheet.Range("AA2").Offset(zz, 0)._Default = States(i, 3) 'objWorksheet.Range("AB2").Offset(zz, 0)._Default = States(i, 4) 'objWorksheet.Range("AC2").Offset(zz, 0)._Default = States(i, 5) 'objWorksheet.Range("AD2").Offset(zz, 0)._Default = States(i, 6) 'objWorksheet.Range("AE2").Offset(zz, 0)._Default = CostToGo(1, i, 1) 'objWorksheet.Range("AF2").Offset(zz, 0)._Default = CostToGo(1, i, 2) 'End If 'Next i 'End If If RBF = 0 Then '**** Reinitialize the Bmatrix For curpricebrk = 1 To pricebreaks For m = 1 To NO_TRT If m = 2 Or m = 4 Or m = 5 Then For i = 1 To term(m) Bmatrix(curpricebrk, m, i) = 0 Next i End If Next m Next curpricebrk '---- Find the coefficient vector Bmatrix --------------------------------------- If itercount = 1 Then zz = 1 End If For curpricebrk = 1 To pricebreaks For m = 1 To NO_TRT If m = 2 Or m = 4 Or m = 5 Then For i = 1 To term(m) For j = 1 To indx(m) TEMP = Cmatrix(m, i, j) * Ymatrix(curpricebrk, m, j) Bmatrix(curpricebrk, m, i) = Bmatrix(curpricebrk, m, i) + TEMP Next j Next i End If Next m Next curpricebrk ' Print CTG values for the given iteration 'If itercount = 2 Then ' zz = 0 ' For i = 5 To z ' If States(i, 6) = 2 Then ' zz = zz + 1 ' AGE = States(i, 1) ' DIAM_S = States(i, 2) ' DIAM_H = States(i, 3) ' PCT_S = States(i, 4) ' CC = States(i, 5) ' NEWTRT = 2 ' curpricebrk = 1 ' B0 = Bmatrix(curpricebrk, NEWTRT, 1) ' B1 = Bmatrix(curpricebrk, NEWTRT, 2) ' B2 = Bmatrix(curpricebrk, NEWTRT, 3) ' B3 = Bmatrix(curpricebrk, NEWTRT, 4) ' B4 = Bmatrix(curpricebrk, NEWTRT, 5) ' B5 = Bmatrix(curpricebrk, NEWTRT, 6) ' B6 = Bmatrix(curpricebrk, NEWTRT, 7) ' B7 = Bmatrix(curpricebrk, NEWTRT, 8) ' B8 = Bmatrix(curpricebrk, NEWTRT, 9) ' B9 = Bmatrix(curpricebrk, NEWTRT, 10) ' B10 = Bmatrix(curpricebrk, NEWTRT, 11) ' B11 = Bmatrix(curpricebrk, NEWTRT, 12) ' B12 = Bmatrix(curpricebrk, NEWTRT, 13) ' B13 = Bmatrix(curpricebrk, NEWTRT, 14) ' B14 = Bmatrix(curpricebrk, NEWTRT, 15) ' B15 = Bmatrix(curpricebrk, NEWTRT, 16) ' B16 = Bmatrix(curpricebrk, NEWTRT, 17) ' B17 = Bmatrix(curpricebrk, NEWTRT, 18) ' B18 = Bmatrix(curpricebrk, NEWTRT, 19) ' B19 = Bmatrix(curpricebrk, NEWTRT, 20) ' B20 = Bmatrix(curpricebrk, NEWTRT, 21) ' FUTURENET = B0 + B1 * AGE + B2 * DIAM_S + B3 * DIAM_H + B4 * PCT_S + B5 * CC + B6 * AGE ^ 2 + B7 * DIAM_S ^ 2 + B8 * DIAM_H ^ 2 + B9 * PCT_S ^ 2 + B10 * CC ^ 2 + B11 * AGE * DIAM_S + B12 * AGE * DIAM_H + B13 * AGE * PCT_S + B14 * AGE * CC + B15 * DIAM_S * DIAM_H + B16 * DIAM_S * PCT_S + B17 * DIAM_S * CC + B18 * DIAM_H * PCT_S + B19 * DIAM_H * CC + B20 * CC * PCT_S ' objWorksheet.Range("AB2").Offset(zz, 0) = FUTURENET ' End If ' Next i 'End If ElseIf RBF = 10 Then 'Skip this section Else '** Calculate the weight matrix for the RBF For m = 1 To NO_TRT If m = 2 Or m = 4 Or m = 5 Then For curpricebrk = 1 To pricebreaks For i = 1 To indx(m) TEMP = 0 For j = 1 To indx(m) TEMP = TEMP + Ymatrix(curpricebrk, m, j) * Cmatrix(m, i, j) Next j Weights(curpricebrk, m, i) = TEMP Next i Next curpricebrk End If Next m 'objWorksheet = objWorkbook.Sheets("Basic") 'For i = 1 To indx(2) ' objWorksheet.Cells._Default(i, 45) = Weights(1, 2, i) ' objWorksheet.Cells._Default(i, 46) = Ymatrix(1, 2, i) ' Next i End If End Sub Private Sub EVALUATE() '**************************************************************************************************** '* '* Subroutine for evaluating the fitted value for every state and printing them in a spreadsheet '* '**************************************************************************************************** objWorksheet = objWorkbook.Sheets("Basic") objWorksheet.Range("ag1").Offset(0, 0)._Default = "State" objWorksheet.Range("ag1").Offset(0, 1)._Default = "TRT" objWorksheet.Range("ag1").Offset(0, 2)._Default = "AGE" objWorksheet.Range("ag1").Offset(0, 3)._Default = "DIAM_S" objWorksheet.Range("ag1").Offset(0, 4)._Default = "DIAM_H" objWorksheet.Range("ag1").Offset(0, 5)._Default = "PCT_S" objWorksheet.Range("ag1").Offset(0, 6)._Default = "CC" objWorksheet.Range("ag1").Offset(0, 7)._Default = "EVAL" For State = 5 To z AGE = States(State, 1) TRT = States(State, 6) objWorksheet.Range("ag1").Offset(State, 0)._Default = State objWorksheet.Range("ag1").Offset(State, 1)._Default = TRT objWorksheet.Range("ag1").Offset(State, 2)._Default = AGE If TRT = 2 Then DIAM_S = States(State, 2) objWorksheet.Range("ag1").Offset(State, 3)._Default = DIAM_S DIAM_H = States(State, 3) objWorksheet.Range("ag1").Offset(State, 4)._Default = DIAM_H PCT_S = States(State, 4) objWorksheet.Range("ag1").Offset(State, 5)._Default = PCT_S CC = States(State, 5) objWorksheet.Range("ag1").Offset(State, 6)._Default = CC ElseIf TRT = 4 Then DIAM_S = States(State, 2) objWorksheet.Range("ag1").Offset(State, 3)._Default = DIAM_S CC = States(State, 3) objWorksheet.Range("ag1").Offset(State, 6)._Default = CC ElseIf TRT = 5 Then DIAM_S = States(State, 2) objWorksheet.Range("ag1").Offset(State, 3)._Default = DIAM_S DIAM_H = States(State, 3) objWorksheet.Range("ag1").Offset(State, 4)._Default = DIAM_H PCT_S = States(State, 4) objWorksheet.Range("ag1").Offset(State, 5)._Default = PCT_S CC = States(State, 5) objWorksheet.Range("ag1").Offset(State, 6)._Default = CC Else GoTo 43 End If If RBF = 0 Then ' Calculate the regression approximation with the new point If TRT = 2 Or TRT = 5 Then B0 = Bmatrix(1, TRT, 1) B1 = Bmatrix(1, TRT, 2) B2 = Bmatrix(1, TRT, 3) B3 = Bmatrix(1, TRT, 4) B4 = Bmatrix(1, TRT, 5) B5 = Bmatrix(1, TRT, 6) B6 = Bmatrix(1, TRT, 7) B7 = Bmatrix(1, TRT, 8) B8 = Bmatrix(1, TRT, 9) B9 = Bmatrix(1, TRT, 10) B10 = Bmatrix(1, TRT, 11) B11 = Bmatrix(1, TRT, 12) B12 = Bmatrix(1, TRT, 13) B13 = Bmatrix(1, TRT, 14) B14 = Bmatrix(1, TRT, 15) B15 = Bmatrix(1, TRT, 16) B16 = Bmatrix(1, TRT, 17) B17 = Bmatrix(1, TRT, 18) B18 = Bmatrix(1, TRT, 19) B19 = Bmatrix(1, TRT, 20) B20 = Bmatrix(1, TRT, 21) Eval = B0 + B1 * AGE + B2 * DIAM_S + B3 * DIAM_H + B4 * PCT_S + B5 * CC + B6 * AGE ^ 2 + B7 * DIAM_S ^ 2 + B8 * DIAM_H ^ 2 + B9 * PCT_S ^ 2 + B10 * CC ^ 2 + B11 * AGE * DIAM_S + B12 * AGE * DIAM_H + B13 * AGE * PCT_S + B14 * AGE * CC + B15 * DIAM_S * DIAM_H + B16 * DIAM_S * PCT_S + B17 * DIAM_S * CC + B18 * DIAM_H * PCT_S + B19 * DIAM_H * CC + B20 * CC * PCT_S ElseIf TRT = 4 Then B0 = Bmatrix(1, TRT, 1) B1 = Bmatrix(1, TRT, 2) B2 = Bmatrix(1, TRT, 3) B3 = Bmatrix(1, TRT, 4) B4 = Bmatrix(1, TRT, 5) B5 = Bmatrix(1, TRT, 6) B6 = Bmatrix(1, TRT, 7) B7 = Bmatrix(1, TRT, 8) B8 = Bmatrix(1, TRT, 9) B9 = Bmatrix(1, TRT, 10) Eval = B0 + B1 * AGE + B2 * DIAM_S + B3 * CC + B4 * AGE ^ 2 + B5 * DIAM_S ^ 2 + B6 * CC ^ 2 + B7 * AGE * DIAM_S + B8 * AGE * CC + B9 * DIAM_S * CC End If Else If TRT = 2 Or TRT = 5 Then For i = 1 To indx(TRT) If RBF = 1 Then TEMP = ((Xmatrix(TRT, i, 1) - AGE) / MAX_STATE_VALUE(TRT, 1)) ^ 2 + ((Xmatrix(TRT, i, 2) - DIAM_S) / MAX_STATE_VALUE(TRT, 2)) ^ 2 + ((Xmatrix(TRT, i, 3) - DIAM_H) / MAX_STATE_VALUE(TRT, 3)) ^ 2 + ((Xmatrix(TRT, i, 4) - PCT_S) / MAX_STATE_VALUE(TRT, 4)) ^ 2 + ((Xmatrix(TRT, i, 5) - CC) / MAX_STATE_VALUE(TRT, 5)) ^ 2 TEMP = System.Math.Sqrt(TEMP) If TEMP = 0 Then Tvalue(i) = 0 Else Tvalue(i) = 2 * TEMP * Log10(TEMP) End If ElseIf RBF = 2 Then Tvalue(i) = System.Math.Sqrt(((Xmatrix(TRT, i, 1) - AGE) / MAX_STATE_VALUE(TRT, 1)) ^ 2 + ((Xmatrix(TRT, i, 2) - DIAM_S) / MAX_STATE_VALUE(TRT, 2)) ^ 2 + ((Xmatrix(TRT, i, 3) - DIAM_H) / MAX_STATE_VALUE(TRT, 3)) ^ 2 + ((Xmatrix(TRT, i, 4) - PCT_S) / MAX_STATE_VALUE(TRT, 4)) ^ 2 + ((Xmatrix(TRT, i, 5) - CC) / MAX_STATE_VALUE(TRT, 5)) ^ 2) ElseIf RBF = 3 Then Tvalue(i) = System.Math.Sqrt(((Xmatrix(TRT, i, 1) - AGE) / MAX_STATE_VALUE(TRT, 1)) ^ 2 + ((Xmatrix(TRT, i, 2) - DIAM_S) / MAX_STATE_VALUE(TRT, 2)) ^ 2 + ((Xmatrix(TRT, i, 3) - DIAM_H) / MAX_STATE_VALUE(TRT, 3)) ^ 2 + ((Xmatrix(TRT, i, 4) - PCT_S) / MAX_STATE_VALUE(TRT, 4)) ^ 2 + ((Xmatrix(TRT, i, 5) - CC) / MAX_STATE_VALUE(TRT, 5)) ^ 2 + Cvalue ^ 2) ElseIf RBF = 4 Then Tvalue(i) = 1 / System.Math.Sqrt(((Xmatrix(TRT, i, 1) - AGE) / MAX_STATE_VALUE(TRT, 1)) ^ 2 + ((Xmatrix(TRT, i, 2) - DIAM_S) / MAX_STATE_VALUE(TRT, 2)) ^ 2 + ((Xmatrix(TRT, i, 3) - DIAM_H) / MAX_STATE_VALUE(TRT, 3)) ^ 2 + ((Xmatrix(TRT, i, 4) - PCT_S) / MAX_STATE_VALUE(TRT, 4)) ^ 2 + ((Xmatrix(TRT, i, 5) - CC) / MAX_STATE_VALUE(TRT, 5)) ^ 2 + Cval(TRT) ^ 2) ElseIf RBF = 5 Or RBF = 6 Or RBF = 7 Then Tvalue(i) = 1 / System.Math.Sqrt(((Xmatrix(TRT, i, 1) - AGE) / MAX_STATE_VALUE(TRT, 1)) ^ 2 + ((Xmatrix(TRT, i, 2) - DIAM_S) / MAX_STATE_VALUE(TRT, 2)) ^ 2 + ((Xmatrix(TRT, i, 3) - DIAM_H) / MAX_STATE_VALUE(TRT, 3)) ^ 2 + ((Xmatrix(TRT, i, 4) - PCT_S) / MAX_STATE_VALUE(TRT, 4)) ^ 2 + ((Xmatrix(TRT, i, 5) - CC) / MAX_STATE_VALUE(TRT, 5)) ^ 2 + Cvalue ^ 2) ElseIf RBF = 8 Then TEMP = System.Math.Sqrt(((Xmatrix(TRT, i, 1) - AGE) / MAX_STATE_VALUE(TRT, 1)) ^ 2 + ((Xmatrix(TRT, i, 2) - DIAM_S) / MAX_STATE_VALUE(TRT, 2)) ^ 2 + ((Xmatrix(TRT, i, 3) - DIAM_H) / MAX_STATE_VALUE(TRT, 3)) ^ 2 + ((Xmatrix(TRT, i, 4) - PCT_S) / MAX_STATE_VALUE(TRT, 4)) ^ 2 + ((Xmatrix(TRT, i, 5) - CC) / MAX_STATE_VALUE(TRT, 5)) ^ 2) Tvalue(i) = System.Math.Exp(-Cvalue * TEMP) ElseIf RBF = 9 Then TEMP = System.Math.Sqrt(((Xmatrix(TRT, i, 1) - AGE) / MAX_STATE_VALUE(TRT, 1)) ^ 2 + ((Xmatrix(TRT, i, 2) - DIAM_S) / MAX_STATE_VALUE(TRT, 2)) ^ 2 + ((Xmatrix(TRT, i, 3) - DIAM_H) / MAX_STATE_VALUE(TRT, 3)) ^ 2 + ((Xmatrix(TRT, i, 4) - PCT_S) / MAX_STATE_VALUE(TRT, 4)) ^ 2 + ((Xmatrix(TRT, i, 5) - CC) / MAX_STATE_VALUE(TRT, 5)) ^ 2) Tvalue(i) = System.Math.Exp(-(Cvalue ^ 2 * TEMP ^ 2)) End If Next i ElseIf TRT = 4 Then For i = 1 To indx(TRT) If RBF = 1 Then TEMP = ((Xmatrix(TRT, i, 1) - AGE) / MAX_STATE_VALUE(TRT, 1)) ^ 2 + ((Xmatrix(TRT, i, 2) - DIAM_S) / MAX_STATE_VALUE(TRT, 2)) ^ 2 + ((Xmatrix(TRT, i, 3) - CC) / MAX_STATE_VALUE(TRT, 3)) ^ 2 TEMP = System.Math.Sqrt(TEMP) If TEMP = 0 Then Tvalue(i) = 0 Else Tvalue(i) = 2 * TEMP * Log10(TEMP) End If ElseIf RBF = 2 Then Tvalue(i) = System.Math.Sqrt(((Xmatrix(TRT, i, 1) - AGE) / MAX_STATE_VALUE(TRT, 1)) ^ 2 + ((Xmatrix(TRT, i, 2) - DIAM_S) / MAX_STATE_VALUE(TRT, 2)) ^ 2 + ((Xmatrix(TRT, i, 3) - CC) / MAX_STATE_VALUE(TRT, 3)) ^ 2) ElseIf RBF = 3 Then Tvalue(i) = System.Math.Sqrt(((Xmatrix(TRT, i, 1) - AGE) / MAX_STATE_VALUE(TRT, 1)) ^ 2 + ((Xmatrix(TRT, i, 2) - DIAM_S) / MAX_STATE_VALUE(TRT, 2)) ^ 2 + ((Xmatrix(TRT, i, 3) - CC) / MAX_STATE_VALUE(TRT, 3)) ^ 2 + Cvalue ^ 2) ElseIf RBF = 4 Then Tvalue(i) = 1 / System.Math.Sqrt(((Xmatrix(TRT, i, 1) - AGE) / MAX_STATE_VALUE(TRT, 1)) ^ 2 + ((Xmatrix(TRT, i, 2) - DIAM_S) / MAX_STATE_VALUE(TRT, 2)) ^ 2 + ((Xmatrix(TRT, i, 3) - CC) / MAX_STATE_VALUE(TRT, 3)) ^ 2 + Cval(NEWTRT) ^ 2) ElseIf RBF = 5 Or RBF = 6 Or RBF = 7 Then Tvalue(i) = 1 / System.Math.Sqrt(((Xmatrix(TRT, i, 1) - AGE) / MAX_STATE_VALUE(TRT, 1)) ^ 2 + ((Xmatrix(TRT, i, 2) - DIAM_S) / MAX_STATE_VALUE(TRT, 2)) ^ 2 + ((Xmatrix(TRT, i, 3) - CC) / MAX_STATE_VALUE(TRT, 3)) ^ 2 + Cvalue ^ 2) ElseIf RBF = 8 Then TEMP = System.Math.Sqrt(((Xmatrix(TRT, i, 1) - AGE) / MAX_STATE_VALUE(TRT, 1)) ^ 2 + ((Xmatrix(TRT, i, 2) - DIAM_S) / MAX_STATE_VALUE(TRT, 2)) ^ 2 + ((Xmatrix(TRT, i, 3) - CC) / MAX_STATE_VALUE(TRT, 3)) ^ 2) Tvalue(i) = System.Math.Exp(-Cvalue * TEMP) ElseIf RBF = 9 Then TEMP = System.Math.Sqrt(((Xmatrix(TRT, i, 1) - AGE) / MAX_STATE_VALUE(TRT, 1)) ^ 2 + ((Xmatrix(TRT, i, 2) - DIAM_S) / MAX_STATE_VALUE(TRT, 2)) ^ 2 + ((Xmatrix(TRT, i, 3) - CC) / MAX_STATE_VALUE(TRT, 3)) ^ 2) Tvalue(i) = System.Math.Exp(-(Cvalue ^ 2 * TEMP ^ 2)) End If Next i End If ' Calculate function approximations Eval = 0 For i = 1 To indx(TRT) Eval = Eval + Tvalue(i) * Weights(1, TRT, i) Next i End If objWorksheet.Range("ag1").Offset(State, itercount + 6)._Default = Eval 43: Next State End Sub Private Sub Initial() '**************************************************************************** '* * '* Subroutine to initialize terms - This subroutine sets initial * '* values for user input information and also puts combinations of * '* decision and state information into an array * '* * '**************************************************************************** Dim i As Integer z = 0 'state counter BigM = 100 'value used in calculating weight factors in DWI discount = System.Math.Exp(-discountrate * 5) '5 year discount calculated from discount rate prLowF = 0.3 'Probability of low intensity fire if a fire occurs prMedF = 0.5 'Probability of medium intensity fire if a fire occurs prHighF = 0.2 'Probability of high intensity fire if a fire occurs prLowH = 0.5 'Probability of low intensity hurricane if a hurricane occurs prMedH = 0.3 'Probability of medium intensity hurricane if a hurricane occurs prHighH = 0.2 'Probability of high intensity hurricane if a hurricane occurs Probfire = 1 - System.Math.Exp(-5 * number_fires) 'Probability fire occurs in the period size_fire = 10000 / number_fires 'Average size of each fire Condprobfire = 5 * number_fires * size_fire / area_region 'Conditional probability stand is burned if fire occurs If Condprobfire > 1 Then Condprobfire = 1 End If Probfireburns = Probfire * Condprobfire 'Probability fire occurs and stand is burned Probhurr = 1 - System.Math.Exp(-5 / interval_hurr) 'Probability hurricane arrives in period Condprobhurr = area_wind / area_region 'Conditional probabibility stand affected by a hurricane Probhurraffects = Probhurr * Condprobhurr 'Probability hurricane occurs and stand is affected by it ProbInsects = 1 - System.Math.Exp(-5 / interval_insect) 'Probability of insect outbreak kkk = 0 kkkk = 0 kkkkk = 0 'Put treatment / decision combinations in an array : There are 5 treatments and each 'treatment has 48 possible decisions (decis(i,j)=k). Therefore, i = current treatment, 'j = current decision, k = future treatment For i = 1 To 13 For j = 1 To 48 decis(i, j) = 0 Next j Next i '********************************************************************************** ' Available decisions ' 1 - Natural stand - Do nothing and let grow (no volumes) ' 2 - Plantation or pct natural - Do nothing and let grow (no volumes) ' 3 - Clear cut and let grow (natural) ' 4 - Clear cut (or site prep) and plant without early competition control - becomes a well stocked natural stand ' 5 - Clear cut (or site prep) and plant 1000 trees/ha with 100% softwood ' 6 - Clear cut (or site prep) and plant 1750 trees/ha with 100% softwood ' 7 - Clear cut (or site prep) and plant 2500 trees/ha with 100% softwood ' 8 - Clear cut (or site prep) and plant 3250 trees/ha with 100% softwood ' 9 - Clear cut (or site prep) and plant 4000 trees/ha with 100% softwood ' 10 - Pre-commercial thinning (pct) - keep mixed wood ' 11 - Pre-commercial thinning (pct) - eliminate softwood and space hardwood if needed ' 12 - Pre-commercial thinning (pct) - eliminate hardwood and space softwood if needed ' 13 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 25% SW from below ' 14 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 50% SW from below ' 15 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 75% SW from below ' 16 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 25% SW from below ' 17 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 50% SW from below ' 18 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 75% SW from below ' 19 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 25% SW from below ' 20 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 50% SW from below ' 21 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 75% SW from below ' 22 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 25% SW across the diameter distribution ' 23 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 50% SW across the diameter distribution ' 24 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 75% SW across the diameter distribution ' 25 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 25% SW across the diameter distribution ' 26 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 50% SW across the diameter distribution ' 27 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 75% SW across the diameter distribution ' 28 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 25% SW across the diameter distribution ' 29 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 50% SW across the diameter distribution ' 30 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 75% SW across the diameter distribution ' 31 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 25% SW from above ' 32 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 50% SW from above ' 33 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 75% SW from above ' 34 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 25% SW from above ' 35 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 50% SW from above ' 36 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 75% SW from above ' 37 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 25% SW from above ' 38 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 50% SW from above ' 39 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 75% SW from above ' 40 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 100% SW from below ' 41 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 100% SW from below ' 42 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 100% SW from below ' 43 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 100% SW across the diameter distribution ' 44 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 100% SW across the diameter distribution ' 45 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 100% SW across the diameter distribution ' 46 - Commercial thinning (ct) - BARem = 20%, BARem_Split = 100% SW from above ' 47 - Commercial thinning (ct) - BARem = 30%, BARem_Split = 100% SW from above ' 48 - Commercial thinning (ct) - BARem = 40%, BARem_Split = 100% SW from above '********************************************************************************** decis(1, 1) = 1 decis(1, 3) = 1 decis(1, 4) = 1 For i = 5 To 9 decis(1, i) = 3 Next i For i = 10 To 12 decis(1, i) = 2 Next i For i = 13 To 48 decis(1, i) = 5 Next i decis(2, 2) = 2 decis(2, 3) = 1 decis(2, 4) = 1 For i = 5 To 9 decis(2, i) = 3 Next i For i = 13 To 48 decis(2, i) = 5 Next i decis(3, 2) = 3 decis(3, 3) = 1 decis(3, 4) = 1 For i = 5 To 9 decis(3, i) = 3 Next i For i = 13 To 48 decis(3, i) = 4 Next i decis(4, 2) = 4 decis(4, 3) = 1 decis(4, 4) = 1 For i = 5 To 9 decis(4, i) = 3 Next i For i = 13 To 48 decis(4, i) = 4 Next i decis(5, 2) = 5 decis(5, 3) = 1 decis(5, 4) = 1 For i = 5 To 9 decis(5, i) = 3 Next i For i = 13 To 48 decis(5, i) = 5 Next i decis(10, 1) = 11 decis(10, 4) = 1 For i = 5 To 9 decis(10, i) = 3 Next i decis(11, 1) = 12 decis(11, 4) = 1 For i = 5 To 9 decis(11, i) = 3 Next i decis(12, 1) = 13 decis(12, 4) = 1 For i = 5 To 9 decis(12, i) = 3 Next i decis(13, 1) = 1 decis(13, 4) = 1 For i = 5 To 9 decis(13, i) = 3 Next i itercount = 0 'Iteration counter for the DP algorithm '*** Fill the price and probs array objWorksheet = objWorkbook.Sheets("Basic") With objWorksheet For i = 1 To pricebreaks Prices(1, i, 1) = objWorksheet.Range("b40").Offset(0, i - 1)._Default Prices(1, i, 2) = objWorksheet.Range("b41").Offset(0, i - 1)._Default Prices(2, i, 1) = objWorksheet.Range("b42").Offset(0, i - 1)._Default Prices(2, i, 2) = objWorksheet.Range("b43").Offset(0, i - 1)._Default For j = 1 To pricebreaks priceprob(i, j) = objWorksheet.Range("b39").Offset(0, j - 1)._Default Next Next End With objWorksheet = objWorkbook.Sheets("Decisiontrt1") With objWorksheet For j = 1 To pricebreaks .Cells._Default(52, 4 + j) = Prices(1, j, 1) .Cells._Default(53, 4 + j) = Prices(1, j, 2) .Cells._Default(54, 4 + j) = Prices(2, j, 1) .Cells._Default(55, 4 + j) = Prices(2, j, 2) Next j End With For k = 2 To 5 Step 3 objWorksheet = objWorkbook.Sheets(Sheet_names(k)) For j = 1 To pricebreaks objWorksheet.Cells._Default(52, 7 + j) = Prices(1, j, 1) objWorksheet.Cells._Default(53, 7 + j) = Prices(1, j, 2) objWorksheet.Cells._Default(54, 7 + j) = Prices(2, j, 1) objWorksheet.Cells._Default(55, 7 + j) = Prices(2, j, 2) Next j Next k For k = 3 To 4 objWorksheet = objWorkbook.Sheets(Sheet_names(k)) For j = 1 To pricebreaks objWorksheet.Cells._Default(52, 5 + j) = Prices(1, j, 1) objWorksheet.Cells._Default(53, 5 + j) = Prices(1, j, 2) objWorksheet.Cells._Default(54, 5 + j) = Prices(2, j, 1) objWorksheet.Cells._Default(55, 5 + j) = Prices(2, j, 2) Next j Next k End Sub Private Sub Store() '*************************************************************************************** '* '* Store all state info in arrays for use during approximation '* '*************************************************************************************** '**** Put zero values in CostToGo array For pricebreak = 1 To pricebreaks For State = 1 To z CostToGo(pricebreak, State, 1) = -0.001 CostToGo(pricebreak, State, 2) = 0 Next State Next pricebreak '********************************************************************************* ' Fill the X1matrix and calculate the Cmatrix for Multiple Regression '********************************************************************************* For i = 1 To NO_TRT indx(i) = 0 'vector that keeps track of the number of records for each treatment type Next i If RBF = 0 Then For i = 5 To z 'skip the 0,0,0 states If States(i, 6) = 2 Or States(i, 6) = 5 Then indx(States(i, 6)) = indx(States(i, 6)) + 1 Xmatrix(States(i, 6), indx(States(i, 6)), 1) = 1 Xtransp(States(i, 6), 1, indx(States(i, 6))) = 1 Xmatrix(States(i, 6), indx(States(i, 6)), 2) = States(i, 1) Xtransp(States(i, 6), 2, indx(States(i, 6))) = States(i, 1) Xmatrix(States(i, 6), indx(States(i, 6)), 3) = States(i, 2) Xtransp(States(i, 6), 3, indx(States(i, 6))) = States(i, 2) Xmatrix(States(i, 6), indx(States(i, 6)), 4) = States(i, 3) Xtransp(States(i, 6), 4, indx(States(i, 6))) = States(i, 3) Xmatrix(States(i, 6), indx(States(i, 6)), 5) = States(i, 4) Xtransp(States(i, 6), 5, indx(States(i, 6))) = States(i, 4) Xmatrix(States(i, 6), indx(States(i, 6)), 6) = States(i, 5) Xtransp(States(i, 6), 6, indx(States(i, 6))) = States(i, 5) Xmatrix(States(i, 6), indx(States(i, 6)), 7) = States(i, 1) ^ 2 Xtransp(States(i, 6), 7, indx(States(i, 6))) = States(i, 1) ^ 2 Xmatrix(States(i, 6), indx(States(i, 6)), 8) = States(i, 2) ^ 2 Xtransp(States(i, 6), 8, indx(States(i, 6))) = States(i, 2) ^ 2 Xmatrix(States(i, 6), indx(States(i, 6)), 9) = States(i, 3) ^ 2 Xtransp(States(i, 6), 9, indx(States(i, 6))) = States(i, 3) ^ 2 Xmatrix(States(i, 6), indx(States(i, 6)), 10) = States(i, 4) ^ 2 Xtransp(States(i, 6), 10, indx(States(i, 6))) = States(i, 4) ^ 2 Xmatrix(States(i, 6), indx(States(i, 6)), 11) = States(i, 5) ^ 2 Xtransp(States(i, 6), 11, indx(States(i, 6))) = States(i, 5) ^ 2 Xmatrix(States(i, 6), indx(States(i, 6)), 12) = States(i, 1) * States(i, 2) Xtransp(States(i, 6), 12, indx(States(i, 6))) = States(i, 1) * States(i, 2) Xmatrix(States(i, 6), indx(States(i, 6)), 13) = States(i, 1) * States(i, 3) Xtransp(States(i, 6), 13, indx(States(i, 6))) = States(i, 1) * States(i, 3) Xmatrix(States(i, 6), indx(States(i, 6)), 14) = States(i, 1) * States(i, 4) Xtransp(States(i, 6), 14, indx(States(i, 6))) = States(i, 1) * States(i, 4) Xmatrix(States(i, 6), indx(States(i, 6)), 15) = States(i, 1) * States(i, 5) Xtransp(States(i, 6), 15, indx(States(i, 6))) = States(i, 1) * States(i, 5) Xmatrix(States(i, 6), indx(States(i, 6)), 16) = States(i, 2) * States(i, 3) Xtransp(States(i, 6), 16, indx(States(i, 6))) = States(i, 2) * States(i, 3) Xmatrix(States(i, 6), indx(States(i, 6)), 17) = States(i, 2) * States(i, 4) Xtransp(States(i, 6), 17, indx(States(i, 6))) = States(i, 2) * States(i, 4) Xmatrix(States(i, 6), indx(States(i, 6)), 18) = States(i, 2) * States(i, 5) Xtransp(States(i, 6), 18, indx(States(i, 6))) = States(i, 2) * States(i, 5) Xmatrix(States(i, 6), indx(States(i, 6)), 19) = States(i, 3) * States(i, 4) Xtransp(States(i, 6), 19, indx(States(i, 6))) = States(i, 3) * States(i, 4) Xmatrix(States(i, 6), indx(States(i, 6)), 20) = States(i, 3) * States(i, 5) Xtransp(States(i, 6), 20, indx(States(i, 6))) = States(i, 3) * States(i, 5) Xmatrix(States(i, 6), indx(States(i, 6)), 21) = States(i, 4) * States(i, 5) Xtransp(States(i, 6), 21, indx(States(i, 6))) = States(i, 4) * States(i, 5) ElseIf States(i, 6) = 4 Then indx(States(i, 6)) = indx(States(i, 6)) + 1 Xmatrix(States(i, 6), indx(States(i, 6)), 1) = 1 Xtransp(States(i, 6), 1, indx(States(i, 6))) = 1 Xmatrix(States(i, 6), indx(States(i, 6)), 2) = States(i, 1) Xtransp(States(i, 6), 2, indx(States(i, 6))) = States(i, 1) Xmatrix(States(i, 6), indx(States(i, 6)), 3) = States(i, 2) Xtransp(States(i, 6), 3, indx(States(i, 6))) = States(i, 2) Xmatrix(States(i, 6), indx(States(i, 6)), 4) = States(i, 3) Xtransp(States(i, 6), 4, indx(States(i, 6))) = States(i, 3) Xmatrix(States(i, 6), indx(States(i, 6)), 5) = States(i, 1) ^ 2 Xtransp(States(i, 6), 5, indx(States(i, 6))) = States(i, 1) ^ 2 Xmatrix(States(i, 6), indx(States(i, 6)), 6) = States(i, 2) ^ 2 Xtransp(States(i, 6), 6, indx(States(i, 6))) = States(i, 2) ^ 2 Xmatrix(States(i, 6), indx(States(i, 6)), 7) = States(i, 3) ^ 2 Xtransp(States(i, 6), 7, indx(States(i, 6))) = States(i, 3) ^ 2 Xmatrix(States(i, 6), indx(States(i, 6)), 8) = States(i, 1) * States(i, 2) Xtransp(States(i, 6), 8, indx(States(i, 6))) = States(i, 1) * States(i, 2) Xmatrix(States(i, 6), indx(States(i, 6)), 9) = States(i, 1) * States(i, 3) Xtransp(States(i, 6), 9, indx(States(i, 6))) = States(i, 1) * States(i, 3) Xmatrix(States(i, 6), indx(States(i, 6)), 10) = States(i, 2) * States(i, 3) Xtransp(States(i, 6), 10, indx(States(i, 6))) = States(i, 2) * States(i, 3) End If Next i TEMP = 0 term(2) = 21 term(4) = 10 term(5) = 21 '**** Reinitialize Xtranspose * X matrix to zero ***** For m = 1 To NO_TRT 'treatment type If m = 2 Or m = 4 Or m = 5 Then For i = 1 To term(m) '# of termes in regression equation For j = 1 To term(m) '# of termes in regression equation XtranspX(m, i, j) = 0 Next j Next i End If Next m '---- Do the multiplication of Xtranspose * X -------------------------- For m = 1 To NO_TRT 'treatment type If m = 2 Or m = 4 Or m = 5 Then For i = 1 To term(m) '# of termes in regression equation For j = 1 To term(m) '# of termes in regression equation For k = 1 To indx(m) TEMP = Xtransp(m, i, k) * Xmatrix(m, k, j) XtranspX(m, i, j) = XtranspX(m, i, j) + TEMP Next k Next j Next i End If Next m '---- Do the inverse of XtransposeX by using the Gauss-Jordan elimination '---- Amatrix is the identity augmented XtranspX matrix For m = 1 To NO_TRT If m = 2 Or m = 4 Or m = 5 Then For i = 1 To term(m) For j = 1 To term(m) Amatrix(m, i, j) = XtranspX(m, i, j) 'identity augmented matrix Amatrix(m, i, j + term(m)) = 0 Next j Next i End If Next m For m = 1 To NO_TRT If m = 2 Or m = 4 Or m = 5 Then For i = 1 To term(m) Amatrix(m, i, i + term(m)) = 1 Next i End If Next m For m = 1 To NO_TRT If m = 2 Or m = 4 Or m = 5 Then For i = 1 To term(m) If Amatrix(m, i, i) = 0 Then 'Have to find the largest element in the remainder of the column and put it on the diagonal TEMP = -1000000 For nn = i + 1 To term(m) If Amatrix(m, nn, i) > TEMP Then TEMP = Amatrix(m, nn, i) rownumb = nn End If Next nn If rownumb <> i Then For nn = 1 To 2 * term(m) TEMP1 = Amatrix(m, i, nn) Amatrix(m, i, nn) = Amatrix(m, rownumb, nn) Amatrix(m, rownumb, nn) = TEMP1 Next nn End If End If TEMP = Amatrix(m, i, i) 'end of putting largest element on the diagonal For j = i To 2 * term(m) Amatrix(m, i, j) = Amatrix(m, i, j) / TEMP Next j For k = 1 To term(m) If k = i Then GoTo 100 End If TEMP = Amatrix(m, k, i) For N = i To 2 * term(m) Amatrix(m, k, N) = Amatrix(m, k, N) - TEMP * Amatrix(m, i, N) Next N 100: Next k Next i End If Next m '**** Reinitialize the Cmatrix to zero For m = 1 To NO_TRT 'treatment type If m = 2 Or m = 4 Or m = 5 Then For i = 1 To term(m) '# of terms in regression equation For j = 1 To indx(m) Cmatrix(m, i, j) = 0 Next j Next i End If Next m '---- Multiply the XtranspX inverse (right half of the transformed Amatrix) with Xtransp For m = 1 To NO_TRT 'treatment type If m = 2 Or m = 4 Or m = 5 Then For i = 1 To term(m) '# of terms in regression equation For j = 1 To indx(m) For k = 1 To term(m) TEMP = Amatrix(m, i, k + term(m)) * Xtransp(m, k, j) Cmatrix(m, i, j) = Cmatrix(m, i, j) + TEMP Next k Next j Next i End If Next m ElseIf RBF = 10 Then 'Distance weighted interpolation For i = 5 To z TRT = States(i, 6) If TRT = 2 Or TRT = 5 Then indx(TRT) = indx(TRT) + 1 Xmatrix(TRT, indx(TRT), 1) = States(i, 1) Xmatrix(TRT, indx(TRT), 2) = States(i, 2) Xmatrix(TRT, indx(TRT), 3) = States(i, 3) Xmatrix(TRT, indx(TRT), 4) = States(i, 4) Xmatrix(TRT, indx(TRT), 5) = States(i, 5) ElseIf TRT = 4 Then indx(TRT) = indx(TRT) + 1 Xmatrix(TRT, indx(TRT), 1) = States(i, 1) Xmatrix(TRT, indx(TRT), 2) = States(i, 2) Xmatrix(TRT, indx(TRT), 3) = States(i, 3) End If Next i Else '************************************************************************************************* '*** Calculate the Amatrix to be used in the RBF during the recursion - only has to be done once '************************************************************************************************* For i = 1 To NO_TRT indx(i) = 0 'vector that keeps track of the number of records for each treatment Next i For i = 5 To z If States(i, 6) = 2 Or States(i, 6) = 5 Then indx(States(i, 6)) = indx(States(i, 6)) + 1 Xmatrix(States(i, 6), indx(States(i, 6)), 1) = States(i, 1) Xmatrix(States(i, 6), indx(States(i, 6)), 2) = States(i, 2) Xmatrix(States(i, 6), indx(States(i, 6)), 3) = States(i, 3) Xmatrix(States(i, 6), indx(States(i, 6)), 4) = States(i, 4) Xmatrix(States(i, 6), indx(States(i, 6)), 5) = States(i, 5) ElseIf States(i, 6) = 4 Then indx(States(i, 6)) = indx(States(i, 6)) + 1 Xmatrix(States(i, 6), indx(States(i, 6)), 1) = States(i, 1) Xmatrix(States(i, 6), indx(States(i, 6)), 2) = States(i, 2) Xmatrix(States(i, 6), indx(States(i, 6)), 3) = States(i, 3) End If Next i TEMP = 0 '**** Reinitialize Amatrix and Atransp ***** For m = 1 To NO_TRT 'treatment type If m = 2 Or m = 4 Or m = 5 Then For i = 1 To indx(m) '# of data points for treatment type M For j = 1 To indx(m) '# of data points for treatment type M Amatrix(m, i, j) = 0 Atransp(m, i, j) = 0 Next j Next i End If Next m '---- Calculate the norms for Amatrix and Atransp-------------------------- no_variabl(2) = 5 no_variabl(4) = 3 no_variabl(5) = 5 For m = 1 To NO_TRT 'treatment type If m = 2 Or m = 4 Or m = 5 Then xx = no_variabl(m) For i = 1 To indx(m) '# of data points for treatment type M For j = 1 To indx(m) '# of data points for treatment type M For k = 1 To xx TEMP = ((Xmatrix(m, i, k) - Xmatrix(m, j, k)) / MAX_STATE_VALUE(m, k)) ^ 2 Amatrix(m, i, j) = Amatrix(m, i, j) + TEMP Atransp(m, j, i) = Atransp(m, j, i) + TEMP Next k Next j Next i End If Next m '---- Apply the Radial Basis Function to the Amatrix and Atransp----------- For m = 1 To NO_TRT If m = 2 Or m = 4 Or m = 5 Then For i = 1 To indx(m) For j = 1 To indx(m) If RBF = 1 Then If Amatrix(m, i, j) <> 0 Then Amatrix(m, i, j) = 2 * Amatrix(m, i, j) * System.Math.Log(Amatrix(m, i, j)) Atransp(m, i, j) = 2 * Atransp(m, i, j) * System.Math.Log(Atransp(m, i, j)) End If ElseIf RBF = 3 Then Cvalue = 5 Amatrix(m, i, j) = System.Math.Sqrt(Amatrix(m, i, j) ^ 2 + Cvalue ^ 2) Atransp(m, i, j) = System.Math.Sqrt(Atransp(m, i, j) ^ 2 + Cvalue ^ 2) ElseIf RBF = 4 Then Amatrix(m, i, j) = 1 / System.Math.Sqrt(Amatrix(m, i, j) ^ 2 + Cval(m) ^ 2) Atransp(m, i, j) = 1 / System.Math.Sqrt(Atransp(m, i, j) ^ 2 + Cval(m) ^ 2) ElseIf RBF = 5 Then Cvalue = 5 Amatrix(m, i, j) = 1 / System.Math.Sqrt(Amatrix(m, i, j) ^ 2 + Cvalue ^ 2) Atransp(m, i, j) = 1 / System.Math.Sqrt(Atransp(m, i, j) ^ 2 + Cvalue ^ 2) ElseIf RBF = 6 Then Cvalue = 10 Amatrix(m, i, j) = 1 / System.Math.Sqrt(Amatrix(m, i, j) ^ 2 + Cvalue ^ 2) Atransp(m, i, j) = 1 / System.Math.Sqrt(Atransp(m, i, j) ^ 2 + Cvalue ^ 2) ElseIf RBF = 7 Then Cvalue = 1.4 Amatrix(m, i, j) = 1 / System.Math.Sqrt(Amatrix(m, i, j) ^ 2 + Cvalue ^ 2) Atransp(m, i, j) = 1 / System.Math.Sqrt(Atransp(m, i, j) ^ 2 + Cvalue ^ 2) ElseIf RBF = 8 Then Cvalue = 0.001 Amatrix(m, i, j) = System.Math.Exp(-Cvalue * Amatrix(m, i, j)) Atransp(m, i, j) = System.Math.Exp(-Cvalue * Atransp(m, i, j)) ElseIf RBF = 9 Then Cvalue = 0.1 Amatrix(m, i, j) = System.Math.Exp(-(Cvalue ^ 2 * Amatrix(m, i, j) ^ 2)) Atransp(m, i, j) = System.Math.Exp(-(Cvalue ^ 2 * Atransp(m, i, j) ^ 2)) End If Next j Next i End If Next m '---- Do the matrix multiplication AtranspA For m = 1 To NO_TRT 'treatment type If m = 2 Or m = 4 Or m = 5 Then For i = 1 To indx(m) '# of states For j = 1 To indx(m) '# of states For k = 1 To indx(m) TEMP = Atransp(m, i, k) * Amatrix(m, k, j) AtranspA(m, i, j) = AtranspA(m, i, j) + TEMP Next k Next j Next i End If Next m '---- Do the inverse of AtranspA --------- '---- Use Gauss-Jordan elimination For m = 1 To NO_TRT If m = 2 Or m = 4 Or m = 5 Then For i = 1 To indx(m) For j = 1 To indx(m) AtranspA(m, i, j + indx(m)) = 0 Next j Next i End If Next m For m = 1 To NO_TRT If m = 2 Or m = 4 Or m = 5 Then For i = 1 To indx(m) AtranspA(m, i, i + indx(m)) = 1 Next i End If Next m For m = 1 To NO_TRT If m = 2 Or m = 4 Or m = 5 Then For i = 1 To indx(m) If AtranspA(m, i, i) = 0 Then 'Have to find the largest element in the column and put it on the diagonal TEMP = -1000000 For nn = i To indx(m) If AtranspA(m, nn, i) > TEMP Then TEMP = AtranspA(m, nn, i) rownumb = nn End If Next nn If rownumb <> i Then For nn = 1 To 2 * indx(m) TEMP1 = AtranspA(m, i, nn) AtranspA(m, i, nn) = AtranspA(m, rownumb, nn) AtranspA(m, rownumb, nn) = TEMP1 Next nn End If End If 'end of putting largest element on the diagonal TEMP = AtranspA(m, i, i) For j = 1 To 2 * indx(m) AtranspA(m, i, j) = AtranspA(m, i, j) / TEMP Next j For k = 1 To indx(m) If k = i Then GoTo 101 End If TEMP = AtranspA(m, k, i) For N = i To 2 * indx(m) AtranspA(m, k, N) = AtranspA(m, k, N) - TEMP * AtranspA(m, i, N) Next N 101: Next k Next i End If Next m End If '---- Multiply inv(A'A) with A' --> result gives Cmatrix For m = 1 To NO_TRT 'treatment type If m = 2 Or m = 4 Or m = 5 Then For i = 1 To indx(m) '# of terms in regression equation For j = 1 To indx(m) For k = 1 To indx(m) TEMP = AtranspA(m, i, k + indx(m)) * Atransp(m, k, j) Cmatrix(m, i, j) = Cmatrix(m, i, j) + TEMP Next k Next j Next i End If Next m 'Set objWorksheet = objWorkbook.Worksheets.Add 'objWorksheet.Name = "Inverse2" 'Set objWorksheet = objWorkbook.Sheets("Inverse2") 'With objWorksheet 'For i = 1 To indx(2) ' For j = 1 To indx(2) ' .Cells(i, j) = Amatrix(2, i, j + indx(2)) ' Next j 'Next i 'End With 'Set objWorksheet = objWorkbook.Worksheets.Add 'objWorksheet.Name = "Inverse4" 'Set objWorksheet = objWorkbook.Sheets("Inverse4") 'With objWorksheet 'For i = 1 To indx(4) ' For j = 1 To indx(4) ' .Cells(i, j) = Amatrix(4, i, j + indx(4)) ' Next j 'Next i 'End With 'Set objWorksheet = objWorkbook.Worksheets.Add 'objWorksheet.Name = "Inverse5" 'Set objWorksheet = objWorkbook.Sheets("Inverse5") 'With objWorksheet 'For i = 1 To indx(5) ' For j = 1 To indx(5) ' .Cells(i, j) = Amatrix(5, i, j + indx(5)) ' Next j 'Next i 'End With End Sub Private Sub DWI_Weights() '******************************************************************************************** '* Weights for Distance Weighted Interpolation '* '* This routine calculates the weights associated with every state-decision combination '* '******************************************************************************************** For State = 5 To z For decision = 2 To 48 If State = 6 And decision = 9 Then zzzz = 1 End If NEWTRT = VOLUMES(State, decision, 6) NEWAGE = VOLUMES(State, decision, 1) If NEWTRT = 1 Or NEWTRT = 3 Or NEWTRT = 11 Or NEWAGE = 1000 Then GoTo 67 End If If NEWTRT = 1 Then NEWSTOCKING = VOLUMES(State, decision, 2) ElseIf NEWTRT = 2 Or NEWTRT = 5 Then NEWDIAM_S = VOLUMES(State, decision, 2) NEWDIAM_H = VOLUMES(State, decision, 3) NEWPCT_S = VOLUMES(State, decision, 4) NEWCC = VOLUMES(State, decision, 5) ElseIf NEWTRT = 3 Then NEWDIAM_S = VOLUMES(State, decision, 2) NEWDENSITY = VOLUMES(State, decision, 3) ElseIf NEWTRT = 4 Then NEWDIAM_S = VOLUMES(State, decision, 2) NEWCC = VOLUMES(State, decision, 3) End If 'Loop to calculate distances zz = indx(NEWTRT) For i = 1 To zz If NEWTRT = 2 Or NEWTRT = 5 Then NEWAGE2 = Xmatrix(NEWTRT, i, 1) NEWDIAM_S2 = Xmatrix(NEWTRT, i, 2) NEWDIAM_H2 = Xmatrix(NEWTRT, i, 3) NEWPCT_S2 = Xmatrix(NEWTRT, i, 4) NEWCC2 = Xmatrix(NEWTRT, i, 5) MAX1 = MAX_STATE_VALUE(NEWTRT, 1) MAX2 = MAX_STATE_VALUE(NEWTRT, 2) MAX3 = MAX_STATE_VALUE(NEWTRT, 3) MAX4 = MAX_STATE_VALUE(NEWTRT, 4) MAX5 = MAX_STATE_VALUE(NEWTRT, 5) Dist(i) = (NEWAGE2 - NEWAGE) / MAX1 * (NEWAGE2 - NEWAGE) / MAX1 + (NEWDIAM_S2 - NEWDIAM_S) / MAX2 * (NEWDIAM_S2 - NEWDIAM_S) / MAX2 + (NEWDIAM_H2 - NEWDIAM_H) / MAX3 * (NEWDIAM_H2 - NEWDIAM_H) / MAX3 + (NEWPCT_S2 - NEWPCT_S) / MAX4 * (NEWPCT_S2 - NEWPCT_S) / MAX4 + (NEWCC2 - NEWCC) / MAX5 * (NEWCC2 - NEWCC) / MAX5 ElseIf NEWTRT = 4 Then NEWAGE2 = Xmatrix(NEWTRT, i, 1) NEWDIAM_S2 = Xmatrix(NEWTRT, i, 2) NEWCC2 = Xmatrix(NEWTRT, i, 5) MAX1 = MAX_STATE_VALUE(NEWTRT, 1) MAX2 = MAX_STATE_VALUE(NEWTRT, 2) MAX3 = MAX_STATE_VALUE(NEWTRT, 3) Dist(i) = (NEWAGE2 - NEWAGE) / MAX1 * (NEWAGE2 - NEWAGE) / MAX1 + (NEWDIAM_S2 - NEWDIAM_S) / MAX2 * (NEWDIAM_S2 - NEWDIAM_S) / MAX2 + (NEWDIAM_H2 - NEWDIAM_H) / MAX3 * (NEWDIAM_H2 - NEWDIAM_H) / MAX3 End If Next i 'Rank all distances from smallest to largest for each TRT type For i = 1 To indx(NEWTRT) k = 1 For j = 1 To indx(NEWTRT) If i <> j And Dist(i) > Dist(j) Then k = k + 1 End If Next Dist_rank(k) = i Next ' Find the largest distance for each state MAXDIST = 0 For i = 1 To num_weight zzz = Dist_rank(i) zzzz = Dist(zzz) If zzzz > MAXDIST Then MAXDIST = zzzz End If Next 'Loop to calculate "Sum of distances factor" SumofDist = 0 For i = 1 To num_weight zzz = Dist_rank(i) zzzz = Dist(zzz) SumofDist = SumofDist + (MAXDIST - zzzz) / (MAXDIST * zzzz) * (MAXDIST - zzzz) / (MAXDIST * zzzz) Next i 'Loop to calculate weights For i = 1 To num_weight zzz = Dist_rank(i) zzzz = Dist(zzz) zzzzz = i + 11 zzzzzz = i + 11 + num_weight VOLUMES(State, decision, zzzzz) = (MAXDIST - zzzz) / (MAXDIST * zzzz) * (MAXDIST - zzzz) / (MAXDIST * zzzz) / SumofDist VOLUMES(State, decision, zzzzzz) = Dist_rank(i) Next i 67: Next decision Next State End Sub Private Sub Natural_Disasters() '******************************************************************************************** '* Natural disasters '* '* Cycle through all states and calculate the P for succumbing to Fire-L, Fire-M, '* Fire-H, Hurricane-L, Hurricane-M, Hurricane-H, Insects with all these probabilities, '* calculate probabilities of going to state 10, 11, 12 and not succumbing at all '* '******************************************************************************************** For State = 1 To z AGE = States(State, 1) TRT = States(State, 6) If TRT = 2 Or TRT = 5 Then DIAM_S = States(State, 2) DIAM_H = States(State, 3) Avg_diam = (DIAM_S + DIAM_H) / 2 ElseIf TRT = 3 Or TRT = 4 Then DIAM_S = States(State, 2) End If Call Fire_L(AGE, DIAM_S, Avg_diam, TRT, prFL) Call Fire_M(AGE, DIAM_S, Avg_diam, TRT, prFM) Call Fire_H(AGE, DIAM_S, Avg_diam, TRT, prFH) Call Hurricane_L(AGE, prHL) Call Hurricane_M(AGE, prHM) Call Hurricane_H(AGE, prHH) Call Insects(AGE, DIAM_S, Avg_diam, TRT, prIns) prSF = prFL * prLowF * Probfireburns + prFM * prMedF * Probfireburns + prFH * prHighF * Probfireburns prSH = prHL * prLowH * Probhurraffects + prHM * prMedH * Probhurraffects + prHH * prHighH * Probhurraffects pr10 = prHighF * prSF + prLowH * prSH + ProbInsects * prIns pr11 = prMedF * prSF + prMedH * prSH pr12 = prLowF * prSF + prHighH * prSH prNS = 1 - pr10 - pr11 - pr12 Probs(State, 1) = pr10 Probs(State, 2) = pr11 Probs(State, 3) = pr12 Probs(State, 4) = prNS Next State End Sub Private Sub GNY() '************************************************************************ '* * '* GROWTH AND YIELD SUBROUTINE * '* * '* This subroutine will do the growth, PCT, CT and clear cut * '* and calculate volumes obtained from these harvests. It will * '* also calculate the diameter and height growth over 5 year * '* periods. * '* * '************************************************************************ P = 0 count_dec = 1 '**** Section to calculate the current volumes for every state **** For State = 5 To z 'precomputed states that work for each treatment type For i = 1 To 10 GNY_CTG(i) = 0 Next i TRT = States(State, 6) For decision = 2 To 48 'Decisions available (see below for definitions) If decis(TRT, decision) = 0 Then 'this decision is not valid for this treatment GoTo 1000 End If 'VARIABLES THAT MUST BE SET TO ZERO NEWDIAM_S = 0 NEWBA_S = 0 NEWTRT = 0 TFREQ_S = 0 MERBA_S = 0 MERDIAM_S = 0 MERFREQ_S = 0 MERVOL_S = 0 BRDBA_S = 0 BRDDIAM_S = 0 BRDFREQ_S = 0 BRDVOL_S = 0 NEWDIAM_H = 0 NEWBA_H = 0 TFREQ_H = 0 MERBA_H = 0 MERDIAM_H = 0 MERFREQ_H = 0 MERVOL_H = 0 BRDBA_H = 0 BRDDIAM_H = 0 BRDFREQ_H = 0 BRDVOL_H = 0 '***************************************************************************** '* '* Each treatment is calculated separately '* '***************************************************************************** If State = 43 Then zzzzz = 1 End If count_dec = count_dec + 1 If TRT = 1 Then Treat1() ElseIf TRT = 2 Then Treat2() ElseIf TRT = 3 Then Treat3() ElseIf TRT = 4 Then Treat4() ElseIf TRT = 5 Then Treat5() End If For i = 1 To pricebreaks 'Gives each states a non-zero current value before starting the DP iterations If (MERVOL_S * Prices(1, i, 1) + MERVOL_H * Prices(2, i, 1) + BRDVOL_S * Prices(1, i, 2) + BRDVOL_H * Prices(2, i, 2) - COST) > GNY_CTG(i) Then CostToGo(i, State, 1) = (MERVOL_S * Prices(1, i, 1) + MERVOL_H * Prices(2, i, 1) + BRDVOL_S * Prices(1, i, 2) + BRDVOL_H * Prices(2, i, 2) - COST) GNY_CTG(i) = CostToGo(i, State, 1) CostToGo(i, State, no_states + 2) = decision 'best decision End If Next i 1000: Next decision 1100: Next State End Sub Private Sub NEWSTAND() '************************************************************************************ '* '* Subroutine for the Regeneration of a natural stand with 0,0,0 state '* '************************************************************************************ If NEWTRT = 10 Then FUTURENET = 0.3 * CTG(futpricebrk, 1, 1, 2) + 0.7 * CTG(futpricebrk, 11, 0, 0) ElseIf NEWTRT = 11 Then FUTURENET = 0.5 * CTG(futpricebrk, 1, 1, 2) + 0.5 * CTG(futpricebrk, 12, 0, 0) ElseIf decision = 1 Then If TRT = 10 Then FUTURENET = 0.3 * CTG(futpricebrk, 1, 1, 2) + 0.7 * CTG(futpricebrk, 11, 0, 0) ElseIf TRT = 11 Then FUTURENET = 0.5 * CTG(futpricebrk, 1, 1, 2) + 0.5 * CTG(futpricebrk, 12, 0, 0) ElseIf TRT = 12 Then FUTURENET = 0.7 * CTG(futpricebrk, 1, 1, 2) + 0.3 * CTG(futpricebrk, 13, 0, 0) ElseIf TRT = 13 Then FUTURENET = CTG(futpricebrk, 1, 1, 2) End If ElseIf decision = 4 Then FUTURENET = CTG(futpricebrk, 1, 1, 3) Else If decision = 5 Then NEWDENSITY = 1000 ElseIf decision = 6 Then NEWDENSITY = 1750 ElseIf decision = 7 Then NEWDENSITY = 2500 ElseIf decision = 8 Then NEWDENSITY = 3250 ElseIf decision = 9 Then NEWDENSITY = 4000 End If 'calculate CostToGo for 5 year old plantation NEWTRT = 3 FUTURENET = CTG(futpricebrk, 3, 1, (NEWDENSITY - 250) / 750) End If End Sub Private Sub FUTUREVALUE() '**************************************************************************************************** '* '* Subroutine for calculating the future value of a stand using the multiple regression '* approximation '* '**************************************************************************************************** If RBF = 0 Then 'Multiple Regression ' Calculate the regression approximation with the new point If NEWTRT = 2 Or NEWTRT = 5 Then B0 = Bmatrix(futpricebrk, NEWTRT, 1) B1 = Bmatrix(futpricebrk, NEWTRT, 2) B2 = Bmatrix(futpricebrk, NEWTRT, 3) B3 = Bmatrix(futpricebrk, NEWTRT, 4) B4 = Bmatrix(futpricebrk, NEWTRT, 5) B5 = Bmatrix(futpricebrk, NEWTRT, 6) B6 = Bmatrix(futpricebrk, NEWTRT, 7) B7 = Bmatrix(futpricebrk, NEWTRT, 8) B8 = Bmatrix(futpricebrk, NEWTRT, 9) B9 = Bmatrix(futpricebrk, NEWTRT, 10) B10 = Bmatrix(futpricebrk, NEWTRT, 11) B11 = Bmatrix(futpricebrk, NEWTRT, 12) B12 = Bmatrix(futpricebrk, NEWTRT, 13) B13 = Bmatrix(futpricebrk, NEWTRT, 14) B14 = Bmatrix(futpricebrk, NEWTRT, 15) B15 = Bmatrix(futpricebrk, NEWTRT, 16) B16 = Bmatrix(futpricebrk, NEWTRT, 17) B17 = Bmatrix(futpricebrk, NEWTRT, 18) B18 = Bmatrix(futpricebrk, NEWTRT, 19) B19 = Bmatrix(futpricebrk, NEWTRT, 20) B20 = Bmatrix(futpricebrk, NEWTRT, 21) FUTURENET = B0 + B1 * NEWAGE + B2 * NEWDIAM_S + B3 * NEWDIAM_H + B4 * NEWPCT_S + B5 * NEWCC + B6 * NEWAGE ^ 2 + B7 * NEWDIAM_S ^ 2 + B8 * NEWDIAM_H ^ 2 + B9 * NEWPCT_S ^ 2 + B10 * NEWCC ^ 2 + B11 * NEWAGE * NEWDIAM_S + B12 * NEWAGE * NEWDIAM_H + B13 * NEWAGE * NEWPCT_S + B14 * NEWAGE * NEWCC + B15 * NEWDIAM_S * NEWDIAM_H + B16 * NEWDIAM_S * NEWPCT_S + B17 * NEWDIAM_S * NEWCC + B18 * NEWDIAM_H * NEWPCT_S + B19 * NEWDIAM_H * NEWCC + B20 * NEWCC * NEWPCT_S ElseIf NEWTRT = 4 Then B0 = Bmatrix(futpricebrk, NEWTRT, 1) B1 = Bmatrix(futpricebrk, NEWTRT, 2) B2 = Bmatrix(futpricebrk, NEWTRT, 3) B3 = Bmatrix(futpricebrk, NEWTRT, 4) B4 = Bmatrix(futpricebrk, NEWTRT, 5) B5 = Bmatrix(futpricebrk, NEWTRT, 6) B6 = Bmatrix(futpricebrk, NEWTRT, 7) B7 = Bmatrix(futpricebrk, NEWTRT, 8) B8 = Bmatrix(futpricebrk, NEWTRT, 9) B9 = Bmatrix(futpricebrk, NEWTRT, 10) FUTURENET = B0 + B1 * NEWAGE + B2 * NEWDIAM_S + B3 * NEWCC + B4 * NEWAGE ^ 2 + B5 * NEWDIAM_S ^ 2 + B6 * NEWCC ^ 2 + B7 * NEWAGE * NEWDIAM_S + B8 * NEWAGE * NEWCC + B9 * NEWDIAM_S * NEWCC End If CTG_limits() ElseIf RBF = 10 Then 'Distance Weighted Interpolation 'Loop to calculate FUTURENET FUTURENET = 0 For i = 1 To num_weight zzzz = VOLUMES(State, decision, i + 11) zzz = i + 11 + num_weight pointer = VOLUMES(State, decision, zzz) xxxx = Ymatrix(futpricebrk, NEWTRT, pointer) FUTURENET = FUTURENET + zzzz * xxxx 'If State = 17 Or State = 18 Or State = 19 Or State = 20 Then 'objWorksheet.Range("A50").Offset(count_limit, 7)._Default = State 'objWorksheet.Range("A50").Offset(count_limit, 8)._Default = decision 'objWorksheet.Range("A50").Offset(count_limit, 9)._Default = zzzz 'objWorksheet.Range("A50").Offset(count_limit, 10)._Default = pointer 'objWorksheet.Range("A50").Offset(count_limit, 11)._Default = Ymatrix(futpricebrk, NEWTRT, pointer) 'count_limit = count_limit + 1 'End If Next i Else 'Radial Basis Functions ' Calculate function approximations FUTURENET = 0 For i = 1 To indx(NEWTRT) FUTURENET = FUTURENET + Tmatrix(State, decision, i) * Weights(futpricebrk, NEWTRT, i) Next i CTG_limits() End If 'objWorksheet = objWorkbook.Sheets("Basic") 'objWorksheet.Range("ag1").Offset(State, 7 + decision)._Default = FUTURENET End Sub Private Sub NatDisast() '****************************************************************** '* * '* Natural disasters * '* * '* Calculate the future value of natural disasters occuring. * '* * '****************************************************************** futurenet_10 = (0.7 * CTG(futpricebrk, 1, 1, 2) + 0.3 * CTG(futpricebrk, 11, 0, 0)) * Probs(State, 1) futurenet_11 = (0.85 * CTG(futpricebrk, 1, 1, 2) + 0.15 * CTG(futpricebrk, 12, 0, 0)) * Probs(State, 2) futurenet_12 = CTG(futpricebrk, 1, 1, 2) * Probs(State, 3) If futurenet_10 < 0 Then futurenet_10 = 0 End If If futurenet_11 < 0 Then futurenet_11 = 0 End If If futurenet_12 < 0 Then futurenet_12 = 0 End If End Sub Private Sub CumNormDist() B1 = 0.31938153 B2 = -0.356563782 B3 = 1.781477937 B4 = -1.821255978 B5 = 1.330274429 P = 0.2316419 c = 0.39894228 If x >= 0 Then t = 1.0# / (1.0# + P * x) NormProb = (1.0# - c * System.Math.Exp(-x * x / 2.0#) * t * (t * (t * (t * (t * B5 + B4) + B3) + B2) + B1)) Else t = 1.0# / (1.0# - P * x) NormProb = (c * System.Math.Exp(-x * x / 2.0#) * t * (t * (t * (t * (t * B5 + B4) + B3) + B2) + B1)) End If End Sub Private Sub CTG_bounds() '****************************************************************** '* * '* This will calculate which state to use to bound the CTG * '* approximation. It also calculates the distance to those * '* points along with the weights to use. * '* * '****************************************************************** For state1 = 1 To z If state1 = 12 Then zzzzz = 1 End If For decision = 1 To 48 If decision = 12 Then zzzzz = 1 End If NEWTRT = VOLUMES(state1, decision, 6) If NEWTRT = 4 Then zzzz = 1 End If If NEWTRT = 2 Or NEWTRT = 5 Then NEWAGE = VOLUMES(state1, decision, 1) If NEWAGE < 1000 Then NEWDIAM_S = VOLUMES(state1, decision, 2) NEWDIAM_H = VOLUMES(state1, decision, 3) NEWPCT_S = VOLUMES(state1, decision, 4) NEWCC = VOLUMES(state1, decision, 5) For i = 1 To 32 status_min_distance(i, 1) = 1000000 status_min_distance(i, 2) = 0 Next zz = indx_sum(NEWTRT) zzz = indx_sum(NEWTRT + 1) For state2 = zz To zzz - 1 NEWAGE2 = States(state2, 1) NEWDIAM_S2 = States(state2, 2) NEWDIAM_H2 = States(state2, 3) NEWPCT_S2 = States(state2, 4) NEWCC2 = States(state2, 5) If state2 = 138 Then zzzzz = 1 End If status = 0 If NEWAGE < NEWAGE2 Then status = 17 Else status = 1 End If If NEWDIAM_S < NEWDIAM_S2 Then status = status + 8 Else status = status End If If NEWDIAM_H < NEWDIAM_H2 Then status = status + 4 Else status = status End If If NEWPCT_S < NEWPCT_S2 Then status = status + 2 Else status = status End If If NEWCC < NEWCC2 Then status = status + 1 Else status = status End If If status > 0 Then MAX1 = MAX_STATE_VALUE(NEWTRT, 1) MAX2 = MAX_STATE_VALUE(NEWTRT, 2) MAX3 = MAX_STATE_VALUE(NEWTRT, 3) MAX4 = MAX_STATE_VALUE(NEWTRT, 4) MAX5 = MAX_STATE_VALUE(NEWTRT, 5) distance = (NEWAGE2 - NEWAGE) / MAX1 * (NEWAGE2 - NEWAGE) / MAX1 + (NEWDIAM_S2 - NEWDIAM_S) / MAX2 * (NEWDIAM_S2 - NEWDIAM_S) / MAX2 + (NEWDIAM_H2 - NEWDIAM_H) / MAX3 * (NEWDIAM_H2 - NEWDIAM_H) / MAX3 + (NEWPCT_S2 - NEWPCT_S) / MAX4 * (NEWPCT_S2 - NEWPCT_S) / MAX4 + (NEWCC2 - NEWCC) / MAX5 * (NEWCC2 - NEWCC) / MAX5 If distance < status_min_distance(status, 1) Then status_min_distance(status, 1) = distance status_min_distance(status, 2) = state2 End If End If Next For i = 1 To 32 VOLUMES(state1, decision, i + 11) = status_min_distance(i, 2) Next End If ElseIf NEWTRT = 4 Then NEWAGE = VOLUMES(state1, decision, 1) If NEWAGE < 1000 Then NEWDIAM_S = VOLUMES(state1, decision, 2) NEWCC = VOLUMES(state1, decision, 3) For i = 1 To 8 status_min_distance(i, 1) = 1000000 status_min_distance(i, 2) = 0 Next zz = indx_sum(NEWTRT) zzz = indx_sum(NEWTRT + 1) For state2 = zz To zzz - 1 NEWAGE2 = States(state2, 1) NEWDIAM_S2 = States(state2, 2) NEWCC2 = States(state2, 3) If state2 = 138 Then zzzzz = 1 End If status = 0 If NEWAGE < NEWAGE2 Then status = 5 Else status = 1 End If If NEWDIAM_S < NEWDIAM_S2 Then status = status + 2 Else status = status End If If NEWCC < NEWCC2 Then status = status + 1 Else status = status End If If status > 0 Then MAX1 = MAX_STATE_VALUE(NEWTRT, 1) MAX2 = MAX_STATE_VALUE(NEWTRT, 2) MAX3 = MAX_STATE_VALUE(NEWTRT, 3) distance = (NEWAGE2 - NEWAGE) / MAX1 * (NEWAGE2 - NEWAGE) / MAX1 + (NEWDIAM_S2 - NEWDIAM_S) / MAX2 * (NEWDIAM_S2 - NEWDIAM_S) / MAX2 + (NEWCC2 - NEWCC) / MAX3 * (NEWCC2 - NEWCC) / MAX3 If distance < status_min_distance(status, 1) Then status_min_distance(status, 1) = distance status_min_distance(status, 2) = state2 End If End If Next For i = 1 To 8 VOLUMES(state1, decision, i + 11) = status_min_distance(i, 2) Next End If End If Next Next End Sub Private Sub CTG_limits() min_value = 1000000 max_value = 0 If NEWTRT = 2 Or NEWTRT = 5 Then zz = 32 Else zz = 8 End If For i = 1 To zz zzzz = i + 11 zzz = VOLUMES(State, decision, zzzz) If zzz > 0 Then pointer = zzz - indx_sum(NEWTRT) + 1 CTG_value = Ymatrix(futpricebrk, NEWTRT, pointer) If CTG_value < min_value Then min_value = CTG_value End If If CTG_value > max_value Then max_value = CTG_value End If End If Next If FUTURENET > max_value Then 'If itercount = 4 Then 'count_limit = count_limit + 1 'objWorksheet = objWorkbook.Worksheets("Basic") 'objWorksheet.Range("A50").Offset(count_limit, 0)._Default = State 'objWorksheet.Range("A50").Offset(count_limit, 1)._Default = decision 'objWorksheet.Range("A50").Offset(count_limit, 2)._Default = FUTURENET 'objWorksheet.Range("A50").Offset(count_limit, 3)._Default = min_value 'objWorksheet.Range("A50").Offset(count_limit, 4)._Default = max_value 'End If FUTURENET = max_value ElseIf FUTURENET < min_value Then 'If itercount = 4 Then 'count_limit = count_limit + 1 'objWorksheet = objWorkbook.Worksheets("Basic") 'objWorksheet.Range("A50").Offset(count_limit, 0)._Default = State 'objWorksheet.Range("A50").Offset(count_limit, 1)._Default = decision 'objWorksheet.Range("A50").Offset(count_limit, 2)._Default = FUTURENET 'objWorksheet.Range("A50").Offset(count_limit, 3)._Default = min_value 'objWorksheet.Range("A50").Offset(count_limit, 4)._Default = max_value 'End If FUTURENET = min_value End If End Sub Private Sub CreateTmatrix() If NEWTRT = 2 Or NEWTRT = 5 Then For i = 1 To indx(NEWTRT) If RBF = 1 Then TEMP = ((Xmatrix(NEWTRT, i, 1) - NEWAGE) / MAX_STATE_VALUE(NEWTRT, 1)) ^ 2 + ((Xmatrix(NEWTRT, i, 2) - NEWDIAM_S) / MAX_STATE_VALUE(NEWTRT, 2)) ^ 2 + ((Xmatrix(NEWTRT, i, 3) - NEWDIAM_H) / MAX_STATE_VALUE(NEWTRT, 3)) ^ 2 + ((Xmatrix(NEWTRT, i, 4) - NEWPCT_S) / MAX_STATE_VALUE(NEWTRT, 4)) ^ 2 + ((Xmatrix(NEWTRT, i, 5) - NEWCC) / MAX_STATE_VALUE(NEWTRT, 5)) ^ 2 If TEMP = 0 Then Tmatrix(State, decision, i) = 0 Else Tmatrix(State, decision, i) = 2 * TEMP * System.Math.Log(TEMP) End If ElseIf RBF = 2 Then Tmatrix(State, decision, i) = ((Xmatrix(NEWTRT, i, 1) - NEWAGE) / MAX_STATE_VALUE(NEWTRT, 1)) ^ 2 + ((Xmatrix(NEWTRT, i, 2) - NEWDIAM_S) / MAX_STATE_VALUE(NEWTRT, 2)) ^ 2 + ((Xmatrix(NEWTRT, i, 3) - NEWDIAM_H) / MAX_STATE_VALUE(NEWTRT, 3)) ^ 2 + ((Xmatrix(NEWTRT, i, 4) - NEWPCT_S) / MAX_STATE_VALUE(NEWTRT, 4)) ^ 2 + ((Xmatrix(NEWTRT, i, 5) - NEWCC) / MAX_STATE_VALUE(NEWTRT, 5)) ^ 2 ElseIf RBF = 3 Then Tmatrix(State, decision, i) = ((Xmatrix(NEWTRT, i, 1) - NEWAGE) / MAX_STATE_VALUE(NEWTRT, 1)) ^ 2 + ((Xmatrix(NEWTRT, i, 2) - NEWDIAM_S) / MAX_STATE_VALUE(NEWTRT, 2)) ^ 2 + ((Xmatrix(NEWTRT, i, 3) - NEWDIAM_H) / MAX_STATE_VALUE(NEWTRT, 3)) ^ 2 + ((Xmatrix(NEWTRT, i, 4) - NEWPCT_S) / MAX_STATE_VALUE(NEWTRT, 4)) ^ 2 + ((Xmatrix(NEWTRT, i, 5) - NEWCC) / MAX_STATE_VALUE(NEWTRT, 5)) ^ 2 + Cvalue ^ 2 ElseIf RBF = 4 Then Tmatrix(State, decision, i) = 1 / (((Xmatrix(NEWTRT, i, 1) - NEWAGE) / MAX_STATE_VALUE(NEWTRT, 1)) ^ 2 + ((Xmatrix(NEWTRT, i, 2) - NEWDIAM_S) / MAX_STATE_VALUE(NEWTRT, 2)) ^ 2 + ((Xmatrix(NEWTRT, i, 3) - NEWDIAM_H) / MAX_STATE_VALUE(NEWTRT, 3)) ^ 2 + ((Xmatrix(NEWTRT, i, 4) - NEWPCT_S) / MAX_STATE_VALUE(NEWTRT, 4)) ^ 2 + ((Xmatrix(NEWTRT, i, 5) - NEWCC) / MAX_STATE_VALUE(NEWTRT, 5)) ^ 2 + Cval(NEWTRT) ^ 2) ElseIf RBF = 5 Or RBF = 6 Or RBF = 7 Then Tmatrix(State, decision, i) = 1 / (((Xmatrix(NEWTRT, i, 1) - NEWAGE) / MAX_STATE_VALUE(NEWTRT, 1)) ^ 2 + ((Xmatrix(NEWTRT, i, 2) - NEWDIAM_S) / MAX_STATE_VALUE(NEWTRT, 2)) ^ 2 + ((Xmatrix(NEWTRT, i, 3) - NEWDIAM_H) / MAX_STATE_VALUE(NEWTRT, 3)) ^ 2 + ((Xmatrix(NEWTRT, i, 4) - NEWPCT_S) / MAX_STATE_VALUE(NEWTRT, 4)) ^ 2 + ((Xmatrix(NEWTRT, i, 5) - NEWCC) / MAX_STATE_VALUE(NEWTRT, 5)) ^ 2 + Cvalue ^ 2) ElseIf RBF = 8 Then TEMP = ((Xmatrix(NEWTRT, i, 1) - NEWAGE) / MAX_STATE_VALUE(NEWTRT, 1)) ^ 2 + ((Xmatrix(NEWTRT, i, 2) - NEWDIAM_S) / MAX_STATE_VALUE(NEWTRT, 2)) ^ 2 + ((Xmatrix(NEWTRT, i, 3) - NEWDIAM_H) / MAX_STATE_VALUE(NEWTRT, 3)) ^ 2 + ((Xmatrix(NEWTRT, i, 4) - NEWPCT_S) / MAX_STATE_VALUE(NEWTRT, 4)) ^ 2 + ((Xmatrix(NEWTRT, i, 5) - NEWCC) / MAX_STATE_VALUE(NEWTRT, 5)) ^ 2 Tmatrix(State, decision, i) = System.Math.Exp(-Cvalue * TEMP) ElseIf RBF = 9 Then TEMP = ((Xmatrix(NEWTRT, i, 1) - NEWAGE) / MAX_STATE_VALUE(NEWTRT, 1)) ^ 2 + ((Xmatrix(NEWTRT, i, 2) - NEWDIAM_S) / MAX_STATE_VALUE(NEWTRT, 2)) ^ 2 + ((Xmatrix(NEWTRT, i, 3) - NEWDIAM_H) / MAX_STATE_VALUE(NEWTRT, 3)) ^ 2 + ((Xmatrix(NEWTRT, i, 4) - NEWPCT_S) / MAX_STATE_VALUE(NEWTRT, 4)) ^ 2 + ((Xmatrix(NEWTRT, i, 5) - NEWCC) / MAX_STATE_VALUE(NEWTRT, 5)) ^ 2 Tmatrix(State, decision, i) = System.Math.Exp(-(Cvalue ^ 2 * TEMP ^ 2)) End If Next i ElseIf NEWTRT = 4 Then For i = 1 To indx(NEWTRT) If RBF = 1 Then TEMP = ((Xmatrix(NEWTRT, i, 1) - NEWAGE) / MAX_STATE_VALUE(NEWTRT, 1)) ^ 2 + ((Xmatrix(NEWTRT, i, 2) - NEWDIAM_S) / MAX_STATE_VALUE(NEWTRT, 2)) ^ 2 + ((Xmatrix(NEWTRT, i, 3) - NEWCC) / MAX_STATE_VALUE(NEWTRT, 3)) ^ 2 If TEMP = 0 Then Tmatrix(State, decision, i) = 0 Else Tmatrix(State, decision, i) = 2 * TEMP * System.Math.Log(TEMP) End If ElseIf RBF = 2 Then Tmatrix(State, decision, i) = ((Xmatrix(NEWTRT, i, 1) - NEWAGE) / MAX_STATE_VALUE(NEWTRT, 1)) ^ 2 + ((Xmatrix(NEWTRT, i, 2) - NEWDIAM_S) / MAX_STATE_VALUE(NEWTRT, 2)) ^ 2 + ((Xmatrix(NEWTRT, i, 3) - NEWCC) / MAX_STATE_VALUE(NEWTRT, 3)) ^ 2 ElseIf RBF = 3 Then Tmatrix(State, decision, i) = ((Xmatrix(NEWTRT, i, 1) - NEWAGE) / MAX_STATE_VALUE(NEWTRT, 1)) ^ 2 + ((Xmatrix(NEWTRT, i, 2) - NEWDIAM_S) / MAX_STATE_VALUE(NEWTRT, 2)) ^ 2 + ((Xmatrix(NEWTRT, i, 3) - NEWCC) / MAX_STATE_VALUE(NEWTRT, 3)) ^ 2 + Cvalue ^ 2 ElseIf RBF = 4 Then Tmatrix(State, decision, i) = 1 / (((Xmatrix(NEWTRT, i, 1) - NEWAGE) / MAX_STATE_VALUE(NEWTRT, 1)) ^ 2 + ((Xmatrix(NEWTRT, i, 2) - NEWDIAM_S) / MAX_STATE_VALUE(NEWTRT, 2)) ^ 2 + ((Xmatrix(NEWTRT, i, 3) - NEWCC) / MAX_STATE_VALUE(NEWTRT, 3)) ^ 2 + Cval(NEWTRT) ^ 2) ElseIf RBF = 5 Or RBF = 6 Or RBF = 7 Then Tmatrix(State, decision, i) = 1 / (((Xmatrix(NEWTRT, i, 1) - NEWAGE) / MAX_STATE_VALUE(NEWTRT, 1)) ^ 2 + ((Xmatrix(NEWTRT, i, 2) - NEWDIAM_S) / MAX_STATE_VALUE(NEWTRT, 2)) ^ 2 + ((Xmatrix(NEWTRT, i, 3) - NEWCC) / MAX_STATE_VALUE(NEWTRT, 3)) ^ 2 + Cvalue ^ 2) ElseIf RBF = 8 Then TEMP = ((Xmatrix(NEWTRT, i, 1) - NEWAGE) / MAX_STATE_VALUE(NEWTRT, 1)) ^ 2 + ((Xmatrix(NEWTRT, i, 2) - NEWDIAM_S) / MAX_STATE_VALUE(NEWTRT, 2)) ^ 2 + ((Xmatrix(NEWTRT, i, 3) - NEWCC) / MAX_STATE_VALUE(NEWTRT, 3)) ^ 2 Tmatrix(State, decision, i) = System.Math.Exp(-Cvalue * TEMP) ElseIf RBF = 9 Then TEMP = ((Xmatrix(NEWTRT, i, 1) - NEWAGE) / MAX_STATE_VALUE(NEWTRT, 1)) ^ 2 + ((Xmatrix(NEWTRT, i, 2) - NEWDIAM_S) / MAX_STATE_VALUE(NEWTRT, 2)) ^ 2 + ((Xmatrix(NEWTRT, i, 3) - NEWCC) / MAX_STATE_VALUE(NEWTRT, 3)) ^ 2 Tmatrix(State, decision, i) = System.Math.Exp(-(Cvalue ^ 2 * TEMP ^ 2)) End If Next i End If End Sub End Class