C***********************************************************************00000110
C*                                                                     *00000120
C*                            F  O  R  M  3                            *00000130
C*                                                                     *00000140
C***********************************************************************00000150
C                                                                       00000160
C     PROGRAM 'FORM3' FORMS OBSERVATION EQUATIONS ON THE ELLIPSOID.     00000170
C  ALL DATA IS READ FROM DISK FILES 'SE.GEODESY.STATIONS.MASTER',       00000180
C  'SE.GEODESY.DIRECTON' AND 'SE.GEODESY.DIST&AZ' (OR EQUIVALENT).      00000190
C  THE OBSERVATION EQUATIONS ARE STORED ON A DATA SET TO BE USED BY     00000200
C  PROGRAM 'SOLVE'. A DATA SET IS ALSO CREATED TO BE USED BY PROGRAM    00000210
C  'COMPARE1' FOR THE COMPARISON OF DIFFERENT ADJUSTMENTS. A FULL       00000220
C  DOCUMENTATION OF THE PROGRAM MAY BE FOUND IN;                        00000230
C  'PROGRAM PACKAGE FOR THE RIGOROUS COMPUTATION OF HORIZONTAL          00000240
C   GEODETIC NETWORKS' UNB MSCE THESIS (C.A. CHAMBERLAIN).              00000250
C  THE JCL REQUIRED AND DATA INPUT IS AS FOLLOWS                        00000260
C                                                                       00000270
C                                                                       00000280
C  JCL                                                                  00000290
C                                                                       00000300
C  1. INPUT DATA SETS                                                   00000310
C                                                                       00000320
C  1.1  STATION DATA                                                    00000330
C  //GO.FT11F001  DD  DSN=SE.GEODESY.STATIONS.MASTER,                   00000340
C  //  VOL=SER=SEGEOM,UNIT=M2314,DISP=(OLD,KEEP)                        00000350
C                                                                       00000360
C  1.2  DIRECTION DATA                                                  00000370
C  //GO.FT04F001  DD  DSN=SE.GEODESY.DIRECTION,                         00000380
C  //  VOL=SER=SEGEOM,UNIT=M2314,DISP=(OLD,KEEP)                        00000390
C                                                                       00000400
C  1.3  DISTANCE/AZIMUTH DATA                                           00000410
C  //GO.FT12F001  DD  DSN=SE.GEODESY.DIST&AZ,                           00000420
C  //  VOL=SER=SEGEOM,UNIT=M2314,DISP=(OLD,KEEP)                        00000430
C                                                                       00000440
C  2. OUTPUT DATA SETS                                                  00000450
C                                                                       00000460
C  2.1  APPROXIMATE COORDINATES (USED BY SOLVE OR COMPARE)              00000470
C  //GO.FT01F001  DD  DSN=APX.COORD,                                    00000480
C  //  UNIT=M2314,VOL=SER=SEGEOM,DISP=(NEW,KEEP),                       00000490
C  //  SPACE=(TRK,(1,2),RLSE),DCB=(RECFM=VBS,LRECL=20,BLKSIZE=7276)     00000500
C                                                                       00000510
C  2.2  OBSERVATION EQUATIONS  (USED BY SOLVE)                          00000520
C  //GO.FT02F001  DD  DSN=OBS.EQN,                                      00000530
C  //  UNIT=M2314,VOL=SER=SEGEOM,DISP=(NEW,KEEP),                       00000540
C  //  SPACE=(TRK,(4,53),RLSE),DCB=(RECFM=VBS,LRECL=76,BLKSIZE=7284)    00000550
C                                                                       00000560
C  2.3  FROM TO DATA  (USED BY COMPARE1)                                00000570
C  //GO.FT13F001  DD  DSN=FROM.TO,                                      00000580
C  //  UNIT=M2314,VOL=SER=SEGEOM,DISP=(NEW,KEEP),                       00000590
C  //  SPACE=(TRK,(1,4),RLSE),DCB=(RECFM=VBS,LRECL=68,BLKSIZE=7276)     00000600
C                                                                       00000610
C  3. TEMPORARY DATA SETS                                               00000620
C                                                                       00000630
C  3.1                                                                  00000640
C  //GO.FT08F001  DD  UNIT=DISK,SPACE=(TRK,(40,10)),                    00000650
C  //  DCB=(RECFM=VBS,LRECL=56,BLKSIZE=7264)                            00000660
C                                                                       00000670
C  3.2                                                                  00000680
C  //GO.FT09F001  DD  UNIT=DISK,SPACE=(TRK,(54,10)),                    00000690
C  //  DCB=(RECFM=VBS,LRECL=72,BLKSIZE=7224)                            00000700
C                                                                       00000710
C  NOTES: DATA SET NAMES ARE ARBITRARY -- THEY MAY CHANGE               00000720
C         UNIT NUMBERS ARE NOT VARIABLE                                 00000730
C         FOR LOAD MODULE EXECUTION REMOVE THE GO.                      00000740
C         CARD READER = FT05                                            00000750
C         LINE PRINTER = FT06                                           00000760
C         CARD PUNCH = FT07                                             00000770
C                                                                       00000780
C                                                                       00000790
C  DATA INPUT                                                           00000800
C                                                                       00000810
C  CARD 1  JOB TITLE                                                    00000820
C          FORMAT 20A4                                                  00000830
C                                                                       00000840
C  CARD 2  JOB OPTIONS                                                  00000850
C          FORMAT (I5,3X,A2,10I5)                                       00000860
C                                                                       00000870
C  VAR.NAME     CODE      OPTION                                        00000880
C                                                                       00000890
C    NSTN                 NUMBER OF NETWORK POINTS                      00000900
C                                                                       00000910
C    DISCOD       A       USE ALL DISTANCES                             00000920
C                 G       USE GEODIMETER DISTANCES ONLY                 00000930
C                 T       USE TELLUROMETER DISTANCES ONLY               00000940
C                 B       USE BASE LINE DISTANCES ONLY                  00000950
C                 S       USE SATELLITE DISTANCES ONLY                  00000960
C                 NO      NO DISTANCES ARE TO BE USED                   00000970
C                                                                       00000980
C    AZCODE       0       USE AZIMUTHS                                  00000990
C                 1       DO NOT USE AZIMUTHS                           00001000
C                                                                       00001010
C    ICORRS       0       NO DISTANCE REDUCTIONS REQUIRED               00001020
C                 1       REDUCE DISTANCE FROM SEA LEVEL TO             00001030
C                          ELLIPSOID                                    00001040
C                                                                       00001050
C    ICORRD       0       NO DIRECTION REDUCTIONS                       00001060
C                 1       CORRECT FOR DEFLECTION OF VERTICAL            00001070
C                 2       SKEW NORMAL CORRECTION                        00001080
C                 3       NORMAL SECTION-GEODESIC CORRECTION            00001090
C                 4       ALL GEOMETRIC CORRECTIONS (2+3 ABOVE)         00001100
C                 5       ALL CORRECTIONS (1+2+3 ABOVE)                 00001110
C                                                                       00001120
C    IO           5       INPUT UNIT NUMBER FOR CARD TYPE 3 (SEE BELOW) 00001130
C                         IF IO.NE.5 A //GO.FT CARD IS REQUIRED TO      00001140
C                         POINT TO THE DATA SET                         00001150
C                                                                       00001160
C    IPRINT       0       ALL OUTPUT                                    00001170
C                 1       OBSERVATIONS ONLY                             00001180
C                 2       OBSERVATIONS AND OBSERVATION EQUATIONS WITH   00001190
C                         LARGE MISCLOSURE TERMS                        00001200
C                 3       OBSERVATION EQUATIONS ONLY                    00001210
C                 4       OBSERVATION EQUATIONS WITH LARGE MISCLOSURE   00001220
C                         TERMS ONLY                                    00001230
C                 5       NO OUTPUT (OBSERVATIONS OR OBSERVATION        00001240
C                         EQUATIONS)                                    00001250
C                                                                       00001260
C    IWS          0       GEODETIC SURVEY OF CANADA WEIGHTING           00001270
C                         (AS READ FROM DATA FILES)                     00001280
C                 1       U.S. WEIGHTING SCHEME                         00001290
C                                                                       00001300
C    IPUN         0       NO DIMENSION STATEMENTS PUNCHED (FOR          00001310
C                         PROGRAM SOLVE)                                00001320
C                 1       GENERAL DIMENSIONS ONLY                       00001330
C                 2       SOLUTION DIMENSIONS ONLY                      00001340
C                 3       PX DIMENSIONS ONLY                            00001350
C                 4       BOTH 1 & 2 ABOVE                              00001360
C                 5       BOTH 2 & 3 ABOVE                              00001370
C                 6       BOTH 1 & 3 ABOVE                              00001380
C                 7       1 & 2 & 3 ABOVE                               00001390
C                                                                       00001400
C    NW                   BAND-WIDTH OF NORMAL EQUATIONS                00001410
C                                                                       00001420
C    NB                   BORDER-WIDTH OF NORMAL EQUATIONS              00001430
C                                                                       00001440
C    NFP                  NUMBER OF FIXED POINTS IN THE ADJUSTMENT      00001450
C                                                                       00001460
C                                                                       00001470
C NOTES: MAXIMUM NUMBER OF NETWORK POINTS = 1000  TO INCREASE THE       00001480
C          DIMENSION STATEMENT MUST BE CHANGED                          00001490
C        IF MORE THAN 1000 POINTS RE-DIMENSION VECTOR M TO 3 TIMES      00001500
C          NUMBER OF STATIONS                                           00001510
C        IF MORE THAN 1000 POINTS CHANGE VARIABLE 'NSTND'               00001520
C        PARAMETER 'DISCOD' MUST BE LEFT JUSTIFIED                      00001530
C        SPATIAL DISTANCES ARE AUTOMATICALLY REDUCED TO THE GEOID       00001540
C        EXAMPLE JCL FOR IO.NE.5                                        00001550
C          //GO.FT03F001  DD  DSN=STATION.NUMBERS,VOL=SER=SEGEOM,       00001560
C          //  UNIT=M2314,DISP=(OLD,KEEP),SPACE=(TRK,(1,1),RLSE),       00001570
C          //  DCB=(RECFM=FB,LRECL=9,BLKSIZE=7290)                      00001580
C        ALL OUTPUT EXCEPT OBSERVATIONS AND OBSERVATION EQUATIONS       00001590
C          IS PRINTED AUTOMATICALLY                                     00001600
C        SEE PROGRAM 'SOLVE' FOR USE OF PUNCHED OUTPUT                  00001610
C        IF IPUN=2  NW & NB ARE REQUIRED                                00001620
C        IF IPUN=3  NFP MUST BE SPECIFIED                               00001630
C        IF IPUN=4  NW & NB ARE REQUIRED                                00001640
C        IF IPUN=5  NW & NB & NFP ARE REQUIRED                          00001650
C        IF IPUN=6  NW & NB & NFP ARE REQUIRED                          00001660
C        IF IPUN=7  NW & NB & NFP ARE REQUIRED                          00001670
C                                                                       00001680
C                                                                       00001690
C  CARD 3  STATION NUMBERS OF NETWORK POINTS                            00001700
C          FORMAT (I9)                                                  00001710
C                                                                       00001720
C NOTES: CARD TYPE 3 IS REPEATED FOR EACH NETWORK STATION               00001730
C        IF IO.NE.5 (SEE CARD TYPE 2) NO CARD TYPE 3 IS                 00001740
C          REQUIRED                                                     00001750
C                                                                       00001760
C                                                                       00001770
C                                                                       00001780
      DOUBLE PRECISION AA,AR,AZ,AZC1,AZC2,AZ1,BB,BR,CC,DCOS,COS,DD,     00001790
     1DIFF,DIR,DIST,DIS1,DRN,DSIN,SIN,DSQRT,SQRT,ELLH,ELLHT,ESQ,ESQP,   00001800
     2F,GES,ONG,ONGA,PHI,PI,RHO,RMI,RMJ,RNJ,SIJ,SIJM,STLAT,STLON,STNM1, 00001810
     3STNM2,TZ,T1,T2,T3,T4,WI,WJ,X,Z1,XX,EIGHT,NINE,PHIM,RM,WM,RMM,RNM  00001820
     4,DEFL,TERM,OMESQ,DTAN,EE,FF,GG                                    00001830
      REAL NO                                                           00001840
      INTEGER AZCODE,ROW,STIONS,STION2                                  00001850
      DIMENSION PHI(1000),ONG(1000),ELLHT(1000),XSI(1000),ETA(1000),    00001860
     1GN(1000),M(3000),STIONS(1000),DESC(20),STION2(30),LOC(30),DRN(30),00001870
     2EIGHT(7),NINE(9),ITIME(4),NIPSN(100),IOBSV(50),KOBSV(50),         00001880
     3ILDIR(1200),N1TERR(700),N2TERR(700), ILSTA(800)                   00001890
      COMMON /BLOCK/AR,BR,F,ESQ,ESQP,OMESQ,PHIM,RMM,RNM,RM              00001900
     1       /STDAT/STLAT,STLON,GES,ELLH,STNM1,STNM2,XSII,ETAA          00001910
     2       /DISTOB/SIJM,DIS1,WGHT1,WGHT2,CODE1,CODE2                  00001920
     3       /LIST1/DIR,AZ,DIST,ONGA,I,K,PDIR,PAZ,PDIST,IC1             00001930
     4       /LIST2/T1,T2,T3,T4,TZ,W,WGHT,I1,I2,I3,I4,IZ,NCD            00001940
      EQUIVALENCE (EIGHT(1),DIR),(NINE(1),T1)                           00001950
      DATA A,NO,B,G,T,S/'A','NO','B','G','T','S'/                       00001960
      DATA PI/3.141592653589793D0/,RHO/206264.8062470963D0/             00001970
      SIN(XX)=DSIN(XX)                                                  00001980
      COS(XX)=DCOS(XX)                                                  00001990
      SQRT(XX)=DSQRT(XX)                                                00002000
      CALL WTO('HELLO \')                                               00002010
      CALL CPUTIM(ITIME(1))                                             00002020
C                                                                       00002030
C  MAXIMUM NUMBER OF STATIONS                                           00002040
C                                                                       00002050
      NSTND=1000                                                        00002060
C                                                                       00002070
C  DATA SET 'SE.GEODESY.STATIONS.MASTER'  (OR EQUIVALENT)               00002080
C                                                                       00002090
      NSTA=800                                                          00002100
      ISTUN=11                                                          00002110
      DEFINE FILE 11(800,230,E,M2)                                      00002120
C                                                                       00002130
C  DATA SET 'SE.GEODESY.DIRECTON'  (OR EQUIVALENT)                      00002140
C                                                                       00002150
      NDIR=1200                                                         00002160
      IDIRUN=4                                                          00002170
      DEFINE FILE 4(1200,442,E,M1)                                      00002180
C                                                                       00002190
C  DATA SET 'SE.GEODESY.DIST&AZ'  (OR EQUIVALENT)                       00002200
C                                                                       00002210
      NTERR=700                                                         00002220
      ITERUN=12                                                         00002230
      DEFINE FILE 12(700,145,E,M3)                                      00002240
C                                                                       00002250
C  ELLIPSOID PARAMETERS                                                 00002260
C                                                                       00002270
      AR=6378206.4D0                                                    00002280
      BR=6356583.8D0                                                    00002290
      F=(AR-BR)/AR                                                      00002300
      ESQ=F*(2.0D0-F)                                                   00002310
      OMESQ=1.0D0-ESQ                                                   00002320
      ESQP=ESQ/OMESQ                                                    00002330
C                                                                       00002340
C  READ AND ECHO DATA CARDS 1 AND 2                                     00002350
C                                                                       00002360
      READ 1000,(DESC(I),I=1,20)                                        00002370
      PRINT 1010,(DESC(I),I=1,20)                                       00002380
      READ 1020,NSTN,DISCOD,AZCODE,ICORRS,ICORRD,IO,IPRINT,IWS,IPUN,NW,N00002390
     1B,NFP                                                             00002400
      PRINT 1030,NSTN,DISCOD,AZCODE,ICORRS,ICORRD                       00002410
      IF(IWS.EQ.0)PRINT 1040                                            00002420
      IF(IWS.EQ.1)PRINT 1050                                            00002430
C                                                                       00002440
C  READ STATION NUMBERS AND STATION DATA  ERROR EXIT FOR TOO FEW OR TOO 00002450
C  MANY STATION CARDS                                                   00002460
C                                                                       00002470
      READ(IO,1060,END=420)(STIONS(I),I=1,NSTN)                         00002480
      DO 10 I=1,NSTN                                                    00002490
          CALL GETFYL(STIONS(I),I,NSTA,ILSTA,ISTUN)                     00002500
            PHI(I)=STLAT                                                00002510
            ONG(I)=STLON                                                00002520
            GN(I)=GES                                                   00002530
            ELLHT(I)=ELLH                                               00002540
            XSI(I)=XSII                                                 00002550
            ETA(I)=ETAA                                                 00002560
              CALL RADARC(STLAT,LATD,LATM,V2)                           00002570
              CALL RADARC(STLON,LOND,LONM,V4)                           00002580
          IF(MOD(I,50).EQ.1)PRINT 1070                                  00002590
10        PRINT 1080,STIONS(I),STNM1,STNM2,I,LATD,LATM,V2,LOND,LONM,V4, 00002600
     1               ELLH,XSI(I),ETA(I)                                 00002610
        READ(IO,1040,END=20)I                                           00002620
          GO TO 420                                                     00002630
20    REWIND 8                                                          00002640
      CALL WTO('ALL STATION DATA IS READ IN \')                         00002650
      CALL CPUTIM(ITIME(2))                                             00002660
C                                                                       00002670
C  INITIALIZE COUNT VARIABLES                                           00002680
C                                                                       00002690
      NIP=0                                                             00002700
      NORU=0                                                            00002710
      ISCAN=0                                                           00002720
      J=1                                                               00002730
C                                                                       00002740
C  READ FROM DATA SETS ALL OBSERVATIONS  STORE  ON TEMPORARY DATA FILE  00002750
C  ON UNIT 8                                                            00002760
C                                                                       00002770
      DO 190 I=1,NSTN                                                   00002780
        IF(IPRINT.LT.3)PRINT 1090,STIONS(I)                             00002790
C                                                                       00002800
C  FIND DIRECTION OBSERVATIONS                                          00002810
C                                                                       00002820
C                                                                       00002830
C  INITIALIZE COUNTERS                                                  00002840
C                                                                       00002850
        NC=0                                                            00002860
        N1=0                                                            00002870
        INDIC=0                                                         00002880
        IC1=0                                                           00002890
        PAZ=0.0                                                         00002900
        PDIST=0.0                                                       00002910
        AZ=0.0D0                                                        00002920
        DIST=0.0D0                                                      00002930
        ONGA=0.0D0                                                      00002940
        JSAVE=J                                                         00002950
C                                                                       00002960
C  FIND GETS THE SET OF DIRECTIONS OBSERVED AT STIONS(I)                00002970
C                                                                       00002980
30      CALL FIND(STIONS(I),STION2,DRN,PDIR,M(J),NC,J,NSTND,NDIR,       00002990
     1  NSTN,INDIC,STIONS,ILDIR,IDIRUN)                                 00003000
          INDIC=INDIC+1                                                 00003010
C                                                                       00003020
C  M(J)=0  NO OBSERVATIONS FOUND                                        00003030
C                                                                       00003040
          IF(M(J).EQ.0)GO TO 60                                         00003050
          IF(IPRINT.LT.3)CALL DIROUT(STION2,DRN,M(J))                   00003060
          NORU=NORU+1                                                   00003070
          MM=M(J)                                                       00003080
C                                                                       00003090
C  FIND SEQUENCE NUMBER OF OBSERVED STATION                             00003100
C                                                                       00003110
          DO 50 J1=1,MM                                                 00003120
          DIR=DRN(J1)                                                   00003130
            DO 40 K=1,NSTN                                              00003140
              IF(STIONS(K).EQ.STION2(J1))GO TO 50                       00003150
40            CONTINUE                                                  00003160
C                                                                       00003170
C  WRITE OBSERVATION ONTO TEMPORARY DATA SET                            00003180
C                                                                       00003190
50          WRITE(8)EIGHT                                               00003200
C                                                                       00003210
C  CHECK FOR MULTIPLE SETS AT STIONS(I)                                 00003220
C                                                                       00003230
60        NC=NC-N1                                                      00003240
          N1=1                                                          00003250
          IF(M(J).NE.0)J=J+1                                            00003260
          IF(NC.EQ.0)GO TO 70                                           00003270
          GO TO 30                                                      00003280
C                                                                       00003290
C  JSAVE USED TO CHECK FOR INTERSECTED STATIONS                         00003300
C                                                                       00003310
70      IF(JSAVE.EQ.J)NIP=NIP+1                                         00003320
        IF(JSAVE.EQ.J)NIPSN(NIP)=I                                      00003330
C                                                                       00003340
C  FIND DISTANCE OR AZIMUTH OBSERVATIONS                                00003350
C                                                                       00003360
        CALL SCANTR(STIONS(I),STION2,M(J),ISCAN,LOC,NSTND,NTERR,NSTN,   00003370
     1             STIONS,N1TERR,N2TERR,ITERUN)                         00003380
C                                                                       00003390
C  M(J)=0  NO OBSERVATIONS                                              00003400
C                                                                       00003410
          IF(M(J).EQ.0)GO TO 190                                        00003420
          FIND(ITERUN'LOC(1))                                           00003430
          PDIR=0.0                                                      00003440
          DIR=0.0D0                                                     00003450
          MM=M(J)                                                       00003460
C                                                                       00003470
C  GET OBSERVATIONS FROM DATA SET   CHECK EACH INDIVIDUAL OBSERVATION   00003480
C  TO SEE IF IT IS REQUIRED IN THE ADJUSTMENT                           00003490
C                                                                       00003500
          DO 180 J1=1,MM                                                00003510
            CALL GETERR(LOC(J1),IC1,IC2,ONGA,AZ,PAZ,AZ1,V4,ITERUN)      00003520
              IF(MM.NE.J1)FIND(ITERUN'LOC(J1+1))                        00003530
C                                                                       00003540
C  ELIMINATE AZIMUTH OBSERVATIONS IF AZCODE=1                           00003550
C                                                                       00003560
              IF(AZCODE.EQ.1)CALL NOAZ(AZ,AZ1)                          00003570
              IF(SIJM.LT.1.0D-4.AND.DIS1.LT.1.0D-4.AND.AZCODE.EQ.1)GO TO00003580
     1            170                                                   00003590
C                                                                       00003600
C  ALL DISTANCES REQUIRED   SKIP CHECKS                                 00003610
C                                                                       00003620
              IF(DISCOD.EQ.A)GO TO 110                                  00003630
C                                                                       00003640
C  NO DISTANCES REQUIRED   ELIMINATE ALL EXCEPT THOSE CODED 'C'         00003650
C                                                                       00003660
              IF(DISCOD.EQ.NO)CALL NODIS(AZ,&110,&170)                  00003670
C                                                                       00003680
C  CHECK THE INDIVIDUAL INSTRUMENTS                                     00003690
C                                                                       00003700
              IF((CODE1.EQ.B.OR.CODE2.EQ.B).AND.(DISCOD.NE.B))          00003710
     1          CALL NOBASE(AZ,&80,&170)                                00003720
80            IF((CODE1.EQ.T.OR.CODE2.EQ.T).AND.(DISCOD.NE.T))          00003730
     1          CALL NOTELL(AZ,&90,&170)                                00003740
90            IF((CODE1.EQ.G.OR.CODE2.EQ.G).AND.(DISCOD.NE.G))          00003750
     1          CALL NOGEOD(AZ,&100,&170)                               00003760
100           IF((CODE1.EQ.S.OR.CODE2.EQ.S).AND.(DISCOD.NE.S))          00003770
     1          CALL NOSAT(AZ,&110,&170)                                00003780
C                                                                       00003790
C  FIND SEQUENCE NUMBER OF OBSERVED STATION                             00003800
C                                                                       00003810
110         DO 120 K=1,NSTN                                             00003820
              IF(STIONS(K).EQ.STION2(J1))GO TO 130                      00003830
120           CONTINUE                                                  00003840
130         IF(SIJM.LT.0.5D-3.AND.AZ.EQ.0.0)M(J)=M(J)-1                 00003850
            IF(SIJM.LT.0.5D-3.AND.AZ.EQ.0.0)GO TO 150                   00003860
            DIST=SIJM                                                   00003870
            PDIST=WGHT1                                                 00003880
C                                                                       00003890
C  COMPUTE WEIGHT ACCORDING TO U.S. FORMULAS                            00003900
C                                                                       00003910
            IF(IWS.EQ.0)GO TO 140                                       00003920
            XX=ELLHT(I)-ELLHT(K)+GN(K)-GN(I)                            00003930
            PDIST=WEIGHT(CODE1,DIST,XX,WGHT1)                           00003940
C                                                                       00003950
C  WRITE OBSERVATION ONTO TEMPORARY DATA SET                            00003960
C                                                                       00003970
140         WRITE(8)EIGHT                                               00003980
              IF(SIJM.GT.0.5D-3.AND.IPRINT.LT.3)CALL DISOUT(STION2(J1), 00003990
     1        SIJM)                                                     00004000
              IF(AZ.NE.0.0.AND.IPRINT.LT.3)CALL AZOUT(STION2(J1),AZ)    00004010
150         IF(DIS1.LT.0.5D-3.AND.AZ1.EQ.0.0)GO TO 180                  00004020
C                                                                       00004030
C  MORE THAN ONE DISTANCE OR AZIMUTH OBSERVATION EXIST ON THIS LINE     00004040
C                                                                       00004050
              PAZ=V4                                                    00004060
              AZ=AZ1                                                    00004070
              DIST=DIS1                                                 00004080
              PDIST=WGHT2                                               00004090
              IF(IWS.EQ.0)GO TO 160                                     00004100
            XX=ELLHT(I)-ELLHT(K)+GN(K)-GN(I)                            00004110
            PDIST=WEIGHT(CODE2,DIST,XX,WGHT2)                           00004120
160           IC1=IC2                                                   00004130
              WRITE(8)EIGHT                                             00004140
                IF(DIS1.GT.0.5D-3.AND.IPRINT.LT.3)CALL DISOUT(STION2(J1)00004150
     1          ,DIS1)                                                  00004160
                IF(AZ1.NE.0.0.AND.IPRINT.LT.3)CALL AZOUT(STION2(J1),AZ1)00004170
              M(J)=M(J)+1                                               00004180
              GO TO 180                                                 00004190
C                                                                       00004200
C  OBSERVATIONS HAVE BEEN ELIMINATED  DECREASE THE COUNT                00004210
C                                                                       00004220
170         M(J)=M(J)-1                                                 00004230
180         CONTINUE                                                    00004240
          IF(M(J).GT.0)J=J+1                                            00004250
190     CONTINUE                                                        00004260
      CALL WTO('THE OBSERVATIONS HAVE BEEN FOUND \')                    00004270
      CALL CPUTIM(ITIME(3))                                             00004280
      J=J-1                                                             00004290
C                                                                       00004300
C  J= NUMBER OF 'SETS' OF DATA                                          00004310
C                                                                       00004320
      WRITE(2)J                                                         00004330
      REWIND 8                                                          00004340
C                                                                       00004350
C  OBSERVATION TYPE COUNTERS                                            00004360
C                                                                       00004370
      N30=0                                                             00004380
      N40=0                                                             00004390
      N50=0                                                             00004400
      IZ=0                                                              00004410
      ROW=0                                                             00004420
      IROW=0                                                            00004430
      DO 380 N=1,J                                                      00004440
        IOBS=0                                                          00004450
C                                                                       00004460
C  L= COUNT OF OBSERVATION EQUATIONS IN A 'SET'                         00004470
C                                                                       00004480
        L=0                                                             00004490
        REWIND 9                                                        00004500
        MM=M(N)                                                         00004510
C                                                                       00004520
C  MM = NUMBER OF OBSERVATIONS IN A SET                                 00004530
C                                                                       00004540
        DO 310 J1=1,MM                                                  00004550
          READ(8)EIGHT                                                  00004560
C                                                                       00004570
C  GEODETIC INVERSE BETWEEN STATIONS USING APPROXIMATE COORDINATES      00004580
C                                                                       00004590
          CALL VININV(PHI(I),ONG(I),PHI(K),ONG(K),AZC1,AZC2,SIJ)        00004600
            AA= SIN(AZC1)                                               00004610
            BB= COS(AZC2)                                               00004620
            CC= SIN(AZC2)                                               00004630
            DD= COS(PHI(K))                                             00004640
            EE=SIN(PHI(I))                                              00004650
            FF=SIN(PHI(K))                                              00004660
            GG=COS(AZC1)                                                00004670
C                                                                       00004680
C  RADII OF CURVATURE                                                   00004690
C                                                                       00004700
              WI= SQRT(1.0D0-ESQ*EE**2)                                 00004710
              RMI=AR*OMESQ/WI**3                                        00004720
              WJ= SQRT(1.0D0-ESQ*FF**2)                                 00004730
              RMJ=AR*OMESQ/WJ**3                                        00004740
              RNJ=AR/WJ                                                 00004750
              PHIM=(PHI(I)+PHI(K))/2.0D0                                00004760
              WM= SQRT(1.0D0-ESQ * SIN(PHIM)**2)                        00004770
              RMM=AR*OMESQ/WM**3                                        00004780
              RNM=AR/WM                                                 00004790
              RM=RMM*RNM/(RMM*AA**2+RNM*GG**2)                          00004800
C                                                                       00004810
C  COLUMN POSITIONS IN 'A' DESIGN MATRIX                                00004820
C                                                                       00004830
                I1=2*I-1                                                00004840
                I2=2*I                                                  00004850
                I3=2*K-1                                                00004860
                I4=2*K                                                  00004870
C                                                                       00004880
C  DIRECTION OBSERVATION EQUATION                                       00004890
C                                                                       00004900
                  IF(DIR.EQ.0.0)GO TO 230                               00004910
                    N30=N30+1                                           00004920
                    L=L+1                                               00004930
                    ROW=ROW+1                                           00004940
                    IF(IPRINT.NE.5.AND.IPRINT.NE.1)IROW=IROW+1          00004950
C                                                                       00004960
C  APPLY CORRECTIONS TO DIRECTION IF ICORRD .NE. 0                      00004970
C                                                                       00004980
                    IF(ICORRD.EQ.0)GO TO 200                            00004990
                      CALL REDDIR(ICORRD,XSI(I),ETA(I),SIJ,ELLHT(I),    00005000
     1                            ELLHT(K),DIR,AZC1)                    00005010
200                 DIFF=2.0D0*PI-DIR                                   00005020
                    IF(DIFF.LE.3.0D-5)DIR=0.0D0                         00005030
C                                                                       00005040
C  APPROXIMATE VALUE OF ORIENTATION UNKNOWN Z1                          00005050
C                                                                       00005060
                    IF(J1.EQ.1)Z1=AZC1-DIFF                             00005070
C                                                                       00005080
C  ELEMENTS OF 'A' MATRIX                                               00005090
C                                                                       00005100
                      T1=AA*RMI/SIJ                                     00005110
                      T2=BB*RNJ*DD/SIJ                                  00005120
                      T3=CC*RMJ/SIJ                                     00005130
                      T4=-T2                                            00005140
                      TZ=-1.0D0                                         00005150
                        X=DIR+Z1                                        00005160
                        IF(X.GE.2.0D0*PI)X=X-2.0D0*PI                   00005170
C                                                                       00005180
C  MISCLOSURE VECTOR                                                    00005190
C                                                                       00005200
                        W=(AZC1-X)*RHO                                  00005210
                        NCD=30                                          00005220
C                                                                       00005230
C  WEIGHT  IF IWS=1 USE U.S. WEIGHTING                                  00005240
C                                                                       00005250
                          WGHT=PDIR                                     00005260
                          IF(IWS.EQ.0)GO TO 210                         00005270
                          WGHT=1.0D0/(0.36D0+2.0D0*(206.2648062D0/SIJ)**00005280
     1                    2)                                            00005290
                          PDIR=WGHT                                     00005300
210                       IF(MOD(IROW,50).EQ.1)PRINT 1100               00005310
                          IF(IPRINT.EQ.5.OR.IPRINT.EQ.1)GO TO 220       00005320
                          IF(IPRINT.EQ.2.OR.IPRINT.EQ.4.AND.ABS(W).LT.2.00005330
     1                      0)GO TO 220                                 00005340
                          PRINT 1110,ROW,I,K,TZ,T1,T2,T3,T4,W,PDIR,NCD  00005350
                          IF(ABS(W).GT.2.0)PRINT 1120                   00005360
C                                                                       00005370
C  WRITE OBSERVATION EQUATION ETC. ONTO TEMPORARY FILE                  00005380
C                                                                       00005390
220                       WRITE(9)NINE                                  00005400
C                                                                       00005410
C  KEEP TRACK OF OBSERVATIONS (FOR PROGRAM COMPARE1)                    00005420
C                                                                       00005430
                            IOBS=IOBS+1                                 00005440
                            IOBSV(IOBS)=K                               00005450
C                                                                       00005460
C  AZIMUTH OBSERVATION EQUATION                                         00005470
C                                                                       00005480
230               IF(AZ.EQ.0.0)GO TO 270                                00005490
                    N50=N50+1                                           00005500
                    L=L+1                                               00005510
                    ROW=ROW+1                                           00005520
                    IF(IPRINT.NE.5.AND.IPRINT.NE.1)IROW=IROW+1          00005530
                    TZ=0.0D0                                            00005540
                    IF(AZ.EQ.2.0D0*PI)AZ=0.0D0                          00005550
C                                                                       00005560
C  ELEMENTS OF 'A' REQUIRED ONLY IF NO DIRECTION EQUATION (ELEMENTS     00005570
C  ALREADY COMPUTED)                                                    00005580
C                                                                       00005590
                    IF(DIR.NE.0.0)GO TO 240                             00005600
                      T1=AA*RMI/SIJ                                     00005610
                      T2=BB*RNJ*DD/SIJ                                  00005620
                      T3=CC*RMJ/SIJ                                     00005630
                      T4=-T2                                            00005640
C                                                                       00005650
C  MISCLOSURE TERM (USING LAPLACE CONDITION  ASTRO-GEODETIC AZIMUTH)    00005660
C                                                                       00005670
240                     DEFL=(ONGA-ONG(I))*EE                           00005680
                        TERM=AZ-DEFL                                    00005690
                        W=(AZC1-TERM)*RHO                               00005700
                        NCD=50                                          00005710
                          IF(MOD(IROW,50).EQ.1)PRINT 1100               00005720
C                                                                       00005730
C  WEIGHT  IF IWS=1 U.S. WEIGHTING                                      00005740
C                                                                       00005750
                          WGHT=PAZ                                      00005760
                          IF(IWS.EQ.0)GO TO 250                         00005770
                          WGHT=1.0D0/(0.8425+(DTAN(PHI(I))/0.8D0)**2+   00005780
     1                    (0.4D0*EE)**2)                                00005790
                          PAZ=WGHT                                      00005800
250                       IF(IPRINT.EQ.5.OR.IPRINT.EQ.1)GO TO 260       00005810
                          IF(IPRINT.EQ.2.OR.IPRINT.EQ.4.AND.ABS(W).LT.2.00005820
     1                      0)GO TO 260                                 00005830
                          PRINT 1110,ROW,I,K,TZ,T1,T2,T3,T4,W,PAZ,NCD   00005840
                          IF(ABS(W).GT.2.0)PRINT 1130                   00005850
C                                                                       00005860
C  WRITE OBSERVATION EQUATION ETC. ONTO TEMPORARY FILE                  00005870
C                                                                       00005880
260                       WRITE(9)NINE                                  00005890
C                                                                       00005900
C  KEEP TRACK OF OBSERVATIONS  (FOR PROGRAM COMPARE1)                   00005910
C                                                                       00005920
                            IOBS=IOBS+1                                 00005930
                            IOBSV(IOBS)=K                               00005940
C                                                                       00005950
C  DISTANCE OBSERVATION EQUATION                                        00005960
C                                                                       00005970
270               IF(DIST.EQ.0.0)GO TO 310                              00005980
                    N40=N40+1                                           00005990
                    L=L+1                                               00006000
                    ROW=ROW+1                                           00006010
                    IF(IPRINT.NE.5.AND.IPRINT.NE.1)IROW=IROW+1          00006020
C                                                                       00006030
C  REDUCE SPATIAL DISTANCE  (NOTE: NOT CONTROLLED BY USER )             00006040
C                                                                       00006050
                    IF(IC1.EQ.0)GO TO 280                               00006060
                      T1=ELLHT(I)-GN(I)                                 00006070
                      T2=ELLHT(K)-GN(K)                                 00006080
                      CALL REDDIS(2,0.0,0.0,T1,T2,DIST)                 00006090
C                                                                       00006100
C  REDUCE DISTANCE TO ELLIPSOID  (CONTROLLED VIA ICORRS)                00006110
C                                                                       00006120
280                 IF(ICORRS.EQ.0)GO TO 290                            00006130
                      CALL REDDIS(ICORRS,GN(I),GN(K),ELLHT(I),ELLHT(K), 00006140
     1                            DIST)                                 00006150
C                                                                       00006160
C  ELEMENTS OF 'A' MATRIX                                               00006170
C                                                                       00006180
290                 TZ=0.0D0                                            00006190
                    T1=-RMI*GG/RHO                                      00006200
                    T2=RNJ*DD*CC/RHO                                    00006210
                    T3=-RMJ* BB       /RHO                              00006220
                    T4=-T2                                              00006230
                      NCD=40                                            00006240
C                                                                       00006250
C  MISCLOSURE VECTOR                                                    00006260
C                                                                       00006270
                      W=SIJ-DIST                                        00006280
                        IF(MOD(IROW,50).EQ.1)PRINT 1100                 00006290
                        IF(IPRINT.EQ.5.OR.IPRINT.EQ.1)GO TO 300         00006300
                        IF(IPRINT.EQ.2.OR.IPRINT.EQ.4.AND.ABS(W).LT.0.1)00006310
     1                    GO TO 300                                     00006320
                        PRINT 1110,ROW,I,K,TZ,T1,T2,T3,T4,W,PDIST,NCD   00006330
                        IF(ABS(W).GT.0.1)PRINT 1140                     00006340
C                                                                       00006350
C  WEIGHT (COMPUTED ABOVE)                                              00006360
C                                                                       00006370
300                     WGHT=PDIST                                      00006380
C                                                                       00006390
C  WRITE OBSERVATION EQUATIONS ETC. ONTO TEMPORARY DATA SET             00006400
C                                                                       00006410
                        WRITE(9)NINE                                    00006420
C                                                                       00006430
C  KEEP TRACK OF OBSERVATIONS (FOR PROGRAM COMPARE1)                    00006440
C                                                                       00006450
                          IOBS=IOBS+1                                   00006460
                          IOBSV(IOBS)=K                                 00006470
310       CONTINUE                                                      00006480
        REWIND 9                                                        00006490
C                                                                       00006500
C  REWRITE OBSERVATIONS TO FILE INSERTING COUNT OF OBSERVATIONS IN      00006510
C  EACH 'SET'                                                           00006520
C                                                                       00006530
        DO 330 MM=1,L                                                   00006540
          READ(9)NINE                                                   00006550
            IF(MM.GT.1)GO TO 320                                        00006560
            WRITE(2 )L,NINE                                             00006570
            GO TO 330                                                   00006580
320         WRITE(2 )NINE                                               00006590
330       CONTINUE                                                      00006600
C                                                                       00006610
C  WRITE UNIQUE OBSERVATIONS TO FILE (FOR COMPARE1)                     00006620
C                                                                       00006630
        DO 350 ML=1,IOBS                                                00006640
          MLL=ML+1                                                      00006650
          IF(MLL.EQ.IOBS+1)GO TO 360                                    00006660
          IF(IOBSV(ML).EQ.0)GO TO 350                                   00006670
          DO 340 MJ=MLL,IOBS                                            00006680
            IF(IOBSV(ML).EQ.IOBSV(MJ))IOBSV(MJ)=0                       00006690
340       CONTINUE                                                      00006700
350     CONTINUE                                                        00006710
360     MJ=0                                                            00006720
        DO 370 ML=1,IOBS                                                00006730
          IF(IOBSV(ML).EQ.0)GO TO 370                                   00006740
          MJ=MJ+1                                                       00006750
          KOBSV(MJ)=IOBSV(ML)                                           00006760
370     CONTINUE                                                        00006770
        WRITE(13)I,MJ,(KOBSV(ML),ML=1,MJ)                               00006780
380     CONTINUE                                                        00006790
C                                                                       00006800
C  WRITE STATION NUMBERS AND APPROXIMATE COORDINATES ON A FILE          00006810
C                                                                       00006820
      DO 390 I=1,NSTN                                                   00006830
390     WRITE( 1)STIONS(I),PHI(I),ONG(I)                                00006840
C                                                                       00006850
C  SUMMARY OF THE JOB                                                   00006860
C                                                                       00006870
      PRINT 1150                                                        00006880
      DO 400 I=1,NIP                                                    00006890
400     PRINT 1160,NIPSN(I),STIONS(NIPSN(I))                            00006900
      NTOT=N30+N40+N50                                                  00006910
      PRINT 1170,(DESC(I),I=1,20),NSTN,NIP,N30,N40,N50,NTOT,NORU        00006920
      CALL WTO('GOOD BYE \')                                            00006930
      CALL CPUTIM(ITIME(4))                                             00006940
      PRINT 1180                                                        00006950
      DO 410 I=1,4                                                      00006960
      ZTIME=FLOAT(ITIME(I))/10000.0                                     00006970
410     PRINT 1190,I,ZTIME                                              00006980
      GO TO 430                                                         00006990
C                                                                       00007000
C  ERROR STOP FOR INCORRECT NUMBER OF STATION CARDS                     00007010
C                                                                       00007020
420   PRINT 1200                                                        00007030
      STOP 100                                                          00007040
C                                                                       00007050
C  PUNCH DIMENSION CARDS FOR PROGRAM 'SOLVE'                            00007060
C                                                                       00007070
430   GO TO (440,460,470,440,460,440,440),IPUN                          00007080
      GO TO 480                                                         00007090
C                                                                       00007100
C  GENERAL CARDS  (NK1,NK2,NK3,NK4, AS DEFINED IN PROGRAM SOLVE)        00007110
C                                                                       00007120
440   NK3=0                                                             00007130
      DO 450 I=1,J                                                      00007140
        IF(M(I).GT.NK3)NK3=M(I)                                         00007150
450     CONTINUE                                                        00007160
          NK3=NK3+1                                                     00007170
          NK4=NK3*2                                                     00007180
          NK1=NSTN                                                      00007190
          NK2=NK1*2                                                     00007200
            WRITE(7,1210)NK3,NK3,NK3,NK3,NK3,NK3,NK3,NK3,NK3,NK3,NK4,   00007210
     1                   NK3,NK3,NK3,NK3,NK3,NK3,NK4,NK4,NK3,NK4,NK4,NK400007220
     2                   ,NK3,NK3,NK3                                   00007230
            WRITE(7,1220)NK1,NK2,NK3,NK4                                00007240
      GO TO (480,480,480,460,480,470,460),IPUN                          00007250
C                                                                       00007260
C  CARDS FOR SOLUTION VECTOR, NORMALS ETC                               00007270
C                                                                       00007280
460   NK2=NSTN*2                                                        00007290
      NK5=NW+NB                                                         00007300
        N=NK2-NB                                                        00007310
        NBB=(NB**2+NB)/2                                                00007320
        NSPACE=N-NW+1                                                   00007330
          WRITE(7,1230)NK2,NK2,NK2,NK2,NK5,NK2                          00007340
          WRITE(7,1240)NK5,NW,NB,N,NBB,NSPACE                           00007350
      GO TO (480,480,480,480,470,480,470),IPUN                          00007360
C                                                                       00007370
C  CARDS FOR PX MATRIX                                                  00007380
C                                                                       00007390
470   NFPT=NFP*2                                                        00007400
        WRITE(7,1250)NFP,NFP,NFPT,NFPT,NFPT,NFP,NFPT,NFPT               00007410
        WRITE(7,1260)NFP,NFPT                                           00007420
C                                                                       00007430
C  NORMAL ENDING                                                        00007440
C                                                                       00007450
480   STOP                                                              00007460
1000  FORMAT(20A4)                                                      00007470
1010  FORMAT('1'//42X,'*****  INPUT CHECK  *****'/'+',T50,11('_')///4X, 00007480
     1'JOB NAME',T29,':',2X,20A4)                                       00007490
1020  FORMAT(I5,3X,A2,10I5)                                             00007500
1030  FORMAT('0',3X,'NUMBER OF STATIONS',T29,':',2X,I5//4X,'DISTANCE TYP00007510
     1E CODE',T29,':',6X,A2//4X,'AZIMUTH USE CODE',T29,':',6X,I1//4X,   00007520
     2'DISTANCE REDUCTION CODE :     ',I2//4X,'DIRECTION REDUCTION CODE:00007530
     3      ',I1)                                                       00007540
1040  FORMAT('-',5X,'WEIGHTING SCHEME OF GEODETIC SURVEY OF CANADA USED'00007550
     1)                                                                 00007560
1050  FORMAT('-',5X,'WEIGHTING SCHEME BASED ON PAPER BY DRACUP (GRENOBLE00007570
     1 1975) USED')                                                     00007580
1060  FORMAT(I9)                                                        00007590
1070  FORMAT('1'//3X,'STATION      STATION       SEQ    APPROXIMATE     00007600
     1 APPROXIMATE      ELLIPSOID    DEFLECTIONS'/3X,'NUMBER        NAME00007610
     2         NO.     LATITUDE         LONGTITUDE       HEIGHT      XSI00007620
     3     ETA'/1X,97('_')//)                                           00007630
1080  FORMAT(' ',I9,2X,2A8,I5,2(I7,I3,F7.3),4X,F8.3,F10.2,F8.2)         00007640
1090  FORMAT('-',32X,'OBSERVATIONS AT STATION #  ',I9/33X,36('_')/)     00007650
1100  FORMAT('1',          45X,'COMPACT FORM OF COEFFICIENT MATRIX A ',/00007660
     1///,3X,'ROW ',3X,'I',3X,'J',1X,'DZ(I)',6X,'DLAT(I)',8X,'DLONG(I)',00007670
     29X,'DLAT(J)',8X,'DLONG(J)',11X,'W(I)',14X,'P(I)',5X,'CODE',////)  00007680
1110  FORMAT(2X,3I4,2X,F4.1,5F16.7,F16.3,I8)                            00007690
1120  FORMAT('+',126X,'<==30')                                          00007700
1130  FORMAT('+',126X,'<==50')                                          00007710
1140  FORMAT('+',126X,'<==40')                                          00007720
1150  FORMAT('1'//40X,'INTERSECTED STATIONS'/'+',39X,20('_')//36X,'SEQUE00007730
     1NCE NO.     STATION NO.'/'+',35X,'________ ___     _______ ___'//)00007740
1160  FORMAT('0',37X,I5,12X,I9)                                         00007750
1170  FORMAT('1',///,T29,'***** SUMMARY OF OBSERVATION EQUATIONS *****',00007760
     1////////,T34,'JOB NAME :',20A4,///,T24,'NUMBER OF STATIONS :',I4, 00007770
     2                          ///,T12,'NUMBER OF INTERSECTED STATIONS 00007780
     3:',I4,///,T13,'NUMBER OF DIRECTION EQUATIONS :',I4,///,T14,'NUMBER00007790
     4 OF DISTANCE EQUATIONS :',I4,///,T15,'NUMBER OF AZIMUTH EQUATIONS 00007800
     5:',I4,///,T17,'TOTAL NUMBER OF EQUATIONS :',I4,///,T12,'NUMBER OF 00007810
     6ORIENTATION UNKNOWNS :',I4)                                       00007820
1180  FORMAT('-',10X,'CPU TIME IN SECONDS BETWEEN WTO''S')              00007830
1190  FORMAT('0',18X,I5,F15.4)                                          00007840
1200  FORMAT('0',10X,'*****  ERROR-THE NUMBER OF STATIONS DOES NOT AGREE00007850
     1 WITH THE NUMBER OF DATA CARDS  *****')                           00007860
1210  FORMAT(6X,'DIMENSION WTAZ(',I2,'),WTDR(',I2,'),WTDS(',I2,'),WVAZ('00007870
     1,I2,'),WVDR(',I2,'),WVDS(',I2,'),'/5X,'1MAZ(',I2,',4),MDIR(',I2,',00007880
     24),MDIS(',I2,',4),STOR(',I2,',',I2,'),STORAZ(',I2,',4),'/5X,'2',T400007890
     32,'STORDR(',I2,',4),STORDS(',I2,',4),'/5X,'3WEIGHT(',I2,'),CONST('00007900
     4,I2,'),ICOL(',I2,'),JCOL(',I2,'),W(',I2,',',I2,'),AA(',I2,',',I2,'00007910
     5),AL(',I2,'),'/5X,'4',T42,'UP(',I2,',',I2,'),V(',I2,')')          00007920
1220  FORMAT(6X,'NK1=',I4/6X,'NK2=',I4/6X,'NK3=',I4/6X,'NK4=',I4)       00007930
1230  FORMAT(6X,'DIMENSION B(',I4,'),XVEC(',I4,'),PHIV(',I4,'),BL(',I4,'00007940
     1),TA(',I3,',',I4,')')                                             00007950
1240  FORMAT(6X,'NK5=',I4/6X,'NW=',I4/6X,'NB=',I4/6X,'N=',I6/6X,'NBB=', 00007960
     1I6/6X,'NSPACE=',I4)                                               00007970
1250  FORMAT(6X,'DIMENSION IVEC(',I3,'),INEW(',I3,'),XSAVE(',I4,'),PX(',00007980
     1I4,',',I4,'),'/5X,'1',T37,'ISTAFP(',I3,'),WTFP(',I4,',',I4,')')   00007990
1260  FORMAT(6X,'NFP=',I4/6X,'NFPT=',I4)                                00008000
      END                                                               00008010
C***********************************************************************00008020
C*                                                                     *00008030
C*                  S U B R O U T I N E   V I N I N V                  *00008040
C*                                                                     *00008050
C***********************************************************************00008060
C                                                                       00008070
C                                                                       00008080
C                                                                       00008090
C     SUBROUTINE 'VININV' COMPUTES THE GEODESIC DISTANCE AND FORWARD    00008100
C  AND REVERSE GEODESIC AZIMUTHS BETWEEN TWO POINTS 1 AND 2. THE        00008110
C  EQUATIONS USED CAN BE FOUND IN 'SURVEY REVIEW  # 176'. THE           00008120
C  SIMPLIFIED EQUATIONS 3A,4A AND 6A ARE USED. THE PRESENT SUBROUTINE   00008130
C  IS A CUT-DOWN VERSION OF A SUBROUTINE OF THE SAME NAME AVAILABLE     00008140
C  AT THE DSE OF U.N.B..                                                00008150
C                                                                       00008160
C  COMMON /BLOCK/ A     = SEMI-MAJOR AXIS OF REFERENCE ELLIPSOID        00008170
C                 B     = SEMI-MINOR AXIS OF REFERENCE ELLIPSOID        00008180
C                 F     = FLATTENING OF ELLIPSOID                       00008190
C                 ESQ1  = FIRST ECCENTRICITY                            00008200
C                 ESQ2  = SECOND ECCENTRICITY                           00008210
C                 OMESQ = 1-ESQ1                                        00008220
C                 C1,C2,C3,C4 ARE NOT USED                              00008230
C                                                                       00008240
C   INPUT: PHI1 = GEODETIC LATITUDE OF POINT 1 (+ VE NORTH)             00008250
C          ONG1 = GEODETIC LONGITUDE OF POINT 1 (+ VE EAST)             00008260
C          PHI2 = GEODETIC LATITUDE OF POINT 2 (+ VE NORTH)             00008270
C          ONG2 = GEODETIC LONGITUDE OF POINT 2 (+ VE EAST)             00008280
C                                                                       00008290
C  OUTPUT: A12 = GEODESIC AZIMUTH 1 - 2 (CLOCKWISE FROM NORTH)          00008300
C          A21 = GEODESIC AZIMUTH 2 - 1 (CLOCKWISE FROM NORTH)          00008310
C          S12 = GEODESIC DISTANCE 1 - 2                                00008320
C                                                                       00008330
      SUBROUTINE VININV     (PHI1,ONG1,PHI2,ONG2,A12,A21,S12)           00008340
      IMPLICIT REAL*8(A-H,O-Z)                                          00008350
      COMMON /BLOCK/A,B,F,ESQ1,ESQ2,OMESQ,C1,C2,C3,C4                   00008360
      DATA PI/3.141592653589793D0/,SING/1.0D-12/                        00008370
      TPI=2.0D0*PI                                                      00008380
        OMF=1.0D0-F                                                     00008390
C                                                                       00008400
C  REDUCED LATITUDES, THEIR TRIG FUNCTIONS AND COMBINATIONS             00008410
C                                                                       00008420
                                        U1=DATAN(OMF*DTAN(PHI1))        00008430
          SU1=DSIN(U1)                                                  00008440
          CU1=DCOS(U1)                                                  00008450
                                        U2=DATAN(OMF*DTAN(PHI2))        00008460
          SU2=DSIN(U2)                                                  00008470
          CU2=DCOS(U2)                                                  00008480
            CU1SU2=CU1*SU2                                              00008490
            SU1CU2=SU1*CU2                                              00008500
            SU1SU2=SU1*SU2                                              00008510
            CU1CU2=CU1*CU2                                              00008520
C                                                                       00008530
C  DELTA LONGITUDE ON AUXILLARY SPHERE - ITERATION TO 10**-12 RADIANS   00008540
C                                                                       00008550
      DLON=ONG2-ONG1                                                    00008560
      DLAS=DLON                                                         00008570
10    SDLAS=DSIN(DLAS)                                                  00008580
      CDLAS=DCOS(DLAS)                                                  00008590
        SSIG=DSQRT((CU2*SDLAS)**2+(CU1SU2-SU1CU2*CDLAS)**2)             00008600
        CSIG=SU1SU2+CU1CU2*CDLAS                                        00008610
        SIG=DARCOS(CSIG)                                                00008620
          SALPHA=CU1CU2*SDLAS/SSIG                                      00008630
          CALPH2=1.0D0-SALPHA**2                                        00008640
          CTSM=0.0D0                                                    00008650
            IF(DABS(CALPH2).GT.SING   )CTSM=CSIG-2.0D0*SU1SU2/CALPH2    00008660
            CTSM2=CTSM**2                                               00008670
              C=F/16.0D0*CALPH2*(4.0D0+F*(4.0D0-3.0D0*CALPH2))          00008680
                DLASUP=DLON+(1.0D0-C)*F*SALPHA*(SIG+C*SSIG*(CTSM+C*CSIG*00008690
     1          (-1.0D0+2.0D0*CTSM2)))                                  00008700
                  IF(DABS(DLASUP-DLAS).LT.SING   )GO TO 20              00008710
                    DLAS=DLASUP                                         00008720
                    GO TO 10                                            00008730
C                                                                       00008740
C  GEODESIC DISTANCE                                                    00008750
C                                                                       00008760
20    USQ=CALPH2*ESQ2                                                   00008770
        A3=1.0D0+USQ/256.0D0*(64.0D0+USQ*(-12.0D0+5.0D0*USQ))           00008780
        B4=USQ/512.0D0*(128.0D0+USQ*(-64.0D0+37.0D0*USQ))               00008790
          DELSIG=B4*SSIG*(CTSM+B4/4.0D0*CSIG*(-1.0D0+2.0D0*CTSM2))      00008800
              S12=B*A3*(SIG-DELSIG)                                     00008810
C                                                                       00008820
C  FORWARD AND REVERSE AZIMUTHS  (0<ALPHA<360)                          00008830
C                                                                       00008840
      A12=DATAN2(CU2*SDLAS,CU1SU2-SU1CU2*CDLAS)                         00008850
      A21=DATAN2(-CU1*SDLAS,SU1CU2-CU1SU2*CDLAS)                        00008860
          IF(A12.GT.TPI)A12=A12-TPI                                     00008870
          IF(A12.LT.0.0)A12=A12+TPI                                     00008880
            IF(A21.GT.TPI)A21=A21-TPI                                   00008890
            IF(A21.LT.0.0)A21=A21+TPI                                   00008900
      RETURN                                                            00008910
      END                                                               00008920
C***********************************************************************00008930
C*                                                                     *00008940
C*                  S U B R O U T I N E   R A D A R C                  *00008950
C*                                                                     *00008960
C***********************************************************************00008970
C                                                                       00008980
C                                                                       00008990
C                                                                       00009000
C     SUBROUTINE 'RADARC' CONVERTS RADIANS TO DEGREES MINUTES AND       00009010
C  SECONDS. FOR NEGATIVE ANGLES ONLY THE LEFTMOST NONZERO VALUE IS      00009020
C  NEGATIVE (EGS.  -50,15,30.5 ; 0,-35,30.0 ; 0,0,-50.5)                00009030
C                                                                       00009040
C  NOTE: THE 0.0005 VALUE IS TO GUARD AGAINST ROUNDOFF                  00009050
C                                                                       00009060
C   INPUT: A = RADIAN VALUE OF ANGLE  (REAL*8)                          00009070
C                                                                       00009080
C  OUTPUT: I = DEGREES  (INTEGER)                                       00009090
C          J = MINUTES  (INTEGER)                                       00009100
C          S = SECONDS  (REAL*4)                                        00009110
C                                                                       00009120
      SUBROUTINE RADARC(A,I,J,S)                                        00009130
      DOUBLE PRECISION A,SEC,AD,AJ,RHO,   SIGN                          00009140
      DATA RHO/206264.8062470963D0/                                     00009150
C                                                                       00009160
C  CHECK SIGN OF 'A' -- SET SIGN=-1 IF NEGATIVE AND CONVERT 'A' TO      00009170
C  POSITIVE VALUE                                                       00009180
C                                                                       00009190
      SIGN=1.0D0                                                        00009200
      IF(A.LT.0.0)SIGN=-1.0D0                                           00009210
      IF(SIGN.LT.0.0)A=-A                                               00009220
C                                                                       00009230
C  CONVERT 'A' TO ARCSECONDS                                            00009240
C                                                                       00009250
      SEC=A*RHO+0.0005D0                                                00009260
C                                                                       00009270
C  FIND INTEGER DEGREES                                                 00009280
C                                                                       00009290
      I=SEC/3600.0D0                                                    00009300
      AD=I                                                              00009310
C                                                                       00009320
C  FIND INTEGER MINUTES                                                 00009330
C                                                                       00009340
      J=SEC/60.0D0-AD*60.0D0                                            00009350
      AJ=J                                                              00009360
C                                                                       00009370
C  FIND REAL*4 SECONDS                                                  00009380
C                                                                       00009390
      S=SEC-AD*3600.0D0-AJ*60.0D0-0.0005D0                              00009400
C                                                                       00009410
C  SET LEFTMOST VALUE NEGATIVE IF SIGN=-1                               00009420
C                                                                       00009430
      IF(I.NE.0)GO TO 20                                                00009440
      IF(J.EQ.0)GO TO 10                                                00009450
      J=J*SIGN                                                          00009460
      GO TO 30                                                          00009470
10    S=S*SIGN                                                          00009480
      GO TO 30                                                          00009490
20    I=I*SIGN                                                          00009500
C                                                                       00009510
C  CONVERT 'A' BACK TO NEGATIVE IF SIGN=-1                              00009520
C                                                                       00009530
30    IF(SIGN.LT.0.0)A=-A                                               00009540
      RETURN                                                            00009550
      END                                                               00009560
C***********************************************************************00009570
C*                                                                     *00009580
C*                  S U B R O U T I N E   O U T P U T                  *00009590
C*                                                                     *00009600
C***********************************************************************00009610
C                                                                       00009620
C                                                                       00009630
C                                                                       00009640
C     SUBROUTINE 'OUTPUT' WRITES ON THE LINE PRINTER THE OBSERVATIONS   00009650
C  USED AT EACH STATION. DIRECTIONS ARE OUTPUT BY CALLING 'DIROUT',     00009660
C  DISTANCES BY CALLING 'DISOUT' AND AZIMUTHS BY CALLING 'AZOUT'. THE   00009670
C  QUANTITIES THAT ARE TO BE OUTPUT ARE CONTROLLED BY VARIABLE 'IPRINT' 00009680
C  (SEE MAIN PROGRAM). THE 'FROM' STATION IS PRINTED IN THE MAIN        00009690
C  PROGRAM.                                                             00009700
C                                                                       00009710
      SUBROUTINE OUTPUT                                                 00009720
      DOUBLE PRECISION DIS,DIR,AZ                                       00009730
      DIMENSION JSTN(30),DIR(30)                                        00009740
C                                                                       00009750
C*****                                                             *****00009760
C*                     E N T R Y   D I R O U T                         *00009770
C*****                                                             *****00009780
C                                                                       00009790
C   INPUT: JSTN = VECTOR OF LENGTH 30 OF THE 'TO' STATION NUMBERS       00009800
C          DIR  = VECTOR OF LENGTH 30 OF THE OBSERVED DIRECTIONS        00009810
C          N    = NUMBER OF OBSERVED DIRECTIONS                         00009820
C                                                                       00009830
C  OUTPUT: DIRECTIONS OUTPUT ON LINE PRINTER IN DEGREES MINUTES AND     00009840
C          SECONDS                                                      00009850
C                                                                       00009860
      ENTRY DIROUT(JSTN,DIR,N)                                          00009870
      WRITE(6,1000)                                                     00009880
      DO 10 I=1,N                                                       00009890
        CALL RADARC(DIR(I),ID,IM,SEC)                                   00009900
10      WRITE(6,1010)JSTN(I),ID,IM,SEC                                  00009910
      RETURN                                                            00009920
C                                                                       00009930
C*****                                                             *****00009940
C*                     E N T R Y   D I S O U T                         *00009950
C*****                                                             *****00009960
C                                                                       00009970
C   INPUT: N   = 'TO' STATION NUMBER                                    00009980
C          DIS = OBSERVED DISTANCE                                      00009990
C                                                                       00010000
C  OUTPUT: DISTANCE OUTPUT ON LINE PRINTER                              00010010
C                                                                       00010020
      ENTRY DISOUT(N,DIS)                                               00010030
        WRITE(6,1020)N,DIS                                              00010040
      RETURN                                                            00010050
C                                                                       00010060
C*****                                                             *****00010070
C*                     E N T R Y    A Z O U T                          *00010080
C*****                                                             *****00010090
C                                                                       00010100
C   INPUT: N  = 'TO' STATION NUMBER                                     00010110
C          AZ = OBSERVED AZIMUTH                                        00010120
C                                                                       00010130
C  OUTPUT: AZIMUTH OUTPUT ON LINE PRINTER IN DEGREES MINUTES AND        00010140
C          SECONDS                                                      00010150
C                                                                       00010160
      ENTRY AZOUT(N,AZ)                                                 00010170
        CALL RADARC(AZ,ID,IM,SEC)                                       00010180
        WRITE(6,1030)N,ID,IM,SEC                                        00010190
      RETURN                                                            00010200
1000  FORMAT('-',34X,'TO STATION         DIRECTION')                    00010210
1010  FORMAT('0',34X,I9,I12,I3,F7.3)                                    00010220
1020  FORMAT('0',26X,'DISTANCE TO STATION #  ',I9,' = ',F11.3,' M')     00010230
1030  FORMAT('0',26X,'AZIMUTH TO STATION # ',I9,' = ',I4,I3,F7.3)       00010240
      END                                                               00010250
C***********************************************************************00010260
C*                                                                     *00010270
C*                  S U B R O U T I N E   R E D U C E                  *00010280
C*                                                                     *00010290
C***********************************************************************00010300
C                                                                       00010310
C                                                                       00010320
C                                                                       00010330
C     SUBROUTINE 'REDUCE' REDUCES DIRECTION AND/OR DISTANCE OBSERVATIONS00010340
C  TO THE ELLIPSOID. THE SUBROUTINE HAS TWO ENTRY POINTS, REDDIR FOR    00010350
C  DIRECTION OBSERVATIONS AND REDDIS FOR DISTANCE OBSERVATIONS. THE     00010360
C  FOLLOWING COMMON BLOCK IS USED FOR BOTH ENTRY POINTS;                00010370
C                                                                       00010380
C  COMMON /BLOCK/  A     = SEMI-MAJOR AXIS OF REFERENCE ELLIPSOID       00010390
C                  B     = SEMI-MINOR AXIS OF REFERENCE ELLIPSOID       00010400
C                  F     = FLATTENING OF REFERENCE ELLIPSOID            00010410
C                  ECC1  = FIRST ECCENTRICITY                           00010420
C                  ECC2  = SECOND ECCENTRICITY                          00010430
C                  OMESQ = 1-ECC1                                       00010440
C                  PHIM  = MEAN LATITUDE OF LINE ENDPOINTS              00010450
C                  RMM   = MERIDIAN RADIUS OF CURVATURE AT PHIM         00010460
C                  RNM   = PRIME VERTICAL RADIUS OF CURVATURE AT PHIM   00010470
C                  RM    = EULER'S RADIUS OF CURVATURE AT ALPHA 1-2     00010480
C                                                                       00010490
      SUBROUTINE REDUCE                                                 00010500
      DOUBLE PRECISION A,ALPH12,B,DCOS,COS,DIR,DSIN,SIN,DSQRT,SQRT,     00010510
     1ECC1,ECC2,F,H1,H2,PHIM,             RHO,RM,RMM,RNM,S12,     DARSIN00010520
     2,ARSIN,OMESQ,STACPM                                               00010530
      COMMON /BLOCK/A,B,F,ECC1,ECC2,OMESQ,PHIM,RMM,RNM,RM               00010540
      DATA RHO/206264.8062470963D0/                                     00010550
      COS(X)=DCOS(X)                                                    00010560
      SIN(X)=DSIN(X)                                                    00010570
      SQRT(X)=DSQRT(X)                                                  00010580
      ARSIN(X)=DARSIN(X)                                                00010590
C                                                                       00010600
C*****                                                             *****00010610
C*                     E N T R Y   R E D D I R                         *00010620
C*****                                                             *****00010630
C                                                                       00010640
C   INPUT: ICORRD = CODE FOR SELECTING REDUCTIONS                       00010650
C                      1= CORRECTION FOR DEFLECTION OF VERTICAL         00010660
C                      2= SKEW NORMAL CORRECTION                        00010670
C                      3= NORMAL SECTION GEODESIC CORRECTION            00010680
C                      4= ALL GEOMETRIC CORRECTIONS (I.E. 2+3 ABOVE)    00010690
C                      5= ALL CORRECTIONS (I.E.1+2+3 ABOVE)             00010700
C          XSI1   = MERIDIAN COMPONENT OF DEFLECTION OF VERTICAL AT     00010710
C                   OBSERVATION STATION                                 00010720
C          ETA1   = PRIME VERTICAL COMPONENT OF DEFLECTION OF           00010730
C                   VERTICAL AT OBSERVATION STATION                     00010740
C          S12    = GEODETIC DISTANCE BETWEEN ENDPOINTS                 00010750
C          H1     = ELLIPSOIDAL HEIGHT AT OBSERVATION STATION           00010760
C          H2     = ELLIPSOIDAL HEIGHT AT OBSERVED STATION              00010770
C          DIR    = OBSERVED DIRECTION                                  00010780
C          ALPH12 = GEODETIC AZIMUTH TO OBSERVED STATION                00010790
C                                                                       00010800
C  OUTPUT: DIR    = CORRECTED DIRECTION                                 00010810
C                                                                       00010820
      ENTRY REDDIR(ICORRD,XSI1,ETA1,S12,H1,H2,DIR,ALPH12)               00010830
C                                                                       00010840
C  CONSTANT TERM                                                        00010850
C                                                                       00010860
        STACPM=SIN(2.0D0*ALPH12)*COS(PHIM)**2                           00010870
C                                                                       00010880
C  SELECT REQUIRED REDUCTIONS                                           00010890
C                                                                       00010900
      GO TO (10,20,30,20,10),ICORRD                                     00010910
C                                                                       00010920
C  CORRECTION FOR DEFLECTION OF VERTICAL                                00010930
C                                                                       00010940
10      DIR=DIR+(-(XSI1* SIN(ALPH12)-ETA1* COS(ALPH12))*(H2-H1)/S12)/RHO00010950
        IF(ICORRD.EQ.1)RETURN                                           00010960
C                                                                       00010970
C  SKEW NORMAL CORRECTION                                               00010980
C                                                                       00010990
20        DIR=DIR+(H2*ECC2*STACPM/2.0D0/RM)                             00011000
          IF(ICORRD.EQ.2)RETURN                                         00011010
C                                                                       00011020
C  NORMAL SECTION - GEODESIC CORRECTION                                 00011030
C                                                                       00011040
30          DIR=DIR+(-(ECC1*S12**2*STACPM)/12.0D0/RNM**2)               00011050
            RETURN                                                      00011060
C                                                                       00011070
C*****                                                             *****00011080
C*                     E N T R Y   R E D D I S                         *00011090
C*****                                                             *****00011100
C                                                                       00011110
C   INPUT: ICORRS = CODE FOR SELECTING REDUCTIONS                       00011120
C                      1= REDUCE DISTANCE FROM SEA-LEVEL (GEOID) TO     00011130
C                         ELLIPSOID                                     00011140
C                      2= REDUCE SPATIAL DISTANCE TO ELLIPSOID          00011150
C          GH1    = GEOID-ELLIPSOID SEPERATION AT FROM STATION          00011160
C          GH2    = GEOID-ELLIPSOID SEPERATION AT TO STATION            00011170
C          H1     = ELLIPSOIDAL HEIGHT AT FROM STATION                  00011180
C          H2     = ELLIPSOIDAL HEIGHT AT TO STATION                    00011190
C          S12    = OBSERVED DISTANCE                                   00011200
C                                                                       00011210
C  OUTPUT: S12    = CORRECTED DISTANCE                                  00011220
C                                                                       00011230
C                                                                       00011240
      ENTRY REDDIS(ICORRS,GH1,GH2,H1,H2,S12)                            00011250
        IF(ICORRS.EQ.2)GO TO 40                                         00011260
C                                                                       00011270
C  REDUCE DISTANCE FROM SEA-LEVEL (GEOID) TO ELLIPSOID                  00011280
C                                                                       00011290
          S12 =S12 *(1.0D0-(GH1+GH2)/2.0D0/RM)                          00011300
          RETURN                                                        00011310
C                                                                       00011320
C  REDUCE SPATIAL DISTANCE TO ELLIPSOID                                 00011330
C                                                                       00011340
40          S12 =2.0D0*RM* ARSIN( SQRT((S12 **2-(H2-H1)**2)/(1.0D0+H1/RM00011350
     1             )/(1.0D0+H2/RM))/2.0D0/RM)                           00011360
      RETURN                                                            00011370
      END                                                               00011380
C***********************************************************************00011390
C*                                                                     *00011400
C*                    F U N C T I O N   W E I G H T                    *00011410
C*                                                                     *00011420
C***********************************************************************00011430
C                                                                       00011440
C                                                                       00011450
C                                                                       00011460
C     FUNCTION 'WEIGHT' DETERMINES THE WEIGHT OF A DISTANCE OBSERVATION 00011470
C  USING THE VALUES FOUND IN DRACUP 'USE OF DOPPLER POSITIONS TO        00011480
C  CONTROL CLASSICAL GEODETIC NETWORKS'.  THE FOLLOWING FORMULAS ARE    00011490
C  USED:                                                                00011500
C      BASELINE       P=1/((1CM**2+(0.5PPM OF DIST)**2+(.00005*DH/3)**2)00011510
C      GEODIMETER     P=1/((1.5CM**2+(1PPM OF DIST)**2+(.00005*DH/3)**2)00011520
C      TELLUROMETER   P=1/((3CM**2+(3.5PPM OF DIST)**2+(.00005*DH/3)**2)00011530
C                                                                       00011540
C   INPUT: CODE = INSTRUMENT CODE  B=BASELINE                           00011550
C                                  G=GEODIMETER                         00011560
C                                  T=TELLUROMETER                       00011570
C                                  S=SATELLITE                          00011580
C                                  C=OBSERVATION REQUIRED (SEE BELOW)   00011590
C          DIST = OBSERVED DISTANCE                                     00011600
C          DH   = DIFFERENCE IN ORTHOMETRIC HEIGHTS BETWEEN THE         00011610
C                 ENDPOINTS OF THE DISTANCE                             00011620
C          WGHT = DEFAULT WEIGHT (ONLY USED IN CASE OF CODE S)          00011630
C                                                                       00011640
C  OUTPUT: WEIGHT=ASSIGNED WEIGHT (1/VARIANCE)                          00011650
C                                                                       00011660
C  NOTES: THERE IS NO PROVISION FOR SATELLITE DERIVED DISTANCES -- THE  00011670
C         DEFAULT WEIGHT IS USED AS READ FROM THE DIST&AZ FILE          00011680
C         FOR DISTANCES CODED C THE FOLLOWING ASSUMPTION IS MADE:       00011690
C                      0 < DIST < 100 M       BASELINE                  00011700
C                    100 < DIST < 10000 M     GEODIMETER                00011710
C                  10000 < DIST               TELLUROMETER              00011720
C                                                                       00011730
C                                                                       00011740
      FUNCTION WEIGHT(CODE,DIST,DH,WGHT)                                00011750
      REAL*8 DIST,DH,VAR,D                                              00011760
      DATA B,G,T,C,S/'B','G','T','C','S'/                               00011770
C                                                                       00011780
C  CONSTANT TERMS                                                       00011790
C                                                                       00011800
      D=DIST/1.0D6                                                      00011810
      DH=(0.00005D0*DH/3.0D0)**2                                        00011820
C                                                                       00011830
C  SATELLITE DISTANCE  --  LEAVE WEIGHT AS DEFAULT                      00011840
C                                                                       00011850
      IF(CODE.EQ.S)WEIGHT=WGHT                                          00011860
C                                                                       00011870
C  BASELINE                                                             00011880
C                                                                       00011890
      IF((CODE.EQ.C.AND.DIST.LT.100.0D0).OR.(CODE.EQ.B))                00011900
     1  VAR=0.0001D0+(D*0.5D0)**2+DH                                    00011910
C                                                                       00011920
C  GEODIMETER                                                           00011930
C                                                                       00011940
      IF((CODE.EQ.C.AND.DIST.GT.100.0D0.AND.DIST.LT.10000.0D0).OR.(CODE.00011950
     1  EQ.G))  VAR=0.000225D0+D**2+DH                                  00011960
C                                                                       00011970
C  TELLUROMETER                                                         00011980
C                                                                       00011990
      IF((CODE.EQ.C.AND.DIST.GT.10000.0D0).OR.(CODE.EQ.T))              00012000
     1  VAR=0.0009D0+(D*3.5D0)**2+DH                                    00012010
C                                                                       00012020
C  WEIGHT=1/VARIANCE                                                    00012030
C                                                                       00012040
      IF(CODE.NE.S)WEIGHT=1.0D0/VAR                                     00012050
      RETURN                                                            00012060
      END                                                               00012070
C***********************************************************************00012080
C*                                                                     *00012090
C*                  S U B R O U T I N E   G E T F Y L                  *00012100
C*                                                                     *00012110
C***********************************************************************00012120
C                                                                       00012130
C                                                                       00012140
      SUBROUTINE GETFYL(NSTN,ICALL,NSTAT,ISNUM,ISTUN)                   00012150
C                                                                       00012160
C     SUBROUTINE 'GETFYL' READS STATION DATA FROM THE 'SE.GEODESY.      00012170
C  STATIONS.MASTER' FILE (OR AN EQUIVALENT FILE) ONE STATION AT A TIME  00012180
C                                                                       00012190
C  COMMON BLOCK /STDAT/  P     = GEODETIC LATITUDE                      00012200
C                        O     = GEODETIC LONGITUDE                     00012210
C                        GES   = GEOID ELLIPSOID SEPERATION             00012220
C                        ELLH  = ELLIPSOIDAL HEIGHT                     00012230
C                        STNM1                                          00012240
C                              = STATION NAME                           00012250
C                        STNM2                                          00012260
C                        XSII  = MERIDIAN COMPONENT OF DEFL. OF VERT.   00012270
C                        ETAA  = PRIME VERTICAL COMP. OF DEFL. OF VERT  00012280
C                                                                       00012290
C   INPUT: NSTN = STATION NUMBER FOR WHICH DATA REQUIRED                00012300
C          ICALL= PARAMETER FOR SAVING DISK I/O -- ON FIRST CALL TO     00012310
C                 SUBROUTINE A COPY OF THE STATION NUMBERS IS READ INTO 00012320
C                 VECTOR 'ISNUM' TO SAVE DISK READS -- THIS DECREASES   00012330
C                 THE PROGRAM EXECUTION TIME IMMENSLY                   00012340
C          NSTAT= NUMBER OF RECORDS ON THE STATION FILE                 00012350
C          ISNUM= VECTOR DIMENSIONED AT LEAST 'NSTAT' LONG TO STORE THE 00012360
C                 STATION NUMBERS (SEE PARAMETER ICALL)                 00012370
C          ISTUN= FORTRAN UNIT NUMBER FOR STATION DATA SET (MUST        00012380
C                 CORRESPOND TO UNIT NUMBER OF DD CARD AND DEFINE FILE) 00012390
C                                                                       00012400
C  OUTPUT: STATION DATA PASSED BACK VIA COMMON BLOCK                    00012410
C                                                                       00012420
C  NOTE: IF STATION CANNOT BE FOUND AFTER 200 TRIES IT IS ASSUMED IT    00012430
C        IS NOT ON THE FILE. THE PROGRAM STOPS WITH A CONDITION CODE    00012440
C        200 -- PROBABLE ERROR - WRONG STATION NUMBER PUNCHED ON INPUT  00012450
C        DATA CARDS                                                     00012460
C                                                                       00012470
      DOUBLE PRECISION P,O,GES,ELLH,STNM1,STNM2                         00012480
      COMMON /STDAT/P,O,GES,ELLH,STNM1,STNM2,XSII,ETAA                  00012490
      DIMENSION ISNUM(NSTAT)                                            00012500
C                                                                       00012510
C  FIRST CALL TO SUBROUTINE -- READ STATION NUMBERS FROM FILE INTO      00012520
C  VECTOR 'ISNUM'                                                       00012530
C                                                                       00012540
      IF(ICALL.NE.1)GO TO 5                                             00012550
      DO 4 I=1,NSTAT                                                    00012560
4     READ(ISTUN'I,1020)ISNUM(I)                                        00012570
C                                                                       00012580
C  COMPUTE ADDRESS OF RECORD AND TEST AGAINST VECTOR 'ISNUM'            00012590
C                                                                       00012600
5     J=0                                                               00012610
        MASH=MOD(NSTN,797)                                              00012620
10      IF(MASH.EQ.0)MASH=1                                             00012630
      IF(ISNUM(MASH).NE.NSTN)GO TO 15                                   00012640
C                                                                       00012650
C  STATION FOUND -- READ AND RETURN                                     00012660
C                                                                       00012670
          READ(ISTUN'MASH,1000)NTMP,STNM1,STNM2,P,O,GES,ELLH,XSII,ETAA  00012680
      RETURN                                                            00012690
C                                                                       00012700
C  COMPUTE NEW ADDRESS -- UP TO 200 TRIES - SPECIAL ADDRESSES ON 200 TH 00012710
C  AND 201 ST TRIES  -- BRANCH BACK AND CHECK VECTOR 'ISNUM'            00012720
C                                                                       00012730
15          MASH=MOD((MASH+NSTN),799)                                   00012740
            J=J+1                                                       00012750
            IF(J.LT.200)GO TO 10                                        00012760
            IF(J.EQ.200)MASH=800                                        00012770
            IF(J.EQ.201)MASH=799                                        00012780
            IF(J.EQ.202)GO TO 20                                        00012790
            GO TO 10                                                    00012800
C                                                                       00012810
C  STATION NOT FOUND -- STOP WITH CONDITION CODE = 200                  00012820
C                                                                       00012830
20      PRINT 1010,NSTN                                                 00012840
      STOP 200                                                          00012850
1000  FORMAT(I9,2A8,2F19.16,T166,F8.3,T182,F8.3,T198,2F8.3)             00012860
1010  FORMAT('0',5X,'** ERROR **     STATION NUMBER ',I9,' IS NOT ON FIL00012870
     1E')                                                               00012880
1020  FORMAT(I9)                                                        00012890
      END                                                               00012900
C***********************************************************************00012910
C*                                                                     *00012920
C*                    S U B R O U T I N E   F I N D                    *00012930
C*                                                                     *00012940
C***********************************************************************00012950
C                                                                       00012960
C                                                                       00012970
C                                                                       00012980
C     SUBROUTINE 'FIND' LOCATES A SET OF DIRECTIONS ON THE              00012990
C  'SE.GEODESY.DIRECTON' FILE (OR EQUIVALENT FILE) KNOWING THE FROM     00013000
C  STATION NUMBER AND THE SET COUNTER (N1). THE ROUTINE CHECKS THE      00013010
C  LIST OF 'TO' STATIONS AGAINST THE STATIONS IN THE NETWORK AND        00013020
C  ELIMINATES ANY OBSERVATIONS TO STATIONS NOT IN THE NETWORK           00013030
C                                                                       00013040
C   INPUT: NSTN   = 'FROM' STATION NUMBER                               00013050
C          N1     = SET COUNTER -- FOR 1 ST SET N1=0, FOR 2 ND SET      00013060
C                   N1=1 ETC.                                           00013070
C          ICALL  = PARAMETER FOR SAVING DISK I/O -- ON FIRST CALL TO   00013080
C                   SUBROUTINE A COPY OF THE 'FROM' STATION NUMBERS     00013090
C                   IS READ INTO VECTOR ISLIST TO SAVE DISK READS --    00013100
C                   THIS DECREASES THE PROGRAM EXECUTION TIME IMMENSLY  00013110
C          NSTND  = DECLARED DIMENSION OF VECTOR NSTN3                  00013120
C          NDIR   = NUMBER OF RECORDS ON THE DIRECTION FILE             00013130
C          NSTN4  = NUMBER OF STATIONS IN THE NETWORK                   00013140
C          INDIC  = PARAMETER FOR CHECKING HASHING ALGORITHM -- SINCE   00013150
C                   ALGORITHM DOES NOT WORK PROPERLY IN ALL             00013160
C                   CIRCUMSTANCES                                       00013170
C          NSTN3  = LIST OF NETWORK STATION NUMBERS                     00013180
C          ISLIST = VECTOR DIMENSIONED NDIR FOR LIST OF STATION         00013190
C                   NUMBERS (SEE ICALL ABOVE)                           00013200
C          IDIRUN = FORTRAN UNIT NUMBER FOR DIRECTION DATA SET (MUST    00013210
C                   CORRESPOND TO DD AND DEFINE FILE)                   00013220
C                                                                       00013230
C  OUTPUT: NSTN2  = VECTOR OF LENGTH 30 CONTAINING THE 'TO' STATION     00013240
C                   NUMBERS (ONLY STATIONS IN THE NETWORK)              00013250
C          DRN    = VECTOR OF LENGTH 30 CONTAINING DIRECTIONS           00013260
C                   CORRESPONDING TO NSTN2                              00013270
C          SIGMA2 = DEFAULT GSC WEIGHT FOR ALL DIRECTIONS IN THE SET    00013280
C          M      = NUMBER OF DIRECTIONS OBSERVED TO NETWORK STATIONS   00013290
C                                                                       00013300
C  NOTE: GSC=GEODETIC SURVEY OF CANADA WEIGHTING SCHEME                 00013310
C                                                                       00013320
      SUBROUTINE FIND(NSTN,NSTN2,DRN,SIGMA2,M,N1,ICALL,NSTND,NDIR,      00013330
     1NSTN4,INDIC,NSTN3,ISLIST,IDIRUN)                                  00013340
      DOUBLE PRECISION DRN,PI                                           00013350
      DIMENSION NSTN3(NSTND),NSTN2(30),MASHC(10),DRN(30),ISLIST(NDIR)   00013360
      DATA PI/3.141592653589793D0/                                      00013370
C                                                                       00013380
C  IF FIRST CALL TO SUBROUTINE STORE STATION NUMBERS IN ISLIST          00013390
C                                                                       00013400
      IF(ICALL.NE.1)GO TO 4                                             00013410
      DO 3 I=1,NDIR                                                     00013420
3     READ(IDIRUN'I,1010)ISLIST(I)                                      00013430
C                                                                       00013440
C  ZERO RETURN VECTORS                                                  00013450
C                                                                       00013460
4     DO 5 I =1,30                                                      00013470
        NSTN2(I)=0                                                      00013480
5       DRN(I)=0.0D0                                                    00013490
C                                                                       00013500
C  PERFORM HASH UP TO 200 TIMES - FIRST ADDRESS FOUND BY FUNCTION KASH  00013510
C                                                                       00013520
      J=0                                                               00013530
        MASH=KASH(NSTN,N1)                                              00013540
10    IF(ISLIST(MASH).EQ.NSTN)GO TO 30                                  00013550
            J=J+1                                                       00013560
            IF(J.GT.200)GO TO 120                                       00013570
20          MASH=MOD((NSTN+MASH),1193)                                  00013580
            IF(MASH.EQ.0)MASH=1200                                      00013590
            GO TO 10                                                    00013600
30        READ(IDIRUN'MASH,1000)N,NC,NT,SIGMA2,(NSTN2(I),DRN(I),I=1,NT) 00013610
C                                                                       00013620
C  CHECK HASHING ALGORITHM FOR ERRORS - IF IT HAS ERRED RETURN TO       00013630
C  HASHING ALGORITHM TO CONTINUE                                        00013640
C                                                                       00013650
              DRN(1)=0.0D0                                              00013660
              IF(INDIC.NE.0)GO TO 40                                    00013670
                MASHC(1)=MASH                                           00013680
                GO TO 60                                                00013690
40                DO 50 K=1,INDIC                                       00013700
                    IF(MASHC(K).EQ.MASH)GO TO 20                        00013710
50                  CONTINUE                                            00013720
                  MASHC(INDIC+1)=MASH                                   00013730
C                                                                       00013740
C  DETERMINE NUMBER OF SETS FROM THIS STATION                           00013750
C                                                                       00013760
60              IF(N1.EQ.0)N1=NC                                        00013770
C                                                                       00013780
C  CHECK IF ALL 'TO' STATIONS ARE IN NETWORK - IF NOT ELIMINATE THEM    00013790
C                                                                       00013800
            M=NT                                                        00013810
            DO 90 K=1,NT                                                00013820
              IF(K.GT.M)GO TO 100                                       00013830
65            DO 80 J=1,NSTN4                                           00013840
                IF(NSTN2(K).EQ.NSTN3(J))GO TO 90                        00013850
                  IF(J.LT.NSTN4)GO TO 80                                00013860
                  M=M-1                                                 00013870
                  IF(M.EQ.0)GO TO 120                                   00013880
                    DO 70 L=K,M                                         00013890
                      NSTN2(L)=NSTN2(L+1)                               00013900
                      DRN(L)=DRN(L+1)                                   00013910
70                    IF(L.GT.1)DRN(L)=DRN(L)-DRN(1)                    00013920
80              CONTINUE                                                00013930
                DRN(1)=0.0D0                                            00013940
                IF(M.GE.K)GO TO 65                                      00013950
90            CONTINUE                                                  00013960
C                                                                       00013970
C  FIRST DIRECTION IDENTIFIED BY A 360 DEGREE (2*PI) READING,           00013980
C  WEIGHT = 1./VARIANCE                                                 00013990
C                                                                       00014000
100         DRN(1)=2.0D0*PI                                             00014010
            SIGMA2=1.0D0/SIGMA2                                         00014020
            RETURN                                                      00014030
C                                                                       00014040
C  NO OBSERVATIONS IN THIS SET  --  SET M=0                             00014050
C                                                                       00014060
120     M=0                                                             00014070
      RETURN                                                            00014080
1000  FORMAT(I9,2I2,F9.5,15(I9,F19.16))                                 00014090
1010  FORMAT(I9)                                                        00014100
      END                                                               00014110
C***********************************************************************00014120
C*                                                                     *00014130
C*                      F U N C T I O N   K A S H                      *00014140
C*                                                                     *00014150
C***********************************************************************00014160
C                                                                       00014170
C                                                                       00014180
      FUNCTION KASH(NSTN,N1)                                            00014190
C                                                                       00014200
C     FUNCTION 'KASH' DETERMINES THE FIRST HASH ADDRESS FOR THE         00014210
C  'SE.GEODESY.DIRECTON' FILE (OR AN EQUIVALENT FILE). IT IS CALLED     00014220
C  FROM SUBROUTINE FIND                                                 00014230
C                                                                       00014240
C   INPUT: NSTN='FROM STATION NUMBER AT WHICH DIRECTIONS OBSERVED       00014250
C          N1  =COUNTER INDICATING WHICH DIRECTION SET IS TO BE         00014260
C               FOUND (N1=0 FOR 1 ST SET, N1=1 FOR 2 ND SET  ETC)       00014270
C                                                                       00014280
C  OUTPUT:HASH ADDRESS VIA ARGUMENT KASH                                00014290
C                                                                       00014300
C                                                                       00014310
C  SUM DIGITS OF STATION NUMBER, RAISE TO POWER (N1+1) AND ADD TO TEN   00014320
C  TIMES STATION NUMBER                                                 00014330
C                                                                       00014340
      NSUM=0                                                            00014350
      N=NSTN                                                            00014360
      DO 10 I=1,8                                                       00014370
        NSUM=NSUM+MOD(N,10)                                             00014380
10      N=N/10                                                          00014390
          ISTN=NSTN*10+NSUM**(N1+1)                                     00014400
C                                                                       00014410
C  ADDRESS=REMAINDER OF ISTN/1197 UNLESS REMAINDER=0 THEN ADDRESS = 120000014420
C                                                                       00014430
          KASH=MOD(ISTN,1197)                                           00014440
            IF(KASH.EQ.0)KASH=1200                                      00014450
      RETURN                                                            00014460
      END                                                               00014470
C***********************************************************************00014480
C*                                                                     *00014490
C*                  S U B R O U T I N E   S C A N T R                  *00014500
C*                                                                     *00014510
C***********************************************************************00014520
C                                                                       00014530
C                                                                       00014540
      SUBROUTINE SCANTR(NSTN1,NSTN2,K,ISCAN,LOC,NSTND,NTERR,NSTN,       00014550
     1NSTN3,N1VEC,N2VEC,ITERUN)                                         00014560
C                                                                       00014570
C     SUBROUTINE 'SCANTR' FINDS THE ADDRESSES OF OBSERVATIONS ON THE    00014580
C  'SE.GEODESY.DIST&AZ' FILE (OR AN EQUIVALENT FILE) AT THE STATION     00014590
C  'NSTN1' -- IF THE 'TO' STATION IS NOT IN THE NETWORK THE ADDRESS     00014600
C  OF THE OBSERVATION IS DELETED -- THE ADDRESSES ARE USED IN           00014610
C  SUBROUTINE GETERR                                                    00014620
C                                                                       00014630
C   INPUT: NSTN1 = 'FROM' STATION FOR WHICH OBSERVATIONS ARE REQUIRED   00014640
C          ISCAN = PARAMETER FOR SAVING DISK I/O -- ON THE FIRST CALL   00014650
C                  TO THE SUBROUTINE THE 'FROM' AND 'TO' STATION        00014660
C                  NUMBERS ARE READ INTO VECTORS 'N1VEC' AND 'N2VEC' -  00014670
C                  THE VECTORS ARE THEN SCANNED RATHER THAN THE DISK -  00014680
C                  A VERY SIGNIFICANT TIME SAVING IS REALIZED USING     00014690
C                  THIS APPROACH                                        00014700
C          NSTND = DECLARED DIMENSION OF VECTOR 'NSTN3'                 00014710
C          NTERR = NUMBER OF RECORDS ON THE 'SE.GEODESY.DIST&AZ' FILE   00014720
C          NSTN  = NUMBER OF STATIONS IN THE NETWORK BEING ADJUSTED     00014730
C          NSTN3 = VECTOR OF NETWORK STATION NUMBERS - DIMENSIONED AT   00014740
C                  LEAST NSTND  IN MAIN                                 00014750
C          N1VEC = VECTOR AT LEAST NTERR LONG TO CONTAIN LIST OF 'FROM' 00014760
C                  STATIONS (SEE ISCAN ABOVE)                           00014770
C          N2VEC = VECTOR AT LEAST NTERR LONG TO CONTAIN LIST OF 'TO'   00014780
C                  STATIONS (SEE ISCAN ABOVE)                           00014790
C          ITERUN= FORTRAN UNIT NUMBER OF 'SE.GEODESY.DIST&AZ' FILE     00014800
C                  (IT MUST CORRESPOND TO THE DD AND DEFINE FILE)       00014810
C                                                                       00014820
C  OUTPUT: NSTN2= VECTOR OF LENGTH 30 CONTAINING LIST OF 'TO' STATION   00014830
C                  NUMBERS (IN NETWORK) OBSERVED FROM 'NSTN1'           00014840
C          K    = NUMBER OF OBSERVED STATIONS (IN NETWORK)              00014850
C          LOC  = VECTOR OF LENGTH 30 CONTAINING ADDRESSES OF           00014860
C                  OBSERVATION RECORDS (USED IN SUBROUTINE GETERR)      00014870
C                                                                       00014880
C  NOTE: THE HASHING ALGORITHM CANNOT BE USED TO FIND ADDRESSES SINCE   00014890
C        IT DOES NOT FIND ALL OBSERVATIONS (IE. THERE IS AN ERROR IN    00014900
C        THE HASHING ALGORITHM UNDER CERTAIN CIRCUMSTANCES)             00014910
C                                                                       00014920
      DIMENSION NSTN3(NSTND),NSTN2(30),N1VEC(NTERR),N2VEC(NTERR),LOC(30)00014930
C                                                                       00014940
C  ON FIRST CALL TO SUBROUTINE READ 'FROM' AND 'TO' STATION NUMBERS     00014950
C  INTO VECTORS N1VEC AND N2VEC                                         00014960
C                                                                       00014970
      IF(ISCAN.NE.0)GO TO 20                                            00014980
        ISCAN=ISCAN+1                                                   00014990
        DO 10 I=1,NTERR                                                 00015000
10        READ(ITERUN'I,1000)N1VEC(I),N2VEC(I)                          00015010
C                                                                       00015020
C  SCAN VECTOR N1VEC FOR 'NSTN1' - STORE 'TO' STATION NUMBERS IN NSTN2, 00015030
C  COUNT NUMBER OF TO STATIONS WITH K AND STORE ADDRESSES IN LOC        00015040
C                                                                       00015050
20    K=0                                                               00015060
        DO 40 I=1,NTERR                                                 00015070
          IF(N1VEC(I).NE.NSTN1)GO TO 40                                 00015080
          K=K+1                                                         00015090
          NSTN2(K)=N2VEC(I)                                             00015100
          LOC(K)=I                                                      00015110
C                                                                       00015120
C  SCAN VECTOR OF NETWORK STATION NUMBERS -- IF TO STATION IS NOT IN    00015130
C  NETWORK DELETE REFERENCE TO IT                                       00015140
C                                                                       00015150
            DO 30 J=1,NSTN                                              00015160
              IF(NSTN2(K).EQ.NSTN3(J))GO TO 40                          00015170
              IF(J.LT.NSTN)GO TO 30                                     00015180
              K=K-1                                                     00015190
30            CONTINUE                                                  00015200
40          CONTINUE                                                    00015210
      RETURN                                                            00015220
1000  FORMAT(2I9)                                                       00015230
      END                                                               00015240
C***********************************************************************00015250
C*                                                                     *00015260
C*                  S U B R O U T I N E   G E T E R R                  *00015270
C*                                                                     *00015280
C***********************************************************************00015290
C                                                                       00015300
C                                                                       00015310
      SUBROUTINE GETERR(LOC,IC1,IC2,AL,A1,V3,A2,V4,ITERUN)              00015320
C                                                                       00015330
C     SUBROUTINE 'GETERR' READS A RECORD FROM THE 'SE.GEODESY.DIST&AZ'  00015340
C  FILE (OR AN EQUIVALENT FILE) AT THE ADDRESS 'LOC'  (SEE SUBROUTINE   00015350
C  SCANTR FOR FINDING LOC)                                              00015360
C                                                                       00015370
C  COMMON BLOCK /DISTOB/ D1   = FIRST DISTANCE                          00015380
C                        D2   = SECOND DISTANCE                         00015390
C                        V1   = DEFAULT (GSC) WEIGHT ASSIGNED TO D1     00015400
C                        V2   = DEFAULT (GSC) WEIGHT ASSIGNED TO D2     00015410
C                        CODE1= INSTRUMENT TYPE CODE FOR D1             00015420
C                        CODE2= INSTRUMENT TYPE CODE FOR D2             00015430
C                                                                       00015440
C   INPUT: LOC   = ADDRESS OF DESIRED RECORD                            00015450
C          ITERUN= FORTRAN UNIT NUMBER OF 'SE.GEODESY.DIST&AZ' FILE     00015460
C                  (IT MUST CORRESPOND TO THE DD AND DEFINE FILE)       00015470
C                                                                       00015480
C  OUTPUT: DISTANCES,WEIGHTS AND INSTRUMENT CODES VIA COMMON BLOCK      00015490
C          IC1= DISTANCE CODE FOR D1                                    00015500
C          IC2= DISTANCE CODE FOR D2                                    00015510
C          AL = ASTRONOMIC LONGITUDE OF 'FROM' STATION                  00015520
C          A1 = FIRST ASTRO-AZIMUTH                                     00015530
C          V3 = DEFAULT (GSC) WEIGHT FOR A1                             00015540
C          A2 = SECOND ASTRO-AZIMUTH                                    00015550
C          V4 = DEFAULT (GSC) WEIGHT FOR A2                             00015560
C                                                                       00015570
C  NOTE: GSC IS THE GEODETIC SURVEY OF CANADA WEIGHTING SCHEME          00015580
C                                                                       00015590
      DOUBLE PRECISION D1,D2,AL,A1,A2                                   00015600
      COMMON /DISTOB/D1,D2,V1,V2,CODE1,CODE2                            00015610
C                                                                       00015620
C  READ RECORD AT ADDRESS 'LOC'                                         00015630
C                                                                       00015640
        READ(ITERUN'LOC,1000)D1,V1,IC1,CODE1,D2,V2,IC2,CODE2,AL,A1,V3,  00015650
     1                       A2,V4                                      00015660
C                                                                       00015670
C  IF VARIANCE .NE. 0  WEIGHT=1/VARIANCE                                00015680
C                                                                       00015690
          IF(V1.NE.0.0)V1=1.0/V1                                        00015700
          IF(V2.NE.0.0)V2=1.0/V2                                        00015710
          IF(V3.NE.0.0)V3=1.0/V3                                        00015720
          IF(V4.NE.0.0)V4=1.0/V4                                        00015730
      RETURN                                                            00015740
1000  FORMAT(T19,2(F13.5,F10.6,I1,A1),2F19.16,F10.6,F19.16,F10.6)       00015750
      END                                                               00015760
C***********************************************************************00015770
C*                                                                     *00015780
C*                  S U B R O U T I N E   N O D I S                    *00015790
C*                                                                     *00015800
C***********************************************************************00015810
C                                                                       00015820
C                                                                       00015830
      SUBROUTINE NODIS(AZ,*,*)                                          00015840
C                                                                       00015850
C     SUBROUTINE 'NODIS' ELIMINATES DISTANCE OBSERVATIONS BY SETTING    00015860
C  THEM TO 0 (ZERO) ACCORDING TO DISCOD, FOLLOWING THE CONVENTION;      00015870
C                                                                       00015880
C     DISCOD = NO   CALL  NODIS                                         00015890
C     DISCOD = B    ENTRY NOBASE                                        00015900
C     DISCOD = T    ENTRY NOTELL                                        00015910
C     DISCOD = G    ENTRY NOGEOD                                        00015920
C     DISCOD = S    ENTRY NOSAT                                         00015930
C                                                                       00015940
C  COMMON BLOCK /DISTOB/ SIJM = FIRST OBSERVED DISTANCE                 00015950
C                        DIS1 = SECOND OBSERVED DISTANCE                00015960
C                        PDIST= VARIANCE SIJM                           00015970
C                        V2   = VARIANCE DIS1                           00015980
C                        CODE1= INSTRUMENT TYPE CODE OF SIJM            00015990
C                        CODE2= INSTRUMENT TYPE CODE OF DIS1            00016000
C                                                                       00016010
C   INPUT: AZ=AZIMUTH OF SAME LINE AS DISTANCE (USED TO CONTROL         00016020
C              MULTIPLE RETURN)                                         00016030
C          SIJM & DIS1 VIA THE COMMON BLOCK                             00016040
C                                                                       00016050
C  OUTPUT: SIJM & DIS1 SET TO 0.0D0 IN COMMON BLOCK                     00016060
C                                                                       00016070
C  MULTIPLE RETURN:RETURN 1  AN OBSERVATION (EITHER DISTANCE OR         00016080
C                             AZIMUTH) STILL EXISTS ON THE LINE         00016090
C                  RETURN 2  ALL OBSERVATIONS ON THE LINE HAVE BEEN     00016100
C                            ELIMINATED                                 00016110
C                                                                       00016120
      DOUBLE PRECISION SIJM,DIS1,AZ                                     00016130
      DATA C,B,T,G,S/'C','B','T','G','S'/                               00016140
      COMMON /DISTOB/SIJM,DIS1,PDIST,V2,CODE1,CODE2                     00016150
C                                                                       00016160
C  ELIMINATE ALL OBSERVATIONS EXCEPT THOSE CODED 'C'  C=OBSERVATIONS    00016170
C  REQUIRED TO DEFINE A POINT                                           00016180
C                                                                       00016190
        I=1                                                             00016200
        IF(CODE1.NE.C)GO TO 50                                          00016210
10      IF(CODE2.NE.C)GO TO 60                                          00016220
        GO TO 70                                                        00016230
      ENTRY NOBASE(AZ,*,*)                                              00016240
C                                                                       00016250
C  ELIMINATE BASELINE OBSERVATIONS                                      00016260
C                                                                       00016270
        I=2                                                             00016280
        IF(CODE1.EQ.B)GO TO 50                                          00016290
20      IF(CODE2.EQ.B)GO TO 60                                          00016300
        GO TO 70                                                        00016310
      ENTRY NOTELL(AZ,*,*)                                              00016320
C                                                                       00016330
C  ELIMINATE TELLUROMETER OBSERVATIONS                                  00016340
C                                                                       00016350
        I=3                                                             00016360
        IF(CODE1.EQ.T)GO TO 50                                          00016370
30      IF(CODE2.EQ.T)GO TO 60                                          00016380
        GO TO 70                                                        00016390
      ENTRY NOGEOD(AZ,*,*)                                              00016400
C                                                                       00016410
C  ELIMINATE GEODIMETER OBSERVATIONS                                    00016420
C                                                                       00016430
        I=4                                                             00016440
        IF(CODE1.EQ.G)GO TO 50                                          00016450
40      IF(CODE2.EQ.G)GO TO 60                                          00016460
        GO TO 70                                                        00016470
      ENTRY NOSAT(AZ,*,*)                                               00016480
C                                                                       00016490
C  ELIMINATE SATELLITE OBSERVATIONS                                     00016500
C                                                                       00016510
        I=5                                                             00016520
        IF(CODE1.EQ.S)GO TO 50                                          00016530
45      IF(CODE2.EQ.S)GO TO 60                                          00016540
        GO TO 70                                                        00016550
C                                                                       00016560
C  FIRST DISTANCE OBSERVATION NOT REQUIRED                              00016570
C                                                                       00016580
50        SIJM=0.0D0                                                    00016590
C                                                                       00016600
C  BRANCH BACK TO TEST DIS1                                             00016610
C                                                                       00016620
          GO TO (10,20,30,40,45),I                                      00016630
C                                                                       00016640
C  SECOND DISTANCE OBSERVATION NOT REQUIRED                             00016650
C                                                                       00016660
60          DIS1=0.0D0                                                  00016670
C                                                                       00016680
C  DETERMINE RETURN CODE                                                00016690
C                                                                       00016700
70            IF(SIJM.EQ.0.0.AND.DIS1.EQ.0.0.AND.AZ.EQ.0.0)RETURN 2     00016710
              RETURN 1                                                  00016720
      END                                                               00016730
C***********************************************************************00016740
C*                                                                     *00016750
C*                    S U B R O U T I N E   N O A Z                    *00016760
C*                                                                     *00016770
C***********************************************************************00016780
C                                                                       00016790
C                                                                       00016800
      SUBROUTINE NOAZ(AZ,AZ1)                                           00016810
C                                                                       00016820
C     SUBROUTINE 'NOAZ' SETS AZIMUTH OBSERVATIONS TO 0 (ZERO) WHEN      00016830
C  THEY ARE NOT REQUIRED IN THE NETWORK ADJUSTMENT  (AZCODE=1)          00016840
C                                                                       00016850
C   INPUT: AZ =FIRST OBSERVED AZIMUTH                                   00016860
C          AZ1=SECOND OBSERVED AZIMUTH                                  00016870
C                                                                       00016880
C  OUTPUT: AZ AND AZ1 SET TO 0.0D0                                      00016890
C                                                                       00016900
      DOUBLE PRECISION AZ,AZ1                                           00016910
        AZ =0.0D0                                                       00016920
        AZ1=0.0D0                                                       00016930
      RETURN                                                            00016940
      END                                                               00016950
