Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-06 - 43,50422/cmod4.bas
There are 2 other files named cmod4.bas in the archive. Click here to see a list.
00020REM ***************************************************************
00030REM    CMOD4    CMOD4    CMOD4    CMOD4    CMOD4     CMOD4
00040REM***************************************************************
00050REM
00060REM        PRIOR FOR STANDARD DEVIATION OF TWO PARAMETER NORMAL
00070REM
00080REM************************************************************
00090S8=0
00100FILES RFILE1,RFILE2,RFILE3,RF4,RF5,RF6,RF7,RF8,RF9
00140RESTORE#1
00141  INPUT#  1,I1,I2,I3
00150SCRATCH#1
00151  PRINT #  1,4,I2,I3
00155S8=0
00160DATA 1,0,0,0,1,0,0,0,1,3,2,1
00170  DIM J(4),S(4,5),W(4,3),V(76),C(72,2)
00180MAT  READ W
00190REM******************************************************************
00200REM                N1=DEGREES OF FREEDOM
00210REM                l1 =scale factor
00220REM******************************************************************
00230D9=0
00240S9=0
00250MAT  READ C
00260FOR K5=1 TO 72
00270K6=INT(C(K5,1)*.1)
00280V(K5+4)=K6/1000
00290C(K5,1)=C(K5,1)-10*K6
00300NEXT K5
00310PRINT L$
00320PRINT "       PRIOR DISTRIBUTION ON THE STANDARD DEVIATION"
00330PRINT
00340PRINT "THIS MODULE WILL ASSIST YOU IN FITTING AN INVERSE CHI DISTRIBUTION"
00350PRINT "TO YOUR PRIOR BELIEFS ABOUT THE STANDARD DEVIATION OF A NORMAL"
00360PRINT "DISTRIBUTION"
00370PRINT
00380PRINT "WE BEGIN BY ASKING YOU TO SPECIFY THE 25TH, 50TH AND"
00390PRINT "75TH PERCENTILES OF YOUR PRIOR DISTRIBUTION."
00400PRINT
00410PRINT "SPECIFY 25TH PERCENTILE.  YOUR BETTING ODDS ARE 3 TO 1 THAT THE "
00420PRINT "STANDARD DEVIATION IS GREATER THAN THIS VALUE.  INPUT 25TH.";
00430GOSUB 9000
00440Q1=O1
00450IF Q1>0 THEN 480
00460PRINT "STANDARD DEVIATION MUST BE POSITIVE."
00470GOTO 410
00480PRINT
00490PRINT "SPECIFY 50TH PERCENTILE.  YOUR BETTING ODDS ARE EVEN THAT THE"
00500PRINT "STANDARD DEVIATION IS LESS THAN THIS VALUE.  INPUT 50TH.";
00510GOSUB 9000
00520Q2=O1
00530IF Q2>Q1 THEN 580
00540PRINT L$
00550PRINT "THE 50TH PERCENTILE MUST BE LARGER THAN THE 25TH,AND THE"
00560PRINT "75TH MUST BE LARGER THAN THE 50TH.  PLEASE RESPECIFY."
00570GOTO 400
00580Q8=Q2
00590PRINT
00600PRINT "SPECIFY 75TH PERCENTILE.  YOUR BETTING ODDS ARE 1 TO 3 THAT THE"
00610PRINT "STANDARD DEVIATION IS GREATER THAN THIS VALUE.  INPUT 75TH.";
00620GOSUB 9000
00630Q3=O1
00640IF Q3>Q2 THEN 660
00650GOTO 540
00660PRINT
00670PRINT"FOUR POSSIBLE APPROXIMATE PRIOR DISTRIBUTIONS ARE NOW BEING"
00680PRINT"FOR YOUR CONSIDERATION."
00690FOR K5=1 TO 4
00700R9=1.E+30
00710FOR K6=1 TO 72
00720R=W(K5,1)*(Q2/Q1-C(K6,1))**2
00730R=R+W(K5,2)*(Q3/Q1-C(K6,2))**2
00740R=R+W(K5,3)*(Q2/Q3-C(K6,1)/C(K6,2))**2
00750IF R>R9 THEN 920
00760R9=R
00770IF K6 <= 16 THEN 840
00780IF K6 <= 28 THEN 880
00790IF K6 <= 32 THEN 820
00800V(K5)=K6-22
00810GOTO 890
00820V(K5)=8+(K6-28)*.5
00830GOTO 890
00840V(K5)=2+(K6-1)*.2
00850IF V(K5) <> 2 THEN 870
00860V(K5)=2.01
00870GOTO 890
00880V(K5)=5+(K6-16)*.25
00890J(K5)=K6
00900NEXT K6
00910GOTO 930
00920IF K5=4 THEN 900
00930IF K5=1 THEN 1000
00940IF K5=2 THEN 1090
00950IF K5=3 THEN 1220
00960IF K5=4 THEN 1310
00970NEXT K5
00980GOTO 1480
00990REM     ASSUME 25TH AND 50TH ARE MORE ACCURATELY ESTIMATED
01000IF J(1) <> 72 THEN 1060
01010K=(Q2-Q1)/.64
01020GOSUB 2310
01030J(1)=L1
01040V(1)=N1
01050GOTO 1350
01060J(1)=Q1/V(J(1)+4)
01070GOTO 1350
01080REM    ASSUME 25TH AND 75TH ARE MOST ACCURATELY ESTIMATED
01090IF J(2) <> 72 THEN 1180
01100Q6=Q2
01110Q2=Q1+(.64/1.34)*(Q3-Q1)
01120K=(Q2-Q1)/.64
01130GOSUB 2310
01140J(2)=L1
01150V(2)=N1
01160Q2=Q6
01170GOTO 1350
01180J(2)=Q3/(C(J(2),2)*V(J(2)+4))
01190GOTO 1350
01200REM    ASSUME 50TH AND 75TH ARE MOST ACCURATELY ESTIMATED
01210Q8=J(3)
01220IF J(3) <> 72 THEN 1280
01230K=(Q3-Q2)/.695
01240GOSUB 2310
01250V(3)=N1
01260J(3)=L1
01270GOTO 1350
01280J(3)=Q2/(C(J(3),1)*V(J(3)+4))
01290GOTO 1350
01300REM      ASSUME ALL ARE EQUALLY WELL ESTIMATED
01310IF Q8 <> J(4) THEN 1340
01320J(4)=Q1/V(J(1)+4)
01330GOTO 1350
01340J(4)=.5*Q2/(C(J(4),1)*V(J(4)+4))+.5*Q3/(C(J(4),2)*V(J(4)+4))
01350N1=V(K5)
01360L1=J(K5)
01370GOSUB 1700
01380IF K5 <> 1 THEN 1450
01390PRINT L$
01400PRINT "HERE ARE THE PERCENTILES OF FOUR INVERSE CHI DISTRIBUTIONS"
01410PRINT "FITTED TO YOUR PERCENTILE SPECIFICATIONS."
01420PRINT
01430REM
01440PRINT"            10TH       25TH     50TH      75TH     90TH"
01450  PRINT  USING 1460,K5,S(K5,1),S(K5,2),S(K5,3),S(K5,4),S(K5,5)
01460:  ##.  #####.##  #####.##  #####.##  #####.##  #####.##
01470GOTO 970
01480PRINT
01490PRINT "COMPARE THE PERCENTILES OF THESE DISTRIBUTIONS AND DECIDE"
01500PRINT "WHICH MOST CLOSELY CORRESPONDS TO YOUR PRIOR BELIEFS. YOU"
01510PRINT "CAN EITHER TENTATIVELY ACCEPT THIS DISTRIBUTION OR SPECIFY"
01520PRINT "NEW VALUES FOR THE PERCENTILES."
01530PRINT
01540PRINT "IF YOU WANT ONE OF THE DISTRIBUTION TYPE ITS NUMBER.";
01550PRINT "IF YOU WANT TO RESPECIFY THE PERCENTILES TYPE '0'."
01560GOSUB 9000
01570IF O1=0 THEN 1990
01580GOTO 1620
01590PRINT "REENTER.  INPUT MUST BE 0 OR THE NUMBER OF A DISTRIBUTION.";
01600GOSUB 9000
01610GOTO 1570
01620IF O1=1 THEN 1680
01630IF O1=2 THEN 1680
01640IF O1=3 THEN 1680
01650IF O1=4 THEN 1680
01660PRINT
01670GOTO 1590
01680K5=O1
01690GOTO 2440
01700E1=0
01710E2=.5*L1
01720P0=.1
01730GOSUB 1910
01740E1=X3
01750E2=L1*.65
01760P0=.25
01770GOSUB 1910
01780P0=.5
01790E1=X3
01800E2=L1*.87
01810GOSUB 1910
01820E1=X3
01830E2=1.4*L1
01840P0=.75
01850GOSUB 1910
01860E1=X3
01870P0=.9
01880E2=2.2*L1
01890GOSUB 1910
01900RETURN
01910GOSUB 3870
01920S(K5,INT(P0/.25+1.5))=X3
01930RETURN
01940REM **** END OF ROUTINE TO FIND PERCENTILE POINTS *******************
01950PRINT
01960PRINT "RESPECIFY YOUR PERCENTILES."
01970PRINT
01980GOTO 2000
01990PRINT
02000PRINT "INPUT 25TH";
02010GOSUB 9000
02020C1=O1
02030PRINT
02040IF C1>0 THEN 2070
02050PRINT "REENTER. STANDARD DEVIATION MUST BE POSITIVE."
02060GOTO 2000
02070PRINT "INPUT 50TH";
02080GOSUB 9000
02090C2=O1
02100PRINT
02110IF C2>C1 THEN 2150
02120PRINT "REENTER.  50TH MUST BE LARGER THAN 25TH."
02130GOTO 2070
02140GOTO 2000
02150PRINT "INPUT 75TH";
02160GOSUB 9000
02170C3=O1
02180IF C3>C2 THEN 2210
02190PRINT "REENTER.  75TH MUST BE LARGER THAN 50TH."
02200GOTO 2150
02210Q1=C1
02220Q2=C2
02230Q3=C3
02240GOTO 660
02250:FOUR POSSIBLE APPROXIMATE PRIOR DISTRIBUTIONS ARE NOW BEING
02260:COMPUTED FOR YOUR CONSIDERATION.
02270REM *****************************************************************
02280REM ***** ROUTINE TO SOLVE FOR INVERSE CHI PARAMETERS ASSUMING"
02290REM ***** THE VARIANCE AND MEDIAN ARE KNOWN                    *******
02300REM ******************************************************************
02310K=K**2
02320B=-22*K/3-Q2*Q2
02330A=2*K
02340C=20*K/3+2*Q2*Q2/3
02350F=(-B+SQR(B**2-4*A*C))/(2*A)
02360IF F<500 THEN 2380
02370F=500
02380L=Q2**2*(F-2/3)
02390L=SQR(L)
02400N1=F
02410L1=L
02420RETURN
02430REM ****** SWITCH FROM PERCENTILE TO HYPOTHETICAL SAMPLE SIZE *******
02440M6=S(K5,3)
02450K7=K5
02460N1=V(K5)
02470L1=J(K5)
02480GOTO 2920
02490GOSUB 7300
02500Q5=L1*J1
02510Q6=L1*J2
02520RETURN
02530PRINT "IF YOU DO NOT FEEL THAT THIS HYPOTHETICAL SAMPLE SIZE ( M )"
02540PRINT "REFLECTS YOUR PRIOR INFORMATION ABOUT THE STANDARD DEVIATION"
02550PRINT "YOU CAN SPECIFY A DIFFERENT ONE. A DIFFERENT M WILL NOT AFFECT"
02560PRINT "THE MEDIAN, BUT WILL CHANGE THE HDRS  AND OTHER PERCENTILES. A"
02570PRINT "LARGER M WILL SHORTEN THE HDR INTERVALS, AND  A SMALLER M WILL"
02580PRINT "LENGTHEN THEM."
02590PRINT
02600REM
02610PRINT "IF YOU WANT TO CHANGE M TYPE THE NEW VALUE (GREATER THAN 3)."
02620PRINT "IF YOU DO NOT WANT TO CHANGE M TYPE '0'."
02630REM
02640GOSUB 9000
02650IF O1=0 THEN 3290
02660IF O1>2000 THEN 2700
02670IF O1>3 THEN 2720
02680PRINT "REENTER.  M MUST BE GREATER THAN 3."
02690GOTO 2630
02700PRINT "REENTER.  M MUST NOT BE GREATER THAN 2000."
02710GOTO 2630
02720N1=O1-1
02730S9=1
02740GOTO 3450
02750E1=0
02760E2=.65*L1
02770P0=.25
02780GOSUB 3870
02790S(K7,2)=X3
02800IF S9=1 THEN 2860
02810E1=X3
02820E2=.87*L1
02830P0=.5
02840GOSUB 3870
02850S(K7,3)=X3
02860E2=1.4*L1
02870E1=X3
02880P0=.75
02890GOSUB 3870
02900S(K7,4)=X3
02910K5=K7
02920PRINT L$
02930PRINT "HERE ARE SOME OF THE CHARACTERISTICS OF THE INVERSE CHI"
02940PRINT "DISTRIBUTION YOU ARE NOW CONSIDERING."
02950PRINT
02960  PRINT  USING 2980,N1+1
02970M9=L1/SQR(N1+1)
02980:        HYPOTHETICAL SAMPLE SIZE(M)####.##
02990IF D9=0 THEN 3060
03000  PRINT  USING 3020,N1
03010  PRINT  USING 3030,L1
03020:        DEGREES OF FREEDOM  ###########.##
03030:        SCALE PARAMETER     ###########.##
03040:        MODE                ###########.##
03050  PRINT  USING 3040,M9
03060  PRINT  USING 3070,S(K5,2)
03070:        25TH PERCENTILE     ###########.##
03080:        75TH PERCENTILE     ###########.##
03090:        50TH  (MEDIAN)          #######.##
03100  PRINT  USING 3090,S(K5,3)
03110  PRINT  USING 3080,S(K5,4)
03120:        50% HDR             #######.## TO#######.##
03130:        75% HDR             #######.## TO#######.##
03140:        95% HDR             #######.## TO#######.##
03150G=N1
03160J5=.5
03170GOSUB 2490
03180  PRINT  USING 3120,Q5,Q6
03190J5=.75
03200GOSUB 2490
03210  PRINT  USING 3130,Q5,Q6
03220J5=.95
03230GOSUB 2490
03240  PRINT  USING 3140,Q5,Q6
03250IF D9=1 THEN 3700
03260PRINT
03270IF S9=0 THEN 2530
03280GOTO 3530
03290PRINT
03300IF S8=1 THEN 3350
03310PRINT "YOU CAN CHANGE THE CENTERING OF THE DISTRIBUTION BY"
03320PRINT "SPECIFYING A DIFFERENT MEDIAN.  THIS WILL NOT AFFECT"
03330PRINT "THE HYPOTHETICAL SAMPLE SIZE."
03340PRINT
03350PRINT "IF YOU WANT TO CHANGE THE MEDIAN TYPE THE NEW VALUE."
03360PRINT "IF YOU DO NOT TYPE '0'."
03370GOSUB 9000
03380IF O1=0 THEN 3650
03390M6=O1
03400IF O1>0 THEN 3440
03410PRINT "REENTER.  INPUT MUST BE '0' OR POSITIVE VALUE FOR MEDIAN.";
03420GOSUB 9000
03430GOTO 3380
03440S8=1
03450L1=1
03460P0=.5
03470E1=0
03480E2=.86
03490GOSUB 3870
03500L1=M6/X3
03510S(K5,3)=L1*X3
03520GOTO 2750
03530PRINT "IF YOU WANT TO CHANGE M TYPE NEW VALUE ELSE '0'.";
03540GOSUB 9000
03550IF O1=0 THEN 3290
03560IF O1>9999 THEN 3600
03570IF O1>3 THEN 3620
03580PRINT "REENTER.  M MUST BE GREATER THAN 3."
03590GOTO 3540
03600PRINT "REENTER.  M MUST BE LESS THAN 9999."
03610GOTO 3540
03620N1=O1-1
03630GOTO 3450
03640D9=1
03650PRINT L$
03660D9=1
03670PRINT "HERE ARE SOME OF THE CHARACTERISTICS OF THE INVERSE CHI"
03680PRINT "DISTRIBUTION FITTED TO YOUR PRIOR BELIEFS ABOUT SIGMA."
03690GOTO 2950
03700PRINT
03710PRINT "THIS COMPLETES THE SPECIFICATION OF A PRIOR DISTRIBUTION"
03720PRINT "ON SIGMA.  IF YOU DO NOT WANT TO FIT A PRIOR DISTRIBTION"
03730PRINT "ON THE MEAN YOU SHOULD RECORD THE PARAMETERS OF  YOUR"
03740PRINT "PRIOR DISTRIBUTION ON SIGMA (DEGREES AND SCALE)."
03750PRINT
03760PRINT "IF YOU WANT TO SPECIFY THE PRIOR ON THE MEAN TYPE '1'."
03770PRINT "IF YOU DO NOT TYPE '0'."
03780GOSUB 9000
03790IF O1=0 THEN 3860
03800IF O1=1 THEN 3840
03810PRINT "REENTER.  MUST BE '0' OR '1'."
03820GOSUB 9000
03830GOTO 3780
03840SCRATCH#2
03841  PRINT #  2,N1,L1,0,0,S(K5,3),0,0,0,0
03850CHAIN "CMOD5"
03860CHAIN "RSTRT"
03870REM*********************************************************
03880IF E1 <> 0 THEN 3910
03890P8=0
03900GOTO 3940
03910X3=E1
03920GOSUB 4000
03930P8=P
03940X3=E2
03950GOSUB 4000
03960P9=P
03970X3=.5*(E1+E2)
03980GOSUB 4000
03990GOTO 4060
04000X=L1*L1/X3/X3
04010G=N1
04020GOSUB 5775
04030GOSUB 5500
04040P=1-P
04050RETURN
04060IF ABS(P-P0)<.001 THEN 4220
04070IF P<P0 THEN 4190
04080E2=X3
04090P9=P
04100P=(P0-P8)/(P9-P8)
04110IF P<.85 THEN 4140
04120P=.85
04130GOTO 4160
04140IF P>.15 THEN 4160
04150P=.15
04160X3=P*(E2-E1)+E1
04170GOSUB 4000
04180GOTO 4060
04190E1=X3
04200P8=P
04210GOTO 4100
04220RETURN
04230DATA 6011.41,2.1944
04240DATA 5731.39,2.0971
04250DATA 5491.36,2.0152
04260DATA 5281.35,1.9474
04270DATA 5091.33,1.8907
04280DATA 4931.32,1.8392
04290DATA 4781.31,1.7965
04300DATA 4641.29,1.7605
04310DATA 4521.29,1.7292
04320DATA 4411.27,1.7003
04330DATA 4301.27,1.6737
04340DATA 4211.26,1.6487
04350DATA 4121.25,1.627
04360DATA 4031.25,1.6116
04370DATA 3961.24,1.5896
04380DATA 3881.23,1.5736
04390DATA 3801.23,1.553
04400DATA 3721.22,1.5354
04410DATA 3641.22,1.5211
04420DATA 3571.21,1.5041
04430DATA 3501.21,1.4922
04440DATA 3441.2,1.4809
04450DATA 3381.2,1.4675
04460DATA 3321.19,1.4581
04470DATA 3271.19,1.4478
04480DATA 3221.19,1.4364
04490DATA 3171.18,1.4277
04500DATA 3121.18,1.4197
04510DATA 3041.17,1.4029
04520DATA 2961.17,1.3888
04530DATA 2891.16,1.3767
04540DATA 2821.16,1.3651
04550DATA 2701.15,1.3454
04560DATA 2591.14,1.3264
04570DATA 2501.14,1.3125
04580DATA 2411.13,1.297
04590DATA 2341.13,1.2857
04600DATA 2271.12,1.275
04610DATA 2201.12,1.2652
04620DATA 2151.12,1.2577
04630DATA 2091.11,1.2491
04640DATA 2041.11,1.242
04650DATA 2001.11,1.2354
04660DATA 1961.1,1.2279
04670DATA 1911.1,1.2239
04680DATA 1881.1,1.2179
04690DATA 1841.1,1.213
04700DATA 1811.1,1.2081
04710DATA 1781.09,1.2036
04720DATA 1751.09,1.2001
04730DATA 1721.09,1.1963
04740DATA 1691.09,1.1922
04750DATA 1661.09,1.1886
04760DATA 1641.09,1.1856
04770DATA 1621.09,1.1822
04780DATA 1591.08,1.1791
04790DATA 1571.08,1.1765
04800DATA 1551.08,1.1733
04810DATA 1531.08,1.1717
04820DATA 1511.08,1.1681
04830DATA 1491.08,1.1666
04840DATA 1481.08,1.1641
04850DATA 1461.08,1.1618
04860DATA 1441.08,1.1603
04870DATA 1431.07,1.1578
04880DATA 1411.07,1.1557
04890DATA 1401.07,1.1543
04900DATA 1381.07,1.1519
04910DATA 1371.07,1.1504
04920DATA 1351.07,1.1482
04930DATA 1341.07,1.147
04940DATA 1331.06,1.1452
05500REM ********************************************************
05501REM          CHI-SQUARE CDF ROUTINE-LOWER TAIL
05502REM                INPUT     G        X
05503REM                OUTPUT    P
05504REM                PRIOR GOSUB 5775
05505REM
05506REM
05510IF G>30 THEN 5795
05515T0=.5*G-1
05520X=X*.5
05525T=81.4983
05530P=5.575E-35*(T+X)**T0
05535T=69.9622
05540P=P+4.0883E-30*(T+X)**T0
05545T=61.0585
05550P=P+2.45182E-26*(T+X)**T0
05555T=53.6086
05560P=P+3.60577E-23*(T+X)**T0
05565T=47.1531
05570P=P+2.01052E-20*(T+X)**T0
05575T=41.4517
05580P=P+5.35019E-18*(T+X)**T0
05585T=36.3584
05590P=P+7.8198E-16*(T+X)**T0
05595T=31.776
05600P=P+6.89418E-14*(T+X)**T0
05605T=27.6359
05610P=P+3.91774E-12*(T+X)**T0
05615T=23.8873
05620P=P+1.50701E-10*(T+X)**T0
05625T=20.4915
05630P=P+4.07286E-09*(T+X)**T0
05635T=17.418
05640P=P+7.96081E-08*(T+X)**T0
05645T=14.6427
05650P=P+1.15132E-06*(T+X)**T0
05655T=12.1461
05660P=P+1.25447E-05*(T+X)**T0
05665T=9.9121
05670P=P+1.04461E-04*(T+X)**T0
05675T=7.92754
05680P=P+6.72163E-04*(T+X)**T0
05685T=6.18154
05690P=P+3.36935E-03*(T+X)**T0
05695T=4.66508
05700P=P+.013226*(T+X)**T0
05705T=3.37077
05710P=P+4.07325E-02*(T+X)**T0
05715T=2.29256
05720P=P+9.81663E-02*(T+X)**T0
05725T=1.4256
05730P=P+.183323*(T+X)**T0
05735T=.766097
05740P=P+.258807*(T+X)**T0
05745T=.311239
05750P=P+.258774*(T+X)**T0
05755T=5.90199E-02
05760P=P+.142812*(T+X)**T0
05761IF X<80 THEN 5765
05762P=1
05763RETURN
05765P=1-(T1*P*EXP(-X))
05770RETURN
05775G9=.5*G
05778IF G>30 THEN 5790
05780GOSUB 5850
05785T1=1/EXP(G0)
05790RETURN
05795X2=((X/G)**(1/3)-(1-2/9/G))/SQR(2/9/G)
05800Y3=X2
05805GOSUB 8000
05810RETURN
05812REM
05813REM            END OF CHI-SQUARE CDF ROUTINE
05815REM *********************************************************
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**2
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 ****************************************************
07300REM *******************************************************
07301REM        INVERSE CHI HIGHEST DENSITY REGION ROUTINE
07302REM              INPUTS     G        J5
07303REM              OUTPUTS    J1       J2
07304REM
07305IF G>30 THEN 7307
07306GOSUB 5775
07307J8=1
07308GOSUB 7337
07309X=1/(J1*J1)
07310GOSUB 5500
07311J3=P
07312X=1/(J2*J2)
07313GOSUB 5500
07314J3=J3-P
07315IF ABS(J3-J5)>.0001 THEN 7317
07316RETURN
07317IF J3>J5 THEN 7320
07318J8=J8+1
07319GOTO 7308
07320J9=J8-1
07321J0=J8
07322J8=(J0+J9)/2
07323GOSUB 7337
07324X=1/(J1*J1)
07325GOSUB 5500
07326J3=P
07327X=1/(J2*J2)
07328GOSUB 5500
07329J3=J3-P
07330IF ABS(J3-J5)>.0001 THEN 7332
07331RETURN
07332IF J3>J5 THEN 7335
07333J9=J8
07334GOTO 7322
07335J0=J8
07336GOTO 7322
07337J=J8*(1+EXP(-2*J8/(G+1)))/(1-EXP(-2*J8/(G+1)))
07338J1=1/SQR(J+J8)
07339J2=1/SQR(J-J8)
07340RETURN
07341REM
07342REM        END OF ROUTINE FOR INVERSE CHI HDR'S
07343REM**************************************************
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)
08021IF X*X/2<80 THEN 8025
08022D=0
08023GOTO 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
09999END