C C 00000030 C 00000040 C ASTRO - PROGRAM TO CONVERT OBSERVED ASTROGEODETIC DEFLECTIONS FOR00000050 C USE IN THE PROGRAMS : INTDOV, ANGEOID 00000060 C 00000070 C C. L. MERRY ... SEPTEMBER, 1974 00000080 C 00000090 C CARD INPUT DATA : 00000100 C 1) CODE FOR SOURCE COUNTRY, AND YEAR OF OBSERVATION 00000110 C CODE: 1 - CANADIAN DATA 00000120 C 2 - AMERICAN DATA 00000130 C I2, I6 00000140 C 2) OBSERVED DEFLECTIONS : STATION NUMBER, LATITUDE, LONGITUDE 00000150 C (DEG, MIN, SEC - LONG. POSITIVE WEST), XSI, ETA - ONE SET OF 00000160 C VALUES PER CARD - I8,2(2I4,F8.2),2F8.2 00000170 C NOTE : IF EITHER OF XSI OR ETA HAVE NOT BEEN OBSERVED, A VALUE 00000180 C OF 99.99 SHOULD BE USED FOR THE PARTICULAR DEFLECTION COMPONENT00000190 C 00000200 C DISC INPUT DATA : 00000210 C DEFLECTION DATA SET TO WHICH NEW DEFLECTIONS ARE TO BE ADDED - 00000220 C FORTRAN FILE :- FT03F001 00000230 C*** THIS MAY BE A DISC OR A TAPE***********************************E**C C*** THE OUT PUT FILE MAY ALSO BE A DISC OR TAPE **********************C C 00000240 IMPLICIT REAL*8(A-H,O-Z) 00000250 RHO=206264.80625D0/3600.D0 00000260 R=6370990.D0 00000270 C DEFINE GEODETIC INITIAL POINT 00000280 X=39.327 00000290 Y=261.456 00000300 100 FORMAT(I8,2(2I4,F8.2),2F8.2) 00000310 101 FORMAT(I2,I6) 00000320 102 FORMAT(I4,I6,2F11.6,4F6.2) 00000330 C PUT DISC DATA ON TEMPORARY FILE 00000340 C***********************************************************************00000350 REWIND2 00000360 REWIND3 00000370 4 READ(3,END=5) NUM,A,B,XSI,ETA,WX,WY 00000380 WRITE(2) NUM,A,B,XSI,ETA,WX,WY 00000390 GOTO4 00000400 5 CONTINUE 00000410 C***********************************************************************00000420 C READ COUNTRY CODE AND YEAR OF OBSERVATION 00000430 READ(5,101) ICODE,IY 00000440 C READ AND CONVERT NEW DATA 00000450 1 READ(5,100,END=2) NUM,IA,IB,C,IX,IY,Z,XSI,ETA 00000460 A=IA+IB/60.D0+C/3600.D0 00000470 B=360.D0-IX-IY/60.D0-Z/3600.D0 00000480 ETA=0.D0-ETA 00000490 C DETERMINE ACCURACY ESTIMATES 00000500 WX=0.25D0 00000510 WY=0.36D0 00000520 IF(ICODE.EQ.2) GOTO3 00000530 WX=WX+0.04D0 00000540 WY=WY+0.04*(DTAN(A/RHO))**2 00000550 3 CONTINUE 00000560 DX=(A-X) /RHO*R 00000570 DY=(B-Y)/RHO*R*DCOS(A/RHO) 00000580 DS=DSQRT(DX**2+DY**2) 00000590 DQ=(1.89D-05*DS**0.667)**2 00000600 WX=WX+DQ 00000610 WY=WY+DQ 00000620 WX=DSQRT(WX) 00000630 WY=DSQRT(WY) 00000640 IF(DABS(XSI).GT.90.D0) WX=0.D0 00000650 IF(DABS(ETA).GT.90.D0) WY=0.D0 00000660 C WRITE NEW DATA ON TEMPORARY FILE 00000670 WRITE(2) NUM,A,B,XSI,ETA,WX,WY 00000680 C PUNCH NEW DATA ON CARDS FOR BACKUP DATA SET 00000690 WRITE(7,102) IY,NUM,A,B,XSI,ETA,WX,WY 00000700 GOTO1 00000710 2 CONTINUE 00000720 C 00000730 C NOTE: THE IBM PROGRAM IEBGENER IS USED TO CHANGE THE REVISED 00000740 C TEMPORARY DATA SET TO A PERMANENT DATA SET, CHANGING THE NAME 00000750 C TO THAT OF THE ORIGINAL (NOW DELETED) DATA SET. 00000760 C 00000770 STOP 00000780 END 00000790