C 00000040 C ALSAGN 00000050 C 00000060 C ANALYSIS OF A LEAST SQUARES ADJUSTMENT OF A TERRESTRIAL GEODETIC 00000070 C NETWORK. THE TESTS APPLIED ARE : 00000080 C 1) ANOVA 00000090 C 2) CHI SQUARE GOODNESS OF FIT (RESIDUALS) 00000100 C 3) NORMAL TEST - RESIDUALS VS APRIORI STD. DEVS. 00000110 C 00000120 C ALL DATA IS READ FROM EITHER DISC DATA SETS AND/OR CARDS 00000130 C 1) DJOB : JOB HEADING (CARD INPUT) 00000140 C 00000150 C 2) OPTIONS : MDI: MODE OF DATA INPUT 00000160 C IF MDI EQ 0 READ DATA FROM DISC DATA SETS 00000170 C IF MDI EQ 1 READ DATA FROM CARDS 00000180 C SLEV : SIGNIFIGANCE LEVEL OF STATISTICAL TESTS 00000190 C APVF : APRIORI VARIANCE FACTOR 00000200 C SEE FORMAT STATEMENT 1010 00000210 C 00000220 C 3) NETWORK INITIAL POINT DATA 00000230 C ORDER OF INPUT : STA. NAME,STA. NO.,SEQ.NO.,TREATMENT CODE(IHFI00000240 C LAT.(D,M,S),LONG(D,M,S),APRIORI STD.DEVS. FOR LAT. AND LONG. 00000250 C SEE FORMAT STATEMENT 1020 00000260 C NOTE : IF IHFIX EQ. 0 INITIAL POINT IS FIXED ( APRIORI STD.DEVS.=000000270 C IF IHFIX EQ. 1 INITIAL POINT HAS APRIORI STD.DEVS. OF 00000280 C SPHI AND SLAM 00000290 C 00000300 C 4) ADJUSTMENT INFORMATION (DISC(11) OR CARDS) 00000310 C N30 : NO. OF DIRECTION OBSERVATIONS 00000320 C N40 : NO. OF DISTANCE OBSERVATIONS 00000330 C N50 : NO. OF AZIMUTH OBSERVATIONS 00000340 C NEQT : TOTAL NO. OF OBS. EQNS. 00000350 C NK1 : TOTAL NO. OF NET PTS. 00000360 C NUN : TOTAL NO. OF UNKNOWNS 00000370 C NDF : DEGREES OF FREEDOM 00000380 C VARFAC : ESTIMATED VARIANCE FACTOR 00000390 C SEE FORMAT STATEMENT 1030 FOR CARD INPUT 00000400 C 00000410 C 5) RESIDUAL INPUT (DISC(12) OR CARDS) 00000420 C IN : DUMMY VARIABLE 00000430 C ISTA : FROM STA. SEQ. NO. 00000440 C JSTA : TO STA. SEQ. NO. 00000450 C V : RESIDUAL 00000460 C WT : WEIGHT USED IN THE ADJUSTMENT 00000470 C NCODE : 30,40,50(DIRECTION,DISTANCE, OR AZIMUTH) 00000480 C SEE FORMAT STATEMENT 1030 IN SUBROUTINE DEFRON FOR CARD INPUT 00000490 C 00000500 C 6) CHI-SQUARE GOODNESS OF FIT DATA 00000510 C NINT : NO. OF INTERVALS REQUIRED ( IF LEFT BLANK,SIZ MUST BE 00000520 C SPECIFIED) 00000530 C SF : ( SEE 'FIT' COMMENT CARDS) 00000540 C SIZ : INTERVAL SIZE REQUIRED ( IF LEFT BLANK, NINT MUST BE GIVEN) 00000550 C ** NOTE : TWO OF THESE CARDS ARE REQUIRED 00000560 C 1ST FOR DIRS. AND AZS. 00000570 C 2ND FOR DISTS. 00000580 C 00000590 IMPLICIT REAL*8 (A-H,O-Z) 00000600 DIMENSION DJOB(20),VDA(5000),VS(1000) 00000610 C 00000620 C READ HEADER CARDS AND SOLUTION SUMMARY INFORMATION 00000630 C 00000640 READ(5,1000) DJOB 00000650 READ(5,1010) MDI,SLEV,APVF 00000660 READ(5,1020) STAFX,STBFX,NFIX,IFIX,IHFIX,DEG,MIN,SEC,IDEG,IMIN, 00000670 1 SSEC,SPHI,SLAM 00000680 IF(MDI.EQ.1) GO TO 10 00000690 READ(11) N30,N40,N50,NEQT,NK1,NUN,NDF,VARFAC 00000700 GO TO 20 00000710 10 READ(5,1030) N30,N40,N50,NEQT,NK1,NUN,NDF,VARFAC 00000720 C 00000730 C PRINT SOLUTION SUMMARY 00000740 C 00000750 20 WRITE(6,1040) DJOB 00000760 WRITE(6,1050) NK1,NFIX,IFIX 00000770 IF(IHFIX.EQ.0) WRITE(6,1060) 00000780 IF(IHFIX.EQ.1) WRITE(6,1070) 00000790 WRITE(6,1080) NUN,N30,N40,N50,NEQT,NDF 00000800 WRITE(6,1090) APVF,VARFAC 00000810 WRITE(6,1100) STAFX,STBFX,NFIX,IFIX,DEG,MIN,SEC,IDEG,IMIN,SSEC 00000820 IF(IHFIX.EQ.1) WRITE(6,1110) SPHI,SLAM 00000830 C 00000840 C ANOVA 00000850 C 00000860 CALL ANALV2(DJOB,NDF,SLEV,APVF,VARFAC) 00000870 C 00000880 C ANALYSIS OF RESIDUALS 00000890 C 00000900 N3050=N30+N50 00000910 CALL DEFRON(DJOB,SLEV,NEQT,MDI,N3050,N40,VDA,VS) 00000920 C 00000930 C CHI-SQUARE GOODNESS OF FIT FOR DIR. AND AZ. RESIDUALS 00000940 C 00000950 CALL FIT (DJOB,VDA,N3050,SLEV,30) 00000960 C 00000970 C CHI-SQUARE GOODNESS OF FIT FOR DIST. RESIDUALS 00000980 C 00000990 CALL FIT (DJOB,VS,N40,SLEV,40) 00001000 STOP 00001010 1000 FORMAT(20A4) 00001020 1010 FORMAT(I4,2F7.3) 00001030 1020 FORMAT(2A8,I9,I5,I2,2(2I4,F7.3),2F6.2) 00001040 1030 FORMAT(7I5,F7.3) 00001050 1040 FORMAT(' ',////,6X,20A4,////,6X,'SOLUTION SUMMARY',///) 00001060 1050 FORMAT(' ',5X,'TOTAL NO. OF NETWORK POINTS : ',I5,//,6X,'NETWORK I00001070 1NITIAL POINT : ',I9,' (SEQ. NO.',I5,' )') 00001080 1060 FORMAT('+',55X,'(COORDS ASSUMED TO HAVE APRIORI STD.DEVS. EQUAL TO00001090 1 ZERO)',//) 00001100 1070 FORMAT('+',55X,'(COORDS ASSIGNED APRIORI STD.DEVS. SHOWN BELOW)',/00001110 1/) 00001120 1080 FORMAT(' ',5X,'TOTAL NO. OF UNKNOWN PARAMETERS (INCL. ORIENTATION 00001130 1UNKNOWNS) : ',I5,/,6X,'NO. OF DIRECTION OBSERVATIONS : ',I5,/,6X,'00001140 2NO. OF DISTANCE OBSERVATIONS : ',I6,/,6X,'NO. OF AZIMUTH OBSERVATI00001150 3ONS : ',I7,/,6X,'TOTAL NO. OF OBSERVATIONS : ',I9,/,6X,'DEGREES OF00001160 4 FREEDOM (N-U) : ',I5,//) 00001170 1090 FORMAT(' ',5X,'APRIORI VARIANCE FACTOR : ',F9.3,/,6X,'ESTIMATED VA00001180 1RIANCE FACTOR : ',F7.3,////) 00001190 1100 FORMAT(' ',5X,'INITIAL POINT DATA',//,6X,'STA. NAME : ',2A8,2X,'ST00001200 1A. NO. : ',I9,2X,'SEQ. NO. : ',I5,//,6X,'LAT.(+N) : ',2I4,F7.3,5X,00001210 2'LONG.(+E) : ',2I4,F7.3,//) 00001220 1110 FORMAT(' ',5X,'APRIORI STD. DEVS. LAT = ',F6.2,5X,'LONG = ',F6.200001230 1) 00001240 END 00001250 SUBROUTINE DEFRON(DJOB,SLEV,NEQT,MDI,N3050,N40,VDA,VS) 00001260 C 00001270 C TESTING OF THE DEPARTURE OF A SAMPLE FROM A STANDARD NORMAL 00001280 C DISTRIBUTATION. 00001290 C DJOB JOB NAME 00001300 C SLEV SIGNIFIGANCE LEVEL OF THE TEST 00001310 C NEQT NO. OF SAMPLES TO BE TESTED 00001320 C MDI MODE OF DATA INPUT 00001330 C N3050 NO. OF SAMPLES OF THE FIRST TYPE (UNITS OF ARC-SECS) 00001340 C N40 NO. OF SAMPLES OF THE SECOND TYPE (UNITS OF METRES) 00001350 C VDA RESIDUAL VECTOR OF THE FIRST TYPE 00001360 C VS RESIDUAL VECTOR OF THE SECOND TYPE 00001370 C 00001380 IMPLICIT REAL*8 (A-H,O-Z) 00001390 DIMENSION DJOB(20),VDA(N3050),VS(N40) 00001400 WRITE(6,1000) DJOB 00001410 ILEV=SLEV*100.D0+0.00005D0 00001420 SLEV1=(1.D0+SLEV)/2.D0 00001430 C 00001440 C NORMAL STATISTIC FOR SLEV1 00001450 C 00001460 C=XNORM(SLEV1,0.D0,1.D0) 00001470 WRITE(6,1010) ILEV,ILEV,C,ILEV 00001480 C 00001490 C L= LINE COUNT 00001500 C J= DISTANCE RESIDUAL COUNT 00001510 C K AZIMUTH AND DIRECTION RESIDUAL COUNTER 00001520 C 00001530 L=1 00001540 J=0 00001550 K=0 00001560 WRITE(6,1020) 00001570 DO 60 I=1,NEQT 00001580 L=L+1 00001590 IF(MDI.EQ.1) GO TO 10 00001600 READ(12) IN,ISTA,JSTA,V,WT,NCODE 00001610 GO TO 20 00001620 10 READ(5,1030) ISTA,JSTA,V,WT,NCODE 00001630 C 00001640 C APRIORI STANDARD DEVIATION 00001650 C 00001660 20 STD=DSQRT(1.D0/WT) 00001670 CSPX=C*STD 00001680 CSNX=-CSPX 00001690 IF(L-21) 40,30,30 00001700 30 L=1 00001710 WRITE(6,1040) 00001720 WRITE(6,1020) 00001730 40 WRITE(6,1050) ISTA,JSTA,STD,CSNX,V,CSPX 00001740 IF(NCODE.EQ.30) WRITE(6,1060) 00001750 IF(NCODE.EQ.40) WRITE(6,1070) 00001760 IF(NCODE.EQ.50) WRITE(6,1080) 00001770 IF(V.LE.CSNX.OR.V.GE.CSPX) WRITE(6,1090) ILEV 00001780 IF(NCODE.EQ.30.OR.NCODE.EQ.50) GO TO 50 00001790 J=J+1 00001800 VS(J)=V 00001810 GO TO 60 00001820 50 K=K+1 00001830 VDA(K)=V 00001840 60 CONTINUE 00001850 RETURN 00001860 1000 FORMAT('1',//,6X,20A4,//,6X,'EXAMINATION OF THE CONSTITUENTS OF TH00001870 1E RESIDUAL VECTOR IN TERMS OF THE ASSUMED STANDARD NORMAL DISTRIBU00001880 2TION',//) 00001890 1010 FORMAT(' ',5X,'LEVEL OF SIGNIFIGANCE = ',I3,'%',/,6X,'C AT',I3,'%(00001900 1STD. NORM. DIST.) = ',F6.2,/,6X,'TEST : PR(-C*STD.DEV. LE X LE00001910 2 +C*STD.DEV.) =',I3,'%',//,6X,'NOTE : THE UNITS FOR DIRECTIONS OR00001920 3 AZIMUTHS AND DISTANCES ARE ARC-SECS AND METRES RESPECTIVLY',//) 00001930 1020 FORMAT(' ',2X,'STA.SEQ.NOS.',3X,'OBSERVATION',3X,'APRIORI STD.DEV.00001940 1',3X,'-C*STD.DEV.',3X,'RESIDUAL',3X,'+C*STD.DEV.',5X,'REMARKS',//)00001950 1030 FORMAT(2I9,2F10.3,I3) 00001960 1040 FORMAT('1',//////) 00001970 1050 FORMAT(' ',/,2I7,22X,F7.3,10X,F7.3,6X,F7.3,5X,F7.3) 00001980 1060 FORMAT('+',18X,'DIRECTION') 00001990 1070 FORMAT('+',18X,'DISTANCE') 00002000 1080 FORMAT('+',18X,'AZIMUTH') 00002010 1090 FORMAT('+',89X,'REJECTED AT',I3,'%') 00002020 END 00002030 SUBROUTINE ANALV2 (DJOB,IDF,SLEV,APVF,SIGMA) 00002040 C 00002050 C ANALV2 : ANOVA 00002060 C 00002070 IMPLICIT REAL*8 (A-H,O-Z) 00002080 DIMENSION DJOB(20) 00002090 WRITE(6,1000) DJOB 00002100 C 00002110 C SIGNIFICANCE LEVELS FOR CHISQ (P1) AND CHISQ (P2) 00002120 C 00002130 ILEV=SLEV*100.D0+0.00005D0 00002140 SLEV1=(1.D0-SLEV)/2.D0 00002150 SLEV2=(1.D0+SLEV)/2.D0 00002160 WRITE(6,1010) APVF,SLEV1,SLEV2 00002170 WRITE(6,1020) IDF,SIGMA,APVF,IDF,SIGMA 00002180 C 00002190 C CHISQ STATISTICS 00002200 C 00002210 ALPHA=CHISQ(SLEV2,IDF) 00002220 BETA=CHISQ(SLEV1,IDF) 00002230 WRITE(6,1030) ALPHA,BETA 00002240 C 00002250 C A=LOWER BOUND B=UPPER BOUND 00002260 C 00002270 A=IDF*SIGMA/CHISQ(SLEV2,IDF) 00002280 B=IDF*SIGMA/CHISQ(SLEV1,IDF) 00002290 WRITE(6,1040) A,APVF,B 00002300 IF(APVF.GE.A.AND.APVF.LE.B) GO TO 10 00002310 C 00002320 C TEST FAILS 00002330 C 00002340 WRITE(6,1050) ILEV,APVF 00002350 GO TO 20 00002360 C 00002370 C TEST PASSES 00002380 C 00002390 10 WRITE(6,1060) ILEV,APVF 00002400 20 CONTINUE 00002410 RETURN 00002420 1000 FORMAT('1',/////,6X,20A4) 00002430 1010 FORMAT(' ',/////,33X,'CHI SQUARE TEST OF A PRIORI VARIANCE FACTOR'00002440 1,/,33X,43('_'),////,10X,'(DEG.FREEDOM)(ESTIMATED VARIANCE FACTOR) 00002450 2 .LE. ',F6.2,' .LE. (DEG.FREEDOM)(ESTIMATED VARIANCE FACTOR)',/00002460 3,10X,40('_'),22X,40('_'),/,23X,'CHI(',F6.3,')',45X,'CHI(',F6.3,')'00002470 4) 00002480 1020 FORMAT(' ',///,10X,'(',I4,')(',F7.3,') .LE.',2X,F7.3,2X,'.LE. ('00002490 1,I4,')(',F7.3,')',/,10X,14('_'),17X,14('_')) 00002500 1030 FORMAT(' ',13X,F9.3,23X,F9.3) 00002510 1040 FORMAT(' ',///,10X,F8.4,2X,'.LE.',F7.3,2X,'.LE.',2X,F8.4) 00002520 1050 FORMAT(' ',////,10X,'AT',I3,'% THE HYPOTHESIS THAT THE APRIORI VAR00002530 1IANCE FACTOR EQUALS',F7.3,' CAN BE REJECTED') 00002540 1060 FORMAT(' ',////,10X,'AT',I3,'% THE HYPOTHESIS THAT THE APRIORI VAR00002550 1IANCE FACTOR EQUALS',F7.3,' CAN NOT BE REJECTED') 00002560 END 00002570 FUNCTION XNORM(ALF,XMEAN,SIG) 00002580 C 00002590 C PERCENTILES OF THE NORMAL DISTRIBUTION N(XMEAN,SIG) 00002600 C INPUT 00002610 C ALF = PROBABILITY INTEGRAL FROM NEGATIVE INFINITY TO XNORM 00002620 C XMEAN = POPULATION MEAN 00002630 C SIG = POPULATION STANDARD DEVIATION 00002640 C OUTPUT 00002650 C XNORM = ABSCISSA VALUE OF N(XMEAN,SIG) CORRESPONDING TO 00002660 C PROBABILITY ALF 00002670 C ABRAMOWITZ AND STEGUN EQUATION 26.2.23 IS USED 00002680 C ACCURACY BETTER THAN THAN 0.00045 00002690 C 00002700 IMPLICIT REAL*8(A-H,O-Z) 00002710 DIMENSION C(6) 00002720 DATA C/2.515517D0,0.802853D0,0.010328D0,1.432788D0,0.189269D0, 00002730 * 0.001308D0/ 00002740 C 00002750 C CHECK FOR INVALID INTEGRAL 00002760 C 00002770 IF(ALF .GE. 1D0 .OR. ALF .LE. 0D0) GO TO 20 00002780 SIGN = -1. 00002790 P = ALF 00002800 IF(ALF .LT. 0.5D0) GO TO 10 00002810 C 00002820 C NORMAL DISTRIBUTION SYMMETRIC ONLY HALF REQUIRED 00002830 C 00002840 SIGN = 1. 00002850 P = 1. - ALF 00002860 C 00002870 C COMPUTE ABSCISSA 00002880 C 00002890 10 T = DSQRT(DLOG(1./P**2)) 00002900 T2 = T * T 00002910 T3 = T * T2 00002920 XP = T - (C(1)+C(2)*T+C(3)*T2) / (1.+C(4)*T+C(5)*T2+C(6)*T3) 00002930 XP = XP * SIGN 00002940 XNORM = XMEAN + XP * SIG 00002950 RETURN 00002960 C 00002970 C ERROR EXIT INTEGRAL MUST OB ON 0,1 00002980 C 00002990 20 WRITE(6,1000) ALF 00003000 XNORM = 0. 00003010 STOP 00003020 1000 FORMAT(10X,'XNORM INPUT PROBABILITY=',E20.10) 00003030 END 00003040 FUNCTION CHISQ(A,N) 00003050 C 00003060 C PERCENTILES OF THE CHI-SQUARE DISTRIBUTION X(N) 00003070 C INPUT 00003080 C A = PROBABILITY INTEGRAL FROM ZERO TO CHISQ 00003090 C N = NUMBER OF DEGREES OF FREEDOM 00003100 C OUTPUT 00003110 C CHISQ = ABSCISSA VALUE OF X(N) CORRESPONDING TO PROBABILITY A 00003120 C ABRAMOWITZ AND STEGUN EQUATION 26.4.17 IS USED (WILSON-HILFERTY APPROX00003130 C ACCURACY BETTER THAN 0.04 FOR N .GT. 1 00003140 C 00003150 IMPLICIT REAL*8(A-H,O-Z) 00003160 CHISQ =N*(1-2./(9.*N)+XNORM(A,0D0,1D0)*DSQRT(2D0/(9.*N)))**3 00003170 RETURN 00003180 END 00003190 SUBROUTINE FIT(DJOB,X,NX,SLEV,NCODE) 00003200 C 00003210 C CHI SQUARE GOODNESS OF FIT TO A STANDARD NORMAL DISTRIBUTATION. 00003220 C 00003230 C DESCRIPTION OF PARAMETERS 00003240 C NI - NUMBER OF OBSERVATIONS 00003250 C SF - SMALLEST ALLOWABLE EXPECTED FREQUENCY FOR THE NORMAL 00003260 C DISTRIBUTION WITH WHICH THE OBSERVED DISTRIBUTION IS TO 00003270 C BE COMPARED (SF.GE.1) 00003280 C NINT - NUMBER OF INTERVALS INTO WHICH THE DISTRIBUTION SHOULD 00003290 C BE DIVIDED 00003300 C SIZ - INTERVAL SIZE DESIRED 00003310 C ('SIZ' WILL BE USED TO DETERMINE THE INTERVALS IF 'NINT'00003320 C EQUALS ZERO) 00003330 C X - SAMPLE 00003340 C 00003350 C NOTE : A MAXIMUM OF 200 INTERVALS CAN BE HANDLED 00003360 C : ONLY ONE OF NINT OR SIZ MAY BE SPECIFIED 00003370 C 00003380 C 00003390 IMPLICIT REAL*8 (A-H,O-Z) 00003400 DIMENSION Z(201),P(201),EF(201),DJOB(20),NCTR(201),X(NX),F(201) 00003410 DIMENSION NEF(201) 00003420 C 00003430 C WRITE APRIORI INFORMATION 00003440 C 00003450 READ(5,1000) NINT,SF,SIZ 00003460 WRITE(6,1010) DJOB 00003470 IF(NCODE.EQ.30) WRITE(6,1020) 00003480 IF(NCODE.EQ.40) WRITE(6,1030) 00003490 C 00003500 C COMPUTE RANGE,INTERVALS,FREQ. COUNTS 00003510 C 00003520 R1=1.D6 00003530 R2=1.D-6 00003540 DO 10 I=1,201 00003550 10 NCTR(I)=0.D0 00003560 C 00003570 C DETERMINE SAMPLE LIMITS 00003580 C 00003590 DO 20 I=1,NX 00003600 IF(X(I).LT.R1) R1=X(I) 00003610 IF(X(I).GT.R2) R2=X(I) 00003620 20 CONTINUE 00003630 C 00003640 C DETERMINE NO. OF INTERVALS IF REQUIRED 00003650 C 00003660 IF(NINT)30,30,40 00003670 30 RA=(R2-R1)/SIZ 00003680 NINT=RA 00003690 IF(RA.GT.NINT)NINT=NINT+1 00003700 R1=R1-SIZ/2.D0 00003710 W=SIZ 00003720 M=NINT+1 00003730 WRITE(6,1040) NX,M,SF,SIZ 00003740 GO TO 50 00003750 C 00003760 C COMPUTE SIZE OF INTERVALS IF REQUIRED 00003770 C 00003780 40 W=(R2-R1)/(NINT-1) 00003790 R1=R1-W/2.D0 00003800 M=NINT 00003810 WRITE(6,1050) NX,NINT,SF,W 00003820 C 00003830 C CLASSIFY OBSERVATIONS INTO THE APPROPRIATE INTERVAL 00003840 C 00003850 50 DO 60 I=1,NX 00003860 KK=((X(I)-R1)/W)+1.D0 00003870 60 NCTR(KK)=NCTR(KK)+1.D0 00003880 DO 70 I=1,M 00003890 70 F(I)=NCTR(I) 00003900 C 00003910 C COMPUTE MEAN,STD.DEV.,CHI-SQ. STATISTIC 00003920 C 00003930 CALL CHINOR(F,M,SF,XB,SD,CHI,NDF,Z,P,EF,NS,N,NP) 00003940 SD=SD*W 00003950 XB=XB*W+R1+W/2.D0 00003960 C 00003970 C COMPUT CHI-SQUARE AT SLEV 00003980 C 00003990 ILEV=(SLEV*100.D0)+0.0005D0 00004000 TEST=CHISQ(SLEV,NDF) 00004010 C 00004020 C PRINT RESULTS 00004030 C 00004040 WRITE(6,1060) XB,SD,CHI,NDF,TEST 00004050 IF(CHI.LT.TEST) WRITE(6,1070) ILEV 00004060 IF(CHI.GE.TEST) WRITE(6,1080) ILEV 00004070 WRITE(6,1090) 00004080 C 00004090 C PRINT OBSERVED AND THEORETICAL DISTRIBUTIONS 00004100 C 00004110 WRITE(6,1100) 00004120 WRITE(6,1110) 00004130 NSS = NS-1 00004140 NXYZ=0 00004150 IF (NS.EQ.1) GO TO 80 00004160 C 00004170 C COMBINE INTERVALS 00004180 C 00004190 NXYZ=1 00004200 J = 1 00004210 JJ = 0 00004220 X(1)=R1+W*JJ 00004230 X(2)=X(1)+W-0.001D0 00004240 WRITE(6,1140) X(1),X(2),F(J),EF(J) 00004250 80 CONTINUE 00004260 IF (NS.LE.2) GO TO 100 00004270 NXYZ=1 00004280 DO 90 J=2,NSS 00004290 JJ = J - 1 00004300 AF=NCTR(J)-NCTR(J-1) 00004310 AEF = EF(J) - EF(J-1) 00004320 X(1)=R1+W*JJ 00004330 X(2)=X(1)+W-0.001D0 00004340 90 WRITE(6,1140) X(1),X(2),AF,AEF 00004350 100 CONTINUE 00004360 IF (NXYZ.EQ.1) WRITE (6,1120) 00004370 DO 110 J=NS,N 00004380 JJ = J - 1 00004390 X(1)=R1+W*JJ 00004400 X(2)=X(1)+W-0.001D0 00004410 WRITE(6,1140) X(1),X(2),F(J),EF(J) 00004420 110 CONTINUE 00004430 IF(N.EQ.M) GO TO 130 00004440 C 00004450 C COMBINED INTERVALS 00004460 C 00004470 WRITE(6,1130) 00004480 NADD = N+1 00004490 DO 120 J=NADD,M 00004500 JJ = J - 1 00004510 X(1)=R1+W*JJ 00004520 X(2)=X(1)+W-0.001D0 00004530 120 WRITE(6,1140) X(1),X(2),F(J),EF(J) 00004540 130 CONTINUE 00004550 DO 140 I=1,M 00004560 140 NEF(I)=EF(I)+0.5D0 00004570 WRITE(6,1150) 00004580 C 00004590 C PLOT THEORETICAL AND OBSERVED DISTRIBUTIONS 00004600 C 00004610 CALL PLOT2(NCTR,NEF,M) 00004620 RETURN 00004630 1000 FORMAT(I5,2F10.3) 00004640 1010 FORMAT('1',////,20A4,//,6X,'CHI-SQUARE GOODNESS OF FIT TO A STANDA00004650 1RD NORMAL DISTRIBUTION',//) 00004660 1020 FORMAT(' ',5X,'DIRECTION AND AZIMUTH RESIDUALS',////) 00004670 1030 FORMAT(' ',5X,'DISTANCE RESIDUALS',////) 00004680 1040 FORMAT(' ',5X,'SAMPLE SIZE : ',I9,//,6X,'NO. OF INTERVALS COMPUTED00004690 1 : ',I4,//,6X,'SMALLEST ALLOWABLE FREQ. : ',F7.3,//,6X,'SIZE OF I00004700 2NTERVALS REQUESTED : ',F7.3,////) 00004710 1050 FORMAT(' ',5X,'SAMPLE SIZE : ',I9,//,6X,'NO. OF INTERVALS REQUESTE00004720 1D : ',I4,//,6X,'SMALLEST ALLOWABLE FREQ. : ',F7.3,//,6X,'SIZE OF I00004730 2NTERVALS (COMPUTED): ',F7.3,////) 00004740 1060 FORMAT(' ',5X,'SAMPLE MEAN : ',F10.3,//,6X,'SAMPLE STD.DEV. : ',F100004750 10.3,//,6X,'COMPUTED CHI-SQ. : ',F10.3,//,6X,'DEGREES OF FREEDOM : 00004760 2',I7,//,6X,'THEORETICAL CHI-SQ. : ',F10.3,////) 00004770 1070 FORMAT(' ',5X,'THE HYPOTHESIS THAT THE SAMPLE IS NORMALLY DISTRIBU00004780 1TED CAN NOT BE REJECTED AT THE ',I3,'% PROBABILITY LEVEL',////) 00004790 1080 FORMAT(' ',5X,'THE HYPOTHESIS THAT THE SAMPLE IS NORMALLY DISTRIBU00004800 1TED IS REJECTED AT THE ',I3,'% PROBABILITY LEVEL',////) 00004810 1090 FORMAT('1',35X,' OBSERVED',6X,'NORMAL') 00004820 1100 FORMAT(33X,'DISTRIBUTION DISTRIBUTION') 00004830 1110 FORMAT (13X,'INTERVAL'//) 00004840 1120 FORMAT(/' **** THE FREQUENCIES ABOVE ARE LESS THAN THE ALLOWED MIN00004850 1IMUM AND HAVE BEEN INCLUDED IN THE NEXT INTERVAL **** '/) 00004860 1130 FORMAT(/' **** THE FREQUENCIES BELOW ARE LESS THAN THE ALLOWED MIN00004870 1IMUM AND HAVE BEEN INCLUDED IN THE LAST INTERVAL ****'/) 00004880 1140 FORMAT(5X,F10.3,2X,'-',2X,F10.3,5X,F5.0,9X,F7.2) 00004890 1150 FORMAT('1',//,6X,'CHI-SQUARE GOODNESS OF FIT HISTOGRAM',///) 00004900 END 00004910 SUBROUTINE CHINOR(F,M,SF,XB,SD,CHI,NDF,Z,P,EF,NS,N,NP) 00004920 IMPLICIT REAL*8 (A-H,O-Z) 00004930 DIMENSION F(M),Z(M),P(M),EF(M) 00004940 C 00004950 C INPUT 00004960 C 00004970 C F IS A VECTOR OF DIMENSION M CONTAINING THE FREQUENCY COUNTS 00004980 C FOR SCORES 0 TO (M-1) AS F(1) TO F(M) 00004990 C M IS THE MAXIMUM POSSIBLE SCORE ON TEST PLUS 1 00005000 C SF IS THE MINIMUM ALLOWABLE EXPECTED FREQUENCY FOR NORMAL DIST00005010 C 00005020 C OUTPUT 00005030 C 00005040 C XB IS THE TEST MEAN 00005050 C SD IS THE TEST STANDARD DEVIATION 00005060 C CHISQ IS THE CHI-SQUARE GOF VALUE FOR OBSERVED DIST VS. NORMAL00005070 C DIST 00005080 C NDF IS THE NUMBER OF DEGREES OF FREEDOM FOR CHISQ 00005090 C Z IS A VECTOR OF DIMENSION M CONTAINING THE Z-SCORES FOR THE 00005100 C M POSSIBLE SCORES ON TEST. SCORE 0 CORRESPONDS TO Z(1). 00005110 C P IS A VECTOR OF M NUMBERS GIVING THE AREAS UNDER THE NORMAL 00005120 C CURVE ABOVE EACH OF THE M Z-SCORES 00005130 C EF IS A VECTOR OF M EXPECTED FREQUENCIES FOR NORMAL DIST 00005140 C CORRESPONDING TO THE M POSSIBLE SCORES. SCORE 0 00005150 C CORRESPONDS TO EF(1). 00005160 C NS IS THE SCORE AT WHICH COMPARISON BETWEEN COLLAPSED OBSERVED00005170 C AND NORMAL DISTRIBUTIONS BEGINS PLUS 1 00005180 C N IS THE SCORE AT WHICH COMPARISON BETWEEN OBSERVED AND NORMAL00005190 C DISTRIBUTIONS ENDS PLUS 1 00005200 C NP IS THE TOTAL NUMBER OF PERSONS WITH SCORES ON THE TEST 00005210 C 00005220 C 00005230 C COMPUTE MEAN AND VARIANCE 00005240 C 00005250 TOTNU = 0.0D0 00005260 SFTS = 0.0D0 00005270 SFTSS = 0.0D0 00005280 DO 10 J=1,M 00005290 FJ = J - 1 00005300 TOTNU = TOTNU + F(J) 00005310 SFTS = SFTS + F(J)*FJ 00005320 10 SFTSS = SFTSS + F(J)*(FJ**2) 00005330 NP = TOTNU 00005340 XB = SFTS/TOTNU 00005350 SD =(DSQRT(TOTNU*(SFTSS)-(SFTS**2)))/TOTNU 00005360 C 00005370 C COMPUTE OBSERVED AND EXPECTED FREQUENCIES 00005380 C 00005390 DO 20 J=1,M 00005400 FJ = J - 1 00005410 FJ = FJ + 0.5D0 00005420 IF (FJ.GE.XB) Z(J) = (FJ-XB)/SD 00005430 IF (FJ.LT.XB) Z(J) = (XB-FJ)/SD 00005440 X = Z(J) 00005450 IF (FJ.GE.XB) P(J) = GAUSS(X) 00005460 IF (FJ.LT.XB) P(J) = 1.0D0 - GAUSS(X) 00005470 IF (J.GT.1) EF(J) = (P(J-1)-P(J))*TOTNU 00005480 20 CONTINUE 00005490 EF(1) = (1.0-P(1))*TOTNU 00005500 EF(M)=P(M-1)*TOTNU 00005510 C 00005520 C COMBINE INTERVALS 00005530 C 00005540 N = 0 00005550 30 N = N+1 00005560 IF (EF(N).LT.SF) GO TO 40 00005570 NS = N 00005580 GO TO 60 00005590 40 EF(N+1) = EF(N+1) + EF(N) 00005600 F(N+1) = F(N+1) + F(N) 00005610 FN = N+1 00005620 NS = N+1 00005630 IF (EF(NS).LT.SF.AND.FN.LT.XB) GO TO 30 00005640 GO TO 60 00005650 50 EF(N) = EF(N) + EF(N-1) 00005660 F(N) = F(N) + F(N-1) 00005670 NS = N 00005680 60 N = N+1 00005690 FN = N 00005700 FMAX = M 00005710 IF (EF(N).LT.SF.AND.FN.LT.XB) GO TO 50 00005720 IF (EF(N).GE.SF.AND.FN.LT.FMAX) GO TO 60 00005730 IF (FN.EQ.FMAX) GO TO 90 00005740 NEND = M-1 00005750 DO 70 IJ = N,NEND 00005760 EF(N) = EF(N) + EF(IJ+1) 00005770 70 F(N) = F(N) + F(IJ+1) 00005780 IF (EF(N).LT.SF) GO TO 80 00005790 GO TO 90 00005800 80 EF(N-1)=EF(N-1) + EF(N) 00005810 F(N-1) = F(N-1) + F(N) 00005820 N = N-1 00005830 C 00005840 C COMPUTE SAMPLE CHISQ 00005850 C 00005860 90 CHI=0.D0 00005870 DO 100 IJ=NS,N 00005880 100 CHI=CHI+((F(IJ)-EF(IJ))**2)/EF(IJ) 00005890 NDF = (N-NS)-2 00005900 RETURN 00005910 END 00005920 FUNCTION GAUSS (Y) 00005930 C 00005940 C NORMAL ABSCISSA VALUE 00005950 C 00005960 IMPLICIT REAL*8 (A-H,O-Z) 00005970 X = Y/1.414214D0 00005980 GAUSS = 0.5D0/(1.D0+.278393D0*X + .230389D0*X**2 + .000972D0*X**3+00005990 1.078108D0*X**4)**4 00006000 RETURN 00006010 END 00006020 SUBROUTINE PLOT2(IA,IB,N) 00006030 C 00006040 C PLOTS THEORETICAL AND OBSERVED DISTRIBUTIONS 00006050 C 00006060 DIMENSION IA(N),IB(N),IPLOT(75) 00006070 DATA IBLANK/' '/,MARKA/'*'/,MARKB/'.'/,IPLUS/'+'/ 00006080 WRITE(6,1000) 00006090 WRITE(6,1010) 00006100 C 00006110 C INITIALIZE PLOTTING VECTOR TO BLANKS 00006120 C 00006130 DO 10 I=1,75 00006140 10 IPLOT(I) = IBLANK 00006150 NCOL=75 00006160 MAX = 0 00006170 C 00006180 C SCALE FREQUENCIES TO PLOTTING SCALE 00006190 C 00006200 DO 20 I = 1,N 00006210 IF(IA(I) .GT. MAX) MAX = IA(I) 00006220 IF(IB(I) .GT. MAX) MAX = IB(I) 00006230 20 CONTINUE 00006240 A = (NCOL - 1.) / MAX 00006250 IF(A .GT. 1) A = 1. 00006260 C 00006270 C PUT PLOTTING SYMBOL INTO PLOT VECTOR 00006280 C 00006290 DO 30 I = 1,N 00006300 J = 1. + A * IA(I) 00006310 K = 1. + A * IB(I) 00006320 IF(J .LT. 1) J = 1 00006330 IF(K .LT. 1) K = 1 00006340 IF(J .GT. NCOL) J = NCOL 00006350 IF(K .GT. NCOL) K = NCOL 00006360 IPLOT(J) = MARKA 00006370 IPLOT(K) = MARKB 00006380 IF(J .EQ. K) IPLOT(J) = IPLUS 00006390 WRITE(6,1020) IPLOT,I,IA(I),IB(I) 00006400 IPLOT(J) = IBLANK 00006410 30 IPLOT(K) = IBLANK 00006420 RETURN 00006430 1000 FORMAT(' ',5X,'LEGEND',68X,'INTERVAL',3X,'OBS.FREQ.',' EXP.FREQ.')00006440 1010 FORMAT(' ',5X,'* OBS. FREQ.',/,6X,'. EXP. FREQ.',/,6X,'+ OBS. &00006450 1 EXP. FREQS. COINCIDENT',//) 00006460 1020 FORMAT(4X,'I',75A1,I5,2I10) 00006470 END 00006480