Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-06 - 43,50422/cmodb.bas
There are 2 other files named cmodb.bas in the archive. Click here to see a list.
00030 REM CMODB
00150  FILES RFILE1,RFILE2,RFILE3
00200RESTORE#1
00201  INPUT#  1,I1,I2,I3
00235GOSUB 5160
00240IF I3=8 THEN 2990
00250SCRATCH#1
00251  PRINT #  1,11,I2,I3
00260RESTORE#3
00261  INPUT#  3,A,B
00270S6=0
00280L9=0
00320IF A=0 THEN 340
00330L9=1
00340PRINT L$
00350X=0
00380PRINT "            EVALUATION OF A BETA DISTRIBUTION"
00390PRINT
00400PRINT "THIS MODULE ALLOWS YOU TO EXAMINE THE CHARACTERISTICS OF A"
00410PRINT "BETA DISTRIBUTION."
00420GOTO 630
00430PRINT
00440PRINT
00450PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT."
00460PRINT "    1. PERCENTILES"
00470PRINT "    2. HIGHEST DENSITY REGIONS"
00480PRINT "    3. PROBABILITY PI IS LESS THAN SOME VALUE"
00490PRINT "    4. PROBABILITY PI IS BETWEEN TWO VALUES"
00500PRINT "    5. GRAPH OF THE DENSITY FUNCTION"
00510PRINT "    6. EXIT"
00520GOSUB 9000
00530IF O1=6 THEN 2880
00540I=O1
00550GOTO 890
00560PRINT
00570PRINT "REENTER.  INPUT MUST BE 1,2,3,4 OR 5."
00580GOTO 440
00630IF L9=1 THEN 430
00640IF S6=1 THEN 440
00650S6=1
00660PRINT
00710PRINT "INPUT FIRST PARAMETER (A) OF THE BETA DISTRIBUTION.";
00720GOSUB 9000
00730A=O1
00740IF A<1.1 THEN 810
00745IF A>2000 THEN 810
00750PRINT
00760PRINT "INPUT SECOND (B) PARAMETER.";
00770GOSUB 9000
00780B=O1
00790IF B<1.1 THEN 810
00795IF B>2000 THEN 810
00800GOTO 440
00810PRINT "REENTER.  PARAMETERS MUST BE BETWEEN 1.1 AND 2000"
00820PRINT
00830GOTO 710
00890GOSUB 5220
00900IF I=3 THEN 2180
00910IF I=4 THEN 2490
00920IF I=2 THEN 1330
00930IF I=1 THEN 1690
00940IF I=5 THEN 3560
00950GOTO 560
00990PRINT L$
01060PRINT "TYPE THE NUMBER OF THE OPTION YOU WANT."
01070PRINT "      1. FURTHER EVALUATE THIS DISTRIBUTION"
01080IF L9=1 THEN 1180
01090PRINT "      2. EVALUATE ANOTHER BETA DISTRIBUTION"
01100PRINT "      3. EXIT MODULE"
01110PRINT "      ";
01120GOSUB 9000
01130IF O1=1 THEN 1250
01140IF O1=3 THEN 1240
01150IF O1=2 THEN 1270
01160PRINT "REENTER.  INPUT MUST BE 1,2 OR 3."
01170GOTO 1120
01180PRINT "      2. EVALUATE PREDICTIVE DISTRIBUTION."
01185PRINT "      3. EXIT MODULE."
01190GOSUB 9000
01200IF O1=1 THEN 1250
01210IF O1=3 THEN 1240
01211IF O1 <> 2 THEN 1220
01212RESTORE#1
01213IF I2 <> 1 THEN 1215
01214CHAIN "CMODX"
01215IF I2 <> 3 THEN 1217
01216CHAIN "CMODY"
01217CHAIN "CERROR"
01220PRINT "REENTER.  INPUT MUST BE 1,2 OR 3."
01230GOTO 1190
01240CHAIN "RSTRT"
01250S6=1
01260GOTO 1280
01270S6=0
01280PRINT L$
01290GOTO 630
01330PRINT L$
01340PRINT "     OPTION 2: HIGHEST DENSITY REGIONS"
01350PRINT
01360PRINT "TO EXIT ROUTINE TYPE '0' WHEN ASKED FOR INPUT."
01370PRINT "INPUT P% AS NUMBER FROM 5 THROUGH 99."
01380GOSUB 1410
01390GOTO 1500
01400 REM
01410 PRINT"--------------------------------------------------------"
01420M5=A/(A+B)
01430S5=(A*B/((A+B) ** 2*(A+B+1))) **.5
01440PRINT  USING 1450,A,B
01450:BETA          A=####.##       B=####.##
01460:           MEAN=##.##   ST. DEV.=##.####
01470PRINT  USING 1460,M5,S5
01480PRINT"----------------------------------------------------------"
01490RETURN
01500PRINT
01510PRINT "INPUT P%";
01520GOSUB 9000
01530IF O1=0 THEN 990
01540J5=O1/100
01550IF J5<.05 THEN 1610
01560IF J5>.99 THEN 1610
01570GOSUB 7000
01580PRINT  USING 1590,J5*100,J1,J2
01590:                      ##.#% HDR = (##.##   - ##.## )
01600GOTO 1510
01610PRINT
01620PRINT "REENTER.  INPUT MUST BE '0' OR ACCEPTABLE P%."
01630PRINT
01640GOTO 1510
01650REM
01660REM            END OF HDR ROUTINE
01670REM
01680REM **************************************************************
01690PRINT L$
01700PRINT
01710PRINT "          OPTION 1: PERCENTILES"
01720PRINT
01730PRINT "TO EXIT ROUTINE TYPE '0' WHEN ASKED FOR INPUT."
01740PRINT "INPUT PERCENTILES AS NUMBERS FROM.5 THROUGH 99.5."
01750GOSUB 1410
01760PRINT
01770PRINT "INPUT PERCENTILE";
01780GOSUB 9000
01790P1=O1
01800IF P1=0 THEN 990
01810IF P1<.5 THEN 1840
01820IF P1 <= 99.5 THEN 1870
01830PRINT
01840PRINT "REENTER.  INPUT MUST BE 0 OR ACCEPTABLE VALUE."
01850PRINT
01860GOTO 1770
01870GOSUB 5600
02100PRINT  USING 2110,P1,J2
02110:                                 ##.#% =##.##
02130GOTO 1770
02140REM
02150REM        END OF PERCENTILE ROUTINE
02160REM
02170REM ***************************************************
02180PRINT L$
02190PRINT "   OPTION 3: PROBABILITY PI IS LESS THAN X"
02200PRINT
02210PRINT "TO EXIT ROUTINE TYPE '0' WHEN ASKED FOR VALUE OF X."
02220PRINT "INPUT X AS A NUMBER BETWEEN 0 AND 1."
02230GOSUB 1410
02240PRINT
02250PRINT "INPUT X";
02260GOSUB 9000
02270IF O1=0 THEN 990
02280X=O1
02290IF X <= 0 THEN 2320
02300IF X >= 1 THEN 2320
02310GOTO 2360
02320PRINT
02330PRINT "REENTER.  INPUT MUST BE 0 OR SOME NUMBER BETWEEN 0 AND 1."
02340PRINT
02350GOTO 2250
02360J1=0
02370J2=X
02380GOSUB 5000
02390IF I3=8 THEN 3330
02400PRINT  USING 2410,X,P
02410:                         PROB( PI <##.### ) =##.##
02420PRINT  USING 2430,X,1-P
02430:                         PROB( P1 >##.### ) =##.##
02440GOTO 2240
02450REM
02460REM         END OF PROBABILITY LESS THAN ROUTINE
02470REM
02480REM **********************************************************
02490PRINT L$
02500PRINT "     OPTION 4:  PROBABILITY PI IS BETWEEN TWO VALUES"
02510PRINT
02520PRINT "TO EXIT ROUTINE TYPE '0''S WHEN ASKED FOR INPUT."
02530GOSUB 1410
02540PRINT
02550PRINT "INPUT SMALLER VALUE";
02560GOSUB 9000
02570X3=O1
02580IF X3=0 THEN 990
02590IF X3<0 THEN 2620
02600IF X3 >= 1 THEN 2620
02610GOTO 2640
02620PRINT "VALUE MUST BE POSITIVE AND LESS THAN 1."
02630GOTO 2550
02640PRINT "INPUT LARGER VALUE";
02650GOSUB 9000
02660IF X3 <> 0 THEN 2680
02670IF O1=0 THEN 990
02680X4=O1
02690IF X4 <= 0 THEN 2720
02700IF X4 >= 1 THEN 2720
02710GOTO 2760
02720PRINT
02730PRINT "VALUE MUST BE GREATER THAN 0 AND LESS THAN 1."
02740PRINT
02750GOTO 2640
02760IF X3 >= X4 THEN 2890
02770J1=0
02772J2=X3
02774GOSUB 5000
02776P3=P
02777J1=0
02780J2=X4
02790GOSUB 5000
02800P=P-P3
02810PRINT  USING 2820,X3,X4,P
02820:                           PROB(##.### < PI <##.### ) =##.##
02830GOTO 2550
02840REM
02850REM          END OF BETWEEN TWO VALUES ROUTINE
02860REM
02870REM ***********************************************************
02880CHAIN "RSTRT"
02890PRINT
02900PRINT "ENTER SMALLER VALUE FIRST.  REENTER."
02910PRINT
02920GOTO 2550
02930REM ****************************************************************
02940REM
02950REM            ROUTINE TO CALCULATE EXPECTED UTILITY
02960REM            ENTER VIA THE EXPECTED UTILITIES COMPONENT (8)
02970REM
02980REM
02990  DIM M(9),U(9),P(3)
03000 RESTORE#3
03001 FOR I=1 TO 9
03002 INPUT#3,M(I)
03003 NEXT I
03004 FOR I=1 TO 9
03005 INPUT #3,U(I)
03006 NEXT I
03007 FOR I=1 TO 3
03008 INPUT #3,P(I)
03009  NEXT I
03010PRINT L$
03020A=P(1)
03030B=P(2)
03040GOSUB 5220
03050K8=0
03060P0=0
03070K5=2
03080IF M(1)=0 THEN 3140
03090J1=0
03100J2=M(1)
03110GOSUB 5000
03120K8=P
03130P0=P
03140U9=0
03150IF M(9)=1 THEN 3200
03160J1=0
03170J2=M(9)
03180GOSUB 5000
03190K8=K8+1-P
03200PRINT "BETA DISTRIBUTION"
03210PRINT
03220PRINT "PARAMTER A=";A;"   PARAMETER B=";B
03230PRINT
03240PRINT "THE EXPECTED UTILITY IS BEING COMPUTED."
03250PRINT
03260FOR I7=M(1) TO M(9) STEP (M(9)-M(1))/110
03270I=I7
03280IF I=0 THEN 3370
03290IF I>.9999 THEN 3380
03300IF I>M(K5) THEN 3490
03310X=I
03320GOTO 2360
03330U9=U9+(P-P0)*U(K5-1)
03340P1=P0
03350U9=U9+(P-P1)*(I-M(K5-1))*((U(K5)-U(K5-1))/(M(K5)-M(K5-1)))
03360P0=P
03370NEXT I7
03380U9=U9/(1-K8)
03390PRINT
03400:THE EXPECTED UTILITY IS ##.##.
03410PRINT  USING 3400,U9
03420  DIM V(1)
03430V(1)=1
03435 SCRATCH #3
03436 PRINT #3,V(1)
03437 FOR I=1 TO 9
03438 PRINT#3,M(I)
03439 NEXT I
03440 FOR I=1 TO 9
03442 PRINT #3,U(I)
03444 NEXTI
03446 FOR I=1 TO 3
03447 PRINT #3,P(I)
03448 NEXT I
03450PRINT
03460PRINT "WHEN YOU ARE READY TO CONTINUE TYPE '1'.";
03470GOSUB 9000
03480CHAIN "CMODP"
03490K5=K5+1
03500GOTO 3320
03510REM
03520REM
03530REM               END OF THE EXPECTED UTILITY ROUTINE
03540REM ***************************************************************
03550REM
03560PRINT L$
03570PRINT "OPTION 5:  GRAPH OF THE DENSITY FUNCTION OVER 99% HDR"
03580GOSUB 1410
03581M0=(A-1)/(A+B-2)
03582J5=.99
03583PRINT "THESE ARE THE PARAMATERS OF THE DISTRIBUTION TO BE GRAPHED."
03584GOSUB 7000
03585K0=J1
03586K1=J2
03587PRINT "WHEN YOU ARE READY FOR THE GRAPH TO BE DISPLAYED TYPE '1'.";
03588GOSUB 9000
03589PRINT L$
03590GOSUB 9400
03595PRINT L$
03600GOTO 1060
03610REM            APPENDED GOSUBS FOLLOW
03620REM
03684PRINT E1;J2;E2;P7;P;P8
04632A7=P1/100
04742L=J2*J2-3
05000REM ***************************************************
05005REM         BETA CDF ROUTINE
05010REM           INPUT    A      B      J1    J2
05015REM           OUTPUT   P
05020REM           GOSUB'S TO BE CALLED PRIOR 5160 AND 5220
05025  DIM W(16),O(16)
05030IF J1 <> 0 THEN 5035
05031IF A<5 THEN 5035
05032IF B >= 5 THEN 5400
05035IF A+B>85 THEN 5280
05040P=0
05045C6=0
05050IF A <= B THEN 5080
05055C6=A
05060C7=B
05065A=C7
05070B=C6
05075J2=1-J2
05080D0=(J2-J1)*.5
05085D1=(J1+J2)*.5
05090FOR I1=1 TO 16
05095D9=D0*O(I1)+D1
05100IF D9=0 THEN 5115
05105IF D9=1 THEN 5115
05107D9=LOG(D9)*(A-1)+LOG(1-D9)*(B-1)
05108IF D9<-80 THEN 5115
05110P=P+W(I1)*EXP(D9)
05115NEXT I1
05120P=P*F0
05125P=P*D0
05130IF C6=0 THEN 5155
05135A=C6
05140B=C7
05145P=1-P
05150J2=1-J2
05155RETURN
05160FOR I1=1 TO 16
05165READ W(I1),O(I1)
05170NEXT I1
05175DATA 2.71525E-02,-.989401
05180DATA 6.22535E-02,-.944575,9.51585E-02,-.865631
05185DATA.124629,-.755404,.149596,-.617876
05190DATA.169156,-.458017,.182603,-.281604,.189451,-9.50125E-02
05195DATA.189451,9.50125E-02,.182603,.281604,.169156,.458017
05200DATA.149596,.617876,.124629,.755404
05205DATA 9.51585E-02,.865631,6.22535E-02,.944575,2.71525E-02
05210DATA.989401
05215RETURN
05220G9=A+B
05225GOSUB 5850
05230F0=G0
05235G9=A
05240GOSUB 5850
05245F0=F0-G0
05250G9=B
05255GOSUB 5850
05260F0=F0-G0
05265IF A+B>85 THEN 5275
05270F0=EXP(F0)
05275RETURN
05280W1=(B*J2)**(1/3)
05285W2=(A*(1-J2))**(1/3)
05290GOSUB 5325
05295I1=P
05300W1=(B*J1)**(1/3)
05305W2=(A*(1-J1))**(1/3)
05310GOSUB 5325
05315P=I1-P
05320RETURN
05325Y3=3*(W1*(1-1/9/B)-W2*(1-1/9/A))/SQR(W1*W1/B+W2*W2/A)
05330GOSUB 8000
05335RETURN
05340REM    2/16/76 CHANGED TO ALL LOG
05345D2=LOG(F0)+(A-1)*LOG(J2)+(B-1)*LOG(1-J2)
05350RETURN
05390REM
05400REM *******************************************************
05403REM      PEIZER PRATT APROXIMATION
05406D0=.02*(J2/B-(1-J2)/A+(J2-.5)/(A+B))
05409D0=B-1/3-(A+B-2/3)*(1-J2)+D0
05412Y=(B-.5)/((A+B-1)*(1-J2))
05415GOSUB 5436
05418D9=G6
05421Y=(A-.5)/((A+B-1)*J2)
05424GOSUB 5436
05427Y3=D0*SQR((1+J2*D9+(1-J2)*G6)/((A+B-5/6)*(1-J2)*J2))
05430GOSUB 8000
05433RETURN
05436IF Y<.00001 THEN 5451
05439IF ABS(Y-1)<.00001 THEN 5457
05442G6=(1-Y*Y+2*Y*LOG(Y))/(1-Y)**2
05445IF G6>-1 THEN 5460
05446G6=-1
05448GOTO 5460
05451G6=1
05454GOTO 5460
05457G6=-1.E+20
05460RETURN
05465REM    END BETA CDF ROUTINE
05470REM***********************************************************
05600REM************************************************************
05606REM     BETA  PERCENTILE   ROUTINE
05609REM        INPUTS    P1
05612REM        OUTPUTS      J2
05615J1=0
05618P2=P1/100+.02
05619IF P2<1 THEN 5621
05620P2=.999
05621GOSUB 5762
05624GOSUB 5000
05627IF ABS(P1/100-P)<.0001 THEN 5750
05630IF P1/100>P THEN 5639
05633E4=J2
05636P8=P
05637A7=P2-.02
05638GOTO 5669
05639E1=J2
05642P7=P
05643A8=P2+.02
05645IF A8<1 THEN 5651
05648A8=.9999
05651P0=A8
05654P2=P0
05657GOSUB 5762
05658GOSUB 5000
05659IF P1/100 <= P THEN 5665
05660J2=J2+.03
05661IF J2<.999 THEN 5658
05662J2=.99991
05663GOTO 5658
05665E4=J2
05666P8=P
05667GOTO 5693
05669IF A7>0 THEN 5675
05672A7=.00001
05675P0=A7
05678P2=P0
05681GOSUB 5762
05682GOSUB 5000
05683IF P <= P1/100 THEN 5690
05684J2=J2-.03
05685IF J2>.001 THEN 5682
05686J2=.0001
05687GOTO 5682
05690P7=P
05691E1=J2
05693E2=E4
05696J2=(P1/100-P7)/(P8-P7)
05699IF J2>.05 THEN 5708
05705J2=.05
05706GOTO 5711
05708IF J2<.85 THEN 5711
05709J2=.85
05711J2=E1+J2*(E2-E1)
05714J1=0
05717GOSUB 5000
05720IF ABS(E1-E2)<.0001 THEN 5750
05726IF ABS(P-P1/100)<.0001 THEN 5750
05729IF P>P1/100 THEN 5741
05732E1=J2
05735P7=P
05738GOTO 5696
05741E2=J2
05744P8=P
05747GOTO 5696
05750RETURN
05753REM        END OF PERCENTILE ROUTINE
05756REM
05759REM ***************************************************
05762REM*********************************************************
05768REM         INVERSE BETA FUNCTION
05771REM                  INPUTS P2
05774REM                    OUTPUTS J2
05777P3=P2
05780IF P2 <=.5 THEN 5786
05783P2=1-P2
05786A1=SQR(LOG(1/P2/P2))
05789A2=2.51552+.802853*A1+.010328*A1*A1
05792A2=A2/(1+1.43279*A1+.189269*A1*A1+.001308*A1*A1*A1)
05795J2=A1-A2
05798IF P3 <=.5 THEN 5810
05801P2=P3
05804J2=-J2
05807GOTO 5813
05810REM
05813L=J2*J2-3
05816L=L/6
05819H=2/(1/(2*A-1)+1/(2*B-1))
05822D=1/(2*B-1)-2/(2*A-1)
05825W=J2*(H+L) **.5/H-D*(L+5/6-2/H/3)
05828X4=A/(A+B*EXP(2*W))
05831J2=X4
05837RETURN
05840REM*********************  END INVERSE BETA  **********************
05850REM ****************************************************
05852REM        LOG GAMMA ROUTINE
05853REM           INPUT G9
05854REM           OUTPUT G0
05860G5=G9
05863IF G9 <= 1.E+30 THEN 5872
05866G0=1.E+38
05869RETURN
05872IF G9>1.E-09 THEN 5881
05875G0=0
05878RETURN
05881IF G9<1.E+10 THEN 5890
05884G0=G9*(LOG(G9)-1)
05887RETURN
05890G6=1
05893IF 18<G5 THEN 5905
05896G6=G6*G5
05899G5=G5+1
05902GOTO 5893
05905R8=1/G5/G5
05908G0=(G5-.5)*LOG(G5)-G5+.918939-LOG(G6)
05911C1=8.33333E-02
05914C2=2.77778E-03
05917C3=7.93651E-04
05920C4=5.95238E-04
05923G0=G0+1/G5*(C1-(R8*(C2+(R8*(C3-(R8*(C4)))))))
05926RETURN
05927REM          END OF LOG GAMMA ROUTINE
05928REM ****************************************************
07000REM**************************************************************
07002REM       BETA HDR ROUTINE
07004REM            INPUT     A      B        J5
07006REM            OUTPUT           J1        J2
07008J7=0
07010U0=0
07012IF A<B THEN 7024
07014U0=1
07016J7=A
07018A=B
07020J=0
07022B=J7
07024J6=SQR((A*B)/(A+B)/(A+B)/(A+B+1))
07026J=(A-1)/(B-1)
07028J0=(A-1)/(A+B-2)
07030GOSUB 5220
07032P9=0
07034J9=J0
07036J6=1.6*J6
07038J8=A/(A+B)+J5*J6
07040IF J8<1 THEN 7044
07042J8=.9999
07044IF A/(A+B)-J5*J6>0 THEN 7050
07046J8=J8/1.E-08
07048GOTO 7052
07050J8=J8/(A/(A+B)-J5*J6)
07052GOSUB 7168
07054GOSUB 5000
07056P0=P
07058IF ABS(P0-J5)<.0001 THEN 7180
07060IF P0>J5 THEN 7084
07062J0=J1
07064J9=J2
07066P9=P
07068J8=J8*1.5
07070GOSUB 7168
07072GOSUB 5000
07074IF P<J5 THEN 7068
07076J6=J1
07078J7=J2
07080P0=P
07082GOTO 7110
07084J6=J1
07086J7=J2
07088P0=P
07090J8=(1+J8)/2
07092GOSUB 7168
07094GOSUB 5000
07096IF P>J5 THEN 7090
07098J0=J1
07100J9=J2
07102P9=P
07104GOTO 7110
07106J6=J1
07108J7=J2
07110J8=(J5-P9)/(P0-P9)
07112J2=J6
07114GOSUB 5345
07116J1=EXP(D2)
07118J2=J0
07120GOSUB 5345
07122C=J8
07124J1=(-2*J1+SQR(4*J1*J1+4*C*(J2+J1)*(J2-J1)))/(2*(J2-J1))
07126IF J1<.9 THEN 7132
07128J1=.9
07130GOTO 7136
07132IF J1>.1 THEN 7136
07134J1=.1
07136J8=(J1*J7+(1-J1)*J9)/(J1*J6+(1-J1)*J0)
07138GOSUB 7168
07140GOSUB 5000
07142J3=P
07144IF ABS(J1-J2)<.0001 THEN 7180
07146IF ABS(J3-J5)>.0001 THEN 7150
07148GOTO 7180
07150IF J3>J5 THEN 7160
07152J0=J1
07154J9=J2
07156P9=J3
07158GOTO 7110
07160J6=J1
07162J7=J2
07164P0=J3
07166GOTO 7110
07168J1=(J8**J-1)/(J8**(J+1)-1)
07170J2=J1*J8
07172IF J2<1 THEN 7178
07174J8=J8*.95
07176GOTO 7172
07178RETURN
07180IF U0=0 THEN 7194
07182J7=A
07184A=B
07186B=J7
07188J7=J2
07190J2=1-J1
07192J1=1-J7
07194RETURN
07196REM       END OF BETA HDR ROUTINE
07198REM*************************************************
08000REM **********************************************************
08001REM      ROUTINE CALCULATES THE CDF FOR NORMAL DISTRIBUTION
08002REM               INPUT       Y3
08003REM               OUTPUT      P
08004REM
08005Y4=ABS(Y3)
08010X1=X
08015X=Y3
08020T=1/(1+.231642*Y4)
08021 IF X*X/2<80 THEN 8025
08022 D=0
08023 GOTO 8030
08025D=.398942*EXP(-X*X/2)
08030C1=1.33027
08035C2=1.82126
08040C3=1.78148
08045C4=.356564
08050C5=.319382
08055P=1-D*T*((((C1*T-C2)*T+C3)*T-C4)*T+C5)
08060IF X >= 0 THEN 8070
08065P=1-P
08070X=X1
08075RETURN
08076REM
08077REM        END OF NORMAL CDF ROUTINE
08078REM **********************************************************
09000REM--SUBROUTINE THAT DETERMINES IF RESTART HAS BEEN REQUESTED.
09005INPUT O1
09015IF O1=-9999 THEN 9025
09020RETURN
09025CHAIN "RSTRT"
09035REM*************END ROUTINE
09400 REM
09412  T$=">>>>>>>>>1>>>>>>>>>2>>>>>>>>>3>>>>>>>>>4>>>>>>>>>5>>>>>>"
09414  S$="\\\\\\\\\I\\\\\\\\\I\\\\\\\\\I\\\\\\\\\I\\\\\\\\\I"
09416  U$="/////////I/////////I/////////I/////////I/////////I"
09419REM**************************************************
09420REM INPUT K0,K1, AND MO
09421REM DENSITY CALL 5345
09422REM******************************************************
09423:    GRAPH OF BETA (####.##  ####.##) ##.#% HDR
09426GOTO 9520
09450  :#####.## I'LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLCONTINUE=1
09458IF ABS(J2)>9999 THEN 9560
09459IF ABS(J2)<.01 THEN 9560
09460IF J2>M0+.4*K2 THEN 9472
09461IF J2<M0-.4*K2 THEN 9466
09462  PRINT  USING 9466,J2,MID$(T$,1,K7-(1)+1)
09464GOTO 9474
09466:#####.## I'LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
09468  PRINT  USING 9466,J2,MID$(S$,1,K7-(1)+1)
09470GOTO 9474
09472  PRINT  USING 9466,J2,MID$(U$,1,K7-(1)+1)
09474RETURN
09510REM ***************************************************************
09520K2=(K1-K0)/19
09522J2=M0
09523PRINT  USING 9423,A,B,J5*100
09524GOSUB 5345
09526D6=D2
09528IF K1-K2-K0<.01 THEN 9582
09530FOR J2=K0 TO K1-.9*K2 STEP K2
09532GOSUB 5345
09533K7=EXP(D2-D6+LOG(50)) 
09534 IF K7>=1 THEN 9536
09535 K7=1
09536GOSUB 9458
09538NEXT J2
09540J2=K1
09542GOSUB 5345
09543K7=EXP(D2-D6+LOG(50)) 
09544 IF K7>=1 THEN 9546
09545 K7=1
09546IF J2<.01 THEN 9575
09547IF J2>9999.99 THEN 9575
09548  PRINT  USING 9450,K1,MID$(U$,1,K7-(1)+1)
09555GOSUB 9000
09556RETURN
09560IF J2>M0+.4*K2 THEN 9572
09561IF J2<M0-.4*K2 THEN 9566
09562  PRINT  USING 9566,J2,MID$(T$,1,K7-(1)+1)
09564RETURN
09566:##.##^^^^ I'LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL
09568  PRINT  USING 9566,J2,MID$(S$,1,K7-(1)+1)
09570RETURN
09572  PRINT  USING 9566,J2,MID$(U$,1,K7-(1)+1)
09574RETURN
09575  PRINT  USING 9580,K1,MID$(U$,1,K7-(1)+1)
09577GOTO 9555
09580  :##.##^^^^ I'LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLCONTINUE=1
09582 PRINT"CAN NOT COMPUTE HDR. TYPE '1' TO CONTINUE."
09587GOTO 9555
09999 END