Listing of file='FCST020A' on disk='vmedia/701-2663.wvd.zip'
# Sector 24, program filename = 'FCST020A'
0010 REM FCST020A, RELEASE 1-0, (12/05/78), THIS PROGRAM IS A COPYRIGHT PRODUC
T OF WANG LABORATORIES., UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED,
FORECASTING,DATE, ORDER POINT ADJ. ROUTINES
0780 DIM A3$1,A4$1,B$1,B0$1,C2$4,C3$4,C4$4,P$1,P(13)
: DIM C6$4,P7$4,P8$4,P9$4,C6$(21)2,C7$(21)1,P6$(14)2,P7$(1)2
0840 DEFFN'181(P9$)
: CONVERT STR(P9$,1,2)TO P9
: UNPACK(####)STR(P6$(P9),1,2)TO P9
: IF P$="D"THEN 900
: P9=P9+(VAL(STR(P9$,3,1))-49)*7+VAL(STR(P9$,4,1))-48
: RETURN
0900 CONVERT STR(P9$,3,2)TO P6
: P9=P9+P6
: RETURN
0940 DEFFN'182(P9)
: P9=P9-INT((P9-1)/P1)*P1
: PACK(####)P9$FROMP9
: MAT SEARCHP6$()<1,P*2+2>,>=STR(P9$,1,2)TO P7$()STEP 2
: P6=(VAL(STR(P7$(1),2))-1)/2
: UNPACK(####)STR(P6$(P6),1,2)TO P7
: CONVERT P6TO P9$,(##)
: P7=P9-P7
: IF P$="D"THEN 1110
: P6=INT((P7+6)/7)
: CONVERT P6TO STR(P9$,3,1),(#)
: CONVERT P7-(P6-1)*7TO STR(P9$,4,1),(#)
: RETURN
1110 CONVERT P7TO STR(P9$,3,2),(##)
: RETURN
1140 DEFFN'183(P7$,P8)
: GOSUB '181(P7$)
: GOSUB '182(P9+P8)
: P8$=P9$
: RETURN
1200 DEFFN'184(P7$,P8$)
: GOSUB '181(P7$)
: P8=P9
: GOSUB '181(P8$)
: P8=P9-P8
: P8=P8+P1*(1-SGN(P8+.5))*.5
: RETURN
1330 DEFFN'170(F9,C3$,C4$)
: GOSUB '184(C3$,C4$)
: F6=P8+1
1380 DEFFN'171(F9,C3$,F6)
: F8,E8,G6=0
: GOSUB '181(C3$)
: CONVERT STR(C3$,1,2)TO F7
: UNPACK(####)P6$(F7+1)TO E6
: IF F9<0THEN 1550
: IF A4$<>"F"THEN 1550
: G6=D1
: IF ABS(D1)<B2THEN 1550
: G6=B2*SGN(D1)
: GOTO 1550
1530 E6=E6+P(F7)
1550 E7=E6-P9+1
: F6=F6-E7
: IF F6>0THEN 1600
: E6=E6+F6
: E7=E7+F6
1600 P9=P9+E7
: E7=E7/P(F7)
: E8=E8+E7
: IF G6>=0THEN 1760
: IF G6*(F9+E8)>=-1THEN 1760
: P9=E8
: E8=-1/G6-F9
: E7=E7-(P9-E8)
: IF F6<=0THEN 1760
: E6=E6+F6
: F6=0
1720 IF E6<=P1THEN 1760
: E6=E6-P1
: GOTO 1720
1760 F8=F8+B(F7)*E7
: IF F6<=0THEN 1850
: F7=F7+1
: IF F7<=PTHEN 1530
: P9,F7=1
: E6=0
: GOTO 1530
1850 GOSUB '182(E6+1)
: C3$=P9$
: F6=D*F8*(1+G6*F9+.5*G6*E8)
: IF F6>0THEN 1920
: F6=0
1920 F7=D0*F8^D5
: RETURN
1970 DEFFN'175
: B$=" "
: B9=0
: IF B0$="N"THEN 2040
: IF B0>0THEN 2100
2040 IF C1<=0THEN 2100
: GOSUB '183(C2$,-C1*7)
: GOSUB '171(0,P8$,C1*7)
: B9=.5*F8*D
2100 B0$="Y"
: IF B0>0THEN 2150
: B0$="N"
2150 IF A3$="S"THEN 2280
: IF A3$="F"THEN 2280
: IF A3$="W"THEN 2720
: IF A3$="M"THEN 2920
: B$="I"
: RETURN
2280 GOSUB '171(0,C2$,C1*3.5+C3)
: B6=F6
: C6=F7
: GOSUB '171(0,C2$,C3)
: B7=F6
: GOSUB '171(E8,C3$,C2*7)
: B7=B7+F6
: IF A3$="S"THEN 2490
: IF B4>0THEN 2440
: B4=1
2440 C7=F6+.5*B4
: IF C7>B4THEN 2540
: C7=B4
: GOTO 2540
2490 C7=F6
: IF C7=0THEN 2540
: IF C7>B5THEN 2540
: C7=B5
2540 GOSUB '177
: C6=C6*C8
: IF C6>D2THEN 2610
: C6=D2
2610 B6=B6+C6
: B7=B7+C6
2650 IF B7>B6THEN 2670
: B7=B6+1
2670 GOSUB '176
: RETURN
2720 GOSUB '171(0,C2$,(C1+D3)*7)
: B6=F6
: C6=D3+C1-.143*C3
: IF C6>=0THEN 2790
: B$="L"
2790 C6=(C6/(C1+D3))*B6
: IF D2<C6THEN 2830
: B6=B6+D2-C6
2830 GOSUB '183(C2$,C3)
: GOSUB '171(C3/30,P8$,C2*7)
: B7=B6+F6
: GOTO 2650
2920 B6=D3
: B7=D4
: GOTO 2650
2990 DEFFN'177
: IF C7*C6=0THEN 3110
: C7=C7/C6*(1-C5)
: IF C7>=.5THEN 3110
: PACK(.####)C6$FROMC7
: MAT SEARCHC6$(),>STR(C6$,1,2)TO P7$()STEP 2
: C9=(VAL(STR(P7$(1),2))+1)/2
: IF C9>1THEN 3140
3110 C8=0
: RETURN
3140 UNPACK(.####)C6$(C9-1)TO D6
: UNPACK(.####)C6$(C9)TO D8
: UNPACK(#.#)C7$(C9-1)TO D7
: UNPACK(#.#)C7$(C9)TO D9
: C8=(D9-D7)/(D8-D6)*(C7-D6)+D7
: RETURN
3230 DEFFN'176
: B8=0
: IF B0+B1>B6THEN 3390
: B8=B7-B0-B1
: IF A3$="F"THEN 3350
: IF B8>B5THEN 3380
: B8=B5
: GOTO 3380
3350 IF B4>=B8THEN 3380
: B$="M"
3380 B8=-INT(-B8/B4)*B4
3390 RETURN
3420 DEFFN'179
: GOSUB '180
: A3$="S"
: A4$="F"
: C1=1
: C2=4
: C3=28
: D3=4
: D4=8
: B4=1
: B5=1
: C5=.95
: B2=.1
: D5=.5
: FOR E9=0TO 20
: PACK(#.#)C7$(21-E9)FROME9*.2
: NEXT E9
3720 PACK(.####)C6$()FROM0,.0004,.0009,.0015,.0023,.0035,.0056,.0088,.0134,.01
99,.0294,.0425,.06,.0829,.1131,.151,.1985,.2561,.3252,.4062,.5
: RETURN
3760 DEFFN'180
: P=12
: P$="D"
: P(1)=31
: P(2)=28
: P(3)=31
: P(4)=30
: P(5)=31
: P(6)=30
: P(7)=31
: P(8)=31
: P(9)=30
: P(10)=31
: P(11)=30
: P(12)=31
: P(13)=00
: P1=0
: FOR P6=1TO P
: PACK(####)P6$(P6)FROMP1
: P1=P1+P(P6)
: NEXT P6
: PACK(####)P6$(P+1)FROMP1
: RETURN