C 00000110 C PROGRAM 'DIRLIST' -- SORTS AND LISTS THE CONTENTS OF FILE 00000120 C 'SE.GEODESY.DIRECTON' 00000130 C 00000140 C INPUT: DATE ON WHICH PROGRAM IS RUN 00000150 C FORMAT IS 5A4 00000160 C 00000170 REAL*8 DIR(15),DATE(5) 00000180 DIMENSION NTO(15) 00000190 C 00000200 C READ DATE CARD 00000210 C 00000220 READ 1000,(DATE(I),I=1,5) 00000230 PRINT 1010,(DATE(I),I=1,5) 00000240 C 00000250 C KOUNT = NUMBER OF SETS OF DIRECTIONS 00000260 C JSTN USED TO FIND MULTIPLE SETS OF DIRECTIONS 00000270 C 00000280 KOUNT=0 00000290 JSTN=-1 00000300 10 READ(1,1020,END=30)ISTN,NSETS,NDIR,VAR,(NTO(I),DIR(I),I=1,NDIR) 00000310 IF(ISTN.EQ.0)GO TO 10 00000320 KOUNT=KOUNT+1 00000330 C 00000340 C DETERMINE IF MULTIPLE SETS OF DIRECTIONS 00000350 C 00000360 IF(ISTN.NE.JSTN)PRINT 1030,ISTN 00000370 IF(ISTN.NE.JSTN)K=1 00000380 IF(ISTN.EQ.JSTN)K=K+1 00000390 JSTN=ISTN 00000400 IF(K.EQ.1)PRINT 1040,K, VAR 00000410 IF(K.EQ.2)PRINT 1050,K, VAR 00000420 IF(K.EQ.3)PRINT 1060,K, VAR 00000430 IF(K.GE.4)PRINT 1070,K, VAR 00000440 DO 20 I=1,NDIR 00000450 CALL RADARC(DIR(I),L,M,SEC) 00000460 20 PRINT 1080,NTO(I),L,M,SEC 00000470 GO TO 10 00000480 30 PRINT 1090,KOUNT 00000490 STOP 00000500 1000 FORMAT(5A4) 00000510 1010 FORMAT('1',20(/),30X,73('*'),2(/30X,'*',71X,'*')/30X,'*',7X,'CONTE00000520 1NTS OF FILE SE.GEODESY.DIRECTON ON ',5A4,T103,'*',2(/30X,'*',71X,'00000530 2*')/30X,73('*')/'1') 00000540 1020 FORMAT(I9,2I2,F9.5,15(I9,F19.16)) 00000550 1030 FORMAT(/////56X,'STATION # ',I9) 00000560 1040 FORMAT(//52X,I2,' ST SET: VARIANCE = ',F6.3,' SEC.SQ'//55X,'TO S00000570 1TATION DIRECTION'/) 00000580 1050 FORMAT(//52X,I2,' ND SET: VARIANCE = ',F6.3,' SEC.SQ'//55X,'TO S00000590 1TATION DIRECTION'/) 00000600 1060 FORMAT(//52X,I2,' RD SET: VARIANCE = ',F6.3,' SEC.SQ'//55X,'TO S00000610 1TATION DIRECTION'/) 00000620 1070 FORMAT(//52X,I2,' TH SET: VARIANCE = ',F6.3,' SEC.SQ'//55X,'TO S00000630 1TATION DIRECTION'/) 00000640 1080 FORMAT(55X,I9,I7,I3,F7.3) 00000650 1090 FORMAT('-',15X,'***** THERE ARE ',I5,' SETS OF DIRECTIONS ON THE00000660 1 FILE') 00000670 END 00000680 C 00000690 C SUBROUTINE 'RADARC' CONVERTS RADIANS TO DEGREES MINUTES AND 00000700 C SECONDS. FOR NEGATIVE ANGLES ONLY THE LEFTMOST NONZERO VALUE IS 00000710 C NEGATIVE (EGS. -50,15,30.5 ; 0,-35,30.0 ; 0,0,-50.5) 00000720 C 00000730 C NOTE: THE 0.0005 VALUE IS TO GUARD AGAINST ROUNDOFF 00000740 C 00000750 C INPUT: A = RADIAN VALUE OF ANGLE (REAL*8) 00000760 C 00000770 C OUTPUT: I = DEGREES (INTEGER) 00000780 C J = MINUTES (INTEGER) 00000790 C S = SECONDS (REAL*4) 00000800 C 00000810 SUBROUTINE RADARC(A,I,J,S) 00000820 DOUBLE PRECISION A,SEC,AD,AJ,RHO, SIGN 00000830 DATA RHO/206264.8062470963D0/ 00000840 C 00000850 C CHECK SIGN OF 'A' -- SET SIGN=-1 IF NEGATIVE AND CONVERT 'A' TO 00000860 C POSITIVE VALUE 00000870 C 00000880 SIGN=1.0D0 00000890 IF(A.LT.0.0)SIGN=-1.0D0 00000900 IF(SIGN.LT.0.0)A=-A 00000910 C 00000920 C CONVERT 'A' TO ARCSECONDS 00000930 C 00000940 SEC=A*RHO+0.0005D0 00000950 C 00000960 C FIND INTEGER DEGREES 00000970 C 00000980 I=SEC/3600.0D0 00000990 AD=I 00001000 C 00001010 C FIND INTEGER MINUTES 00001020 C 00001030 J=SEC/60.0D0-AD*60.0D0 00001040 AJ=J 00001050 C 00001060 C FIND REAL*4 SECONDS 00001070 C 00001080 S=SEC-AD*3600.0D0-AJ*60.0D0-0.0005D0 00001090 C 00001100 C SET LEFTMOST VALUE NEGATIVE IF SIGN=-1 00001110 C 00001120 IF(I.NE.0)GO TO 20 00001130 IF(J.EQ.0)GO TO 10 00001140 J=J*SIGN 00001150 GO TO 30 00001160 10 S=S*SIGN 00001170 GO TO 30 00001180 20 I=I*SIGN 00001190 C 00001200 C CONVERT 'A' BACK TO NEGATIVE IF SIGN=-1 00001210 C 00001220 30 IF(SIGN.LT.0.0)A=-A 00001230 RETURN 00001240 END 00001250