C ANALYTICAL BLOCK ADJUSTMENT 99 PHOTOS AND 700 OBJECTS LIMIT /**/00100000 IMPLICIT REAL*8(A-H,O-Z) 00100010 DEFINE FILE 3(2500,25,U,KK3) 00100020 DEFINE FILE 10(5200,72,U,KK4) 00100030 DEFINE FILE 11(110,1044,U,KK5) 00100040 REAL*8CAM(99,40),C(20,3),D(6,7) 00100050 COMMON/AREA4/CAM,C,D,FL,RESID,ITOTAL,LARRY,IJOB,I8,JS2,KFF4,KP9, 00100060 1NPUNC,I9,KK3,JS1,NREAD,KD4,KP8,NPRNT,KD3,JISECT,JCOORD,JRESCT,JS3,00100070 2IFROM,ITO,KTOT,N7,NN,IDIR,KK5,KD5 00100080 NREAD=5 00100090 NPRNT=6 00100100 NPUNC=7 00100110 C DATA SET REFERENCE NUMBERS 00100120 JS1=1 00100130 JS2=2 00100140 JS3=4 00100150 KD3=3 00100160 KD4=10 00100170 KD5=11 00100180 74 READ (NREAD,73)IJOB 00100190 C JOB CONTROL CARD 00100200 JCOORD=0 00100210 IF(IJOB.EQ.9)GO TO 75 00100220 IF(IJOB.EQ.8)CALL EXIT 00100230 IF(IJOB.EQ.7)GO TO 77 00100240 GO TO 74 00100250 C RESECTION AND BLOCK OUTPUT ROUTINE 00100260 75 CALL PART6(&72,&74) 00100270 C SOLUTION OF BLOCK NORMAL EQUATIONS 00100280 71 CALL EQUAT1 00100290 CALL PART8(&72,&74) 00100300 GO TO 71 00100310 C INTERSECTION OF POINTS AFTER BLOCK ADJUSTMENT 00100320 72 IF(JISECT.EQ.0)CALL INSECS 00100330 76 IF(JCOORD.EQ.0)CALL KCOORS 00100340 WRITE (NPRNT,542) 00100350 GO TO 74 00100360 77 READ (NREAD,78)IFROM,ITO,JISECT 00100370 GO TO 76 00100380 73 FORMAT (79X,I1) 00100390 78 FORMAT(3I5) 00100400 542 FORMAT (/' BLOCK END') 00100410 END 00100420 C /**/00200000 SUBROUTINE PART6(*,*) 00200010 C 00200020 C R E S E C T I O N & B L O C K O U T P U T USC&GS00200030 C 00200040 IMPLICIT REAL*8(A-H,O-Z) 00200050 REAL*8A(6,700),B(31,3),C(20,3),CAM(99,40),D(6,7),E(29,6),G(4830), 00200060 1P(13,10),Y(87,6),Z(87,6) 00200070 COMMON/AREA3/A,B,E,G,P,Y,Z,SQR,WT712,WT12P,RADIUS,WTCON,WEIGHT,FK,00200080 1SCALE,LINE,NCON,NU,L,ITERAT,IPHO,I,NROW,IP1,IGO,K,ITEST,NMI,NMIP1,00200090 2IOUT,MAX,IMAGE,M,MARK,IRE,J,LAST,N,JULY,JUNE,ME,JOYCE,NEIL,MORT, 00200100 3LROW,NA,KF4 00200110 COMMON/AREA4/CAM,C,D,FL,RESID,ITOTAL,LARRY,IJOB,I8,JS2,KFF4,KP9, 00200120 1NPUNC,I9,KK3,JS1,NREAD,KD4,KP8,NPRNT,KD3,JISECT,JCOORD,JRESCT,JS3,00200130 2IFROM,ITO,KTOT,N7,NN,IDIR,KK5,KD5 00200140 776 ITERAT=1 00200150 REWIND JS1 00200160 REWIND JS2 00200170 REWIND JS3 00200180 IGO=1 00200190 IOUT=1 00200200 IRE=1 00200210 LINE=0 00200220 READ (NREAD,531) 00200230 WRITE (NPRNT,531) 00200240 WRITE (NPRNT,532) 00200250 IPHO=0 00200260 C P H O T O R E S E C T I O N P H A S E 00200270 755 DO 638 K=1,29 00200280 638 E(K,1)=0.D0 00200290 DO 639 K=1,700 00200300 639 A(1,K)=0.D0 00200310 C READ BLOCK CONSTANTS 00200320 READ (NREAD,524)LARRY,FL,WT712,WT12P,WTCON,MAX,RESID,JRESCT,JISECT00200330 1,JCOORD,IFROM,ITO 00200340 C READ IN ALL GROUND COORDINATES FOR BLOCK 00200350 J=1 00200360 605 NCON=J+5 00200370 READ (NREAD,527)(G(I),I=J,NCON),ITEST 00200380 IF(ITEST.NE.0)GO TO 670 00200390 NCON=NCON/6 00200400 IF(NCON-804)603,603,801 00200410 603 J=J+6 00200420 GO TO 605 00200430 670 NCON=NCON/6 00200440 IF(NCON-805)604,604,801 00200450 801 WRITE (NPRNT,529)NCON 00200460 CALL EXIT 00200470 C READ IN REFINED IMAGE COORDINATES FOR PLATE BEING RESECTED 00200480 604 READ (NREAD,525)B(30,1),B(30,2),B(30,3),B(31,1),B(31,2) 00200490 IF(LARRY)804,804,805 00200500 805 FL=B(31,2) 00200510 804 IMAGE=1 00200520 602 READ (NREAD,526)(B(IMAGE,J),J=1,3),ITEST 00200530 IF(ITEST.NE.0)GO TO 601 00200540 IF(IMAGE.GT.28)GO TO 611 00200550 600 IMAGE=IMAGE+1 00200560 GO TO 602 00200570 601 B(31,3)=IMAGE 00200580 IF(IMAGE-29)880,880,611 00200590 611 WRITE (NPRNT,545)B(30,1),IMAGE 00200600 CALL EXIT 00200610 C STORE IN DISK THE REFINED IMAGE COORDINATES OF THIS PLATE FOR USE 00200620 C IN RESECTION AND BLOCK ADJUSTMENT 00200630 880 WRITE (JS1)B 00200640 C EXTRACT GROUND COORDINATES FOR PLATE AND PLACE IN E ARRAY 00200650 764 LAST=0 00200660 NU=0 00200670 IF(B(30,2).EQ.0.D0)GO TO 630 00200680 631 NROW=7 00200690 NU=6 00200700 GO TO 637 00200710 630 IF(B(30,3).EQ.0.D0)GO TO 634 00200720 633 NROW=1 00200730 NMI=12 00200740 LAST=1 00200750 GO TO 632 00200760 634 NROW=1 00200770 637 NMI=B(31,3) 00200780 632 DO 792 K=NROW,NMI 00200790 J=B(K,1)/100000.D0 00200800 FK=J*100000 00200810 FK=B(K,1) -FK 00200820 IF(ITERAT-1)790,790,780 00200830 790 GO TO (781,780),IOUT 00200840 780 DO 782 M=1,LINE 00200850 IF(FK-A(1,M))782,783,782 00200860 782 CONTINUE 00200870 783 NU=NU+1 00200880 DO 784 J=1,4 00200890 784 E(NU,J)=A(J,M) 00200900 GO TO 792 00200910 781 DO 607 M=1,NCON 00200920 I=6*M-5 00200930 IF(FK-G(I))607,629,607 00200940 607 CONTINUE 00200950 WRITE (NPRNT,528)FK 00200960 CALL EXIT 00200970 629 NU=NU+1 00200980 DO 606 J=1,6 00200990 E(NU,J)=G(I) 00201000 606 I=I+1 00201010 792 CONTINUE 00201020 IF(LAST)635,635,636 00201030 636 IF(IMAGE-18)635,635,649 00201040 649 NROW=19 00201050 NU=18 00201060 LAST=0 00201070 GO TO 637 00201080 C EXPEDITE OBJECT ORDER LIST IN A ARRAY BY STORING E ARRAY IN DISK 00201090 635 WRITE (JS2)E 00201100 IF(ITERAT-1)761,761,762 00201110 761 GO TO (785,762),IOUT 00201120 762 IF(B(31,1))673,673,675 00201130 675 GO TO (757,758),IOUT 00201140 C ESTABLISH ORDER LIST OF OBJECTS IN A ARRAY 00201150 785 DO 640 K=1,IMAGE 00201160 IF(E(K,1))640,640,641 00201170 641 NU=1 00201180 646 IF(E(K,1)-A(1,NU))642,640,642 00201190 642 IF(A(1,NU))644,643,644 00201200 643 DO 645 J=1,6 00201210 645 A(J,NU)=E(K,J) 00201220 LINE=LINE+1 00201230 GO TO 640 00201240 644 NU=NU+1 00201250 GO TO 646 00201260 640 CONTINUE 00201270 C INITIAL APPROXIMATIONS OF CAMERA PARAMETERS 00201280 N=0 00201290 DO 608 J=1,2 00201300 C(1,J)=E(11,J+1) 00201310 C(2,J)=0.D0 00201320 608 C(3,J)=1.D0 00201330 C ADJUST APPROXIMATE AZIMUTH PARAMETERS FOR SWING AND Z0 00201340 DO 609 I=1,2 00201350 D(1,I)=B(7,I+1)-B(9,I+1) 00201360 609 D(2,I)=E(7,I+1)-E(9,I+1) 00201370 D(2,4)=D(2,1)*D(2,1) +D(2,2)*D(2,2) 00201380 D(1,3)=(D(2,1)*D(1,1) +D(2,2)*D(1,2))/D(2,4) 00201390 D(2,3)=(D(2,2)*D(1,1) -D(2,1)*D(1,2))/D(2,4) 00201400 SCALE=DSQRT(D(1,3)*D(1,3)+ D(2,3)*D(2,3)) 00201410 C(2,3)=D(2,3)/SCALE 00201420 C(1,3)=FL/SCALE 00201430 C(3,3)=D(1,3)/SCALE 00201440 C ORIENTATION FACTORS IN C ARRAY 00201450 610 N=N+1 00201460 IF(N- 9)652,652,695 00201470 695 WRITE (NPRNT,535)B(30,1) 00201480 WRITE (NPRNT,540) (B(30,1),(C(I,J),J=1,3),I=1,2) 00201490 IRE=2 00201500 GO TO 893 00201510 652 C(4,1)=C(3,2)*C(3,3) 00201520 C(5,1)=-C(3,2)*C(2,3) 00201530 C(6,1)=C(2,2) 00201540 C(10,1)=-C(2,2)*C(3,3) 00201550 C(11,1)=C(2,2)*C(2,3) 00201560 C(12,1)=C(3,2) 00201570 C(10,2)=C(4,1)*C(2,1) 00201580 C(11,2)=C(5,1)*C(2,1) 00201590 C(12,2)=C(2,1)*C(2,2) 00201600 C(10,3)=-C(4,1)*C(3,1) 00201610 C(11,3)=-C(5,1)*C(3,1) 00201620 C(12,3)=-C(3,1)*C(2,2) 00201630 C(4,2)=C(3,1)*C(2,3) +C(12,2)*C(3,3) 00201640 C(5,2)=C(3,1)*C(3,3) -C(12,2)*C(2,3) 00201650 C(6,2)=-C(2,1)*C(3,2) 00201660 C(4,3)=C(2,1)*C(2,3) +C(10,1)*C(3,1) 00201670 C(5,3)=C(2,1)*C(3,3) +C(11,1)*C(3,1) 00201680 C(6,3)=C(3,1)*C(3,2) 00201690 DO 612 I=7,9 00201700 C(I,1)=0.D0 00201710 C(I,2)=-C(I-3,3) 00201720 C(I,3)=C(I-3,2) 00201730 C(13,I-6)=C(5,I-6) 00201740 C(14,I-6)=-C(4,I-6) 00201750 612 C(15,I-6)=0.D0 00201760 GO TO (613,809),IGO 00201770 C CLEAR NORMAL EQUATION D ARRAY TO ZERO 00201780 613 DO 614 I=1,6 00201790 DO 614 J=I,7 00201800 614 D(I,J)=0.D0 00201810 C COMPUTE P TERMS FOR PASS POINTS USED FOR RESECTION 00201820 IF(B(30,2).EQ.0.D0)GO TO 796 00201830 615 M=7 00201840 NROW=15 00201850 GO TO 617 00201860 796 IF(B(30,3).EQ.0.D0)GO TO 797 00201870 616 M=1 00201880 NROW=9 00201890 GO TO 617 00201900 797 M=1 00201910 NROW=17 00201920 617 DO 618 NU=M,NROW,2 00201930 DO 619 K=1,3 00201940 619 C(16,K)=E(NU,K+1)-C(1,K) 00201950 K=4 00201960 DO 620 L=17,20 00201970 DO 620 I=1,3 00201980 C(L,I)=C(K,1)*C(16,1) + C(K,2)*C(16,2) + C(K,3) *C(16,3) 00201990 620 K=K+1 00202000 DO 621 I=1,2 00202010 DO 622 L=1,4 00202020 622 P(I,L)=(B(NU,I+1)*C(L+16,3) -(-FL)*C(L+16,I))/C(17,3) 00202030 DO 623 L=5,7 00202040 623 P(I,L)=(-B(NU,I+1)*C(6,L-4) +(-FL)*C(I+3,L-4))*C(1,3)/C(17,3) 00202050 621 P(I,8)=-P(I,1) 00202060 C CONTRIBUTION TO NORMAL EQUATIONS 00202070 DO 618 I=1,6 00202080 DO 618 J=I,7 00202090 DO 618 K=1,2 00202100 618 D(I,J)=D(I,J)+P(K,I+1)*P(K,J+1) 00202110 C FORWARD SOLUTION 00202120 624 DO 699 I=1,6 00202130 SQR=DSQRT(D(I,I)) 00202140 DO 698 J=I,7 00202150 698 D(I,J)=D(I,J)/SQR 00202160 IF(I-6)697,696,696 00202170 697 IP1=I+1 00202180 DO 699 L=IP1,6 00202190 DO 699 J=L,7 00202200 699 D(L,J)=D(L,J)-D(I,L)*D(I,J) 00202210 C BACK SOLUTION 00202220 696 D(6,7)=D(6,7)/D(6,6) 00202230 DO 691 I=1,5 00202240 NMI=6-I 00202250 NMIP1=NMI+1 00202260 DO 690 J=NMIP1,6 00202270 690 D(NMI,7)=D(NMI,7)-D(J,7)*D(NMI,J) 00202280 691 D(NMI,7)=D(NMI,7)/D(NMI,NMI) 00202290 DO 625 I=4,6 00202300 625 D(I,7)=D(I,7)*C(1,3) 00202310 C ADD LEAST SQUARES RESULTS TO CAMERA PARAMETERS IN C ARRAY 00202320 DO 626 J=1,3 00202330 C(1,J)=C(1,J)+D(J+3,7) 00202340 C(4,J)=D(J,7) 00202350 C(5,J)=DSQRT(1.D0-C(4,J)*C(4,J)) 00202360 C(6,J)=C(2,J)*C(5,J)+C(3,J)*C(4,J) 00202370 C(7,J)=C(3,J)*C(5,J) -C(2,J)*C(4,J) 00202380 C(2,J)=C(6,J) 00202390 626 C(3,J)=C(7,J) 00202400 C TEST MAGNITUDE OF CORRECTIONS FOR ORIETATION PARAMETERS 00202410 627 DO 628 I=1,3 00202420 IF(DABS(D(I,7))-.00001D0)628,628,610 00202430 628 CONTINUE 00202440 JPHO=IPHO+1 00202450 WRITE (NPRNT,7)JPHO,N 00202460 C STORE CAMERA PARAMETERS AS COMPUTED FROM PHOTO RESECTION 00202470 893 IPHO=IPHO+1 00202480 CAM(IPHO,1)=B(30,1) 00202490 DO 647 J=1,3 00202500 IF( JRESCT.EQ.1)WRITE (NPRNT,6)(C(I,J),I=1,3) 00202510 CAM(IPHO,J+37)=C(3,J) 00202520 CAM(IPHO,J+1)=C(2,J) 00202530 647 CAM(IPHO,J+4)=C(1,J) 00202540 IF(B(31,1))604,604,765 00202550 765 IF(IRE-2)763,894,894 00202560 894 CALL EXIT 00202570 C STORE A ARRAY IN DISK AND PRINT THE NUMBER OF OBJECT POSITIONS 00202580 C TO BE COMPUTED IN THE BLOCK 00202590 763 IF(LINE-700)810,810,811 00202600 811 WRITE (NPRNT,544)LINE 00202610 CALL EXIT 00202620 810 ITOTAL=IPHO 00202630 WRITE (NPRNT,543)ITOTAL,LINE 00202640 IF(JRESCT.EQ.1)RETURN 2 00202650 KTOT=LINE 00202660 757 WRITE (KD3'0001)((A(I,J),J=1,LINE),I=1,6) 00202670 C B L O C K A D J U S T M E N T P H A S E 00202680 IGO=2 00202690 DO 819 I=1,2694 00202700 819 G(I)=0.D0 00202710 IF(ITERAT-1)730,730,760 00202720 730 DO 766 J=1,LINE 00202730 G(3*J+2692)=A(1,J) 00202740 G(3*J+2693)=A(5,J) 00202750 766 G(3*J+2694)=A(6,J) 00202760 760 DO 816 J=1,LINE 00202770 DO 816 I=1,6 00202780 816 A(I,J)=0.D0 00202790 758 IPHO=0 00202800 REWIND JS1 00202810 REWIND JS2 00202820 C RESET REFINED IMAGE AND GROUND COORDINATES IN B AND E ARRAYS 00202830 756 READ (JS1)B 00202840 READ (JS2)E 00202850 GO TO (759,768),IOUT 00202860 759 MARK=0 00202870 ITEST=1 00202880 DO 802 I=4795,4830 00202890 802 G(I)=0.D0 00202900 C RESET CAMERA PARAMETERS IN C ARRAY 00202910 768 IPHO=IPHO+1 00202920 DO 812 J=1,3 00202930 C(1,J)=CAM(IPHO,J+4) 00202940 C(2,J)=CAM(IPHO,J+1) 00202950 812 C(3,J)=CAM(IPHO,J+37) 00202960 GO TO 652 00202970 809 LAST=0 00202980 IF(LARRY.EQ.0)GO TO 767 00202990 807 FL=B(31,2) 00203000 C COMPUTE C ARRAY ROWS 16 THROUGH 20 FOR EACH IMAGE 00203010 767 IF(B(30,2).EQ.0.D0)GO TO 650 00203020 648 NMI=7 00203030 GO TO 651 00203040 650 IF(B(30,3).EQ.0.D0)GO TO 653 00203050 654 NMI=1 00203060 NROW=12 00203070 LAST=1 00203080 GO TO 655 00203090 653 NMI=1 00203100 651 NROW=B(31,3) 00203110 655 DO 656 NU=NMI,NROW 00203120 GO TO (866,867),IOUT 00203130 867 DO 868 J=1,LINE 00203140 IF(E(NU,1)-A(1,J))868,869,868 00203150 868 CONTINUE 00203160 869 JULY=3*J 00203170 IF(A(5,J).EQ.0.D0)GO TO 870 00203180 871 E(NU,2)=E(NU,2)+G(JULY-2) 00203190 E(NU,3)=E(NU,3)+G(JULY-1) 00203200 870 IF(A(6,J).EQ.0.D0)GO TO 866 00203210 872 E(NU,4)=E(NU,4)+G(JULY) 00203220 866 DO 657 K=1,3 00203230 657 C(16,K)=E(NU,K+1)-C(1,K) 00203240 GO TO (873,874),IOUT 00203250 874 J=17 00203260 GO TO 875 00203270 873 J=20 00203280 875 K=4 00203290 DO 658 L=17,J 00203300 DO 658 I=1,3 00203310 C(L,I)=C(K,1)*C(16,1) + C(K,2)*C(16,2) + C(K,3)*C(16,3) 00203320 658 K=K+1 00203330 GO TO (769,770),IOUT 00203340 C COMPUTE P COEFFICIENTS OF OBSERVATION EQUATIONS FOR EACH IMAGE 00203350 769 DO 659 I=1,2 00203360 DO 660 L=1,4 00203370 660 P(I,L)=(B(NU,I+1)*C(L+16,3)-(-FL)*C(L+16,I))/C(17,3) 00203380 DO 659 L=5,7 00203390 659 P(I,L)=(-B(NU,I+1)*C(6,L-4)+(-FL)*C(I+3,L-4))*CAM(1,7)/C(17,3) 00203400 C ARRANGE AUGMENTED COEFFICIENT MATRIX 00203410 DO 661 I=3,4 00203420 DO 662 N=1,3 00203430 662 P(I,N)=-P(I-2,N+4) 00203440 DO 663 N=4,9 00203450 663 P(I,N)=P(I-2,N-2) 00203460 661 P(I,10)=-P(I-2,1) 00203470 C WEIGHTING THE CONTROL STATION OBSERVATION EQUATIONS 00203480 DO 860 J=1,LINE 00203490 IF(E(NU,1)-G(3*J+2692))860,864,860 00203500 860 CONTINUE 00203510 864 IF(G(3*J+2693))862,861,862 00203520 861 IF(G(3*J+2694))862,865,862 00203530 862 DO 863 I=3,4 00203540 DO 863 J=1,10 00203550 863 P(I,J)=P(I,J)*WTCON 00203560 865 CONTINUE 00203570 C WEIGHTING EQUATIONS FOR LOCATION OF IMAGE ON PLATE (RESOLUTION) 00203580 RADIUS=DSQRT(B(NU,2)*B(NU,2) + B(NU,3)*B(NU,3)) 00203590 IF(RADIUS-.07D0)727,727,779 00203600 779 IF(RADIUS-.12D0)786,786,787 00203610 786 WEIGHT=WT712 00203620 GO TO 788 00203630 787 WEIGHT=WT12P 00203640 788 DO 789 I=3,4 00203650 DO 789 J=1,10 00203660 789 P(I,J)=P(I,J)*WEIGHT 00203670 C CONTRIBUTION TO COMPRESSED NORMAL EQUATIONS 00203680 727 DO 664 I=5,13 00203690 DO 664 J=1,10 00203700 664 P(I,J)=0.D0 00203710 DO 665 I=1,9 00203720 DO 665 IP1=3,4 00203730 DO 665 M=I,10 00203740 665 P(I+4,M)=P(I+4,M)+P(IP1,I)*P(IP1,M) 00203750 DO 666 J=1,LINE 00203760 IF(E(NU,1)-G(3*J+2692))666,667,666 00203770 666 CONTINUE 00203780 667 DO 668 I=1,3 00203790 668 A(I,J)=A(I,J)+P(5,I) 00203800 A(4,J)=A(4,J)+P(6,2) 00203810 A(5,J)=A(5,J)+P(6,3) 00203820 A(6,J)=A(6,J)+P(7,3) 00203830 G(3*J-2)=G(3*J-2)+P(5,10) 00203840 G(3*J-1)=G(3*J-1)+P(6,10) 00203850 G(3*J)=G(3*J)+P(7,10) 00203860 DO 672 I=5,7 00203870 MARK=MARK+1 00203880 L=4 00203890 DO 672 K=1,6 00203900 Z(MARK,K)=P(I,L) 00203910 672 L=L+1 00203920 I=8 00203930 L=4 00203940 DO 674 N=4795,4830 00203950 G(N)=G(N)+P(I,L) 00203960 I=I+1 00203970 IF(I-13)674,674,817 00203980 817 L=L+1 00203990 I=8 00204000 674 CONTINUE 00204010 NMIP1=2100+6*IPHO-5 00204020 DO 676 I=8,13 00204030 G(NMIP1)=G(NMIP1)+P(I,10) 00204040 676 NMIP1=NMIP1+1 00204050 CAM(IPHO,ITEST+7)=E(NU,1) 00204060 ITEST=ITEST+1 00204070 GO TO 656 00204080 C BLOCK FINALIZED COMPUTE X,Y PLATE RESIDUALS 00204090 770 DO 771 I=1,2 00204100 771 P(I,1)=(B(NU,I+1)*C(17,3)-(-FL)*C(17,I))/C(17,3) 00204110 WRITE (NPRNT,540)B(NU,1),P(1,1),P(2,1) 00204120 P(1,10)=P(1,10)+P(1,1)*P(1,1) 00204130 P(2,10)=P(2,10)+P(2,1)*P(2,1) 00204140 SCALE=SCALE+2.D0 00204150 656 CONTINUE 00204160 GO TO (693,694),IOUT 00204170 C BLOCK FINALIZED RECYCLE FOR OTHER PLATES IN THE BLOCK 00204180 694 IF(LAST)773,773,772 00204190 772 IF(B(31,3)-18.D0)773,773,774 00204200 773 IF(B(31,1))756,756,775 00204210 774 NMI=19 00204220 LAST=-1 00204230 GO TO 651 00204240 C BLOCK FINALIZED PRINT OUT RMS RESIDUAL AND CAMERA PARAMETERS 00204250 C FOR ENTIRE BLOCK 00204260 775 P(1,10)=DSQRT((P(1,10)+P(2,10))/SCALE) 00204270 WRITE (NPRNT,538)P(1,10) 00204280 WRITE (NPRNT,539) 00204290 DO 800 I=1,IPHO 00204300 WRITE (NPRNT,540)(CAM(I,J),J=1,4) 00204310 800 WRITE (NPRNT,540)CAM(I,1),(CAM(I,J),J=38,40) 00204320 WRITE (NPRNT,541) 00204330 WRITE (NPRNT,540)(CAM(I,1),(CAM(I,J),J=5,7),I=1,IPHO) 00204340 C O B J E C T I N T E R S E C T I O N P H A S E 00204350 RETURN 1 00204360 C B L O C K A D J U S T M E N T C O M P L E T E D 00204370 C I N I T I A L I Z E F O R N E X T B L O C K 00204380 C RECYCLE FOR OTHER PLATES THAT CONTRIBUTE EQUATIONS 00204390 C TO THE LEAST SQUARES BLOCK ADJUSTMENT 00204400 693 IF(LAST)680,680,678 00204410 678 IF(B(31,3)-18.D0)680,680,679 00204420 680 CAM(IPHO,37)=ITEST-1 00204430 WRITE (KD5'IPHO)Z 00204440 KP8=IPHO-1 00204450 KP9=0 00204460 IF(IPHO.EQ.1)GO TO 91 00204470 DO 90 I9=1,KP8 00204480 90 KP9=KP9+I9 00204490 91 WRITE (KD4'IPHO*ITOTAL-ITOTAL+IPHO-KP9)(G(I8),I8=4795,4830) 00204500 IF(B(31,1))756,756,677 00204510 679 NMI=19 00204520 LAST=-1 00204530 GO TO 651 00204540 C WEIGHTING THE POSITIONS OF THE CONTROL STATIONS 00204550 677 DO 791 J=1,LINE 00204560 IF(G(3*J+2693))846,846,847 00204570 847 A(1,J)=A(1,J)*G(3*J+2693) 00204580 A(4,J)=A(4,J)*G(3*J+2693) 00204590 846 IF(G(3*J+2694))791,791,848 00204600 848 A(6,J)=A(6,J)*G(3*J+2694) 00204610 791 CONTINUE 00204620 RETURN 00204630 ENTRY PART8 00204640 754 WRITE (NPRNT,533)ITERAT,G(L) 00204650 IF(DABS(G(L))-.00001D0)746,746,747 00204660 C ITERATION REQUIRED 00204670 747 ITERAT=ITERAT+1 00204680 IF(ITERAT-MAX)748,748,746 00204690 748 REWIND JS1 00204700 REWIND JS2 00204710 673 READ (JS1)B 00204720 GO TO 764 00204730 C BLOCK FINALIZED OUTPUT OF X,Y,Z ON GROUND 00204740 746 WRITE (NPRNT,534) 00204750 WRITE (NPRNT,540)((A(J,I),J=1,4),I=1,LINE) 00204760 WRITE (NPUNC,540)((A(J,I),J=1,4),I=1,LINE) 00204770 DO 20 I=1,LINE 00204780 20 WRITE (JS3)(A(J,I),J=1,4) 00204790 C BLOCK FINALIZED OUTPUT OF LAST DX,DY,DZ COMPUTED FOR CONTROL 00204800 C STATIONS BY LEAST SQUARES BLOCK SOLUTION 00204810 WRITE (NPRNT,530) 00204820 DO 721 M=1,LINE 00204830 IF(A(5,M))843,843,703 00204840 843 IF(A(6,M))721,721,703 00204850 703 JULY=3*M 00204860 JUNE=JULY-2 00204870 WRITE (NPRNT,540)A(1,M),(G(I),I=JUNE,JULY) 00204880 721 CONTINUE 00204890 C BLOCK FINALIZED OUTPUT OF X,Y PLATE RESIDUALS 00204900 WRITE (NPRNT,536) 00204910 IOUT=2 00204920 SCALE=0.D0 00204930 P(1,10)=0.D0 00204940 P(2,10)=0.D0 00204950 GO TO 748 00204960 6 FORMAT (3(5X,D16.10)) 00204970 7 FORMAT (3X,2I10) 00204980 524 FORMAT (1X,I1,1X,D16.10,2(3X,F2.1),2X,F2.0,3X,I1,F8.6,5I5) 00204990 525 FORMAT (5X,F5.0,3(2X,F1.0),2X,D16.10) 00205000 526 FORMAT (F10.0,2(2X,D16.10),33X,I1) 00205010 527 FORMAT (2X,F8.0,3(3X,D18.12),2X,2F2.0,I1) 00205020 528 FORMAT (/' GRD. COORD. MISSING AT ',F10.0/) 00205030 529 FORMAT (' GRD. COORD. ENTERED FOR ',I7,' OBJECTS'/) 00205040 530 FORMAT (/T4,'CONTROL',T21,'DX',T40,'DY',T59,'DZ'/) 00205050 531 FORMAT (' HEADING 00205060 1 ') 00205070 532 FORMAT (/T14,'RESECTION'/T11,'PHOTO',T19,'ITER IS'/) 00205080 533 FORMAT (' PASS',I5,' PRODUCES A MAX ORIENTATION COR. OF ',D16.10)00205090 534 FORMAT (/ T5,'OBJECT',T17,'X GROUND',T36,'Y GROUND',T55,'Z GROUND'00205100 1/) 00205110 535 FORMAT (/T3,'PLATE',F10.0,' NEEDS') 00205120 536 FORMAT (/T6,'IMAGE',T16,'X PLATE RESID',T35,'Y PLATE RESID'/) 00205130 538 FORMAT (/T5,'RMS RESID FOR BLOCK = ',D16.10) 00205140 539 FORMAT (/T6,'PLATE',T17,'OMEGA',T36,'PHI',T55,'KAPPA'/) 00205150 540 FORMAT (1X,F10.0,3X,D18.12,3X,D18.12,3X,D18.12) 00205160 541 FORMAT (/T6,'PLATE',T17,'X0',T36,'YO',T55,'Z0'/) 00205170 543 FORMAT (' BLOCK CONTAINS',I4,' PHOTO AND',I6,' OBJECTS'/) 00205180 544 FORMAT (' OBJECTS EXCEED LIMIT',I8) 00205190 545 FORMAT (/' PLATE',F10.0,' HAS',I4,' IMAGES') 00205200 END 00205210 C /**/00300000 SUBROUTINE EQUAT1 00300010 C 00300020 C S O L U T I O N O F B L O C K E Q U A T I O N USC&GS00300030 C 00300040 IMPLICIT REAL*8(A-H,O-Z) 00300050 REAL*8A(6,700),B(31,3),C(20,3),CAM(99,40),D(6,7),E(29,6),G(4830), 00300060 1P(13,10),Y(87,6),Z(87,6) 00300070 COMMON/AREA3/A,B,E,G,P,Y,Z,SQR,WT712,WT12P,RADIUS,WTCON,WEIGHT,FK,00300080 1SCALE,LINE,NCON,NU,L,ITERAT,IPHO,I,NROW,IP1,IGO,K,ITEST,NMI,NMIP1,00300090 2IOUT,MAX,IMAGE,M,MARK,IRE,J,LAST,N,JULY,JUNE,ME,JOYCE,NEIL,MORT, 00300100 3LROW,NA,KF4 00300110 COMMON/AREA4/CAM,C,D,FL,RESID,ITOTAL,LARRY,IJOB,I8,JS2,KFF4,KP9, 00300120 1NPUNC,I9,KK3,JS1,NREAD,KD4,KP8,NPRNT,KD3,JISECT,JCOORD,JRESCT,JS3,00300130 2IFROM,ITO,KTOT,N7,NN,IDIR,KK5,KD5 00300140 C FORWARD SOLUTION OF NORMAL EQUATIONS FOR BLOCK 00300150 J64=KLOCK(J) 00300160 DO 681 M=1,LINE 00300170 NU=3*M 00300180 LAST=3 00300190 NROW=0 00300200 DO 682 I=1,3 00300210 L=LAST 00300220 NROW=NROW+1 00300230 SQR=DSQRT(A(NROW,M)) 00300240 DO 683 J=NROW,LAST 00300250 683 A(J,M)=A(J,M)/SQR 00300260 N=3*(M-1)+I 00300270 G(N)=G(N)/SQR 00300280 IF(I-3)684,685,684 00300290 684 K=N+1 00300300 DO 671 ME=K,NU 00300310 NROW=NROW+1 00300320 DO 702 J=NROW,L 00300330 LAST=LAST+1 00300340 702 A(LAST,M)=A(LAST,M)-A(NROW,M)*A(J,M) 00300350 671 G(ME)=G(ME)-A(NROW,M)*G(N) 00300360 682 LAST=4+I 00300370 685 DO 681 NU=1,IPHO 00300380 N=7.D0+ CAM(NU,37) 00300390 DO 687 ITEST=8,N 00300400 IF(G(3*M+2692)-CAM(NU,ITEST))687,688,687 00300410 687 CONTINUE 00300420 GO TO 681 00300430 688 READ (KD5'NU)Z 00300440 MARK=(ITEST-8)*3 00300450 MORT=MARK+3 00300460 NROW=0 00300470 DO 689 I=1,3 00300480 NROW=NROW+1 00300490 MARK=MARK+1 00300500 DO 700 J=1,6 00300510 700 Z(MARK,J)=Z(MARK,J)/A(NROW,M) 00300520 IF(I-3)701,686,701 00300530 701 K=MARK+1 00300540 DO 689 L=K,MORT 00300550 NROW=NROW+1 00300560 DO 689 J=1,6 00300570 689 Z(L,J)=Z(L,J)-A(NROW,M)*Z(MARK,J) 00300580 686 WRITE (KD5'NU)Z 00300590 681 CONTINUE 00300600 C EFFECT OF OBJECT ROWS ON CAMERA ROWS 00300610 WRITE (KD3'1500)((A(I7,J7),J7=1,LINE),I7=1,6) 00300620 J66=KLOCK(J) 00300630 TIME=(J66-J64)/100. 00300640 WRITE (NPRNT,101)TIME 00300650 DO 704 NU=1,IPHO 00300660 MORT=ITOTAL+1-NU 00300670 M=6*MORT 00300680 NMI=7.D0+CAM(NU,37) 00300690 LAST=3.D0*CAM(NU,37) 00300700 NCON=NU 00300710 KP9=0 00300720 KP8=NU-1 00300730 IF(NU.EQ.1)GO TO 92 00300740 DO 93 I9=1,KP8 00300750 93 KP9=KP9+I9 00300760 92 KF4=NU*ITOTAL-ITOTAL+NU-KP9 00300770 823 DO 824 I=1,6 00300780 DO 824 J=1,M 00300790 824 A(I,J)=0.D0 00300800 READ (KD4'KF4)((A(I6,J6),I6=1,6),J6=1,6) 00300810 READ (KD5'NU)Z 00300820 DO 705 L=1,6 00300830 DO 705 I=1,LAST 00300840 DO 705 J=L,6 00300850 705 A(L,J)=A(L,J)-Z(I,L)*Z(I,J) 00300860 ITEST=8 00300870 712 IF(ITEST-NMI)798,798,713 00300880 798 LAST=3*(ITEST-7) 00300890 MARK=LAST-2 00300900 710 NCON=NCON+1 00300910 IF(NCON-IPHO)711,711,709 00300920 709 DO 714 J=1,LINE 00300930 IF(G(3*J+2692)-CAM(NU,ITEST))714,715,714 00300940 714 CONTINUE 00300950 715 JOYCE=0 00300960 N=2100+6*NU 00300970 K=N-5 00300980 DO 716 L=K,N 00300990 JOYCE=JOYCE +1 00301000 NROW=3*J-3 00301010 DO 716 I=MARK,LAST 00301020 NROW=NROW+1 00301030 716 G(L)=G(L)-Z(I,JOYCE)*G(NROW) 00301040 ITEST=ITEST+1 00301050 NCON=NU 00301060 GO TO 712 00301070 711 N=7.D0+CAM(NCON,37) 00301080 DO 707 IMAGE=8,N 00301090 IF(CAM(NCON,IMAGE)-CAM(NU,ITEST))707,706,707 00301100 707 CONTINUE 00301110 GO TO 710 00301120 706 READ (KD5'NCON)Y 00301130 JULY=6*(NCON-NU+1) 00301140 JUNE=JULY-5 00301150 DO 708 L=1,6 00301160 NEIL=3*(IMAGE-8) 00301170 DO 708 I=MARK,LAST 00301180 NEIL=NEIL+1 00301190 K=0 00301200 DO 708 J=JUNE,JULY 00301210 K=K+1 00301220 708 A(L,J)=A(L,J)-Z(I,L)*Y(NEIL,K) 00301230 GO TO 710 00301240 713 WRITE (KD4'KF4)((A(I6,J6),I6=1,6),J6=1,M) 00301250 704 CONTINUE 00301260 C FORWARD SOLUTION OF CAMERA ROWS 00301270 N=6*IPHO 00301280 WRITE (KD3'1000)(G(I8),I8=1,N) 00301290 WRITE (KD3'1100)((CAM(I7,J7),J7=1,37),I7=1,99) 00301300 J67=KLOCK(J) 00301310 TIME=(J67-J66)/100. 00301320 WRITE (NPRNT,102)TIME 00301330 DO 723 NU=1,IPHO 00301340 NCON=NU 00301350 JULY=6*(ITOTAL+1-NU) 00301360 KP9=0 00301370 KP8=NU-1 00301380 IF(NU.EQ.1)GO TO 94 00301390 DO 95 I9=1,KP8 00301400 95 KP9=KP9+I9 00301410 94 KF4=NU*ITOTAL-ITOTAL+NU-KP9 00301420 READ (KD4'KF4)((A(I6,J6),I6=1,6),J6=1,JULY) 00301430 DO 728 I=1,6 00301440 SQR=1.D0/DSQRT(A(I,I)) 00301450 DO 718 J=I,JULY 00301460 718 A(I,J)=A(I,J)*SQR 00301470 K=2094+6*NU+I 00301480 G(K)=G(K)*SQR 00301490 IF(I-6)720,728,728 00301500 720 IP1=I+1 00301510 DO 717 L=IP1,6 00301520 DO 722 J=L,JULY 00301530 722 A(L,J)=A(L,J)-A(I,L)*A(I,J) 00301540 M=K+L-I 00301550 717 G(M)=G(M)-A(I,L)*G(K) 00301560 728 CONTINUE 00301570 WRITE (KD4'KF4)((A(I7,J7),I7=1,6),J7=1,JULY) 00301580 IF(NU-IPHO)829,723,729 00301590 829 N=1 00301600 DO 845 I=1,6 00301610 L=0 00301620 DO 719 J=1,JULY 00301630 L=L+1 00301640 IF(L-99)719,719,833 00301650 833 N=N+1 00301660 L=1 00301670 719 CAM(L,N)=A(I,J) 00301680 845 N=N+1 00301690 724 NCON=NCON+1 00301700 IF(NCON-IPHO)831,831,830 00301710 831 N=6*(NCON-NU+1) 00301720 M=N-5 00301730 DO 825 J=M,N 00301740 DO 825 I=1,6 00301750 IF(A(I,J))818,825,818 00301760 825 CONTINUE 00301770 CAM(NCON,37)=0.D0 00301780 GO TO 724 00301790 818 CAM(NCON,37)=1.D0 00301800 GO TO 724 00301810 830 CAM(NU,37)=0.D0 00301820 DO 832 NCON=NU,IPHO 00301830 IF(CAM(NCON,37))835,832,835 00301840 835 KP9=0 00301850 KP8=NCON-1 00301860 IF(NCON.EQ.1)GO TO 96 00301870 DO 97 I9=1,KP8 00301880 97 KP9=KP9+I9 00301890 96 KFF4=NCON*ITOTAL-ITOTAL+NCON-KP9 00301900 NA= 6*(ITOTAL+1-NCON) 00301910 J=6*(NCON-NU)+1 00301920 MA=J+NA-1 00301930 READ (KD4'KFF4)((A(I7,J7),I7=1,6),J7=J,MA) 00301940 N=1 00301950 DO 808 I=1,6 00301960 JUNE=J-1 00301970 K=2094+6*NU+I 00301980 M=2094+6*NCON 00301990 L=0 00302000 DO 836 NEIL=1,JULY 00302010 L=L+1 00302020 IF(L-99)836,836,837 00302030 837 N=N+1 00302040 L=1 00302050 836 G(NEIL)=CAM(L,N) 00302060 DO 725 L=1,6 00302070 M=M+1 00302080 JUNE=JUNE+1 00302090 DO 726 IP1=JUNE,JULY 00302100 726 A(L,IP1)=A(L,IP1)-G(JUNE)*G(IP1) 00302110 G(M)=G(M)-G(JUNE)*G(K) 00302120 725 CONTINUE 00302130 808 N=N+1 00302140 WRITE (KD4'KFF4)((A(I7,J7),I7=1,6),J7=J,MA) 00302150 832 CONTINUE 00302160 723 CONTINUE 00302170 729 READ (KD3'1100)((CAM(I7,J7),J7=1,37),I7=1,99) 00302180 J68=KLOCK(J) 00302190 TIME=(J68-J67)/100. 00302200 WRITE (NPRNT,103)TIME 00302210 C BACK SOLUTION CAMERA ROWS 00302220 N=6*IPHO 00302230 READ (KD3'1000)(G(I8),I8=1,N) 00302240 WRITE (NPRNT,556)ITERAT,G(K),A(6,6) 00302250 G(K)=G(K)/A(6,6) 00302260 DO 731 NU=1,IPHO 00302270 KP9=0 00302280 KP8=ITOTAL-NU-1 00302290 IF(ITOTAL-NU-1)733,89,88 00302300 88 DO 87 I9=1,KP8 00302310 87 KP9=KP9+I9 00302320 89 KFF4=(ITOTAL-NU)*ITOTAL-NU-KP9 00302330 FIND (KD4'KFF4) 00302340 IF(NU-1)734,734,733 00302350 734 N=5 00302360 M=6 00302370 JUNE=6 00302380 GO TO 735 00302390 733 N=6 00302400 M=7 00302410 JUNE=7 00302420 735 DO 732 I=1,N 00302430 NMI=M-I 00302440 K=K-1 00302450 L=K 00302460 DO 736 J=JUNE,JULY 00302470 L=L+1 00302480 736 G(K)=G(K)-G(L)*A(NMI,J) 00302490 G(K)=G(K)/A(NMI,JUNE-1) 00302500 732 JUNE=JUNE-1 00302510 IF(NU-IPHO)841,842,842 00302520 841 NA=NA+ 6 00302530 READ (KD4'KFF4)((A(I6,J6),I6=1,6),J6=1,NA) 00302540 731 JULY=NA 00302550 C BACK SOLUTION OBJECT ROWS 00302560 842 READ (KD3'1500)((A(I7,J7),J7=1,LINE),I7=1,6) 00302570 J69=KLOCK(J) 00302580 TIME=(J69-J68)/100. 00302590 WRITE (NPRNT,104)TIME 00302600 ITEST=LINE 00302610 742 NROW=3*ITEST 00302620 DO 743 NU=1,IPHO 00302630 NCON=IPHO+1-NU 00302640 M=CAM(NCON,37)+7.D0 00302650 DO 737 K=8,M 00302660 IF(G(NROW+2692)-CAM(NCON,K))737,738,737 00302670 737 CONTINUE 00302680 GO TO 743 00302690 738 READ (KD5'NCON)Z 00302700 I=3*(K-7) 00302710 MORT=2100+6*NCON 00302720 MARK=MORT-5 00302730 DO 740 N=1,3 00302740 JOYCE=1 00302750 DO 739 K=MARK,MORT 00302760 G(NROW)=G(NROW)-G(K)*Z(I,JOYCE) 00302770 739 JOYCE=JOYCE+1 00302780 I=I-1 00302790 740 NROW=NROW-1 00302800 NROW=NROW+3 00302810 743 CONTINUE 00302820 G(NROW)=G(NROW)/A(6,ITEST) 00302830 G(NROW-1)=(G(NROW-1)-G(NROW)*A(5,ITEST))/A(4,ITEST) 00302840 G(NROW-2) =(G(NROW-2)-G(NROW)*A(3,ITEST)-G(NROW-1)*A(2,ITEST))/A(100302850 1,ITEST) 00302860 ITEST=ITEST-1 00302870 IF(ITEST-1)741,742,742 00302880 C ADD LEAST SQUARES RESULTS TO OBJECT ORDER LIST AND CAM ARRAY 00302890 741 SCALE=CAM(1,7) 00302900 J70=KLOCK(J) 00302910 TIME=(J70-J69)/100. 00302920 WRITE (NPRNT,105)TIME 00302930 READ (KD3'0001)((A(I7,J7),J7=1,LINE),I7=1,6) 00302940 DO 744 M=1,LINE 00302950 J=1 00302960 JULY=3*M 00302970 JUNE=JULY-2 00302980 DO 744 K=JUNE,JULY 00302990 G(K)=G(K)*SCALE 00303000 J=J+1 00303010 IF(J-3)793,793,794 00303020 793 IF(A(5,M))795,795,744 00303030 794 IF(A(6,M))795,795,744 00303040 795 A(J,M)=A(J,M)+G(K) 00303050 744 CONTINUE 00303060 DO 745 K=1,IPHO 00303070 J=4 00303080 JUNE=2095+6*K+3 00303090 JULY=JUNE+2 00303100 DO 745 I=JUNE,JULY 00303110 G(I)=G(I)*SCALE 00303120 J=J+1 00303130 CAM(K,J)=CAM(K,J)+G(I) 00303140 C(4,J-4)=G(I-3) 00303150 C(5,J-4)=DSQRT(1.D0-C(4,J-4)*C(4,J-4)) 00303160 C(6,J-4)=CAM(K,J-3)*C(5,J-4)+CAM(K,J+33)*C(4,J-4) 00303170 C(7,J-4)=CAM(K,J+33)*C(5,J-4)-CAM(K,J-3)*C(4,J-4) 00303180 CAM(K,J-3)=C(6,J-4) 00303190 745 CAM(K,J+33)=C(7,J-4) 00303200 C DETERMINE MAXIMUM CORRECTION TO ORIENTATION PARAMETERS AND TEST 00303210 C AGAINST LIMIT 00303220 LROW=2100+6*IPHO 00303230 L=2101 00303240 J=2101 00303250 753 DO 749 N=1,2 00303260 IF(DABS(G(L))-DABS(G(J)))750,749,749 00303270 750 L=J 00303280 749 J=J+1 00303290 IF(DABS(G(L))-DABS(G(J)))751,752,752 00303300 751 L=J 00303310 752 J=J+4 00303320 IF(J-LROW)753,753,754 00303330 754 J65=KLOCK(J) 00303340 TIME=(J65-J64)/100. 00303350 WRITE (NPRNT,100)TIME 00303360 RETURN 00303370 100 FORMAT (//T15,'EQUATION SOLUTION TIME WAS ',F9.2,' SECONDS'/) 00303380 101 FORMAT (/T15,'OBJECT ROWS',F9.2,' SEC.') 00303390 102 FORMAT (/T15,'OBJ. & CAM. ROWS',F9.2,' SEC.') 00303400 103 FORMAT (/T15,'CAMERA ROWS',F9.2,' SEC.') 00303410 104 FORMAT (/T15,'BACK SOL. CAM.',F9.2,' SEC.') 00303420 105 FORMAT (/T15,'BACK SOL. OBJ.',F9.2,' SEC.') 00303430 556 FORMAT (/' PROGRAM PASS',I3,' LAST PLATE DZO IS ',D16.10,' DIVID00303440 1ED BY ',D16.10) 00303450 END 00303460 C /**/00400000 SUBROUTINE INSECS 00400010 C 00400020 C B L O C K I N T E R S E C T I O N R O U T I N E USC&GS00400030 C 00400040 IMPLICIT REAL*8 (A-H,O-Z) 00400050 REAL*8CAM(99,40),C(20,3),D(6,7) 00400060 COMMON/AREA4/CAM,C,D,FL,RESID,ITOTAL,LARRY,IJOB,I8,JS2,KFF4,KP9, 00400070 1NPUNC,I9,KK3,JS1,NREAD,KD4,KP8,NPRNT,KD3,JISECT,JCOORD,JRESCT,JS3,00400080 2IFROM,ITO,KTOT,N7,NN,IDIR,KK5,KD5 00400090 WRITE (NPRNT,547) 00400100 LINE=1 00400110 NEIL=1 00400120 IMAGE=1 00400130 MARK=0 00400140 IGO=1 00400150 881 IF(LARRY)879,879,878 00400160 878 READ (NREAD,546)(CAM(IMAGE,J),J=11,13),CAM(IMAGE,19) 00400170 GO TO 877 00400180 879 READ (NREAD,546)(CAM(IMAGE,J),J=11,13) 00400190 CAM(IMAGE,19)=FL 00400200 877 J=CAM(IMAGE,11)/100000.D0 00400210 CAM(IMAGE+1,19)=J 00400220 FK=J*100000 00400230 CAM(IMAGE,14)=CAM(IMAGE,11)-FK 00400240 929 IF(CAM(1,14)-CAM(IMAGE,14))882,901,882 00400250 901 IMAGE=IMAGE+2 00400260 GO TO 881 00400270 882 JOE=IMAGE 00400280 924 IMAGE=IMAGE-2 00400290 MORT=IMAGE+1 00400300 904 DO 883 I=1,IMAGE,2 00400310 DO 884 J=1,ITOTAL 00400320 IF(CAM(J,1)-CAM(I+1,19))884,885,884 00400330 884 CONTINUE 00400340 885 L=5 00400350 DO 886 K=1,3 00400360 C(1,K)=CAM(J,L) 00400370 C(2,K)=CAM(J,L-3) 00400380 C(3,K)=CAM(J,L+33) 00400390 886 L=L+1 00400400 C ORIENTATION MATRIX 00400410 C(4,1)=C(3,2)*C(3,3) 00400420 C(5,1)=-C(3,2)*C(2,3) 00400430 C(6,1)=C(2,2) 00400440 C(4,2)=C(3,1)*C(2,3) + C(2,1)*C(2,2)*C(3,3) 00400450 C(5,2)=C(3,1)*C(3,3) - C(2,1)*C(2,2)*C(2,3) 00400460 C(6,2)=-C(2,1)*C(3,2) 00400470 C(4,3)=C(2,1)*C(2,3) - C(3,1)*C(2,2)*C(3,3) 00400480 C(5,3)=C(2,1)*C(3,3) + C(3,1)*C(2,2)*C(2,3) 00400490 C(6,3)=C(3,1)*C(3,2) 00400500 GO TO (899,895),NEIL 00400510 C FORM AUGMENTED COEFFICIENT MATRIX 00400520 899 K=1 00400530 DO 887 L=15,17 00400540 CAM(I,L)= CAM(I,12)*C(6,K)-(-CAM(I,19))*C(4,K) 00400550 CAM(I+1,L)= CAM(I,13)*C(6,K)-(-CAM(I,19))*C(5,K) 00400560 887 K=K+1 00400570 CAM (I,18)= C(1,1)*CAM(I,15) +C(1,2)*CAM(I,16) +C(1,3)*CAM(I,17) 00400580 CAM(I+1,18)= C(1,1)*CAM(I+1,15)+C(1,2)*CAM(I+1,16)+C(1,3)*CAM(I+1,00400590 117) 00400600 GO TO (937,895),IGO 00400610 937 GO TO 883 00400620 895 DO 896 K=1,3 00400630 896 C(8,K)=D(K,4)-C(1,K) 00400640 DO 897 K=1,3 00400650 897 C(9,K)=C(K+3,1)*C(8,1)+C(K+3,2)*C(8,2)+C(K+3,3)*C(8,3) 00400660 GO TO (938,939),NEIL 00400670 938 DO 940 L=15,18 00400680 CAM(I,L)=CAM(I,L)/C(9,3) 00400690 940 CAM(I+1,L)=CAM(I+1,L)/C(9,3) 00400700 GO TO 883 00400710 939 CAM(I,20) =CAM(I,12) - (-CAM(I,19))*C(9,1)/C(9,3) 00400720 CAM(I+1,20)=CAM(I,13) - (-CAM(I,19))*C(9,2)/C(9,3) 00400730 883 CONTINUE 00400740 GO TO (905,912),NEIL 00400750 C FORM NORMAL EQUATIONS 00400760 905 DO 902 I=1,3 00400770 DO 902 J=I,4 00400780 D(I,J)=0.D0 00400790 DO 902 K=1,MORT 00400800 902 D(I,J)=D(I,J)+CAM(K,I+14)*CAM(K,J+14) 00400810 C FORWARD SOLUTION 00400820 DO 909 I=1,3 00400830 SQR=DSQRT(D(I,I)) 00400840 DO 908 J=I,4 00400850 908 D(I,J)=D(I,J)/SQR 00400860 IF(I-3)907,906,906 00400870 907 IP1=I+1 00400880 DO 909 L=IP1,3 00400890 DO 909 J=L,4 00400900 909 D(L,J)=D(L,J)-D(I,L)*D(I,J) 00400910 C BACK SOLUTION 00400920 906 D(3,4)=D(3,4)/D(3,3) 00400930 DO 911 I=1,2 00400940 NMI=3-I 00400950 NMIP1=NMI+1 00400960 DO 910 J=NMIP1,3 00400970 910 D(NMI,4)=D(NMI,4)-D(J,4)*D(NMI,J) 00400980 911 D(NMI,4)=D(NMI,4)/D(NMI,NMI) 00400990 GO TO (941,942),IGO 00401000 C ITERATE XYZ SOLUTION 00401010 941 DO 936 J=1,3 00401020 936 CAM(99,J+10)=D(J,4) 00401030 IGO=2 00401040 GO TO 904 00401050 C TEST TO TERMINATE XYZ ITERATIVE SOLUTION 00401060 942 FK=DABS(D(1,4)-CAM(99,11))*(-CAM(IMAGE,19))/C(9,3) 00401070 IF(FK-.000001D0)943,943,941 00401080 943 FK=DABS(D(2,4)-CAM(99,12))*(-CAM(IMAGE,19))/C(9,3) 00401090 IF(FK-.000001D0)944,944,941 00401100 C COMPUTE PLATE RESIDUALS 00401110 944 NEIL=2 00401120 GO TO 904 00401130 C DETERMINE MAXIMUM PLATE RESIDUAL AND TEST AGAINST RESIDUAL LIMIT 00401140 912 I=1 00401150 M=I 00401160 916 M=M+1 00401170 IF(M-MORT)913,913,914 00401180 913 IF(DABS(CAM(I,20))-DABS(CAM(M,20)))915,916,916 00401190 915 I=M 00401200 GO TO 916 00401210 914 IF(DABS(CAM(I,20))-RESID)917,917,918 00401220 C BAD RAY 00401230 918 L=I/2 00401240 IF(I-2*L)921,921,922 00401250 921 I=I-1 00401260 922 MARK=MARK+1 00401270 IF(MARK-1)919,919,920 00401280 919 IF(IMAGE-3)920,920,926 00401290 926 WRITE (NPRNT,549)CAM(I,11) 00401300 IF(I-IMAGE)923,900,900 00401310 923 DO 925 K=11,19 00401320 CAM(I,K)=CAM(IMAGE,K) 00401330 925 CAM(I+1,K)=CAM(MORT,K) 00401340 900 NEIL=1 00401350 DO 945 J=1,3 00401360 945 CAM(99,J+10)=D(J,4) 00401370 GO TO 924 00401380 920 WRITE (NPRNT,550)CAM(I,11) 00401390 C OUTPUT OF XYZ AND PLATE RESIDUALS 00401400 917 WRITE (NPRNT,548) 00401410 IWRIT=CAM(1,14) 00401420 WRITE (NPRNT,554) IWRIT,(D(K,4),K=1,3) 00401430 WRITE (NPUNC,554) IWRIT,(D(K,4),K=1,3) 00401440 WRITE (JS3)CAM(1,14),(D(K,4),K=1,3) 00401450 WRITE (NPRNT,553) 00401460 DO 935 I=1,IMAGE,2 00401470 IWRIT=CAM(I,11) 00401480 935 WRITE (NPRNT,554) IWRIT,CAM(I,20),CAM(I+1,20) 00401490 IF(CAM(JOE,11))930,930,931 00401500 930 WRITE (NPRNT,552)LINE 00401510 N7=LINE+KTOT 00401520 40 RETURN 00401530 931 LINE=LINE+1 00401540 WRITE (NPRNT,551) 00401550 DO 928 K=11,14 00401560 928 CAM(1,K)=CAM(JOE,K) 00401570 CAM(1,19)=CAM(JOE,19) 00401580 CAM(2,19)=CAM(JOE+1,19) 00401590 NEIL=1 00401600 IMAGE=1 00401610 MARK=0 00401620 IGO=1 00401630 GO TO 929 00401640 546 FORMAT (1X,F9.0,2X,D16.10,2X,D16.10,2X,D16.10) 00401650 547 FORMAT (//' OBJECT POSITIONS COMPUTED BY INTERSECTION'/) 00401660 548 FORMAT(T5,'OBJECT',T17,'X GROUND',T36,'Y GROUND',T55,'Z GROUND'/) 00401670 549 FORMAT (1X,F10.0,' EXCEEDS RESIDUAL LIMIT DISCARDED') 00401680 550 FORMAT (1X,F10.0,' EXCEEDS RESIDUAL LIMIT') 00401690 551 FORMAT (1H ///) 00401700 552 FORMAT (// ' TOTAL NUMBER OF INTERSECTED OBJECTS IS', I6) 00401710 553 FORMAT (/' IMAGE X PLATE RESID Y PLATE RESID'/) 00401720 554 FORMAT (1X,I9,1X,3(3X,D18.12)) 00401730 END 00401740 C /**/00500000 SUBROUTINE KCOORS 00500010 C 00500020 C T R A N S F O R M A T I O N O F C O O R D I N A T E00500030 C 00500040 IMPLICIT REAL*8(A-H,O-Z) 00500050 REAL*8G(4,100),CONV(100),T(11),CAM(99,40),C(20,3),D(6,7) 00500060 COMMON/AREA3/G,T,PHDG,PHMIN,PHSEC,PLGDG,PLGMN,PLSEC,AMTFT,FTMT, 00500070 1SECRD,ESQ,CONV,A,SNONS 00500080 COMMON/AREA4/CAM,C,D,FL,RESID,ITOTAL,LARRY,IJOB,I8,JS2,KFF4,KP9, 00500090 1NPUNC,I9,KK3,JS1,NREAD,KD4,KP8,NPRNT,KD3,JISECT,JCOORD,JRESCT,JS3,00500100 2IFROM,ITO,KTOT,N7,NN,IDIR,KK5,KD5 00500110 C SET ELLIPSOID PARAMETERS AND CONVERSION CONSTANTS CLARKE 1866 00500120 DATA PI/3.1415926535898D0/ 00500130 REWIND JS3 00500140 ESQ=.6768658D-2 00500150 FTMT=3.28083989501312D0 00500160 AMTFT=.3048D0 00500170 A=6378206.4D0 00500180 SECRD=648000.D0/PI 00500190 SNONS=1.D0/SECRD 00500200 IRUN2=0 00500210 IRUN=0 00500220 N5=N7 00500230 WRITE (NPRNT,998) 00500240 I9=KLOCK(J) 00500250 IF(JISECT.NE.7)GO TO 1 00500260 N7=0 00500270 42 READ (NREAD,41)P1,P2,P3,P4,IT 00500280 WRITE (JS3)P1,P2,P3,P4 00500290 N7=N7+1 00500300 IF(IT.GT.0)GO TO 43 00500310 GO TO 42 00500320 43 REWIND JS3 00500330 N5=N7 00500340 1 IF(N5-100)30,30,31 00500350 30 NN=N5 00500360 IRUN=1 00500370 33 DO 32 I=1,NN 00500380 32 READ (JS3,ERR=900,END=900)(G(J,I),J=1,4) 00500390 GO TO 34 00500400 31 NN=100 00500410 N5=N5-NN 00500420 GO TO 33 00500430 34 IF(IRUN2.EQ.1)GO TO 53 00500440 C WRITE ORIGIN AND DESTINATION COORDINATE SYSTEMS 00500450 WRITE (NPRNT,1021)IFROM,ITO 00500460 WRITE (NPRNT,1020)ESQ,A 00500470 53 L=0 00500480 C IF SECANT PLANE SYSTEM IS INVOLVED, READ AND WRITE THE LATITUDE AN00500490 C LONGITUDE OF THE SYSTEM ORIGIN 00500500 IF(IFROM.NE.13.AND.ITO.NE.13) GO TO 2 00500510 IF(IRUN2.EQ.1)GO TO 2 00500511 READ (NREAD,1000)PHDG,PHMIN,PHSEC,PLGDG,PLGMN,PLSEC 00500520 IOUT1=PHDG 00500530 IOUT2=PHMIN 00500540 IOUT3=PLGDG 00500550 IOUT4=PLGMN 00500560 WRITE (NPRNT,1022)IOUT1,IOUT2,PHSEC,IOUT3,IOUT4,PLSEC 00500570 2 IF(IFROM.EQ.1) GO TO 5 00500580 IF(IFROM.EQ.2) GO TO 15 00500590 IF(ITO.EQ.1) GO TO 5 00500600 GO TO 15 00500610 C READ AND WRITE PLANE SYSTEMS CONSTANTS IF REQUIRED 00500620 5 IF(IRUN2.EQ.1)GO TO 54 00500630 READ (NREAD,1003)(T(M),M=1,6) 00500640 WRITE (NPRNT,1023) 00500650 WRITE (NPRNT,1024)(T(M),M=1,6) 00500660 54 IF(L.EQ.1) GO TO 20 00500670 GO TO 15 00500680 10 IF(IRUN2.EQ.1)GO TO 36 00500690 READ (NREAD,1003)(T(M),M=1,11) 00500700 WRITE (NPRNT,1023) 00500710 WRITE (NPRNT,1024)(T(M),M=1,11) 00500720 36 IF(L.EQ.1)GO TO 20 00500730 15 IF(IFROM.NE.12)GO TO 130 00500740 19 I=ITO 00500750 IDIR=1 00500760 C CALL APPROPRIATE TRANSFORMATION SUBROUTINE 00500770 20 IF(IABS(I).GT.100)GO TO 80 00500780 GO TO (50,60,70,80,80,80,80,80,80,80,80,1,90,100),I 00500790 50 CONTINUE 00500800 GO TO 110 00500810 60 CALL STERGS 00500820 GO TO 110 00500830 70 CONTINUE 00500840 GO TO 110 00500850 80 CALL UTMGP1 00500860 GO TO 110 00500870 90 CALL GPSP1 00500880 GO TO 110 00500890 100 CALL GEOCGS 00500900 110 IF(IDIR.EQ.0)GO TO 160 00500910 IF(ITO.EQ.13)GO TO 120 00500920 IF(ITO.EQ.2)GO TO 200 00500930 C PRINT PLANE COORDINATE OUTPUT 00500940 IF(IRUN2.EQ.1)GO TO 37 00500950 WRITE (NPRNT,1027) 00500960 37 DO 141 J=1,NN 00500970 IOUT=G(1,J) 00500980 C WRITE (NPUNC,1036)IOUT,(G(M,J),M=2,4) 00500990 141 WRITE (NPRNT,1036)IOUT,(G(M,J),M=2,4) 00501000 GO TO 900 00501010 C PRINT SECANT PLANE OUTPUT 00501020 120 IF(IRUN2.EQ.1)GO TO 38 00501030 WRITE (NPRNT,1028) 00501040 38 DO 142 J=1,NN 00501050 IOUT=G(1,J) 00501060 WRITE (NPUNC,1036)IOUT,(G(M,J),M=2,4) 00501070 142 WRITE (NPRNT,1036)IOUT,(G(M,J),M=2,4) 00501080 GO TO 900 00501090 200 IF(IRUN2.EQ.1)GO TO 39 00501100 WRITE (NPRNT,1040) 00501110 39 DO 201 J=1,NN 00501120 IOUT=G(1,J) 00501130 CC=CONV(J) 00501140 CALL DES(CC,IC,MC,SC) 00501150 C WRITE (NPUNC,1041)IOUT,(G(M,J),M=2,4) 00501160 201 WRITE (NPRNT,1041)IOUT,(G(M,J),M=2,4),IC,MC,SC 00501170 GO TO 900 00501180 130 IDIR=0 00501190 IF(IFROM.NE.13)GO TO 150 00501200 C TRANSFORM SECANT PLANE COORDINATES TO GEOGRAPHIC POSITIONS AND ELE00501210 CALL GPSP1 00501220 IF(ITO.NE.12)GO TO 19 00501230 135 IF(IRUN2.EQ.1)GO TO 136 00501240 WRITE (NPRNT,1026) 00501250 C CONVERT SECONDS OF GEOGRAPHIC POSITIONS TO DEGREES,MINUTES,SECONDS00501260 136 DO 140 J=1,NN 00501270 LAD=G(2,J)/3600.D0 00501280 XS=LAD 00501290 G(2,J)=G(2,J)-3600.D0*XS 00501300 LAM=G(2,J)/60.D0 00501310 XS=LAM 00501320 XS=G(2,J)-60.D0*XS 00501330 LOD=G(3,J)/3600.D0 00501340 YS=LOD 00501350 G(3,J)=G(3,J)-3600.D0*YS 00501360 LOM=G(3,J)/60.D0 00501370 YS=LOM 00501380 YS=G(3,J)-60.D0*YS 00501390 LOM=IABS(LOM) 00501400 YS=DABS(YS) 00501410 LAM=IABS(LAM) 00501420 XS=DABS(XS) 00501430 IOUT=G(1,J) 00501440 C PRINT GEOGRAPHIC POSITION AND ELEVATION 00501450 IF(IFROM.EQ.2)GO TO 205 00501460 C WRITE (NPUNC,1018)IOUT,LAD,LAM,XS,LOD,LOM,YS,G(4,J) 00501470 WRITE (NPRNT,1018)IOUT,LAD,LAM,XS,LOD,LOM,YS,G(4,J) 00501480 GO TO 140 00501490 205 CC=DABS(CONV(J)) 00501500 CALL DES(CC,IC,MC,SC) 00501510 WRITE (NPRNT,1018)IOUT,LAD,LAM,XS,LOD,LOM,YS,G(4,J),IC,MC,SC 00501520 140 CONTINUE 00501530 GO TO 900 00501540 150 I=IFROM 00501550 GO TO 20 00501560 160 IF(ITO.EQ.12)GO TO 135 00501570 IF(ITO.NE.13)GO TO 170 00501580 IDIR=1 00501590 CALL GPSP1 00501600 GO TO 120 00501610 170 IDIR=1 00501620 I=ITO 00501630 L=1 00501640 K=IFROM+ITO 00501650 IF(K.GT.3)GO TO 20 00501660 GO TO (5,10),ITO 00501670 900 IRUN2=1 00501680 IF(IRUN.EQ.0)GO TO 1 00501690 I=KLOCK(J) 00501700 TIME=(I-I9)/100. 00501710 WRITE (NPRNT,1009)TIME 00501720 RETURN 00501730 41 FORMAT (2X,F8.0,3F15.3,24X,I1) 00501740 998 FORMAT (1H1) 00501750 C SECANT PLANE SYSTEM ORIGIN LATITUDE AND LONGITUDE FORMAT 00501760 1000 FORMAT (2(F4.0,F2.0,F8.5,6X)) 00501770 C ORIGIN AND DESTINATION SYSTEMS FORMAT 00501780 1001 FORMAT (3I5) 00501790 C PLANE CONSTANTS INPUT FORMAT 00501800 1003 FORMAT (5D16.10) 00501810 1009 FORMAT (///' TRANSFORMATION RUN TIME WAS ',F7.2,' SECONDS'/) 00501820 C GEOGRAPHIC POSITION AND ELEVATION OUTPUT FORMAT 00501830 1018 FORMAT (1X,I10,1X,I4,I3,1X,F8.5,5X,I4,I3,1X,F8.5,4X,F11.5,I8,I3,F500501840 1.1) 00501850 1020 FORMAT (/' ECCENTRECITY =',D14.8,' MAJOR SEMI-DIAMETER = ',D16.100501860 10/) 00501870 1021 FORMAT (' ORIGINAL SYSTEM = ',I4,' FINAL SYSTEM = ',I4/) 00501880 1022 FORMAT (' SECANT ORIGIN LAT ',I4,I3,F9.5,' LONG ',I4,I3,F9.5/) 00501890 1023 FORMAT (/' PLANE CONSTANTS'/) 00501900 1024 FORMAT (1X,D16.10) 00501910 1026 FORMAT (///T5,'STATION',T18,'LATITUDE',T38,'LONGITUDE',T54,'ELEVAT00501920 1ION FT.',T74,'CONV.'/) 00501930 1027 FORMAT (///' PLANE, GEOCENTRIC OR UTM OUTPUT COORDINATES'/) 00501940 1028 FORMAT (///' SECANT PLANE COORDINATE OUTPUT X,Y,Z IN METERS'/) 00501950 C SECANT PLANE, UTM, GEOCENTRIC OR PLANE COORDINATE OUTPUT FORMAT 00501960 1036 FORMAT (1X,I9,3(3X,D18.12)) 00501970 1040 FORMAT (///T5,'STATION',T18,'X COORD',T33,'Y COORD',T48,'ELEVATION00501980 1',T66,'CONV.'/) 00501990 1041 FORMAT (1X,I10,3F15.3,I8,I3,F5.1) 00502000 END 00502010 C /**/00600000 SUBROUTINE STERGS 00600010 C 00600020 IMPLICIT REAL*8(A-H,O-Z) 00600030 REAL*8G(4,100),CONV(100),T(11),CAM(99,40),C(20,3),D(6,7) 00600040 COMMON/AREA3/G,T,PHDG,PHMIN,PHSEC,PLGDG,PLGMN,PLSEC,AMTFT,FTMT, 00600050 1SECRD,ESQ,CONV,A,SNONS 00600060 COMMON/AREA4/CAM,C,D,FL,RESID,ITOTAL,LARRY,IJOB,I8,JS2,KFF4,KP9, 00600070 1NPUNC,I9,KK3,JS1,NREAD,KD4,KP8,NPRNT,KD3,JISECT,JCOORD,JRESCT,JS3,00600080 2IFROM,ITO,KTOT,N7,NN,IDIR,KK5,KD5 00600090 DATA RAD/57.2957795D0/,E1/676.8658D-5/,E2/681.4785D-5/,FU/.434294500600100 1D0/ 00600110 C TRANSFORMATION AND INVERSE FOR STEREOGRAPHIC AND GEOGRAPHIC POSITION 00600120 IF(IDIR.EQ.1)GO TO 400 00600130 C STEREOGRAPHIC TO GEOGRAPHIC POSITION 00600140 DO 350 N=1,NN 00600150 Z=(G(2,N) -1.D6)/1.D6 00600160 W=(G(3,N) -1.D6)/1.D6 00600170 G(3,N)=.665D2+(-.142952945665D5*Z-.7186600649D3*Z*W-.7206D-3*Z*Z 00600180 1-.442990316D2*Z*W*W+.148300635D2*Z**3-.25941871D1*Z*W**3+.2630264800600190 2D1*Z**3*W-.1245733D0*Z**5)/3600.D0 00600200 G(2,N)=.465D2+(.987200337240D4*W-.2481452114D3*Z*Z-.2400224D1*W*W-00600210 1.179973728D2*Z*Z*W-.18776066D1*W**3+.2988811D0*Z**4-.923441D0*Z*Z 00600220 2*W*W+.573046D-1*Z**4*W)/3600.D0 00600230 1/3600.D0 00600250 G(3,N)=-G(3,N)*3600.D0 00600260 350 G(2,N)=G(2,N)*3600.D0 00600270 RETURN 00600280 C GEOGRAPHIC POSITION TO STEROGRAPHIC 00600290 400 T3=FU/(24.D0*RAD*RAD) 00600300 T31=T3*2.D0 00600310 T32=T3*3.D0 00600320 DO 450 N=1,NN 00600330 DT=G(2,N)/3600.D0 00600340 DG=-G(3,N)/3600.D0 00600350 DT1=DT-.465D2 00600360 DG1=.665D2-DG 00600370 IF(DT1)42,41,42 00600380 41 IF(DG1)42,43,42 00600390 43 CONV(N)=0.D0 00600400 G(2,N)=0.D0 00600410 G(3,N)=0.D0 00600420 GO TO 450 00600430 42 DT12=DT1*DT1 00600440 DG12=DG1*DG1 00600450 SL=DSIN(((DT+.465D2)/2.D0)/RAD) 00600460 SL2=SL*SL 00600470 CL=DCOS(((DT+.465D2)/2.D0)/RAD) 00600480 CL2=CL*CL 00600490 TL=SL/CL 00600500 TL2=TL*TL 00600510 FN2=E2*CL2 00600520 V2=1.D0+FN2 00600530 V4=V2*V2 00600540 BN=A/DSQRT(1.D0-E1*SL2) 00600550 BM=A*(1.D0-E1)/DSQRT((1.D0-E1*SL2)**3) 00600560 T1=RAD/BM 00600570 T2=RAD/BN 00600580 T4=(1.D0+FN2-9.D0*FN2*TL2)/V4*T3 00600590 T5=T3*(1.D0-2.D0*FN2) 00600600 T6=T32*(FN2*(TL2-1.D0-FN2-4.D0*FN2*TL2)/V4) 00600610 T7=T31*V2 00600620 T8=T3*(3.D0+8.D0*FN2+5.D0*FN2*FN2)/V4 00600630 SSA=DG1*CL/T2*(1.D0-T3*DG12*SL2/FU+T4*DT12/FU) 00600640 SCA=DT1*DCOS((DG1/2.D0)/RAD)/T1*(1.D0+T5*DG12*CL2/FU-T6*DT12/FU) 00600650 DA=DG1*SL*(1.D0+T7*DG12*CL2/FU+T8*DT12/FU) 00600660 IF(DT1)30,31,30 00600670 31 IF(DG1)32,33,33 00600680 32 BG=90.D0 00600690 GO TO 4 00600700 33 BG=270.D0 00600710 GO TO 4 00600720 30 BG=DATAN(SSA/SCA)*RAD 00600730 IF(DT1)1,2,2 00600740 1 BG=BG+180.D0 00600750 2 IF(DG1)3,4,4 00600760 3 BG=BG+360.D0 00600770 4 SMA=DSIN(BG/RAD) 00600780 CMA=DCOS(BG/RAD) 00600790 IF(DABS(SMA)-DABS(CMA))5,6,6 00600800 5 S=SCA/CMA 00600810 GO TO 7 00600820 6 S=SSA/SMA 00600830 7 GA=BG-DA/2.D0 00600840 IF(GA)8,9,9 00600850 8 GA=GA+360.D0 00600860 9 GD=S/AMTFT 00600870 GD=GD+1.902D0*1.D-16*GD**3-8.846*1.D-5*GD+4.343D0*1.D-32*GD**5 00600880 G(2,N)=GD*DSIN(GA/RAD)+1.D6 00600890 G(3,N)=GD*DCOS(GA/RAD)+1.D6 00600900 CONV(N)=DABS(DA) 00600910 450 CONTINUE 00600920 RETURN 00600930 END 00600940 C /**/00700000 SUBROUTINE DES(ANG,ID,IM,SS) 00700010 C 00700020 IMPLICIT REAL*8(A-H,O-Z) 00700030 ID=ANG 00700040 AID=ID 00700050 FID=(ANG-AID)*60.D0 00700060 IM=FID 00700070 FIS=IM 00700080 SS=(FID-FIS)*60.D0 00700090 RETURN 00700100 END 00700110 C /**/00800000 SUBROUTINE GPSP1 00800010 C 00800020 IMPLICIT REAL*8(A-H,O-Z) 00800030 REAL*8G(4,100),CONV(100),T(11),CAM(99,40),C(20,3),D(6,7) 00800040 COMMON/AREA3/G,T,PHDG,PHMIN,PHSEC,PLGDG,PLGMN,PLSEC,AMTFT,FTMT, 00800050 1SECRD,ESQ,CONV,A,SNONS 00800060 COMMON/AREA4/CAM,C,D,FL,RESID,ITOTAL,LARRY,IJOB,I8,JS2,KFF4,KP9, 00800070 1NPUNC,I9,KK3,JS1,NREAD,KD4,KP8,NPRNT,KD3,JISECT,JCOORD,JRESCT,JS3,00800080 2IFROM,ITO,KTOT,N7,NN,IDIR,KK5,KD5 00800090 DATA PI/3.1415926535898D0/ 00800100 C TRANSFORMATION AND INVERSE FOR GEOGRAPHIC POSITIONS AND SECANT PLA00800110 C SOLVE FOR THE TRANSFORMATION CONSTANTS DEPENDENT ON ELLIPSOID 00800120 C PARAMETERS AND SECANT PLANE SYSTEM ORIGIN 00800130 PANME=1.D0-ESQ 00800140 IF(PHDG)3,4,4 00800150 3 PSGLAT=-1.D0 00800160 PHMIN=-PHMIN 00800170 PHSEC=-PHSEC 00800180 GO TO 11 00800190 4 PSGLAT=1.D0 00800200 11 PHRAD=(PHDG*3600.D0+PHMIN*60.D0+PHSEC)*SNONS 00800210 IF(PLGDG)5,6,6 00800220 5 PSGLNG=-1.D0 00800230 PLGMN=-PLGMN 00800240 PLSEC=-PLSEC 00800250 PNT1=0.D0 00800260 PNT2=-PI 00800270 PNT3=-PI/2.D0 00800280 GO TO 13 00800290 6 PSGLNG=1.D0 00800300 PNT1=PI 00800310 PNT2=0.D0 00800320 PNT3=PI/2.D0 00800330 13 PLRAD=(PLGDG*3600.D0+PLGMN*60.D0+PLSEC)*SNONS 00800340 PSNPHO=DSIN(PHRAD) 00800350 PCSPHO=DCOS(PHRAD) 00800360 PSNLGO=DSIN(PLRAD) 00800370 PCSLGO=DCOS(PLRAD) 00800380 PEPHM=DSQRT(1.D0-ESQ*PSNPHO*PSNPHO) 00800390 C COMPUTE LENGTH OF NORMAL THROUGH SYSTEM ORIGIN 00800400 PENO=A/PEPHM 00800410 PENSYT=PENO*ESQ*PSNPHO 00800420 PSNPL=PSNPHO*PSNLGO 00800430 PCSPL=PCSPHO*PSNLGO 00800440 PSCPLA=PSNPHO*PCSLGO 00800450 PCSPLA=PCSPHO*PCSLGO 00800460 C COMPUTE MAGNITUDE OF TRANSLATION FOR X-Y PLANE 00800470 IBASE=PENO/1000.D0 00800480 PBASE=IBASE*1000 00800490 IF(IDIR.EQ.1)GO TO 99 00800500 C SECANT PLANE TO GEOGRAPHIC POSITION 00800510 50 DO 98 N=1,NN 00800520 C TRANSFORM SECANT PLANE COORDINATES TO MODIFIED GEOCENTRIC COORDS, 00800530 C I.E. Z=0 AT INTERSECTION OF NORMAL WITH MINOR AXIS 00800540 PZPB=G(4,N)+PBASE 00800550 PX=G(2,N)*PCSLGO-G(3,N)*PSNPL+PZPB*PCSPL 00800560 PY=-(G(2,N)*PSNLGO+G(3,N)*PSCPLA)+PZPB*PCSPLA 00800570 PZ=G(3,N)*PCSPHO+PZPB*PSNPHO 00800580 C COMPUTE LATITUDE BY ITERATIVE PROCESS 00800590 PZAPP=PZ 00800600 PDEM=DSQRT(PX*PX+PY*PY) 00800610 DO 80 IX=1,5 00800620 PTNPHP=PZ/PDEM 00800630 PHR=DATAN(PTNPHP) 00800640 PSNPHP=DSIN(PHR) 00800650 PCSPHP=DCOS(PHR) 00800660 PENPH=DSQRT(1.D0-ESQ*PSNPHP*PSNPHP) 00800670 PENPT=A/PENPH 00800680 80 PZ=-PENSYT+(PENPT*ESQ*PSNPHP)+PZAPP 00800690 C COMPUTE STATION LONGITUDE 00800700 81 PALAM=DATAN(PX/PY) 00800710 IF(PALAM)74,75,76 00800720 74 PANGLE=PALAM+PNT1 00800730 GO TO 77 00800740 75 PANGLE=PNT3 00800750 GO TO 77 00800760 76 PANGLE=PALAM+PNT2 00800770 77 G(3,N)=PANGLE*SECRD 00800780 C COMPUTE STATION ELEVATION 00800790 PSINL=DSIN(PANGLE) 00800800 PH=(PX/(PCSPHP*PSINL))-PENPT 00800810 G(4,N)=PH*FTMT 00800820 G(2,N)=PHR*SECRD 00800830 98 CONTINUE 00800840 IF (PHDG)30,31,31 00800841 30 PHMIN=-PHMIN 00800842 PHSEC=-PHSEC 00800843 31 IF(PLGDG)32,33,33 00800844 32 PLGMN=-PLGMN 00800845 PLSEC=-PLSEC 00800846 33 RETURN 00800850 C GEOGRAPHIC POSITION TO SECANT PLANE 00800860 99 DO 199 N=1,NN 00800870 PELEV=G(4,N) 00800880 C CONVERT LATITUDE AND LONGITUDE TO RADIANS 00800890 PPRAD=G(2,N)*SNONS 00800900 PLGRD=G(3,N)*SNONS 00800910 PSNPHI=DSIN(PPRAD) 00800920 PCSPHI=DCOS(PPRAD) 00800930 PSNLAM=DSIN(PLGRD) 00800940 PCSLAM=DCOS(PLGRD) 00800950 PH=G(4,N)*AMTFT 00800960 PAMSQ=DSQRT(1.D0-ESQ*PSNPHI*PSNPHI) 00800970 C COMPUTE NORMAL OF STATION 00800980 PRN=A/PAMSQ 00800990 C COMPUTE CLASSICAL GEOCENTRIC COORDINATES 00801000 PSNH=PRN+PH 00801010 PX=PSNLAM*PCSPHI*PSNH 00801020 PY=PCSLAM*PCSPHI*PSNH 00801030 PZ=((PRN*PANME+PH)*PSNPHI)+PENSYT 00801040 C COMPUTE SECANT PLANE COORDINATES 00801050 G(2,N)=PX*PCSLGO-PY*PSNLGO 00801060 G(3,N)=PZ*PCSPHO-(PX*PSNPL+PY*PSCPLA) 00801070 G(4,N)=PX*PCSPL+PY*PCSPLA+PZ*PSNPHO-PBASE 00801080 199 CONTINUE 00801090 IF(PHDG)34,35,35 00801091 34 PHMIN=-PHMIN 00801092 PHSEC=-PHSEC 00801093 35 IF(PLGDG)36,200,200 00801094 36 PLGMN=-PLGMN 00801095 PLSEC=-PLSEC 00801096 200 RETURN 00801100 END 00801110 C /**/00900000 SUBROUTINE GEOCGS 00900010 C 00900020 IMPLICIT REAL*8(A-H,O-Z) 00900030 REAL*8G(4,100),CONV(100),T(11),CAM(99,40),C(20,3),D(6,7) 00900040 COMMON/AREA3/G,T,PHDG,PHMIN,PHSEC,PLGDG,PLGMN,PLSEC,AMTFT,FTMT, 00900050 1SECRD,ESQ,CONV,A,SNONS 00900060 COMMON/AREA4/CAM,C,D,FL,RESID,ITOTAL,LARRY,IJOB,I8,JS2,KFF4,KP9, 00900070 1NPUNC,I9,KK3,JS1,NREAD,KD4,KP8,NPRNT,KD3,JISECT,JCOORD,JRESCT,JS3,00900080 2IFROM,ITO,KTOT,N7,NN,IDIR,KK5,KD5 00900090 C TRANSFORMATION AND INVERSE FOR GEOGRAPHIC POSITIONS AND 00900100 C RIGHT-HAND GEOCENTRIC SYSTEM IN METERS 00900110 DATA PI/3.1415926535898D0/ 00900120 IF(IDIR.EQ.1) GO TO 800 00900130 C GEOCENTRIC GEOGRAPHIC POSITION 00900140 DO 750 N=1,NN 00900150 X=G(3,N)/G(2,N) 00900160 IF(X.LT.10.D0)GO TO 710 00900170 FLONG=DATAN(G(2,N)/G(3,N)) 00900180 X=0.5D0*PI-DABS(FLONG) 00900190 IF(FLONG.LT.0.D0)FLONG=-X 00900200 IF(FLONG.GE.0.D0)FLONG=X 00900210 GO TO 715 00900220 710 FLONG=DATAN(X) 00900230 IF(G(2,N).LT.0.D0.AND.G(3,N).GT.0.D0)FLONG=PI+FLONG 00900240 IF(G(2,N).LT.0.D0.AND.G(3,N).LT.0.D0)FLONG=-PI+FLONG 00900250 715 PHIEST=DATAN(G(4,N)/DSQRT(G(2,N)*G(2,N)+G(3,N)*G(3,N))) 00900260 DO 720 I=1,10 00900270 IF(I.EQ.10)WRITE (NPRNT,1000) 00900280 S=DSIN(PHIEST) 00900290 S=S*S 00900300 TEMP=A*DSQRT(1.D0-((ESQ*S*(1.D0-ESQ))/(1.D0-ESQ*S))) 00900310 H=DSQRT(G(2,N)*G(2,N)+G(3,N)*G(3,N)+G(4,N)*G(4,N)) -TEMP 00900320 BSQ=A*A*(1.D0-ESQ) 00900330 TEMP=BSQ+A*H*DSQRT(1.D0-ESQ*S) 00900340 TEMP=(A*A+A*H*DSQRT(1.D0-ESQ*S))/TEMP 00900350 PHI=DATAN(G(4,N)*TEMP/DSQRT(G(2,N)*G(2,N)+G(3,N)*G(3,N))) 00900360 IF(DABS(PHIEST-PHI).LT.1.D-15)GO TO 730 00900370 PHIEST=PHI 00900380 720 CONTINUE 00900390 730 G(2,N)=PHI*SECRD 00900400 G(3,N)=FLONG*SECRD 00900410 750 G(4,N)=H*FTMT 00900420 RETURN 00900430 C GEOGRAPHIC POSITION TO GEOCENTRIC 00900440 800 DO 850 N=1,NN 00900450 H=G(4,N)*AMTFT 00900460 SP=DSIN(G(2,N)*SNONS) 00900470 CP=DCOS(G(2,N)*SNONS) 00900480 SL=DSIN(G(3,N)*SNONS) 00900490 CL=DCOS(G(3,N)*SNONS) 00900500 R=DSQRT(1.D0-ESQ*SP*SP) 00900510 G(2,N)=(A*CP*CL/R)+H*CP*CL 00900520 G(3,N)=(A*CP*SL/R)+H*CP*SL 00900530 850 G(4,N)=(A*(1.D0-ESQ)*SP/R)+H*SP 00900540 RETURN 00900550 1000 FORMAT(//' 10 ITERATIONS ON LATITUDE NECESSARY'//) 00900560 END 00900570 C /**/01000000 SUBROUTINE UTMGP1 01000010 C 01000020 IMPLICIT REAL*8(A-H,O-Z) 01000030 REAL*8G(4,100),CONV(100),T(11),CAM(99,40),C(20,3),D(6,7) 01000040 COMMON/AREA3/G,T,PHDG,PHMIN,PHSEC,PLGDG,PLGMN,PLSEC,AMTFT,FTMT, 01000050 1SECRD,ESQ,CONV,A,SNONS 01000060 COMMON/AREA4/CAM,C,D,FL,RESID,ITOTAL,LARRY,IJOB,I8,JS2,KFF4,KP9, 01000070 1NPUNC,I9,KK3,JS1,NREAD,KD4,KP8,NPRNT,KD3,JISECT,JCOORD,JRESCT,JS3,01000080 2IFROM,ITO,KTOT,N7,NN,IDIR,KK5,KD5 01000090 DATA CONS1/.24682D0/,CONS2/30.02335D0/,CONS3/5078.64977D0/, 01000100 1CONS4/.1570499810D0/,SEPQ/.0408887094D0/,Y1/.11422D0/,Y2/21.73607 01000110 2D0/,Y3/5104.57388D0/,Y4/6367399.689D0/,CNII/.2424068406D-1/, 01000120 3CNIII/.0195870255D-21/,CNV/.0391740509D-2/, 01000130 4CNA6/.0153460626D-6/,CNB5/.0460381879D-6/,CNI3/7.83481018D0/, 01000140 5CNC5/.36830550D-2/ 01000150 C TRANSFORMATION AND INVERSE FOR UNIVERSAL TRANSVERSE MERCATOR 01000160 C TO GEOGRAPHIC POSITION ABOVE CONSTANTS FOR CLARKE 1866 01000170 IF(IABS(IFROM).LE.14.AND.IDIR.EQ.0)GO TO 703 01000180 IF(IABS(IFROM).GT.14.AND.IDIR.EQ.0)GO TO 700 01000190 IF(IABS(ITO).LE.14.AND.IDIR.EQ.1)GO TO 704 01000200 I=ITO 01000210 GO TO 701 01000220 700 I=IFROM 01000230 C SET SCALE AND ORIGIN PARAMETERS FOR UTM SYSTEM 01000240 701 ALORG=0.D0 01000250 SCALE=.9996D0 01000260 FE=500000.D0*FTMT 01000270 IX=IABS(I)-100 01000280 X=IX 01000290 CM=(6.D0*X-183.D0)*3600.D0 01000300 GO TO 706 01000310 703 I=IFROM 01000320 GO TO 705 01000330 704 I=ITO 01000340 C ALASKA ZONES 01000350 705 ALORG=5985100.923D0 01000360 SCALE=.9999 01000370 IX=I-2 01000380 FE=500000.D0 01000390 IF(IX.EQ.7)FE=700000.D0 01000400 IF(IX.EQ.9)FE=600000.D0 01000410 X=IX 01000420 CM=482400.D0+X*14400.D0 01000430 706 EPSQ=ESQ/(1.D0-ESQ) 01000440 IF(IDIR.EQ.1)GO TO 800 01000450 C UTM TO GEOGRAPHIC 01000460 DO 750 N=1,NN 01000470 IF(I.LE.0)G(3,N)=10000000.D0-G(3,N) 01000480 C CONVERT FROM METERS TO FEET IF UTM 01000490 IF(IABS(I).LE.14)GO TO 702 01000500 G(2,N)=FTMT*G(2,N) 01000510 G(3,N)=FTMT*G(3,N) 01000520 702 PPRD=((G(3,N)*AMTFT+ALORG)*CONS4*10.D-7)/SCALE 01000530 SNLT=DSIN(PPRD) 01000540 CSLT=DCOS(PPRD) 01000550 CSSQ=CSLT*CSLT 01000560 PHRD=((CONS1*CSSQ+CONS2)*CSSQ+CONS3)*(SNLT*CSLT)*10.D-7+PPRD 01000570 PHIS=PHRD*SECRD 01000580 Q=((G(2,N)-FE)*AMTFT)*10.D-7 01000590 IF(Q)720,710,720 01000600 710 DLAM=0.D0 01000610 G(2,N)=PHIS 01000620 GO TO 740 01000630 720 SNLAT=DSIN(PHRD) 01000640 CSLAT=DCOS(PHRD) 01000650 SNSQ=SNLAT*SNLAT 01000660 CCSQ=CSLAT*CSLAT 01000670 TNLAT=SNLAT/CSLAT 01000680 TNSQ=TNLAT*TNLAT 01000690 ENU=A/DSQRT(1.D0-ESQ*SNSQ) 01000700 ENSNS=ENU*SNONS 01000710 EPCS=EPSQ*CCSQ 01000720 EPCSQ=1.D0+EPCS 01000730 QSQ=Q*Q 01000740 QCU=QSQ*Q 01000750 QFR=QCU*Q 01000760 QFV=QFR*Q 01000770 QSX=QFV*Q 01000780 SCLAT=1.D0/CSLAT 01000790 ENSN5=ENU**4*ENSNS 01000800 SVN=(((TNLAT/(2.D0*ENU*ENSNS))*EPCSQ)/SCALE**2)*10.D11 01000810 EGHT=((TNLAT/(24.D0*ENU**3*ENSNS))*(5.D0+3.D0*TNSQ+SEPQ*(CCSQ-SNSQ01000820 1)-(3.D0*EPSQ**2*CCSQ)*(CCSQ+3.D0*SNSQ))/SCALE**4)*10.D23 01000830 D6=(QSX*(TNLAT/(720.D0*ENU**5*ENSNS))*(61.D0+(45.D0*TNSQ)*(2.D0+ 01000840 1TNSQ-EPSQ*SNSQ)+EPSQ*(107.D0*CCSQ-162.D0*SNSQ))/SCALE**6)*10.D35 01000850 ANINE=(SCLAT/ENSNS)/SCALE*10.D5 01000860 TEN=(SCLAT/(6.D0*ENU**2*ENSNS))*(1.D0+2.D0*TNSQ+EPCS)/SCALE**3*10.01000870 1D17 01000880 E5=QFV*(SCLAT/(120.D0*ENSN5))*(5.D0+(4.0D0*TNSQ)*(7.D0+6.D0*TNSQ) 01000890 1+(2.D0*EPSQ)*(3.D0*CCSQ+4.D0*SNSQ))/SCALE**5*10.D29 01000900 G(2,N)=PHIS-SVN*QSQ+EGHT*QFR-D6 01000910 IF(IFROM.LT.0)G(2,N)=-G(2,N) 01000920 DLAM=ANINE*Q-TEN*QCU+E5 01000930 740 G(3,N)=CM-DLAM 01000940 IF(IABS(IFROM).GE.15)G(3,N)=CM+DLAM 01000950 IF(IABS(IFROM).LE.11)G(3,N)=-G(3,N) 01000960 750 CONTINUE 01000970 RETURN 01000980 C GEOGRAPHIC POSITION TO UTM 01000990 800 DO 850 N=1,NN 01001000 IF(IABS(ITO).LE.11)G(3,N)=-G(3,N) 01001010 PHRD=G(2,N)*SNONS 01001020 SNLAT=DSIN(PHRD) 01001030 CSLAT=DCOS(PHRD) 01001040 SNSQ=SNLAT*SNLAT 01001050 CCSQ=CSLAT*CSLAT 01001060 TNLAT=SNLAT/CSLAT 01001070 TNSQ=TNLAT*TNLAT 01001080 ENU=A/DSQRT(1.D0-ESQ*SNSQ) 01001090 ENSNS=ENU*SNONS 01001100 EPCS=EPSQ*CCSQ 01001110 EPCSQ=1.D0+EPCS 01001120 RWON=(Y4*(PHRD-(SNLAT*CSLAT*10.D-7)*(Y3-CCSQ*(Y2-Y1*CCSQ))))*SCALE01001130 P=(CM-G(3,N))*10.D-5 01001140 IF(IABS(ITO).GE.15)P=-P 01001150 IF(P)819,820,819 01001160 820 G(2,N)=FE 01001170 G(3,N)=(RWON-ALORG)*FTMT 01001180 GO TO 825 01001190 819 PSQ=P*P 01001200 PCU=PSQ*P 01001210 PFR=PCU*P 01001220 PFV=PFR*P 01001230 PSX=PFV*P 01001240 FOUR=ENSNS*CSLAT*SCALE*10.D3 01001250 TWO=FOUR*SNLAT*CNII 01001260 EPCTN=EPCSQ-TNSQ 01001270 THRE=TWO*CNIII*CCSQ*(4.D0*EPCSQ*EPCSQ+EPCTN) 01001280 FIVE=FOUR*CNV*CCSQ*EPCTN 01001290 CSFR=CCSQ*CCSQ 01001300 CSFRR=1.D0/CSFR 01001310 A6=PSX*TWO*CNA6*CSFR*(60.D0*EPCTN+CSFRR+540.D0*EPCS-330.D0*EPSQ) 01001320 B5=PFV*FOUR*CNB5*CSFR*(20.D0*EPCTN+CSFRR+52.D0*EPCS-58.D0*EPSQ-16.01001330 1D0) 01001340 G(2,N)=(P*FOUR+PCU*FIVE+B5)*FTMT+FE 01001350 G(3,N)=((PSQ*TWO+PFR*THRE+RWON+A6)-ALORG)*FTMT 01001360 C CONVERT FEET TO METERS IF UTM CONVERSION 01001370 825 IF(IABS(ITO).LE.14)GO TO 850 01001380 G(2,N)=G(2,N)*AMTFT 01001390 G(3,N)=G(3,N)*AMTFT 01001400 850 IF(ITO.LE.0)G(3,N)=10000000.D0-G(3,N) 01001410 RETURN 01001420 END 01001430