C***********************************************************************00000040 C* *00000050 C* PROGRAM 'COORDUP' UPDATES THE COORDINATES (LATITUDE AND *00000060 C* LONGITUDE) ON A STATION FILE USING THE RESULTS OF PROGRAM *00000070 C* SOLVE (IE. A L.S. ADJUSTMENT PROGRAM). EACH TIME THE PROGRAM IS RUN*00000080 C* A NEW FILE IS GENERATED ON DISC SEGEOM. ONLY THE STATIONS THAT HAVE*00000090 C* BEEN ADJUSTED ARE UPDATED, ALL OTHER STATIONS ARE SIMPLY COPIED *00000100 C* ONTO THE NEW DATA SET AS THEY ARE ON THE PREVIOUS DATA SET. *00000110 C* *00000120 C* DATA SETS REQUIRED ARE: *00000130 C* (1) SOLN.VEC THE SOLUTION VECTOR FROM THE ADJUSTMENT (UNIT 4) *00000140 C* (2) APX.COORD THE STATION NUMBERS TO BE UPDATED (UNIT 3) *00000150 C* (3) THE PREVIOUS FILE TO BE UPDATED (UNIT 1) *00000160 C* *00000170 C* DATA SET CREATED: *00000180 C* (1) THE NEW STATION FILE (UNIT 2) *00000190 C* *00000200 C* NOTE 1: NO DATA SETS (OLD) ARE DESTROYED BY THE PROGRAM--IF THEY *00000210 C* ARE NO LONGER REQUIRED THEY SHOULD BE DESTROYED BY A *00000220 C* SEPERATE PROGRAM. *00000230 C* NOTE 2: THE PROGRAM IS DIMENSIONED TO HANDLE 800 STATIONS--IF MORE*00000240 C* STATIONS ARE INVOLVED THE DIMENSIONS AND DEFINE FILE *00000250 C* CARDS MUST BE CHANGED *00000260 C* NOTE 3: UNIT NUMBER IS THE FORTRAN SEQUENCE NUMBER *00000270 C* *00000280 C* C. CHAMBERLAIN MAY 1976 *00000290 C* *00000300 C***********************************************************************00000310 IMPLICIT REAL*8(A-H,O-$) 00000320 REAL*4 SP,SX,SAP,SAL,SH,SN,SEH,SXSI,SETA,XSI,ETA ,SPX,SAPL,ISEC, 00000330 1JSEC 00000340 DIMENSION NSTNCH(800),XVEC(1600) 00000350 DEFINE FILE 1(800,230,L,M1),2(800,230,L,M2) 00000360 RHO=206264.8062470963D0 00000370 REWIND 3 00000380 REWIND 4 00000390 C 00000400 C READ FROM UNIT 3 THE STATION NUMBERS TO BE UPDATED 00000410 C 00000420 I=1 00000430 10 READ(3,END=20)NSTNCH(I),A,B 00000440 I=I+1 00000450 GO TO 10 00000460 20 NSTN=I-1 00000470 NXVEC=2*NSTN 00000480 C 00000490 C READ IN THE ELEMENTS OF THE SOLUTION VECTOR (UNIT 4) 00000500 C 00000510 DO 30 I=1,NXVEC 00000520 30 READ(4)XVEC(I) 00000530 C 00000540 C READ FROM OLD STATION FILE ALL INFORMATION STORED (UNIT 1) 00000550 C 00000560 PRINT 1000 00000570 DO 70 I=1,800 00000580 READ(1'I,1010)ISTN,T1,T2,PHI,XLON,SP,SX,SPX,APHI,ALON,SAP,SAL,SAPL00000590 1,H,SH,HN,SN,EH,SEH,XSI,ETA,SXSI,SETA 00000600 C 00000610 C CHECK IF THIS STATION IS TO BE UPDATED 00000620 C 00000630 IF(ISTN.EQ.0)GO TO 70 00000640 IPOS=0 00000650 DO 40 L=1,NSTN 00000660 IF(ISTN.EQ.NSTNCH(L))IPOS=L 00000670 IF(IPOS.EQ.L)GO TO 50 00000680 40 CONTINUE 00000690 C 00000700 C IF STATION DOES NOT HAVE TO BE UPDATED WRITE ON THE NEW FILE 00000710 C THE OLD INFORMATION 00000720 C 00000730 GO TO 60 00000740 C 00000750 C FIND THE ELEMENTS IN THE X-VECTOR FOR UPDATING THIS STATION 00000760 C 00000770 50 CORRP=XVEC(2*IPOS-1) 00000780 CORRL=XVEC(2*IPOS) 00000790 C 00000800 C UPDATE THE LATITUDE AND LONGTITUDE 00000810 C 00000820 PHI=PHI+CORRP/RHO 00000830 XLON=XLON+CORRL/RHO 00000840 CALL RADARC(PHI,IDEG,IMIN,ISEC) 00000850 CALL RADARC(XLON,JDEG,JMIN,JSEC) 00000860 PRINT 1020,NSTNCH(IPOS),IDEG,IMIN,ISEC,JDEG,JMIN,JSEC 00000870 C 00000880 C WRITE ON THE NEW DATA SET ALL STATIONS 00000890 C 00000900 60 WRITE(2'I,1010)ISTN,T1,T2,PHI,XLON,SP,SX,SPX,APHI,ALON,SAP,SAL,SAP00000910 1L,H,SH,HN,SN,EH,SEH,XSI,ETA,SXSI,SETA 00000920 C 00000930 C DO ANOTHER STATION 00000940 C 00000950 70 CONTINUE 00000960 CALL WTO('THE COORDINATES HAVE BEEN UPDATED \') 00000970 STOP 00000980 1000 FORMAT('1',33X,'U P D A T E D C O O R D I N A T E S'//18X,'STATI00000990 1ON NUMBER',T44,'LATITUDE',T70,'LONGITUDE'/) 00001000 1010 FORMAT(I9,2A8,2(2F19.16,3F8.3),10F8.3) 00001010 1020 FORMAT('0',21X,I9,10X,I3,2X,I2,2X,F7.3,10X,I4,2X,I2,2X,F7.3) 00001020 END 00001030 C 00001040 C SUBROUTINE 'RADARC' CONVERTS RADIANS TO DEGREES MINUTES AND 00001050 C SECONDS. FOR NEGATIVE ANGLES ONLY THE LEFTMOST NONZERO VALUE IS 00001060 C NEGATIVE (EGS. -50,15,30.5 ; 0,-35,30.0 ; 0,0,-50.5) 00001070 C 00001080 C NOTE: THE 0.0005 VALUE IS TO GUARD AGAINST ROUNDOFF 00001090 C 00001100 C INPUT: A = RADIAN VALUE OF ANGLE (REAL*8) 00001110 C 00001120 C OUTPUT: I = DEGREES (INTEGER) 00001130 C J = MINUTES (INTEGER) 00001140 C S = SECONDS (REAL*4) 00001150 C 00001160 SUBROUTINE RADARC(A,I,J,S) 00001170 DOUBLE PRECISION A,SEC,AD,AJ,RHO, SIGN 00001180 DATA RHO/206264.8062470963D0/ 00001190 C 00001200 C CHECK SIGN OF 'A' -- SET SIGN=-1 IF NEGATIVE AND CONVERT 'A' TO 00001210 C POSITIVE VALUE 00001220 C 00001230 SIGN=1.0D0 00001240 IF(A.LT.0.0)SIGN=-1.0D0 00001250 IF(SIGN.LT.0.0)A=-A 00001260 C 00001270 C CONVERT 'A' TO ARCSECONDS 00001280 C 00001290 SEC=A*RHO+0.0005D0 00001300 C 00001310 C FIND INTEGER DEGREES 00001320 C 00001330 I=SEC/3600.0D0 00001340 AD=I 00001350 C 00001360 C FIND INTEGER MINUTES 00001370 C 00001380 J=SEC/60.0D0-AD*60.0D0 00001390 AJ=J 00001400 C 00001410 C FIND REAL*4 SECONDS 00001420 C 00001430 S=SEC-AD*3600.0D0-AJ*60.0D0-0.0005D0 00001440 C 00001450 C SET LEFTMOST VALUE NEGATIVE IF SIGN=-1 00001460 C 00001470 IF(I.NE.0)GO TO 20 00001480 IF(J.EQ.0)GO TO 10 00001490 J=J*SIGN 00001500 GO TO 30 00001510 10 S=S*SIGN 00001520 GO TO 30 00001530 20 I=I*SIGN 00001540 C 00001550 C CONVERT 'A' BACK TO NEGATIVE IF SIGN=-1 00001560 C 00001570 30 IF(SIGN.LT.0.0)A=-A 00001580 RETURN 00001590 END 00001600