'===================================================================================== ' Program to read Mineral Potential raw estimation values and ' generate input batch file for the MARK3B simulator. All estimates ' for a tract and deposit type will be merged into one estimate by ' applying the weighting factors supplied by the estimators. ' The input to the program must be a correctly formatted comma delimited file. ' The input must be sorted by tract and deposit type. '===================================================================================== ' '==================== ' Get user input. '==================== INPUT "Enter the number of estimators in this run:"; estno INPUT "Enter filename of input data:"; f$ INPUT "Enter filename of the output command file:"; f1$ INPUT "Enter filename of the summary file:"; f2$ '=================== ' Open files. '=================== OPEN f$ FOR INPUT AS #1 OPEN f1$ FOR OUTPUT AS #2 OPEN f2$ FOR APPEND AS #3 '============================== ' Declare Variables. '============================== DIM inner$(5, 19), valu(5, 10), con(5, 10) per(1) = 90: per(2) = 50: per(3) = 10: per(4) = 5: per(5) = 1 '=========================================== ' Read records for tract-deposit grouping. '=========================================== 10 REM FOR l = 1 TO estno IF EOF(1) THEN 200 FOR j = 1 TO 19 INPUT #1, inner$(l, j) NEXT j INPUT #1, ester(l) FOR k = 1 TO ester(l) INPUT #1, valu(l, k), con(l, k) NEXT k NEXT l '========================= ' Add up weights. '========================= FOR l = 1 TO estno summer(l) = 50 FOR j = 1 TO estno IF inner$(j, 11) = inner$(l, 6) THEN summer(l) = summer(l) + VAL(inner$(j, 10)) IF inner$(j, 13) = inner$(l, 6) THEN summer(l) = summer(l) + VAL(inner$(j, 12)) IF inner$(j, 15) = inner$(l, 6) THEN summer(l) = summer(l) + VAL(inner$(j, 14)) IF inner$(j, 17) = inner$(l, 6) THEN summer(l) = summer(l) + VAL(inner$(j, 16)) NEXT j NEXT l '========================= ' Calculate weights. '========================= FOR l = 1 TO estno summer(l) = summer(l) / (estno * 150) NEXT l '================================================================== ' Test that weights add to the correct number if not error message. '================================================================== wtsum = 0 FOR l = 1 TO estno wtsum = wtsum + summer(l) NEXT l IF wtsum < .95 OR wtsum > 1.05 THEN PRINT oldtract$, inner$(1, 5), "weights wrong": GOTO 300 '======================= ' calculate zero value. '======================= zero = 0 FOR l = 1 TO estno zero = zero + summer(l) * con(l, 1) NEXT l zero = 1 - zero / 100 '================================================= ' Calculate all then % values for each estimate. '================================================= FOR l = 1 TO estno: FOR j = 1 TO 5: mark(l, j) = 0: NEXT j: NEXT l FOR l = 1 TO 5: marker(l) = 0: NEXT l FOR l = 1 TO estno FOR j = 1 TO 5 IF per(j) >= con(l, 1) THEN mark(l, j) = 0: GOTO 50 IF per(j) <= con(l, ester(l)) THEN mark(l, j) = valu(l, ester(l)): GOTO 50 FOR k = 2 TO ester(l) IF per(j) < con(l, k) THEN 45 mark(l, j) = valu(l, k) - (valu(l, k) - valu(l, k - 1)) * (per(j) - con(l, k)) / (con(l, k - 1) - con(l, k)): GOTO 50 45 NEXT k 50 NEXT j FOR j = 1 TO 5 mark(l, j) = mark(l, j) * summer(l) NEXT j NEXT l FOR l = 1 TO estno FOR j = 1 TO 5 marker(j) = marker(j) + mark(l, j) NEXT j NEXT l '================================================================== ' Test if minimum entry point will round to less than 1 deposit. '================================================================== IF marker(5) < .5 THEN 124 '================================== ' If new tract do right things. '================================== IF inner$(1, 3) = oldtract$ THEN 31 '================================== ' Write new tract info to batch '================================== PRINT #2, "1" PRINT #2, inner$(1, 3) PRINT #2, "4999" PRINT #2, "Yukon Mineral Potential" PRINT #2, "2004" oldtract$ = inner$(1, 3) '======================================================= ' Print values for this model and tract to batch file. '======================================================= 31 PRINT #2, "3" PRINT #2, inner$(1, 4) PRINT #2, "5" PRINT #2, marker(1); ","; marker(2); ","; marker(3); ","; marker(4); ","; marker(5) PRINT #2, zero IF randy = 1 THEN 123 PRINT #2, "123456": randy = 1 123 PRINT #2, "5" 124 PRINT #3, oldtract$; ","; inner$(1, 5); ","; marker(1); ","; marker(2); ","; marker(3); ","; marker(4); ","; marker(5) GOTO 10 200 PRINT #2, "9" 300 CLOSE END SUB reader END SUB