DIMENSION DATA(100,10),NAMA( 9),NAMB( 9),P(100),Q(100) DATA FTM/0.3048/ WRITE (6,601) 601 FORMAT ('1',10X,'TRANS-CANADA DISCREPANCY'/11X,24('=')////37X, @'INPUT DATA'/37X,10('-')///11X,62('-')/11X,'NO DIST. NEW ELEV @. OLD ELEV. DIST. ELEV. DISCR.'/17X,'(MLS) (FT)',8X, @'(FT)',7X,'(KM) (M) (M)'/11X,62('-')//) I=1 102 READ (5,501) IBM,TMILE,FELN,FELO 501 FORMAT (I2,1X,F6.1,1X,2F10.4) IF (IBM.EQ.99) GO TO 101 DATA(IBM,3)=TMILE*5.28*FTM DATA(IBM,1)=(FELN-FELO)*FTM DATA(IBM,2)=FELN*FTM WRITE (6,602) IBM,TMILE,FELN,FELO,DATA(IBM,3),DATA(IBM,2),DATA(IBM @,1) 602 FORMAT (I3,F9.1,2F12.4,2F9.1,F8.3) I=I+1 GO TO 102 101 N=I-1 WRITE (6,603) 603 FORMAT (1X,62('-')) DO 401 J=4,6 DO 402 I=1,N IF (I.GT.1) GO TO 103 DATA(I,J)=DATA(I,J-3) GO TO 402 103 DATA(I,J)=DATA(I,J-3)-DATA(I-1,J-3) 402 CONTINUE 401 CONTINUE DO 403 J=7,8 DO 404 I=1,N DATA(I,J)=DATA(I,J-3)/DATA(I,6) 404 CONTINUE 403 CONTINUE DO 405 J=9,10 DO 406 I=1,N IF (I.GT.1) GO TO 104 DATA(I,J)=DATA(I,J-2) GO TO 406 104 DATA(I,J)=DATA(I,J-2)-DATA(I-1,J-2) 406 CONTINUE 405 CONTINUE IT=0 106 READ (5,502,END=105) JA,JB,NAMA,NAMB 502 FORMAT (2I3,2X,18A4) IT=IT+1 WRITE (6,604) IT,JA,NAMA,JB,NAMB 604 FORMAT ('1',10X,'CORRELATION TEST NO.',I3/11X,23('=')//11X,'VAR. A @ :',I3,' -- ',9A4/ 11X,'VAR. B :',I3,' -- ',9A4///) S=0.0 CALL REGPLT (DATA(1,JA),DATA(1,JB),N,S,P,Q) GO TO 106 105 WRITE (6,605) 605 FORMAT ('1END OF DATA') STOP END SUBROUTINE REGPLT (A,B,N,S,P,Q) DIMENSION A(1),B(1),P(1),Q(1),IPLT(60,102),KHAR(11) DATA IBLK,IDAS,IPLU,IBAR,IA,IB/' ','-','+','|','A','B'/ DATA KHAR/'*','2','3','4','5','6','7','8','9','#','#'/ DO 400 IX=1,102 DO 400 IY=1,60 IPLT(IY,IX)=IBLK 400 CONTINUE CALL CORREL (A,B,N,AM,AS,BM,BS,COV,RHO) DO 401 I=1,N P(I)=(A(I)-AM)/AS Q(I)=(B(I)-BM)/BS 401 CONTINUE CALL LOCS(KMAX,KMIN,P,1,N) PMAX=P(KMAX) PMIN=P(KMIN) PRAN=PMAX-PMIN CALL LOCS(KMAX,KMIN,Q,1,N) QMAX=Q(KMAX) QMIN=Q(KMIN) QRAN=QMAX-QMIN YRAN=AMIN1(PRAN,QRAN) XRAN=AMAX1(PRAN,QRAN) IF (S.NE.0.0) GO TO 101 SY=YRAN/7.25 SX=XRAN/10.0 S=AMAX1(SX,SY) 101 IF (S.LE.1.0) GO TO 102 NSD=S+1 NI=1 GO TO 103 102 NSD=1 NI=1.0/S 103 S=FLOAT(NSD)/NI YMAX=PMAX XMIN=QMIN IF (PRAN.LT.QRAN) GO TO 104 YMAX=QMAX XMIN=PMIN 104 IYA=((7.25-YRAN/S)/2.+YMAX/S)*8.+1 IXA=((10.0-XRAN/S)/2.-XMIN/S)*10.+1 DO 402 I=2,101 IPLT(1,I)=IDAS IPLT(60,I)=IDAS IPLT(IYA,I)=IDAS IF (I.GT.59) GO TO 402 IPLT(I,1)=IBAR IPLT(I,102)=IBAR IPLT(I,IXA)=IBAR 402 CONTINUE IPLT(1,1)=IPLU IPLT(1,102)=IPLU IPLT(IYA,IXA)=IPLU IPLT(60,1)=IPLU IPLT(60,102)=IPLU DO 403 I=1,100 IX=I/S*10.+0.5 IXP=IXA+IX IXM=IXA-IX IY=I/S*8.+0.5 IYM=IYA+IY IYP=IYA-IY K=0 IF (IXP.GT.101) GO TO 105 IPLT(IYA,IXP)=IPLU K=1 105 IF (IXM.LT.2) GO TO 106 IPLT(IYA,IXM)=IPLU K=1 106 IF (IYM.GT.59) GO TO 107 IPLT(IYM,IXA)=IPLU K=1 107 IF (IYP.LT.2) GO TO 108 IPLT(IYP,IXA)=IPLU K=1 108 IF (K.EQ.0) GO TO 109 403 CONTINUE 109 J=0 DO 404 I=1,N Y=P(I) X=Q(I) IF (PRAN.LT.QRAN) GO TO 110 Y=Q(I) X=P(I) 110 Y=-Y/S*8. IY=Y+SIGN(0.5,Y)+IYA IF (IY.LT.1.OR.IY.GT.60) GO TO 404 IX=X/S*8.+SIGN(0.5,X)+IXA IF (IX.LT.1.OR.IX.GT.100) GO TO 404 J=J+1 DO 405 K=1,10 IF (IPLT(IY,IX).EQ.KHAR(K)) GO TO 111 405 CONTINUE IPLT(IY,IX)=KHAR(1) GO TO 404 111 IPLT(IY,IX)=KHAR(K+1) 404 CONTINUE WRITE(6,601) (I,A(I),B(I),P(I),Q(I),I=1,N) 601 FORMAT (12X,52('-')/13X,'NO.',8X,'"A"',11X,'"B"',7X,'STD. A STD @. B'/12X,52('-')//(12X,I4,2F14.4,2F10.3)) WRITE (6,602) AM,BM,AS,BS,COV,RHO,J 602 FORMAT (/1X,63('-')////10X,'MEAN =',F13.4,F14.4/' STANDARD DEVN. @=',F13.4,F14.4//4X,'COVARIANCE =',F13.4/3X,'CORRELATION =',F13.4 @//3X,'NO. PLOTTED =',I8) KY=IA KX=IB IF (PRAN.LT.QRAN) GO TO 112 KY=IB KX=IA 112 WRITE (6,603) KY,KX,NSD,NI 603 FORMAT (/22X,'A'/22X,'|'/19X,'"',A1,'"|'/22X,'|'/' PLOT ORIENTATIO @N |'/22X,'|'/22X,'+------>'/25X,'"',A1,'"'//' SCALE OF PLOT = @',I4,' STD. DEVN(S). TO',I2,' INCH(ES)') WRITE (6,604) ((IPLT(IY,IX),IX=1,102),IY=1,60) 604 FORMAT ('1',2X,102A1/(3X,102A1)) RETURN END SUBROUTINE CORREL (A,B,N,AM,AS,BM,BS,COV,RHO) DIMENSION A(1),B(1) SIGA=0. SIGB=0. SIGAA=0. SIGBB=0. SIGAB=0. DO 401 I=1,N SIGA=SIGA+A(I) SIGB=SIGB+B(I) SIGAA=SIGAA+A(I)**2 SIGBB=SIGBB+B(I)**2 SIGAB=SIGAB+A(I)*B(I) 401 CONTINUE AM=SIGA/N BM=SIGB/N NMO=N-1 AS=SQRT((SIGAA-N*AM**2)/NMO) BS=SQRT((SIGBB-N*BM**2)/NMO) COV=(SIGAB-N*AM*BM)/NMO RHO=COV/(AS*BS) RETURN END