DECLARE FUNCTION RAND! (IX&)
DECLARE SUB OUTLINE (LEFT%, RIGHT%, TOP%, BOTTOM%)
DECLARE SUB StartUpAnArea ()
DECLARE SUB ContinueAnArea ()
DECLARE SUB RunAModel ()
DECLARE SUB PrintModelResults ()
DECLARE SUB AddModelResults ()
DECLARE SUB PrintAreaTotals ()
DECLARE SUB PrintListOfModels ()
DECLARE SUB DOSSHELL ()
DECLARE SUB DISTRIB (NX%)
DECLARE SUB NORVALE (PROB!, VALV!)
DECLARE SUB NORPROBE (PROB!, VALV!)
DECLARE SUB EMPVAL (PROB!, CC!(), PVAL!(), VALV!)
DECLARE SUB RSORT (RITEM!(), N%)
'MARK3 - A MINERAL SIMULATION PROGRAM
'
DEFINT I-N
OPTION BASE 1
CONST MaxModelNumber = 99

COMMON SHARED XNORE(), ND(), D(), CMETAL(), SPROB(), ISUITE(), JSUITE(), FEMP(), AEMP(), CMETAL$(), IORDER(), JORDER(), NSUITE, NUMCOM, PVAL(), XZ(), SMETAL(), AA(), Z(), METN(), VECT(), KONT(), KONTT(), KONT1(), RSU(), GSU(), SU(), XX(), XXT(),  _
XX1(), DISTP(), ECODE%, INOD, PROBZ, NOR, IDIST, TOTVAR$, SCRVAR$, RECLEN%, NBT&, NI, ITR, BASNAME$, REQNAME$, AREANM$, REQDATE$, EMPFILE$, NUMOFMTL, MODNUM, NoDeposits&, I2222, TOT, INTV, ICP1, IC, MAXKT
' $DYNAMIC
DIM XNORE(2, 101), ND(10), D(10), CMETAL(46), SPROB(19), ISUITE(19), JSUITE(19), FEMP(19, 26, 10), AEMP(19, 10, 10), KONT(500), KONTT(500), KONT1(500), PVAL(26), XZ(10), SMETAL(46), AA(26), Z(10), METN(10), VECT(5000), RSU(46), GSU(46), SU(46), XX( _
500), XXT(500), XX1(500), DISTP(9), CMETAL$(46), IORDER(23), JORDER(23)
' $STATIC

     RECLEN% = 184
     ITR = 0
     IORDER(1) = 1
     IORDER(2) = 250
     IORDER(3) = 500
     IORDER(4) = 750
     IORDER(5) = 1000
     IORDER(6) = 1250
     IORDER(7) = 1500
     IORDER(8) = 1750
     IORDER(9) = 2000
     IORDER(10) = 2250
     IORDER(11) = 2500
     IORDER(12) = 2750
     IORDER(13) = 3000
     IORDER(14) = 3250
     IORDER(15) = 3500
     IORDER(16) = 3750
     IORDER(17) = 4000
     IORDER(18) = 4250
     IORDER(19) = 4500
     IORDER(20) = 4750
     IORDER(21) = 4875
     IORDER(22) = 4950
     IORDER(23) = 4999

     CMETAL$(1) = "CHROMIUM"
     CMETAL$(2) = "COPPER"
     CMETAL$(3) = "MOLYBDENUM"
     CMETAL$(4) = "GOLD"
     CMETAL$(5) = "IRON"
     CMETAL$(6) = "TUNGSTEN"
     CMETAL$(7) = "ZINC"
     CMETAL$(8) = "SILVER"
     CMETAL$(9) = "LEAD"
     CMETAL$(10) = "NICKEL"
     CMETAL$(11) = "ASBESTOS"
     CMETAL$(12) = "MANGANESE"
     CMETAL$(13) = "BARITE"
     CMETAL$(14) = "MERCURY"
     CMETAL$(15) = "PLATINUM"
     CMETAL$(16) = "PHOSPHORUS"
     CMETAL$(17) = "COBALT"
     CMETAL$(18) = "TIN"
     CMETAL$(19) = "TONNES"
     CMETAL$(20) = "THORIUM"
     CMETAL$(21) = "R.E. OXIDE"
     CMETAL$(22) = "FLUORINE"
     CMETAL$(23) = "ANTIMONY"
     CMETAL$(24) = "URANIUM"
     CMETAL$(25) = "PALLADIUM"
     CMETAL$(26) = "SILICON"
     CMETAL$(27) = "CALCIUM"
     CMETAL$(28) = "ALUMINUM"
     CMETAL$(29) = "RUTILE"
     CMETAL$(30) = "ILMENITE"
     CMETAL$(31) = "LEUCOXENE"
     CMETAL$(32) = "ZIRCON"
     CMETAL$(33) = "MONAZITE REO"
     CMETAL$(34) = "GYPSUM"
     CMETAL$(35) = "NIOBIUM"
     CMETAL$(36) = "IRIDIUM"
     CMETAL$(37) = "BORON"
     CMETAL$(38) = "AMORPHOUS GRAPHITE"
     CMETAL$(39) = "DISSEMINATED FLAKE GRAPHITE"
     CMETAL$(40) = "RHODIUM"
     CMETAL$(41) = "RUTHENIUM"
     CMETAL$(42) = "42NA"
     CMETAL$(43) = "43NA"
     CMETAL$(44) = "44NA"
     CMETAL$(45) = "45NA"
     CMETAL$(46) = "46NA"

     DISTP(1) = .9
     DISTP(2) = .5
     DISTP(3) = .1
     DISTP(4) = .05
     DISTP(5) = .01
     DISTP(6) = .005
     DISTP(7) = .001
     DISTP(8) = .0005
     DISTP(9) = .0001
     FOR I = 1 TO 26
          PVAL(I) = (I - 1) * .04
     NEXT I
     NI = 1
     NX = 0
     TM2 = .01
     TM4 = .0001
     TM6 = .000001

     INTV = 20
     IMODCT = 0
     NBT& = 0
     OPEN "TNTABLE.DAT" FOR INPUT AS #1
     I = 1
     DO WHILE NOT EOF(1)
          INPUT #1, XNORE(1, I), XNORE(2, I)
          I = I + 1
     LOOP
     CLOSE #1
     IFO$ = "N"
     BASNAME$ = ""
     REQNAME$ = ""
     AREANM$ = ""
     IF COMMAND$ <> "" THEN
          TEMP$ = COMMAND$
          BASNAME$ = LTRIM$(RTRIM$(TEMP$))
     END IF
'DISPLAY DISCLAIMER SCREEN WHILE LOADING SYMBOLS
     SCREEN 0
     ECODE% = 0
     ON ERROR GOTO 3000
     COLOR 15, 1
     ON ERROR GOTO 0
     IF ECODE% <> 0 THEN
          COLOR 7, 0
     END IF
     WIDTH 80
     CLS
     LEFT% = 5
     RIGHT% = 75
     TOP% = 2
     BOTTOM% = 24
     CALL OUTLINE(LEFT%, RIGHT%, TOP%, BOTTOM%)
     LOCATE 6, 23: PRINT "          M  A  R  K  I I I  "

     LOCATE 16, 23: PRINT "      U.S. Geological Survey"
     LOCATE 19, 23: PRINT "           DISCLAIMER          "
     LOCATE 21, 10: PRINT "Although program tests have been made, no guarantee (expressed";
     LOCATE 22, 10: PRINT "or implied) is made by the author; regarding; program; correctness, ";
     LOCATE 23, 10: PRINT "accuracy, or proper execution on all; computer; systems.; "; ""
     SLEEP (2)
190  CLS
     LEFT% = 5
     RIGHT% = 75
     TOP% = 2
     BOTTOM% = 24
     CALL OUTLINE(LEFT%, RIGHT%, TOP%, BOTTOM%)
     LOCATE 3, 40: PRINT BASNAME$;
     LOCATE 4, 40: PRINT AREANM$;
     LOCATE 5, 40: PRINT REQNAME$;
     LOCATE 7, 10: PRINT "  M  A  R  K  I  I  I";
     LOCATE 10, 10: PRINT "  1  -  START ASSESSMENT FOR A NEW AREA";
     LOCATE 11, 10: PRINT "  2  -  CONTINUE THE ASSESSMENT FOR AN AREA"; ";"
     LOCATE 12, 10: PRINT "  3  -  RUN A MODEL";
     LOCATE 13, 10: PRINT "  4  -  PRINT MODEL RESULTS";
     LOCATE 14, 10: PRINT "  5  -  ADD THE RESULTS OF A MODEL TO TOTALS FOR THE AREA";
     LOCATE 15, 10: PRINT "  6  -  PRINT AREA TOTALS";
     LOCATE 16, 10: PRINT "  7  -  PRINT A LIST OF ALL MODELS";
     LOCATE 17, 10: PRINT "  8  -  ISSUE DOS COMMANDS AND STAY IN; MARK3B; "; ""
     LOCATE 18, 10: PRINT "  9  -  EXIT TO DOS";
     LOCATE 21, 10: INPUT "  ENTER CHOICE BY NUMBER: ", ICHOICE%
     IF IFO$ = "N" AND (ICHOICE% > 2 AND ICHOICE% < 7) THEN
          CLS
          PRINT "You must START or CONTINUE an area before using; options; 3 - 7; "; ""
          LOCATE 24, 1
          PRINT "Press any key to continue.";
          IDUM$ = INPUT$(1)
     ELSE
          SELECT CASE ICHOICE%
                        CASE IS <= 0, IS > 9
                    BEEP
                                GOTO 190
               CASE 1
                    CLS
                    ON ERROR GOTO 3010
                    FILES "*.TOT"
                    ON ERROR GOTO 0
                    CALL StartUpAnArea
               CASE 2
                    CLS
                    ON ERROR GOTO 3010
                    FILES "*.TOT"
                    ON ERROR GOTO 0
                    CALL ContinueAnArea
               CASE 3
                    CALL RunAModel
               CASE 4
                    CALL PrintModelResults
               CASE 5
                    CALL AddModelResults
               CASE 6
                    CALL PrintAreaTotals
               CASE 7
                    CALL PrintListOfModels
               CASE 8
                    CALL DOSSHELL
               CASE 9
                    GOTO 11000
          END SELECT
          TCODE% = 0
          IFO$ = "Y"
     END IF
     GOTO 190
'
'END OF PROGRAM
'
11000     ERASE XNORE, ND, D, CMETAL, SPROB, ISUITE, JSUITE, FEMP, AEMP, KONT, PVAL, XZ, SMETAL, AA, Z, METN, VECT, RSU, GSU, SU, XX, DISTP, CMETAL$, IORDER, JORDER
     ON ERROR GOTO 3010
     KILL BASNAME$ + ".SCR"
     ON ERROR GOTO 0
     CLS
END

'ERROR BRANCH FOR IMMEDIATE RETURN
3000 ECODE% = 1
     RESUME NEXT
'ERROR BRANCH FOR FILES COMMAND
3010 RESUME NEXT

SUB AddModelResults STATIC
' CONVOLVING FREQUENCIES
' kontt() is the convolved sum of the number of deposits
' kont() is the number of deposits in the last model run
' kont1() is the convolution of kontt() and kont() so knot1() becomes the new kontt()
' kont(i) is the number of times there were i-1 deposits
        FOR I = 1 TO 500
        KONT1(I) = KONTT(I)
        NEXT I

        MAXK = 500
        FOR I = 1 TO 500
        IF KONT(501 - I) = 0 THEN GOTO 2
        MAXK = 501 - I
        GOTO 3
2       NEXT I
3       MAXKT = 500
        FOR I = 1 TO 500
        IF KONTT(501 - I) = 0 THEN GOTO 4
        MAXKT = 501 - I
        GOTO 5
4       NEXT I
5       FOR JCON = 1 TO ITR
        R = RAND(NBT&)
        NR = INT(R * (ITR - JCON + 1)) + 1
        IF NR > ITR THEN NR = ITR
        NKT = 0
        FOR I = 1 TO MAXKT
        NKT = NKT + KONTT(I)
        IF NR > NKT THEN GOTO 6
        IKT = I
        GOTO 8
6       NEXT I
8       R = RAND(NBT&)
        NR = INT(R * (ITR - JCON + 1)) + 1
        NK = O
        FOR I = 1 TO MAXK
        NK = NK + KONT(I)
        IF NR > NK THEN GOTO 13
        IK = I
        GOTO 14
13      NEXT I
14      KONT1(IKT) = KONT1(IKT) - 1
        ITEMP = IKT + IK - 1
        IF ITEMP > 500 THEN ITEMP = 500
        KONT1(ITEMP) = KONT1(ITEMP) + 1
        KONT(IK) = KONT(IK) - 1
        KONTT(IKT) = KONTT(IKT) - 1
        NEXT JCON
        FOR I = 1 TO 500
        KONTT(I) = KONT1(I)
        KONT1(I) = 0
        XX1(I) = 0
        NEXT I
        FOR I = 1 TO MAXK
        FOR J = 1 TO MAXKT
        ITEMP = I + J - 1
        IF ITEMP > 500 THEN ITEMP = 500
        XX1(ITEMP) = XX1(ITEMP) + XX(I) * XXT(J)
        NEXT J
        NEXT I
        FOR I = 1 TO 500
        XXT(I) = XX1(I)
        NEXT I

'UPDATE TOTALS FILE AND COMPUTE SUMS FOR EACH METAL
     FOR I = 1 TO 46
          GSU(I) = 0!
     NEXT I
     CLS
     PRINT "UPDATING TOTALS FILE FOR ASSESSMENT AREA"
     OPEN BASNAME$ + ".SCR" FOR RANDOM AS #2 LEN = RECLEN%
     FIELD #2, RECLEN% AS SCRVAR$
     OPEN BASNAME$ + ".TOT" FOR RANDOM AS #3 LEN = RECLEN%
     FIELD #3, RECLEN% AS TOTVAR$
     FOR I = 1 TO ITR
          IR = I + 1
          GET #3, IR
          FOR J = 1 TO 46
               I1 = (J - 1) * 4 + 1
               RSU(J) = CVS(MID$(TOTVAR$, I1, 4))
          NEXT J
          IR = I + 1
          GET #2, IR
          FOR J = 1 TO 46
               I1 = (J - 1) * 4 + 1
               SMETAL(J) = CVS(MID$(SCRVAR$, I1, 4))
               RSU(J) = RSU(J) + SMETAL(J)
               GSU(J) = GSU(J) + RSU(J)
          NEXT J
          FOR J = 1 TO 46
               I1 = (J - 1) * 4 + 1
               MID$(TOTVAR$, I1, 4) = MKS$(RSU(J))
          NEXT J
          IR = I + 1
          LSET TOTVAR$ = TOTVAR$
          PUT #3, IR
     NEXT I
     IR = 1
     GET #3, IR
     NoDeposits& = CVI(MID$(TOTVAR$, 1, 2))
     NoDeposits& = NoDeposits& + TOT
     MID$(TOTVAR$, 1, 2) = MKI$(NoDeposits&)
     LSET TOTVAR$ = TOTVAR$
     IR = 1
     PUT #3, IR
     CLOSE #2, #3
     OPEN BASNAME$ + ".PRT" FOR OUTPUT AS #1
     PRINT #1, "                        MARK3 SIMULATION RESULTS"
     PRINT #1, "                         TOTAL OF ALL MODELS"
     PRINT #1, "                       (EXPRESSED IN METRIC TONS)"
     PRINT #1,
     PRINT #1,
     PRINT #1,
     PRINT #1, "                        REQUESTED BY: "; REQNAME$
     PRINT #1,
     PRINT #1,
     PRINT #1,
     PRINT #1, "                        ASSESSMENT AREA: "; AREANM$
     PRINT #1,
     PRINT #1,
     PRINT #1,
     PRINT #1, "                        REQUEST DATE: "; REQDATE$
     FOR J = 1 TO 46
          IF (GSU(J) = 0!) THEN
               GOTO TOTLP2
          END IF
          TSU = 0!
          PRINT "PROCESSING "; CMETAL$(J)
          PRINT #1, USING "!"; CHR$(12)
          PRINT #1, "TOTAL OF ALL MODELS"
          PRINT #1,
          PRINT #1,
          OPEN BASNAME$ + ".TOT" FOR RANDOM AS #3 LEN = RECLEN%
          FIELD #3, RECLEN% AS TOTVAR$
          FOR I = 1 TO ITR
               IR = I + 1
               GET #3, IR
               I1 = (J - 1) * 4 + 1
               VECT(I) = CVS(MID$(TOTVAR$, I1, 4))
               TSU = TSU + VECT(I)
          NEXT I
          CLOSE #3
          CALL RSORT(VECT(), ITR)
          IFIRST = ITR
          FOR I = 1 TO ITR
               IF (VECT(I) > 0!) THEN
                    IFIRST = I
                    GOTO TOTLP1
               END IF
          NEXT I
TOTLP1:        JORDER(1) = IFIRST
               IORDER(1) = 1
          FOR I = 2 TO INTV
               tr = 0!
               FIRST = 0!
               XINTV = 0!
               tr = ITR
               XI = I
               XINTV = CSNG(INTV)
               FIRST = CSNG(IFIRST)
               DRP = (1! / XINTV) * (XI - 1!)
               JORDER(I) = INT((tr - FIRST + 1!) * DRP + FIRST - 1! + .9999)
               IF JORDER(I) > ITR THEN JORDER(I) = ITR
               IORDER(I) = INT(tr * DRP + .9999)
               IF IORDER(I) > ITR THEN IORDER(I) = ITR

          NEXT I
          JORDER(21) = INT(CSNG(ITR - IFIRST + 1) * .975 + FIRST - 1 + .9999)
          JORDER(22) = INT(CSNG(ITR - IFIRST + 1) * .99 + FIRST - 1 + .9999)
          JORDER(23) = ITR
          IORDER(21) = INT(tr * .975 + .9999)
          IF IORDER(21) > ITR THEN IORDER(21) = ITR
          IORDER(22) = INT(tr * .99 + .9999)
          IF IORDER(22) > ITR THEN IORDER(22) = ITR
          IORDER(23) = ITR

          PRINT #1, "SORTED TOTAL SIMULATION RESULTS FOR "; CMETAL$(J)
          PRINT #1,
          PRINT #1, "           ORDER OF OCCURENCE"
          PRINT #1,
          PRINT #1, "      UNCONDITIONAL          CONDITIONAL"
          FOR I = 1 TO 23
               IDR = IORDER(I)
               JDR = JORDER(I)
               PRINT #1, USING "####  ##################,.###  #####  ##################,.###"; IDR; VECT(IDR); JDR; VECT(JDR)
          NEXT I
          TTTT = TSU / (ITR - IFIRST + 1)
          PRINT #1, "            EXPECTED MEAN "; CMETAL$(J)
          PRINT #1, USING "      ############,.###  ############,.###"; TSU / ITR; TTTT
          MAXKT = 500
          FOR I = 1 TO 500
          IF KONTT(501 - I) = 0 THEN GOTO 16
          MAXKT = 501 - I
          GOTO 15
16        NEXT I
15        IPRT = 499
          IF MAXKT < 500 THEN IPRT = MAXKT
          IF J <> 19 GOTO TOTLP2
          FOR I = 1 TO IPRT
               IM = I - 1
               IF (ND(INOD + 1) <> 0) THEN
                    PRINT #1,
                    PRINT #1, USING "N= ###  FREQ(N)= ######## PROB(N)=####.####"; IM; KONTT(I); XXT(I)
               END IF
          NEXT I
               IM = MAXKT - 1
               IF (ND(INOD + 1) <> 0 AND MAXKT = 500) THEN
                    PRINT #1,
                    PRINT #1, USING "N>=###  FREQ(N)= ######## PROB(N)=####.####"; IM; KONTT(500); XXT(I)
               END IF

'         XMEANDP = TOT / CSNG(ITR)
'         PRINT #1,
'         PRINT #1,USING "MEAN NUMBER OF DEPOSITS=#######,###";XMEANDP
TOTLP2:   NEXT J
     PRINT #1, USING "!"; CHR$(12)
     CLOSE #1
END SUB

SUB ContinueAnArea STATIC
C1:  LOCATE 25, 1
     PRINT "PLEASE ENTER THE SHORT NAME FOR THE AREA ";
     INPUT ; BASNAME$
     ECODE% = 0
     ON ERROR GOTO 3000
     OPEN BASNAME$ FOR INPUT AS #1
     ON ERROR GOTO 0
     IF ECODE% <> 0 THEN
          BEEP: BEEP
          LOCATE 25, 1: PRINT SPACE$(78);
          PRINT "CAN NOT FIND MAIN FILE FOR SPECIFIED AREA";
          SLEEP (2)
          LOCATE 25, 1: PRINT SPACE$(78);
          GOTO C1
     END IF
     INPUT #1, REQNAME$
     INPUT #1, AREANM$
     INPUT #1, REQDATE$
     CLOSE #1
REM THE NEXT THREE LINES DETERMINE ITR FOR THE CONTINUATION OF AN AREA
     OPEN BASNAME$ + ".TOT" FOR RANDOM AS #3 LEN = RECLEN%
     ITR = LOF(3) / 184 - 1
     CLOSE #3
         tr! = ITR
     XXT(1) = 1
     KONTT(1) = ITR
     FOR I = 2 TO 500
     XXT(I) = 0!
     KONTT(I) = 0
     NEXT I
END SUB

SUB DISTRIB (NX) STATIC
'     DIMENSION OF XX IS MAX NUMBER DEPOSITS
'     DIMENSION XX MUST BE GE ND(4)
'
     ND(1) = 0
     FOR I = 1 TO INOD + 1
               ND(I) = ND(I) + 1
               D(I) = ND(I)
     NEXT I
     FOR L = 1 TO ND(INOD + 1)
               XX(L) = 0!
     NEXT L
      IDUM = ND(2) - ND(1)
      IF (IDUM = 0) THEN
          XX(ND(1)) = 1! - DISTP(1)
          GOTO 12
     END IF
      IF (IDUM > 0) THEN
          DUM = (1! - DISTP(1)) / (2 * (D(2) - D(1)) + 1)
     END IF
     FOR L = ND(1) TO ND(2)
           IF (L = ND(2)) THEN
          XX(L) = XX(L) + DUM
          END IF
           IF (L < ND(2)) THEN
          XX(L) = XX(L) + 2! * DUM
          END IF
     NEXT L
12    FOR I = 2 TO INOD
           IDUM = ND(I + 1) - ND(I)
          SELECT CASE IDUM
               CASE 0
                         DUM = DISTP(I - 1) - DISTP(I)
               CASE 1
                    DUM = (DISTP(I - 1) - DISTP(I)) / 2!
               CASE ELSE
                    DUM = (DISTP(I - 1) - DISTP(I)) / (2! * (IDUM - 1!) + 2!)
          END SELECT
          FOR L = ND(I) TO ND(I + 1)
                IF (L = ND(I) OR L = ND(I + 1)) THEN
               XX(L) = XX(L) + DUM
               END IF
                IF (L > ND(I) AND L < ND(I + 1)) THEN
               XX(L) = XX(L) + 2! * DUM
               END IF
          NEXT L
     NEXT I
      XX(ND(INOD + 1)) = XX(ND(INOD + 1)) + DISTP(INOD)
      IF (PROBZ < -.01 OR PROBZ > 1!) THEN
          GOTO 9
     END IF
      DUM = 1! - XX(1)
      XX(1) = PROBZ
      IF (DUM > 0) THEN
     GOTO 11
     END IF
     PRINT " DIST. OF DEPOSIT NUMBER INCONSISTENTLY SPECIFIED."
     SYSTEM
11    IF (DUM > 0) THEN
          A = ((1! - PROBZ) / DUM)
     END IF
     FOR I = 2 TO ND(INOD + 1)
           XX(I) = XX(I) * A
     NEXT I
     RANDOMIZE (NBT&)
9    R = RAND(NBT&)
'9   R = RND
'9     CALL URNMX (NBT&,NI,R)
      TEST = 0!
     FOR L = 1 TO ND(INOD + 1)
           TEST = TEST + XX(L)
           IF (TEST > R) THEN
               EXIT FOR
          END IF
     NEXT L
7     NX = L - 1
     FOR I = 1 TO INOD + 1
           ND(I) = ND(I) - 1
     NEXT I
END SUB

SUB DOSSHELL STATIC
'ROUTINE TO ALLOW THE USER TO EXECUTE A DOS COMMAND.
DOS10:    CLS
     PRINT "ENTER DOS COMMAND FOLLOWED BY A RETURN(RETURN ONLY TO EXIT)"
     INPUT DOSLINE$
     IF DOSLINE$ = "" THEN
          EXIT SUB
     END IF
     SHELL DOSLINE$
     PRINT "HIT ANY KEY TO CONTINUE"
     IDUM$ = INPUT$(1)
     GOTO DOS10
END SUB

SUB EMPVAL (PROB, CC(), PVAL(), VALV) STATIC
'     THIS WILL FIND THAT VALUE THAT CORRESPONDS TO A PROBABILITY
'     IN A PIECEWISE LINEAR DISTRIBUTION.  VALV IS RETURNED
     IF PROB <= 0! THEN
          VALV = CC(1)
          EXIT SUB
     END IF
     IF (PROB >= 1!) THEN
          VALV = CC(11)
     END IF
     FOR I = 2 TO IDIST
          IF (PROB <= PVAL(I)) THEN
               TAEMP = PVAL(I) - PROB
               TAEMP = TAEMP / (PVAL(I) - PVAL(I - 1))
               VALV = TAEMP * CC(I - 1) + (1! - TAEMP) * CC(I)
               EXIT SUB
          END IF
     NEXT I
END SUB

SUB NORPROBE (PROB, VALV) STATIC
'     THIS WILL FIND THE PROBABILITY THAT CORRESPONDS TO A GIVEN
'     VALUE OF A NORMAL RANDOM VARIBLE.  PROB IS RETURNED
     SELECT CASE VALV
          CASE IS <= XNORE(2, 1)
               PROB = .001
               EXIT SUB
          CASE IS >= XNORE(2, NOR)
               PROB = .999
               EXIT SUB
          CASE ELSE
     END SELECT
     FOR I = 1 TO NOR
           IF (VALV < XNORE(2, I)) THEN
                AEMP = XNORE(2, I) - VALV
                AEMP = AEMP / (XNORE(2, I) - XNORE(2, I - 1))
                PROB = AEMP * XNORE(1, I - 1) + (1! - AEMP) * XNORE(1, I)
               EXIT SUB
          END IF
     NEXT I
END SUB

SUB NORVALE (PROB, VALV) STATIC
'     THIS WILL FIND THE VALUE OF A NORMAL RANDOM VARIABLE THAT
'     CORRESPONDS TO A GIVEN PROBABILITY.  VALV IS RETURNED
      VALV = XNORE(2, 1) - (XNORE(2, 2) - XNORE(2, 1))
      IF (PROB < XNORE(1, 1)) THEN
     EXIT SUB
     END IF
     FOR I = 2 TO NOR
           IF (PROB < XNORE(1, I)) THEN
                AEMP = XNORE(1, I) - PROB
                AEMP = AEMP / (XNORE(1, I) - XNORE(1, I - 1))
                VALV = AEMP * XNORE(2, I - 1) + (1! - AEMP) * XNORE(2, I)
               EXIT SUB
          END IF
     NEXT I
      VALV = XNORE(2, NOR) + (XNORE(2, NOR) - XNORE(2, NOR - 1))
END SUB

SUB OUTLINE (LEFT%, RIGHT%, TOP%, BOTTOM%) STATIC
'ROUTINE TO DRAW A DOUBLE LINE BOX AROUND AN AREA ON THE SCREEN
'
    LOCATE TOP%, LEFT%
    PRINT CHR$(201);
    LOCATE TOP%, RIGHT%
    PRINT CHR$(187);
    LOCATE BOTTOM%, LEFT%
    PRINT CHR$(200);
    LOCATE BOTTOM%, RIGHT%
    PRINT CHR$(188);
    FOR VERT% = TOP% + 1 TO BOTTOM% - 1
        LOCATE VERT%, LEFT%
        PRINT CHR$(186);
        LOCATE VERT%, RIGHT%
        PRINT CHR$(186);
    NEXT VERT%
    HORIZ% = RIGHT% - LEFT% - 1
    HLINE$ = STRING$(HORIZ%, 205)
    LOCATE TOP%, LEFT% + 1
    PRINT HLINE$;
    LOCATE BOTTOM%, LEFT% + 1
    PRINT HLINE$;
END SUB

SUB PrintAreaTotals STATIC
     CLS
     PRINT "PLEASE TURN THE PRINTER ON AND HIT RETURN WHEN READY"
     ICH$ = INPUT$(1)
     ECODE% = 0
     ON ERROR GOTO 3000
     OPEN BASNAME$ + ".PRT" FOR INPUT AS #1
     ON ERROR GOTO 0
     IF ECODE% <> 0 THEN
          BEEP: BEEP
          PRINT "CANNOT FIND TOTALS PRINTOUT"
          SLEEP (2)
          EXIT SUB
     END IF
     DO WHILE NOT EOF(1)
          LINE INPUT #1, DLINE$
          LPRINT DLINE$
     LOOP
     CLOSE #1
END SUB

SUB PrintListOfModels STATIC
     CLS
     PRINT "PLEASE TURN THE PRINTER ON AND HIT RETURN WHEN READY"
     ICH$ = INPUT$(1)
     OPEN "MARK3.HLP" FOR INPUT AS #1
     DO WHILE NOT EOF(1)
          LINE INPUT #1, DLINE$
          LPRINT DLINE$
     LOOP
     CLOSE #1
END SUB

SUB PrintModelResults STATIC
     CLS
     PRINT "PLEASE TURN THE PRINTER ON AND HIT RETURN WHEN READY"
     ICH$ = INPUT$(1)
     IF MODNUM <> 0 THEN
          ECODE% = 0
          ON ERROR GOTO 3000
          OFILE$ = BASNAME$ + "." + LTRIM$(RTRIM$(STR$(MODNUM)))
          OPEN OFILE$ FOR INPUT AS #1
          ON ERROR GOTO 0
          IF ECODE% <> 0 THEN
               PRINT "CANNOT FIND MODEL RESULTS PRINTOUT"
               SLEEP (2)
               EXIT SUB
          END IF
          DO WHILE NOT EOF(1)
               LINE INPUT #1, DLINE$
               LPRINT DLINE$
          LOOP
          CLOSE #1
     ELSE
          PRINT "MODEL NUMBER IS UNKNOWN"
          SLEEP (2)
     END IF
END SUB

FUNCTION RAND (IX&) STATIC
'--------------------------------------------------
'***  RAND IS A PORTABLE RANDOM NUMBER GENERATOR BASED
'***  ON THE RECURSION IX=IX*A MOD P.
'***  GENERATES UNIFORM RANDOM NUMBERS ON INTERVAL 0,1
'***
'***  FORTRAN CODE WAS WRITTEN BY LINUS SCHRAGE
'***  REFERENCE AND DOCUMENTATION IS IN
'***  ACM TRANSACTIONS JUNE 1979
'----------------------------------------------------
     A& = 16807
     B15& = 32768
     B16& = 65536
     P& = 2147483647
'***  GET 15 HI ORDER BITS OF IX
     XHI& = IX& \ B16&
'***  GET 16 LO ORDER BITS OF IX AND FORM LO PRODUCT
     XALO& = (IX& - XHI& * B16&) * A&
'***  GET 15 HI ORDER BITS OF LO PRODUCT
     LEFTLO& = XALO& \ B16&
'***  FORM THE 31 HIGHEST BITS OF FULL PRODUCT
     FHI& = XHI& * A& + LEFTLO&
'***  GET OVERFLO PAST 31ST BIT OF FULL PRODUCT
     K& = FHI& \ B15&
'***  ASSEMBLE ALL THE PARTS AND PRESUBTRACT P
'***  THE PARENTHESES ARE ESSENTIAL
     IX& = (((XALO& - LEFTLO& * B16&) - P&) + (FHI& - K& * B15&) * B16&) + K&
'***  ADD P BACK IN IF NECESSARY
     IF (IX& < 0) THEN
          IX& = IX& + P&
     END IF
'***  MULTIPLY BY 1/(2**31-1)
     RAND = CSNG(IX&) * 4.656612875D-10
END FUNCTION

SUB RSORT (RITEM(), N) STATIC
'
' FROM DAVE GRUNDY, MAY, 1980  A CDC PROGRAM
'
'
' ***  CDC MODIFIED BINARY SORT(SUPERSORT)
' ***  WILL SORT ARRAY OF NOT GREATER THAN 2**15 (23,768)
'
DIM IU(15), IL(15)
      M = 1
      I = 1
      J = N
10 IF (I >= J) GOTO 110
20 K = I
      L = J
      IJ = (I + J) / 2
      IF (RITEM(I) <= RITEM(IJ)) GOTO 30
      XT = RITEM(I)
      RITEM(I) = RITEM(IJ)
      RITEM(IJ) = XT
30 IF (RITEM(J) >= RITEM(IJ)) GOTO 60
      XT = RITEM(J)
      RITEM(J) = RITEM(IJ)
      RITEM(IJ) = XT
      IF (RITEM(IJ) >= RITEM(I)) GOTO 60
      XT = RITEM(I)
      RITEM(I) = RITEM(IJ)
      RITEM(IJ) = XT
      GOTO 60
40 XT = RITEM(L)
      RITEM(L) = RITEM(K)
      RITEM(K) = XT
      IF (IJ <> L) GOTO 50
      IJ = K
      GOTO 60
50 IF (IJ <> K) GOTO 60
      IJ = L
60 L = L - 1
      IF (RITEM(IJ) < RITEM(L)) GOTO 60
70 K = K + 1
      IF (RITEM(K) < RITEM(IJ)) GOTO 70
'      IF(K-L)40,80,90
     IF K - L < 0 GOTO 40
     IF K - L = 0 GOTO 80
     GOTO 90
80 K = K + 1
      L = L - 1
90 IF (L - I <= J - K) GOTO 100
      IL(M) = I
      IU(M) = L
      I = K
      M = M + 1
      GOTO 120
100 IL(M) = K
      IU(M) = J
      J = L
      M = M + 1
      GOTO 120
110 M = M - 1
      IF (M = 0) THEN
     EXIT SUB
     END IF
      I = IL(M)
      J = IU(M)
120 IF (J - I >= 11) GOTO 20
      IF (I = 1) GOTO 10
      GOTO 140
130 I = I + 1
140 IF (I = J) GOTO 110
      IF (RITEM(I) <= RITEM(I + 1)) GOTO 130
      K = I
150 XT = RITEM(K)
      RITEM(K) = RITEM(K + 1)
      RITEM(K + 1) = XT
      K = K - 1
      IF (RITEM(K + 1) < RITEM(K)) GOTO 150
      GOTO 130
END SUB

SUB RunAModel STATIC
     CLS
MLOOP:    INPUT "ENTER MODEL NUMBER(1-99): ", MODNUM
     IF MODNUM < 1 OR MODNUM > MaxModelNumber THEN
          BEEP: BEEP
          PRINT "INVALID MODEL NUMBER - TRY AGAIN"
          GOTO MLOOP
     END IF
IN5: INPUT "ENTER EST NUMBER OF DEPOSIT COUNTS(3,5,9):", INOD
222  PRINT "ENTER ESTIMATED NUMBER OF DEPOSITS FOR FOLLOWING LEVELS:"
     SELECT CASE INOD
          CASE 3
               PRINT "90%,50%,10% (MAXIMUM MUST BE < 500)"
               INPUT ND(2), ND(3), ND(4)
          CASE 5
               PRINT "90%,50%,10%,5%,1% (MAXIMUM MUST BE < 500)"
               INPUT ND(2), ND(3), ND(4), ND(5), ND(6)
          CASE 9
               PRINT "90%,50%,10%,5%,1%,0.5%,0.1%,0.05%,0.01% (MAXIMUM MUST BE < 500)"
               INPUT ND(2), ND(3), ND(4), ND(5), ND(6), ND(7), ND(8), ND(9), ND(10)
          CASE ELSE
               BEEP
               PRINT "INVALID RESPONSE - USE 3 OR 5 OR 9 "
               GOTO IN5
     END SELECT
     FOR I = 1 TO INOD
     IF ND(I + 1) > 499 THEN PRINT " TOO MANY DEPOSITS (MAXIMUM < 500)"
     IF ND(I + 1) > 499 THEN GOTO 222
     NEXT I

     PRINT
444  PRINT "TO FIX THE PROBABILITY OF ZERO DEPOSITS,"
     PRINT "ENTER PROBABILITY BETWEEN 0 AND 1"
     PRINT "OR ENTER -1 OR RETURN FOR DEFAULT: ";
     INPUT DUM$
     IF DUM$ = "" THEN GOTO 555
     IF DUM$ = "-1" THEN GOTO 555
     IF VAL(DUM$) <= 1 AND VAL(DUM$) >= 0 THEN GOTO 555
     PRINT "INVALID RESPONSE"
     GOTO 444
555  IF DUM$ = "" THEN
     PROBZ = -1!
     ELSE
     PROBZ = VAL(DUM$)
     END IF
'    INPUT PROBZ
     

CD1:  IF NBT& = 0 THEN
          INPUT "ENTER SEED NUMBER:(POSITIVE AND < 2147483647) ", NBT&
          IF NBT& <= 0 THEN
               NBT& = 987
          END IF
     END IF
     DEFFILE$ = LTRIM$(RTRIM$(STR$(MODNUM))) + ".DEF"
     OPEN DEFFILE$ FOR INPUT AS #1
     INPUT #1, DUMM$     'NOT USED IN THIS ROUTINE PART OF PHASE1
     INPUT #1, EMPFILE$
     INPUT #1, MTITLE$
     INPUT #1, NUMOFMTL
     FOR IPMET = 1 TO NUMOFMTL + 1
          INPUT #1, METN(IPMET)
     NEXT IPMET
     CLOSE #1
     NOR = 100
     NI = 1
     RANGE = 1.5
     MEMP = 10
     IC = 10
     ICP1 = IC + 1
     MAXD = 500
     MAXS = 19
     IDIST = 26
     NSUITE = 0
     FOR J = 1 TO MAXS
          SPROB(J) = 0!
          ISUITE(J) = 0
          JSUITE(J) = 0
          FOR K = 1 TO IC
               FOR L = 1 TO IDIST
                    FEMP(J, L, K) = 0!
                    FOR I8 = 1 TO IC
                         AEMP(J, K, I8) = 0!
                    NEXT I8
               NEXT L
          NEXT K
     NEXT J
     FOR I = 1 TO 46
          SU(I) = 0!
     NEXT I
     ECODE% = 0
     ON ERROR GOTO 3000
     OPEN EMPFILE$ FOR INPUT AS #2
     ON ERROR GOTO 0
     IF ECODE% = 1 THEN
          PRINT "DATA FILE IS MISSING FOR MODEL "; MODNUM
          SYSTEM
     END IF
     INPUT #2, NSUITE, NUMCOM
     FOR I = 1 TO NSUITE
          FOR J = 1 TO IDIST
               FOR K = 1 TO NUMCOM
                    INPUT #2, FEMP(I, J, K)
               NEXT K
          NEXT J
          FOR J = 1 TO NUMCOM
               FOR K = 1 TO NUMCOM
                    INPUT #2, AEMP(I, J, K)
               NEXT K
          NEXT J
          INPUT #2, SPROB(I)
     NEXT I
     CLOSE #2
' SIMUINSE ROUTINE BEGINS
     OPEN BASNAME$ + ".SCR" FOR RANDOM AS #2 LEN = RECLEN%
     FIELD #2, RECLEN% AS SCRVAR$
     FOR LL = 1 TO ITR
          LOCATE 25, 1: PRINT USING "#####"; LL;
          FOR J = 1 TO 46
               SMETAL(J) = 0
          NEXT J
          CALL DISTRIB(NX)
          KONT(NX + 1) = KONT(NX + 1) + 1
'         NWKONT(NX+1)=NWKONT(NX+1)+1
          IF (NX < 1) THEN
               GOTO 111
          END IF
          FOR INDX = 1 TO NX
               EST = RAND(NBT&)
'              EST = RND
'              CALL URNMX(NBT&,NI,EST)
               TEST = 0!
               FOR J = 1 TO NSUITE
                    TEST = TEST + SPROB(J)
                    IF (EST <= TEST) THEN
                         JS = J
                         GOTO 333
                    END IF
               NEXT J
               PRINT "SUITE TROUBLE "; EST; TEST; SPROB(J)
               JS = NSUITE
333
               FOR L = 1 TO IC
                    DUM = RAND(NBT&)
'                   DUM = RND
'                   CALL URNMX(NBT&,NI,DUM)
                    CALL NORVALE(DUM, XZ(L))
               NEXT L
               FOR L = 1 TO IC
                    VALT = 0!
                    FOR J = 1 TO L
                         VALT = VALT + AEMP(JS, L, J) * XZ(J)
                    NEXT J
                    FOR K = 1 TO IDIST
                         AA(K) = FEMP(JS, K, L)
                    NEXT K
                    CALL NORPROBE(DUM, VALT)
                    CALL EMPVAL(DUM, AA(), PVAL(), TDUM)
                    Z(L) = TDUM
               NEXT L
               SMETAL(19) = SMETAL(19) + Z(1)
               FOR L = 2 TO NUMCOM
                    TTTT = Z(1) * Z(L) / 100
                    IGARY = METN(L)
                    SMETAL(IGARY) = SMETAL(IGARY) + TTTT
               NEXT L
          NEXT INDX
111
          FOR INDX = 1 TO 46
               I1 = (INDX - 1) * 4 + 1
               MID$(SCRVAR$, I1, 4) = MKS$(SMETAL(INDX))
               SU(INDX) = SU(INDX) + SMETAL(INDX)
          NEXT INDX
          IR = LL + 1
          LSET SCRVAR$ = SCRVAR$
          PUT #2, IR
     NEXT LL
'END OF SIMUINESE ROUTINE
     CLS
     SELECT CASE INOD
          CASE 3
               I2222 = ND(4) + 1
          CASE 5
               I2222 = ND(6) + 1
          CASE 9
               I2222 = ND(10) + 1
          CASE ELSE
     END SELECT
     TOT = 0!
     FOR I = 1 TO I2222
          TOT = TOT + (CSNG(KONT(I)) * CSNG(I - 1))
     NEXT I
'PRINT RESULTS FOR EACH METAL
     OFILE$ = BASNAME$ + "." + LTRIM$(RTRIM$(STR$(MODNUM)))
     OPEN OFILE$ FOR OUTPUT AS #1
     PRINT #1, "                        MARK3 SIMULATION RESULTS"
     PRINT #1,
     PRINT #1, "                       (EXPRESSED IN METRIC TONS)"
     PRINT #1,
     PRINT #1,
     PRINT #1,
     PRINT #1, "                        REQUESTED BY: "; REQNAME$
     PRINT #1,
     PRINT #1,
     PRINT #1,
     PRINT #1, "                        ASSESSMENT AREA: "; AREANM$
     PRINT #1,
     PRINT #1,
     PRINT #1,
     PRINT #1, "                        REQUEST DATE: "; REQDATE$
     PRINT "PROCESSING EACH METAL "
     FOR J = 1 TO 46
          IF (SU(J) = 0!) THEN
               GOTO 2890
          END IF
          PRINT "PROCESSING "; CMETAL$(J)
          PRINT #1, USING "!"; CHR$(12)
          PRINT #1, MTITLE$
          SELECT CASE INOD
               CASE 3
                    PRINT #1, "EMPIRICAL ("; ND(2); ","; ND(3); ","; ND(4); ")"
               CASE 5
                    PRINT #1, "EMPIRICAL ("; ND(2); ","; ND(3); ","; ND(4); ND(5); ND(6); ")"
               CASE 9
                    PRINT #1, "EMPIRICAL ("; ND(2); ","; ND(3); ","; ND(4); ND(5); ND(6); ND(7); ND(8); ND(9); ND(10); ")"
               END SELECT
               IF PROBZ >= 0 THEN PRINT #1, USING "THE PROBABILITY OF ZERO DEPOSITS WAS SET TO  #.####"; PROBZ
          PRINT #1,
          PRINT #1,
          FOR I = 1 TO ITR
               IR = I + 1
               GET #2, IR
               I1 = (J - 1) * 4 + 1
               VECT(I) = CVS(MID$(SCRVAR$, I1, 4))
          NEXT I
'         CLOSE #2
          CALL RSORT(VECT(), ITR)
          IFIRST = ITR
          FOR I = 1 TO ITR
               IF (VECT(I) > 0!) THEN
                    IFIRST = I
                    GOTO 2794
               END IF
          NEXT I
2794      JORDER(1) = IFIRST
          IORDER(1) = 1
          FOR I = 2 TO INTV
               tr = 0!
               FIRST = 0!
               XINTV = 0!
               tr = ITR
               XI = I
               XINTV = INTV
               FIRST = IFIRST
               DRP = (1! / XINTV) * (XI - 1!)
               JORDER(I) = INT((tr - FIRST + 1!) * DRP + FIRST - 1! + .9999)
               IF JORDER(I) > ITR THEN JORDER(I) = ITR
               IORDER(I) = INT(tr * DRP + .9999)
               IF IORDER(I) > ITR THEN IORDER(I) = ITR

          NEXT I
          JORDER(21) = INT((CSNG(ITR - IFIRST + 1) * 975!) / 1000! + IFIRST - 1 + .9999)
          JORDER(22) = INT((CSNG(ITR - IFIRST + 1) * 99!) / 100! + IFIRST - 1 + .9999)
          JORDER(23) = ITR
          IORDER(21) = INT(tr * .975 + .9999)
          IF IORDER(21) > ITR THEN IORDER(21) = ITR
          IORDER(22) = INT(tr * .99 + .9999)
          IF IORDER(22) > ITR THEN IORDER(22) = ITR
          IORDER(23) = ITR
          PRINT #1, "SORTED SIMULATION RESULTS FOR "; CMETAL$(J)
          PRINT #1,
          PRINT #1, "           ORDER OF OCCURENCE"
          PRINT #1,
          PRINT #1, "      UNCONDITIONAL          CONDITIONAL"
          FOR I = 1 TO 23
               IDR = IORDER(I)
               JDR = JORDER(I)
               PRINT #1, USING "####  ##############,.#####  ####  ##############,.#####"; IDR; VECT(IDR); JDR; VECT(JDR)
          NEXT I
          TTTT = SU(J) / (ITR - IFIRST + 1)
          PRINT #1, "            EXPECTED MEAN "; CMETAL$(J)
          PRINT #1, USING "      ############,.#####   ############,.#####"; SU(J) / CSNG(ITR); TTTT
          FOR I = 1 TO I2222
               IM = I - 1
               IF (ND(INOD + 1) <> 0) THEN
                    PRINT #1,
                    PRINT #1, USING "N= ###  FREQ(N)= ######## PROB(N)=####.####"; IM; KONT(I); XX(I)
               END IF
          NEXT I
          XMEANDP = TOT / CSNG(ITR)
          PRINT #1,
          PRINT #1, USING "MEAN NUMBER OF DEPOSITS=#######,.###"; XMEANDP
2890 NEXT J
     PRINT #1, USING "!"; CHR$(12)
     CLOSE #1, #2
END SUB

SUB StartUpAnArea
SU1: LOCATE 25, 1
     PRINT "PLEASE ENTER A SHORT NAME FOR THE AREA: ";
     INPUT ; BASNAME$
     PRINT "ENTER NUMBER OF ITERATIONS ( < 5000 ), OR RETURN FOR DEFAULT 4999"
     INPUT DUM$
     IF DUM$ = "" THEN
     ITR = 4999
     ELSE
     ITR = CINT(VAL(DUM$))
     END IF
     IF ITR < 1 THEN PRINT "NUMBER OF ITERATIONS WILL BE SET TO 1"
     IF ITR < 1 THEN ITR = 1
     IF ITR > 4999 THEN PRINT "NUMBER OF ITERATIONS WILL BE SET TO 4999"
     IF ITR > 4999 THEN ITR = 4999
         tr! = ITR
         x = tr / 4999!
        FOR I = 1 TO 23
         order = IORDER(I)
         order = order * x
         IORDER(I) = CINT(order)
         IF IORDER(I) < 1 THEN IORDER(I) = 1
         IF IORDER(I) > ITR THEN IORDER(I) = ITR
        NEXT I

     PRINT "CREATING TOTALS FILE FOR ASSESSMENT AREA"
     OPEN BASNAME$ + ".TOT" FOR RANDOM AS #3 LEN = RECLEN%
     FIELD #3, RECLEN% AS TOTVAR$
     NoDeposits& = 0
     MID$(TOTVAR$, 1, 2) = MKI$(NoDeposits&)
     IR = 1
     LSET TOTVAR$ = TOTVAR$
     PUT #3, IR
     SR = 0!
     FOR I = 1 TO 46
          I1 = (I - 1) * 4 + 1
          MID$(TOTVAR$, I1, 4) = MKS$(SR)
     NEXT I
     FOR I = 1 TO ITR
          IR = I + 1
          LSET TOTVAR$ = TOTVAR$
          PUT #3, IR
     NEXT I
     CLOSE #3
     PRINT "PLEASE TYPE INITIAL INFORMATION FOR HEADER PAGE"
     INPUT "REQUESTED BY: ", REQNAME$
     INPUT "FULL NAME OF THE ASSESSMENT AREA: ", AREANM$
     REQDATE$ = DATE$
     OPEN BASNAME$ FOR OUTPUT AS #1
     PRINT #1, REQNAME$
     PRINT #1, AREANM$
     PRINT #1, REQDATE$
     CLOSE #1
     XXT(1) = 1
     KONTT(1) = ITR
     FOR I = 2 TO 500
     XXT(I) = 0!
     KONTT(I) = 0
     NEXT I
END SUB

'!!!!!!!!  NOT CURRENTLY BEING USED!!!!!!!!!!!!!!
SUB URNMX (NBT&, NI, R) STATIC
'
' URNMT GENERATES UNIFORM RANDOM NUMBERS IN THE INTERVAL
' 0 TO 1 USING THE METHOD OF TAUSWORTHE.  VARIABLE NBT (A
' POSITIVE INTEGER) IS THE STARTING BIT OF THE SEQUENCE.
' VARIABLE NI IS 1 TO INITIALIZE URNMT AND IS 2 THEREAFTER.
' VARIABLE R IS THE RANDOM NUMBER.  THE PRIMITIVE
' POLYNOMIAL IS XEMP**LP + XEMP**LQ + 1.
'
DIM L1&(521), P2(32)
'      COMMON /OWN/L1(521),P2(32),LP,LQ,NQ1,MM,MEMP
     SELECT CASE NI
          CASE 1         'INITIALIZATION ROUTINE.
               LP& = 521
               LQ& = 32
               NQ1& = LQ& + 1
               MM& = LP& / LQ&
'
' A PRIME NUMBER 48611 IS USED TO GENERATE THE FIRST LP
' BITS.
'
               FOR I& = 1 TO LP&
                    L1&(I&) = (48611 / I&) MOD 2&
               NEXT I&
               FOR I& = 1 TO LQ&
                    P2(I&) = .5 ^ I&
               NEXT I&
               NI = 2
               MEMP& = 0
               KL& = (NBT& - 1) / LP&
               IF KL& <> 0 THEN
                    NSW1% = 1
                    FOR J& = 1 TO KL&
                         FOR I& = 1 TO LQ&
                              NS& = LP& - LQ& + I&
                              L1&(I&) = L1&(I&) + L1&(NS&)
                              IF (L1&(I&) = 2) THEN
                                   L1&(I&) = 0
                              END IF
                         NEXT I&
                         FOR I& = NQ1& TO LP&
                              L1&(I&) = L1&(I&) + L1&(I& - LQ&)
                              IF L1&(I&) = 2 THEN
                                   L1&(I&) = 0
                              END IF
                         NEXT I&
                    NEXT J&
               END IF
               KNBT& = NBT& - KL& * LP& - 1&
               IF (KNBT& = 0) THEN
                    GOTO 5050
               END IF
'
' SHIFT BITS.
'
               FOR J& = 1 TO KNBT&
                    NTMP& = L1&(1) + L1&(LP& - LQ& + 1&)
                    IF (NTMP& = 2) THEN
                         NTMP& = 0
                    END IF
                    FOR JJ& = 2 TO LP&
                         L1&(JJ& - 1) = L1&(JJ&)
                         L1&(LP&) = NTMP&
                    NEXT JJ&
               NEXT J&
          CASE 2
5050           R = 0!
               MEMP& = MEMP& + 1
               IF (MEMP& = MM&) THEN
                    GOTO 6060
               END IF
               MEMP& = 1
               NSW1% = 2
'
' GENERATE THE NEXT LP BITS.
'
52             FOR I& = 1 TO LQ&
                    NS& = LP& - LQ& + I&
                    L1&(I&) = L1&(I&) + L1&(NS&)
                    IF (L1&(I&) = 2) THEN
                         L1&(I&) = 0
                    END IF
               NEXT I&
               FOR I& = NQ1& TO LP&
                    L1&(I&) = L1&(I&) + L1&(I& - LQ&)
                    IF (L1&(I&) = 2) THEN
                         L1&(I&) = 0
                    END IF
               NEXT I&
'
'     COMPUTE RANDOM NUMBER R.
'
6060           FOR I& = 1 TO LQ&
                    R = R + P2(I&) * CSNG(L1&((MEMP& - 1&) * LQ& + I&))
               NEXT I&
          END SELECT
END SUB