Trailing-Edge
-
PDP-10 Archives
-
decus_20tap1_198111
-
decus/20-0025/sixcur.bas
There are 2 other files named sixcur.bas in the archive. Click here to see a list.
00010 DIMA(6),B(6),C(7),X(180),Y(180),U(180),V(180),Z(6)
00012 LET I=0
00015 LETC(0)=-2
00020 LET T1=0
00025 LET T2=0
00030 LET T3=0
00035 LET M=0
00040 LET A2=0
00045 LET A3=0
00050 LETB2=0
00055 LETB3=0
00065 LET I=0
00070 FORK=1TO6
00075 LETZ(K)=0
00080 NEXTK
00085 LETI=I+1
00090 READX(I),Y(I)
00100 GO TO 1990
00150 DATA 1E37,1E37
00151 IFX(I)<>1E37THEN 85
00152 IFY(I)<>1E37THEN 85
00153 LETN=I-1
00154 FORI=1TON
00155 LETT1=T1+X(I)
00156 LETT2=T2+Y(I)
00157 LETT3=T3+Y(I)^2
00160 IFX(I)<>0THEN 175
00165 LETA2=A2+1
00170 GOTO 180
00175 LETA2=A2
00180 IFX(I)>=0THEN 195
00185 LETA3=A3+1
00190 GOTO 200
00195 LETA3=A3
00200 IFY(I)<>0THEN 220
00205 LETB2=B2+1
00210 GOTO 225
00220 LETB2=B2
00225 IFY(I)>=0THEN 240
00230 LETB3=B3+1
00235 GOTO 241
00240 LETB3=B3
00241 NEXTI
00245 FORI=1TON-1
00250 FORJ=I+1TON
00255 IFX(I)<=X(J)THEN 295
00260 LETP=X(I)
00265 LET Q=Y(I)
00270 LETX(I)=X(J)
00275 LETY(I)=Y(J)
00280 LETX(J)=P
00285 LETY(J)=Q
00290 NEXTJ
00295 NEXTI
00300 IFA2<=0THEN 320
00305 LETZ(3)=-1
00310 LETZ(4)=-1
00315 LETZ(6)=-1
00320 IFA3<=0THEN 330
00325 LETZ(3)=-1
00330 IFB2<=0THEN 355
00335 LETZ(2)=-1
00340 LETZ(3)=-1
00345 LETZ(5)=-1
00350 LETZ(6)=-1
00355 IFB3<=0THEN 370
00360 LETZ(2)=-1
00365 LETZ(3)=-1
00370 PRINT
00375 PRINT"LEAST SQUARES FIT OF SIX CURVE TYPES:"
00380 PRINT
00385 PRINT"NUMBER"," CURVE"," INDEX"," A"," B"
00390 PRINT
00395 LETR2=C(0)
00400 LETX2=T1/N
00405 LETY4=T2/N
00410 FORK=1TO6
00415 PRINTK,
00420 GOSUB 1000
00425 IFK<>1THEN 435
00430 PRINT"Y=A+B*X",
00431 GOTO 485
00435 IFK<>2THEN 445
00440 PRINT"Y=A*EXP(B*X)",
00441 GOTO 485
00445 IFK<>3THEN 455
00450 PRINT"Y=A*(X^B)",
00451 GOTO 485
00455 IFK<>4THEN 465
00460 PRINT"Y=A+(B/X)",
00461 GOTO 485
00465 IFK<>5THEN 475
00470 PRINT"Y=1/(A+B*X)",
00471 GOTO 485
00475 IFK<>6THEN 485
00480 PRINT"Y=X/(A*X+B)",
00485 IFZ(K)<0THEN 520
00490 IFL3<>0THEN 505
00495 LETA(K)=EXP(A(K))
00500 GOTO 510
00505 LETA(K)=A(K)
00510 PRINT,C(K),A(K),B(K)
00511 NEXTK
00515 GOTO 525
00520 PRINT"CAN'T FIT....SOME DATA IS ZERO OR NEGATIVE"
00525 PRINT
00530 PRINT"FOR WHICH CURVE ARE DETAILS DESIRED (NUMBER) ";
00535 INPUT M
00536 IF M= 0 GO TO 1999
00540 IFM>0 THEN 545
00541 GO TO 550
00545 IFM<7THEN 565
00550 PRINT
00555 PRINT"....ANSWER 1,2,3,4,5, OR 6...."
00560 GOTO 530
00565 IFZ(M)>=0THEN 590
00570 PRINT
00575 PRINT"....THAT CURVE HAS NOT BEEN FITTED....TRY ANOTHER?"
00580 PRINT
00585 GOTO 530
00590 LETK=M
00595 GOSUB 1000
00600 LETM=K
00605 LETS8=SQR((D2-B1*D3)/(N*(N-2)))
00610 LETS9=S8/SQR(D1/N)
00615 LETS6=S8/SQR(N)
00620 LETT4=1.95996+2.37226/(N-2)+2.8225/((N-2)^2)
00625 LETP=T4*S6
00630 LETQ=T4*S9
00635 LETA2=A1-P
00640 LETA3=A1+P
00645 LETB2=B1-Q
00650 LETB3=B1+Q
00655 IFL3<>0THEN 675
00660 LETA1=EXP(A1)
00665 LETA2=EXP(A2)
00670 LETA3=EXP(A3)
00675 PRINT
00680 PRINT"RESULTS FOR THE SELECTED CURVE ARE:"
00685 PRINT
00690 PRINT"COEFFICIENTS:"
00695 PRINT
00700 PRINT" EXPECTED VALUE 95 PCT CONFIDENCE LIMITS"
00705 PRINT
00710 PRINT" A:",A1,A2,A3
00715 PRINT" B:",B1,B2,B3
00720 PRINT
00725 PRINT"MEAN VALUES:"
00730 PRINT
00735 PRINT" XBAR =",X2," YBAR =",Y4
00740 PRINT
00745 PRINT"ESTIMATED VALUE AND CONFIDENCE LIMITS FOR:"
00750 PRINT"THE INDIVIDUAL VALUE OF Y FOR EACH X:"
00755 PRINT
00760 PRINT"X-ACTUAL","Y-ACTUAL","Y-ESTIM","95 PCT CONFIDENCE LIMITS"
00765 PRINT
00770 FORI=1TON
00775 LETT=U(I)
00780 GOSUB 1500
00785 LETU(I)=T
00790 PRINTX(I),Y(I),P,Y2,Y3
00795 NEXTI
00799 PRINT
00800 GO TO 530
00815 DATA 9E37
00820 PRINT"CALCULATED VALUES OF Y FOR EXTRA X'S SUPPLIED:"
00825 PRINT
00830 PRINT"X-EXTRA"," ","Y-ESTIM","95 PCT CONFIDENCE LIMITS"
00835 PRINT
00840 READT1
00845 IFT1<>9E37THEN 870
00850 RESTORE
00854 FOR I=1 TO N+1
00855 READX(I),Y(I)
00856 NEXT I
00860 PRINT
00865 GOTO 530
00870 IFM<>3THEN 885
00875 LETR2=LOG(T1)
00880 GOTO 905
00885 IFL1=0THEN 900
00890 LETR2=T1
00895 GOTO 905
00900 LETR2=1/T1
00905 LETT=R2
00910 GOSUB 1500
00920 PRINTT1," ",P,Y2,Y3
00930 GOTO 840
01000 IFZ(K)>=0THEN 1030
01010 LETC(K)=0
01020 GOTO 1480
01030 LETL1=(K-4)*(K-6)
01040 LETL2=(K-5)*(K-6)
01050 LETL3=(K-2)*(K-3)
01060 LETS1=0
01070 LETS2=0
01080 LETS3=0
01090 LETS4=0
01100 LETS5=0
01110 FORI=1TON
01120 IFL3<>0THEN 1150
01130 LETV(I)=LOG(Y(I))
01140 GOTO 1190
01150 IFL2<>0THEN 1180
01160 LETV(I)=1/Y(I)
01170 GOTO 1190
01180 LETV(I)=Y(I)
01190 IFK<>3THEN 1220
01200 LETU(I)=LOG(X(I))
01210 GOTO 1260
01220 IFL1<>0THEN 1250
01230 LETU(I)=1/X(I)
01240 GOTO 1260
01250 LETU(I)=X(I)
01260 LETS1=S1+U(I)
01270 LETS2=S2+V(I)
01280 LETS3=S3+U(I)^2
01290 LETS4=S4+V(I)^2
01300 LETS5=S5+U(I)*V(I)
01310 NEXTI
01320 LETX1=S1/N
01330 LETY1=S2/N
01340 LETD1=N*S3-S1^2
01350 LETD2=N*S4-S2^2
01360 LETD3=N*S5-S1*S2
01370 LETB1=B(K)
01375 LETB1=D3/D1
01380 LETB(K)=D3/D1
01390 LETA1=A(K)
01395 LET A1=Y1-B1*X1
01400 LETA(K)=Y1-B1*X1
01430 LETS1=0
01440 LETS3=0
01450 FORI=1TON
01452 LETW=Y1+B1*(U(I)-X1)
01454 IFL3<>0THEN 1460
01456 LETW=EXP(W)
01458 GOTO 1466
01460 IFL2<>0THEN 1464
01462 LETW=1/W
01463 GOTO 1466
01464 LETW=W
01466 LETW=Y(I)-W
01468 LETS1=S1+W
01470 LETS3=S3+W^2
01472 NEXTI
01474 LETC(K)=1-(N*S3-S1^2)/(N*T3-T2^2)
01476 IFC(K)>=0THEN 1480
01478 LETC(K)=0
01480 RETURN
01500 LETS7=S8*SQR(1+1/N+((T-X1)^2)/(D1/N))
01510 LETP=Y1+B1*(T-X1)
01520 LETS1=T4*S7
01530 LETY2=P-S1
01540 LETY3=P+S1
01550 IFL3<>0THEN 1590
01560 LETP=EXP(P)
01570 LETY2=EXP(Y2)
01580 LETY3=EXP(Y3)
01590 IFL2<>0THEN 1630
01600 LETP=1/P
01610 LETY2=1/Y2
01620 LETY3=1/Y3
01630 RETURN
01990 PRINT"LIST THE FILE 'SIXEXP*' FOR INSTRUCTIONS ON USING SIXCUR*"
01999 END