5	! ******************* WESS3 ************************
	! **  WRIST VERSION OF LESS3, FEBRUARY, 1975      **
10	! **  FROM LOUISVILLE EXP SIMULATION SYSTEM       **
15	! **  WABASH COLLEGE: P. SPELT & J. WARDEN        **
20	! **************************************************
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)
70	U=Q(D(9),D(10)) : IF U<0 OR U>6 THEN U=0
75	U$="  ###  ########.##"
77	U1$=";!  ###  !" : U2$="!########.##!"
80 RANDOMIZE
90	C0$=CHR$(10%) : A0$=A1$(0%)
100 GOTO 2000
500 !*****SUBROUTINE TO RANDOMIZE*****
510 IF N(3)=0 THEN 800
520 FOR P1=N(1)+N(2)+1 TO N
530 IF S(P1)<>0 THEN 600
540 P3=RND(1)
550 IF R4>1 THEN 690
560 L1=1
570 L2=7+N(1)+N(2)+N(3)+N(5)+N(6)+N(7)+2*P1
580 GOSUB 1100
590 I(P1)=Q(1,L2-1)+P3*(Q(L1,L2)-Q(L1,L2-1))
600 IF R4<=1 THEN 700
610 FOR P4=1 TO R4
620 IF Q(D(1),D(2)+P4+1)<S(P1) THEN 650
630 I(P1)=P4
640 GOTO 800
650 NEXT P4
660 &"DISCRETIZATION ERROR IN CVV<>";P1
670 X(4)=1
680 GOTO 800
690 FOR P4=1TOR4
700 L1=D(3)
710 L2=D(4)+P4
720 GOSUB 1100
730 IF Q(L1,L2)<P3 THEN 760
740 I(P1)=P4
750 GOTO 790
760 NEXT P4
770 &"DISCRETE DRAW ERROR IN CVV<>";P1
780 X(4)=1
790 NEXT P1
800 RETURN
1000	! GAUSS: MEAN=P9   STD.DEV.=P4   VALUE=P3
1010	P3=P4*SQR(-2.*LOG(RND))*COS(6.28318*RND) + P9
1060	RETURN
1100  !  SUBROUTINE TO CORRECT L1 & L2 (ROW & COLUMN INDICES).
1110 IF L2>128 THEN L2=L2-128 : L1=L1+1 : GO TO 1110
1150 RETURN
2000 !*****IMPRINTING MODEL--MODIFIED FROM UNIVERSITY OF MICHIGAN
	! FORTRAN PROGRAM BY A. CROMER OF U. OF LOUISVILLE,
	! TRANSLATED INTO BASIC PLUS BY J.A.WARDEN & P.F.SPELT
	! VERSION OF FEBRUARY, 1975.
2050 IF S(6)<>1 THEN 2110
2060 IF S(7)>2 THEN 2110
2070 &"HOW DOES ONE MECHANICALLY LOWER AROUSAL LEVEL?  BETTER TRY
2080 &"PHARMACOLOGICAL MEANS."
2090 X(4)=1
2100 GOTO 2680
2110 T0$="RESULTS (PROXIMITY SCORES FOR EACH SUBJECT)" : GOSUB 3990
2120 D8=1
2130 R4=6
2140 FOR L=1 TO S(1)
2150 GOSUB 510
2160 IF X(4)>0 THEN 2680
2170 L1=D(9)
2180 L2=D(10)+24+(S(7)-1)*6+I(8)
2190 GOSUB 1100
2200 O1=Q(L1,L2)
2210 P9=0
2220 P4=(2-ABS(O1-10)/10)*Q(1,31)
2230 GOSUB 1000
2240 O1=O1+P3
2250 IF O1<=20 THEN 2270
2260 O1=20
2270 IF O1>0 THEN 2290
2280 O1=0
2290 P4=D8
2300 GOSUB 1000
2310 L1=D(9)
2320 L2=D(10)+S(2)
2330 GOSUB 1100
2340 O1=O1*Q(L1,L2)
2350 L1=D(9)
2360 L2=D(10)+8+S(5)
2370 GOSUB 1100
2380 O1=O1+Q(L1,L2)+P3
2390 IF O1<=0 THEN O1=ABS(RND/10)
2420 P5=P5+O1
2430 P6=P6+O1^2
2440 PRINT USING U$,L,O1
2445 T0$=U1$+CVTF$(L) : GOSUB 4000 : T0$=U2$+CVTF$(O1) :
	GOSUB 4000
2450 NEXT L
2470 L1=D(7)
2480 L2=D(8)+8+S(5)
2490 GOSUB 1100
2500 O1=Q(L1,L2)
2510 L1=D(7)
2520 L2=D(8)+2+S(3)
2530 GOSUB 1100
2540 O1=O1*(40+Q(L1,L2))
2550 L1=D(7)
2560 L2=D(8)+S(2)
2570 GOSUB 1100
2580 P1=Q(L1,L2)
2590 L1=D(7)
2600 L2=D(8)+18+I(8)
2610 GOSUB 1100
2620 P1=P1*Q(L1,L2)
2630 L1=D(7)
2640 L2=D(8)+13+S(7)
2650 GOSUB 1100
2660 O1=O1+S(1)*(P1+Q(L1,L2))
2670 T0$=C0$+"THE COST FOR THIS RUN IS"+NUM$(INT(O1))+"POINTS." :
	GOSUB 3990
2680	!BACK TO WESS
2690 	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
2700	CLOSE 1%,2%,3% : PRINT"." : PRINT
2710	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