DECLARE SUB PARSELINE (X$, SEP$, A$(), CNT%)
DECLARE SUB SORTD (N11%, ICP1%)
DECLARE SUB EMPDIST ()
DECLARE SUB EMPCOR (PROD!, RHO!)
DECLARE SUB NORVALE (PROB!, VALV!)
DECLARE SUB NORPROBE (PROB!, VALV!)
DECLARE SUB EMPVAL (PROB!, CC!(), VALV!)
DECLARE SUB PARSEWORD (A$, SEP$, WORD$)
'PHASE1
'
DEFINT I-N
OPTION BASE 1

CONST DELEMP = .1
CONST DELNOR = .06
CONST ListMetals = 46
CONST MaxDeposits = 500
CONST MaxSuites = 19

COMMON SHARED XNORE(), SPROB(), ISUITE(), JSUITE(), ICO(), FEMP(), R(), ADUM(), AEMP(), CMETAL$(), XMEAN(), DEMP(), PVAL(), XZ(), AA(), BB(), METYES(), ZEMP(), P(), IZDFLAG, ECODE%, INOD, PROBZ, NOR, IDIST, TOTVAR$, SCRVAR$, RECLEN%, NSUITE, IC
	DIM PARAS$(2)
	SEP$ = CHR$(32) + CHR$(44)      'space or comma
' $DYNAMIC
DIM XNORE(2, 101), SPROB(MaxSuites), ISUITE(MaxSuites), JSUITE(MaxSuites), ICO(10), FEMP(MaxSuites, 26, 10), R(10, 10), ADUM(10, 10), AEMP(MaxSuites, 10, 10), XMEAN(MaxSuites, 11), DEMP(MaxDeposits, MaxSuites), PVAL(26), XZ(10), AA(26), METYES(10),  _
CMETAL$(ListMetals), ZEMP(101), P(MaxSuites, 10, 10), BB(26)
' $STATIC
	RECLEN% = 184

	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"

	FOR I = 1 TO 26
		PVAL(I) = (I - 1) * .04
	NEXT I
	JF = 0
	NI = 1
	NX = 0
	TM2 = .01
	TM4 = .0001
	TM6 = .000001
	INTV = 20
	IMODCT = 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

	NOR = 100
	NI = 1
	RANGE = 1.5
	MEMP = 10
	IC = 10
	ICP1 = IC + 1
	IDIST = 26
	NSUITE = 0
	FOR J = 1 TO MaxSuites
		SPROB(J) = 0!
		ISUITE(J) = 0
		JSUITE(J) = 0
		FOR K = 1 TO IC
			ICO(K) = 0
			FOR I8 = 1 TO IC
				R(K, I8) = 0!
				ADUM(K, I8) = 0!
				AEMP(J, K, I8) = 0!
			NEXT I8
			FOR L = 1 TO IDIST
				FEMP(J, L, K) = 0!
			NEXT L
		NEXT K
	NEXT J
	FOR L = 1 TO MaxDeposits
		FOR I = 1 TO ICP1
			DEMP(L, I) = 0!
		NEXT I
	NEXT L

	IF COMMAND$ = "" THEN
		CLS
		INPUT "ENTER MODEL NUMBER: ", MODNUM
		INPUT "ENTER FILENAME FOR PRINTED OUTPUT: ", OUTFILE$
	ELSE
		DUMMY$ = COMMAND$
		CALL PARSELINE(DUMMY$, SEP$, PARAS$(), CNT%)
		MODNUM = VAL(PARAS$(1))
		OUTFILE$ = PARAS$(2)
	END IF
	OPEN OUTFILE$ FOR OUTPUT AS #3
	PRINT #3, "PHASE1 RESULTS"
	PRINT #3, "GENERATED ON "; DATE$
	PRINT #3, "STARTED AT "; TIME$
	PRINT "STARTED AT "; TIME$
	STIME = TIMER
	DEFFILE$ = LTRIM$(RTRIM$(STR$(MODNUM))) + ".DEF"
	OPEN DEFFILE$ FOR INPUT AS #1
	INPUT #1, DINFILE$
	PRINT #3, "INPUT FILE="; DINFILE$
	INPUT #1, EMPFILE$
	PRINT #3, "GENERATED FILE = "; EMPFILE$
	INPUT #1, MTITLE$
	PRINT #3, "MODEL NUMBER "; MODNUM
	PRINT #3, MTITLE$
	INPUT #1, NUMOFMTL              'NOTE THIS IS INFO (SEE BELOW)
	PRINT #3, "NUMBER OF METALS = "; NUMOFMTL
	FOR IPMET = 1 TO NUMOFMTL + 1
		INPUT #1, ICO(IPMET)
		PRINT #3, ICO(IPMET); " ("; CMETAL$(ICO(IPMET)); ")"
	NEXT IPMET
	CLOSE #1
	NUMCOM = NUMOFMTL + 1
65      OPEN EMPFILE$ FOR OUTPUT AS #2
	INFOC = 10
	OPEN DINFILE$ FOR INPUT AS #1
'     READ IN DATA COUNT NUMBER OF DEPOSITS
	I = 1
14      DO WHILE NOT EOF(1)
		INPUT #1, DUM$
		FOR J = 1 TO NUMOFMTL + 1
			INPUT #1, DEMP(I, J)
		NEXT J
		ISC = 0 'COMPUTE THE SUITE INDEX
		FOR I17 = 1 TO INFOC
			IF (DEMP(I, I17) > 0!) THEN
				ISC = ISC + 2 ^ (I17 - 1)
			END IF
		NEXT I17
		IF DEMP(I, 1) < 1! THEN
			GOTO 14
		END IF
		IF ISC <= 1 THEN
			GOTO 14
		END IF
		DEMP(I, ICP1) = ISC
		I = I + 1
	LOOP
	CLOSE #1
	N11 = I - 1     'THE NUMBER OF DEPOSITS IN MODEL
	CALL SORTD(N11, ICP1)
'NOW WE COUNT THE SUITES AND SEE WHERE THEY START AND END
	NSUITE = 1
	ISUITE(1) = 1
	JSUITE(1) = 1
	ISTOP = N11 - 1
	FOR I = 1 TO ISTOP
		TEST = DEMP(I, ICP1) - DEMP(I + 1, ICP1)
		IF (TEST > .5) THEN
			NSUITE = NSUITE + 1
			ISUITE(NSUITE) = I + 1
			JSUITE(NSUITE) = I + 1
		ELSE
			JSUITE(NSUITE) = I + 1
		END IF
	NEXT I
	FOR I = 1 TO NSUITE
		DUM = N11
		DEE = JSUITE(I) - ISUITE(I) + 1!
		SPROB(I) = DEE / DUM
	NEXT I
	FOR I = 1 TO NSUITE
		FOR J = 1 TO IC
			FOR K = 1 TO IC
				DUM = 0
				FOR L = ISUITE(I) TO JSUITE(I)
					DUM = DUM + DEMP(L, K) * DEMP(L, J)
				NEXT L
				DUM = DUM / (JSUITE(I) - ISUITE(I) + 1!)
				P(I, J, K) = DUM
			NEXT K
		NEXT J
	NEXT I
'     FIND IDIST POINTS ON A PIECEWISE LINEAR DISTRIBUTION THAT
'     APPROXIMATES AN EMPIRICAL AND HAS SAME MEAN
	CALL EMPDIST
'     CALCULATE THE MEANS WITHIN A SUITE
	FOR J = 1 TO NSUITE
		FOR I = 1 TO IC
			DUM = 0!
			FOR K = ISUITE(J) TO JSUITE(J)
				DUM = DUM + DEMP(K, I) / (JSUITE(J) - ISUITE(J) + 1)
			NEXT K
			XMEAN(J, I) = DUM
		NEXT I
	NEXT J
	FOR I = 1 TO NSUITE    'LIST WHAT METALS ARE PRESENT IN THIS SUITE
PRINT "SUITE "; I; " OUT OF "; NSUITE
		FOR K = 1 TO IC
			METYES(K) = 0
			TEST = FEMP(I, 26, K) * 1000000!
			IF (TEST > .5) THEN
				METYES(K) = 1
			END IF
		NEXT K
'     FIND ALL THE PAIRWISE CORRELATIONS
		FOR K = 1 TO IC
			FOR J = 1 TO IC
				IF K = J THEN
					R(J, K) = 1!
				ELSE
					IF (METYES(K) = 1 AND METYES(J) = 1) THEN
						FOR L = 1 TO IDIST
							AA(L) = FEMP(I, L, K)
							BB(L) = FEMP(I, L, J)
						NEXT L
						TV1 = P(I, K, J)
						TV2 = -99!
						CALL EMPCOR(TV1, TV2)
						R(K, J) = TV2
					ELSE
						R(J, K) = 0!
					END IF
				END IF
			NEXT J
		NEXT K
'     FILL THE MATRIX OF COEFFICIENTS, AEMP(I,.,.), FOR LINEAR
'     COMBINATIONS OF NORMALS THAT GIVE THE RIGHT CORRELATIONS
		FOR K = 1 TO IC
			IF (METYES(K) = 0) THEN
				AEMP(I, K, K) = 1!
				GOTO 32
			END IF
			IF (METYES(K) = 1) THEN
				AEMP(I, K, 1) = R(K, 1)
			END IF
			IF (K = 1) THEN
				GOTO 32
			END IF
			DUM = 0!
			FOR J = 2 TO K
				DUM = DUM + AEMP(I, K, J - 1) ^ 2
				IF (DUM > 1!) THEN
					BUM = DUM
					DUM = DUM - AEMP(I, K, J - 1) ^ 2
					DEE = SQR(1! - DUM)
					SGNC = 1!
					IF (AEMP(I, K, J - 1) < 0!) THEN
						SGNC = -1!
					END IF
					AEMP(I, K, J - 1) = SGNC * DEE
					PRINT #3, "INCONSISTENT CORRELATIONS"
					AEMP(I, K, K) = 0!
					GOTO 32
				END IF
				IF (J = K) THEN
					AEMP(I, K, J) = SQR(1! - DUM)
					GOTO 33
				END IF
				IF (METYES(J) = 0) THEN
					GOTO 33
				END IF
				JM1 = J - 1
				DEE = 0!
				FOR L = 1 TO JM1
					DEE = DEE + AEMP(I, K, L) * AEMP(I, J, L)
				NEXT L
				DEE = R(K, J) - DEE
				IF (AEMP(I, J, J) > 0!) THEN
					AEMP(I, K, J) = DEE / AEMP(I, J, J)
				ELSE
					AEMP(I, K, J) = 0!
				END IF
33                      NEXT J
32              NEXT K
		FOR K = 1 TO IC
			FOR J = 1 TO IC
				DUM = 0!
				FOR L = 1 TO IC
					DUM = DUM + AEMP(I, J, L) * AEMP(I, K, L)
				NEXT L
				IF (METYES(J) = 0 OR METYES(K) = 0) THEN
					GOTO 44
				END IF
			NEXT J
44              NEXT K
	NEXT I
	INFOC = NUMCOM
	PRINT #2, NSUITE, NUMCOM
	PRINT #3, NSUITE, NUMCOM
	FOR I = 1 TO NSUITE
		FOR J = 1 TO IDIST
			FOR K = 1 TO NUMCOM
				PRINT #2, USING "###########.#####"; FEMP(I, J, K);
				PRINT #3, USING "###########.#####"; FEMP(I, J, K);
			NEXT K
			PRINT #2,
			PRINT #3,
		NEXT J
		FOR J = 1 TO NUMCOM
			FOR K = 1 TO NUMCOM
				PRINT #2, USING "###########.#####"; AEMP(I, J, K);
				PRINT #3, USING "###########.#####"; AEMP(I, J, K);
			NEXT K
			PRINT #2,
			PRINT #3,
		NEXT J
		PRINT #2, USING "###########.#####"; SPROB(I)
		PRINT #3, USING "###########.#####"; SPROB(I)
	NEXT I
	CLOSE #2
	ETIME = TIMER - STIME
	PRINT #3, "FINISHED AT "; TIME$
	PRINT #3, "ELAPSED TIME(SECONDS)= "; ETIME
	PRINT "FINISHED AT "; TIME$
	PRINT "ELAPSED TIME(SECONDS)= "; ETIME
	CLOSE #3
END

'ERROR ROUTINE FOR OPENING FILES
9876    ECODE% = 1
	RESUME NEXT

SUB EMPCOR (PROD, RHO) STATIC
'     THIS WILL FIND THE CORRELATION BETWEEN TWO DISTRIBUTIONS
'     THAT WILL GIVE A SPECIFIED MEAN PRODUCT
	NGRID = 100
      LESS = NGRID - 1
      GRID = NGRID
	RGRIDSQ = 1! / (GRID * GRID)
      XX = .5 * (1! / GRID)
      CRES = 1! / GRID
	FOR I = 1 TO NGRID
	      CALL NORVALE(XX, ZEMP(I))
	      XX = XX + CRES
	NEXT I
	BESTVAL = 9999.9
      TH = 3.14159 / 4!
      TL = -3.14159 / 4!
	LOOPC = 0
L2:     T = (TH + TL) / 2!
	A1 = COS(T)
	A2 = SIN(T)
	RHO = SIN(2! * T)
	TEST = 0!
	FOR I = 1 TO NGRID
		TS1 = A1 * ZEMP(I)
		TS2 = A2 * ZEMP(I)
		FOR J = 1 TO NGRID
		      Z1 = TS1 + A2 * ZEMP(J)
		      Z2 = TS2 + A1 * ZEMP(J)
		      CALL NORPROBE(XX, Z1)
		      CALL NORPROBE(YY, Z2)
		      CALL EMPVAL(XX, AA(), V1)
		      CALL EMPVAL(YY, BB(), V2)
		      TEST = TEST + V1 * V2
		NEXT J
	NEXT I
	TEST = TEST * RGRIDSQ
	SELECT CASE TEST
		CASE IS > PROD
			TH = T
		CASE IS < PROD
			TL = T
		CASE ELSE
			EXIT SUB
	END SELECT
	DCHG = ABS(TEST - PROD)
	PCHG = 100! * (DCHG / PROD)
	IF PCHG < BESTVAL THEN
		SAVERHO = RHO
		BESTVAL = PCHG
	END IF
	LOOPC = LOOPC + 1
	IF (LOOPC <= 15) THEN
		GOTO L2
	END IF
L3:
	RHO = SAVERHO
END SUB

SUB EMPDIST STATIC
'     THIS ROUTINE CALCULATES DISTRIBUTIONS OF GRADES AND
'     TONNAGES THAT APPROXIMATE THE EMPIRICAL AND HAVE THE
'     SAME MEANS.  THE DISTRIBUTIONS ARE PIECEWISE LINEAR
'     AND SPECIFIED AT IDIST POINTS.
	FOR I = 1 TO NSUITE
		FOR J = 1 TO IC
			RANGE = 1.5
			TRUE = 0!
			TOP = 0!
			BOT = 10! ^ 11!
			SIZE = JSUITE(I) - ISUITE(I) + 1!
			FOR K = ISUITE(I) TO JSUITE(I)
				TRUE = TRUE + DEMP(K, J)
				IF (DEMP(K, J) > TOP) THEN
					TOP = DEMP(K, J)
				END IF
				IF (DEMP(K, J) < BOT) THEN
					BOT = DEMP(K, J)
				END IF
			NEXT K
			TOP = TOP * RANGE
			BOT = BOT * (1! - (RANGE - 1!))
			TRUE = TRUE / SIZE
			IF TRUE <= 0! THEN
				FOR K = 1 TO IDIST
				      FEMP(I, K, J) = 0!
				NEXT K
				GOTO 2
			END IF
4                       KSTOP = IDIST - 1
			FOR K = 1 TO KSTOP
				LOOPV = 0
				XH = TOP
				XL = BOT
9                               XT = (XH + XL) / 2!
				VALV = 0!
				LOOPV = LOOPV + 1
				IF (LOOPV > 46) THEN
					GOTO 10
				END IF
				FOR I7 = ISUITE(I) TO JSUITE(I)
					RANGE = 1.5
					IF (J > 1) THEN
						RANGE = 1.5 - .5 * DEMP(I7, J) / 100!
					END IF
					TEST = RANGE * DEMP(I7, J)
					BEST = (1! - (RANGE - 1!)) * DEMP(I7, J)
					IF XT > BEST THEN
						IF XT <= TEST THEN
							VALV = VALV + (XT - BEST) / (TEST - BEST) * (1! / SIZE)
						ELSE
							VALV = VALV + 1! / SIZE
						END IF
					END IF
				NEXT I7
				IF (VALV >= PVAL(K)) THEN
					XH = XT
				END IF
				IF (VALV <= PVAL(K)) THEN
					XL = XT
				END IF
				GOTO 9
10                              FEMP(I, K, J) = XT
			NEXT K
			KSTOP = IDIST - 1
			AVG = 0!
			XINT = IDIST - 1
			FOR K = 1 TO KSTOP
				FAC = 1! / XINT
				IF (K = 1) THEN
					FAC = FAC / 2!
				END IF
				AVG = AVG + FAC * FEMP(I, K, J)
			NEXT K
			FEMP(I, IDIST, J) = (XINT * 2!) * (TRUE - AVG)
			IF (FEMP(I, IDIST, J) <= FEMP(I, IDIST - 1, J)) THEN
				DIFF = FEMP(I, IDIST - 1, J) - FEMP(I, IDIST, J)
				FEMP(I, IDIST, J) = FEMP(I, IDIST - 1, J)
				FEMP(I, IDIST - 1, J) = FEMP(I, IDIST - 1, J) - DIFF / 2!
				IF (FEMP(I, IDIST - 1, J) <= FEMP(I, IDIST - 2, J)) THEN
					PRINT #3, "EMPDIST ERROR: "; I, J, FEMP(I, IDIST - 2, J); FEMP(I, IDIST - 1, J)
				END IF
			END IF
2               NEXT J
	NEXT I
END SUB

SUB EMPVAL (PROB, CC(), 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
	IST = INT(PROB / DELEMP) + 1
	IF IST < 2 THEN
		IST = 2
	END IF
	FOR I = IST TO IDIST
		IF (PROB <= PVAL(I)) THEN
			AEMP = PVAL(I) - PROB
			AEMP = AEMP / (PVAL(I) - PVAL(I - 1))
			VALV = AEMP * CC(I - 1) + (1! - AEMP) * 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
	IST = (VALV - XNORE(2, 1)) / DELNOR
	IF IST <= 0 THEN
		IST = 1
	END IF
	FOR I = IST 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 PARSELINE (X$, SEP$, A$(), CNT%) STATIC
	CNT% = 0
	T$ = X$
	FOR I% = LBOUND(A$) TO UBOUND(A$)
		CALL PARSEWORD(T$, SEP$, A$(I%))
		IF A$(I%) = "" THEN
			CNT% = I% - 1
			EXIT FOR
		END IF
	NEXT I%
	T$ = ""
END SUB

SUB PARSEWORD (A$, SEP$, WORD$) STATIC
	WORD$ = ""
	LENA% = LEN(A$)
	IF A$ = "" THEN
		EXIT SUB
	END IF
	FOR I% = 1 TO LENA%
		IF INSTR(SEP$, MID$(A$, I%, 1)) = 0 THEN
			EXIT FOR
		END IF
	NEXT I%
	FOR J% = I% TO LENA%
		IF INSTR(SEP$, MID$(A$, J%, 1)) THEN
			EXIT FOR
		END IF
	NEXT J%
	FOR K% = J% TO LENA%
		IF INSTR(SEP$, MID$(A$, K%, 1)) = 0 THEN
			EXIT FOR
		END IF
	NEXT K%
	IF I% > LENA% THEN
		A$ = ""
		EXIT SUB
	END IF
	IF J% > LENA% THEN
		WORD$ = MID$(A$, I%)
		A$ = ""
		EXIT SUB
	END IF
	WORD$ = MID$(A$, I%, J% - I%)
	IF K% > LENA% THEN
		A$ = ""
	ELSE
		A$ = MID$(A$, K%)
	END IF
END SUB

SUB SORTD (N11, ICP1) STATIC
'     THIS SORTS THE ROWS OF THE DATA MATRIX DEMP() ON THE LAST
'     COLUMN, THE SUITE INDEX
      ISTART = N11
3 ISWITCH = 0
	FOR I = 2 TO ISTART
		IF (DEMP(I - 1, ICP1) < DEMP(I, ICP1)) THEN
			FOR J = 1 TO ICP1
				SWAP DEMP(I, J), DEMP(I - 1, J)
			NEXT J
			ISWITCH = ISWITCH + 1
		END IF
	NEXT I
	ISTART = ISTART - 1
	IF (ISWITCH <> 0 AND ISTART >= 2) THEN
		GOTO 3
	END IF
END SUB