5	! ******************* WESS2 ************************
	! ** WRIST VERSION OF LESS2, FEBRUARY, 1975       **
10	! **  FROM LOUISVILLE EXP SIMULATION SYSTEM       **
15	! **  WABASH COLLEGE: P. SPELT & J. WARDEN        **
20	! **************************************************
25	!OTHER PROGRAMS CHAIN HERE
30 O$=SYS(CHR$(7%))
35 OPEN O$ FOR INPUT AS FILE 1%
40 DIM #1%,X%(48),A9(1),A1$(5)=128,A2$(24,4)=128,D2(24,12),X2(24,384)
45 !       \-----ID RECORD ------/ \-----24 MODEL RECORDS-----------/
50	CHANGE SYS(CHR$(6%)+CHR$(9%)) TO M% :
	O2$="WESS"+CHR$(65%+M%(2%)/2%)+".TMP" :
	OPEN O2$ AS FILE 2%
55 DIM #2%,A3$(4)=128,Q(3,128),I(27),S(27),X(48),O(27),D(12),N(10),
	P(10),K(20),V(20),T$(500)=64
60	X9=V(1) : Q0=V(2) : P5=V(3) : P6=V(4) : D2=V(5) :
	Q2=V(6) : M2=V(7) : N=V(8) : A8=V(9) : A9=V(10) :
	J=V(11)
62	IF T$(0%)="BACKUP" THEN O3%=-1%
65 DIM T1(10,50),A(10),B(24,2),M%(30)
75	U$="  ###  #######.#"
77	U1$=";!  ###  !" : U2$="!#######.#!"
80 RANDOMIZE
90	C0$=CHR$(10%) : A0$=A1$(0%)
300 GOTO 2000
1000  REM GAUSS - MEAN=P5,  STD. DEV.=P4,  VALUE=P3
1010	P3=P4*SQR(-2.*LOG(RND))*COS(6.28318*RND)+P9
1050	RETURN
1100  REM SUBROUTINE TO CORRECT L1 & L2 (ROW & COLUMN INDICES)
1110  IF L2>128 THEN L2=L2-128 : L1=L1+1 : GO TO 1110
1150  RETURN
1500  ! SUBROUTINE TO CALCULATE "X" EFFECT
1510  !FUNCTION B DEFINES Y GIVEN X FOR GAUSSIAN DISTRIBUTION
1520  !Y=1/SQR(2*3.14159*.1667^2)*EXP(-.5(KO-.5)^2/.1667^2)
1530 DEF FNB(K0)=2.39365*EXP(-18*(K0-.5)^2)
1540 IFS(V9)>0 THEN1570
1550 I(V9)=RND(1)*V7
1560 GO TO 1930
1570 I(V9)=0
1580 H3=1
1590 IF K(1)=0 THEN 1900
1600 IF K(1)>4 THEN 1740
1610 IF K(1) <> 1 THEN 1650
1620 IF K(11)<.5 THEN 1930
1630 I(V9)=K(11)*V7*H3
1640 GO TO 1930
1650 IF K(1) <> 2 THEN 1680
1660 I(V9)=-V7+K(11)*2*V7
1670 GO TO 1930
1680IF K(1) <> 3 THEN 1710
1690 H3=-1
1700 GO TO 1620
1710 IF K(1) <> 4 THEN 1920
1720 I(V9)=V7-K(11)*2*V7
1730 GO TO 1930
1740 IF K(1)>6 THEN 1810
1750 IF K(1) <> 5 THEN 1780
1760 I(V9)=FNB(K(11))*.45*V7*H3
1770 GO TO 1930
1780 IF K(1) <> 6 THEN 1920
1790 H3=-1
1800 GO TO 1760
1810 IF K(1) <> 7 THEN 1840
1820 I(V9)=K(11)^4*V7*2*H3
1830 GO TO 1930
1840 IF K(1) <> 8 THEN 1870
1850 I(V9)=2*H3*(V7-(1-K(11))^4*V7)
1860 GO TO 1930
1870 IF K(1) <> 9 THEN 1920
1880 H3=-1
1890 GO TO 1820
1900 H3=-1
1910 GO TO 1850
1920 PRINT "ERROR IN X ROUTINE"
1930 I(V9)=I(V9)+V8
1940 RETURN		!
--------------------------------------------------------------
2000 !	PROGRAM SEGMENT CONTAINING OBESITY MODEL.
	 THIS MODEL ORIGINATED BY JOHN THURMOND AND PROGRAMMED
	 BY ARTHUR CROMER AT THE UNIVERSITY OF LOUISVILLE.
	VERSION OF JULY 1, 1974
2040 T0$=C0$+"  SUBJ   AMOUNT EATEN (IN GRAMS)"+C0$ :
	GOSUB 3990
2050 MAT I=ZER(7)
2060 FOR L=1 TO S(1)
2070 L1=D(9)
2080 L2=D(10)+4+(I(5)-1)*2+S(2)
2090 GO SUB 1100
2100 O1=Q(L1,L2)
2110 L1=D(9)
2120 L2=D(10)+12+(S(6)-1)*2+S(2)
2130 GO SUB 1100
2140 O1=O1+Q(L1,L2)
2150 L1=D(9)
2160 L2=D(10)+S(3)
2170 GO SUB 1100
2180 O2=Q(L1,L2)
2190 L1=D(9)
2200 L2=D(10)+S(4)+2
2210 GO SUB 1100
2220 O2=O2*Q(L1,L2)
2230 V8=16
2240 V7=4
2250 GOSUB 1500
2255 O1=O1+I(7)
2260 O1=O1*O2
2270 O1=O1+V8
2280 P9=100 : P4=6	! MEAN,S.D.
2300 IF S(3)=2 THEN 2320
2310 P4=P4*O1/10
2320 GO SUB 1000
2330 O2= O1+P3
2340 IF O2>0 THEN 2360
2350 O2 = ABS(RND(1)/100)
2360 P5=P5+O2
2370 P6=P6+O2^2
2380 PRINT USING U$,L,O2
2385 T0$=U1$+CVTF$(L) : GOSUB 4000 : T0$=U2$+CVTF$(O2) :
	GOSUB 4000
2390 NEXT L
2400 L1=D(5)
2410 L2=D(6)+2+S(3)
2420 GO SUB 1100
2430 O1=Q(L1,L2)
2440 L1=D(5)
2450 L2=D(6)+4+S(4)
2460 GO SUB 1100
2470 O1=O1+Q(L1,L2)
2480 IF S(2) <> 2 THEN 2500
2490 O1=O1+2
2500 IF S(5) < 3 THEN 2520
2510 O1=O1+1
2520 IF S(7)=0 THEN 2540
2530 O1=O1+5
2540 O1=50+S(1)*O1
2550 T0$=C0$+"COST FOR THIS RUN IS"+NUM$(INT(O1))+"POINTS" :
	GOSUB 3990
2560   !BACK TO WESS
2570	V(1)=X9 : V(2)=Q0 : V(3)=P5 : V(4)=P6 : V(5)=D2 : V(6)=Q2 :
	V(7)=M2 : V(8)=N : V(9)=A8 : V(10)=A9 : V(11)=J
2580 CLOSE 1%,2%,3% : &"." : &
2590 O$=SYS(CHR$(8%)+O$+"!2000") : CHAIN A0$+"WESS" 14
3990	PRINT T0$
4000	IF O3% THEN V(0)=V(0)+1 : T$(V(0))=T0$
4010	RETURN
9999 END