C 00000110 C PROGRAM STALIST SORTS AND LISTS THE CONTENTS OF FILE 00000120 C 'SE.GEODESY.STATION.MASTER' 00000130 C INPUT: OUTPUT CODE 0=SELECTED INFORMATION (STATION NUMBER,NAME, 00000140 C GEODETIC AND ASTRONOMIC COORDINATES, 00000150 C ORTHOMETRIC AND ELLIPSOID HEIGHTS AND COMPONEN00000160 C OF THE DEFLECTION OF THE VERTICAL) IN 00000170 C FORMATTED STYLE 00000180 C 1=ALL INFORMATION ON FILE IN UNFORMATTED STYLE 00000190 C FORMAT=I1 (CARD 1) 00000200 C : DATE ON WHICH PROGRAM IS RUN 00000210 C FORMAT=5A4 (CARD 2) 00000220 C 00000230 C NOTE: TO OUTPUT AN UPDATED STATION FILE SIMPLY CHANGE THE DATA SET 00000240 C NAME ON THE //SORTIN CARD (PINK CARD) BUT NOTE THEN THAT THE BOXED 00000250 C TITLE IS WRONG 00000260 C EG. //SORTIN DD DSN=SE.GEODESY.STATIONS.UPDATE1,VOL=SER=SEGEOM, 00000270 C // UNIT=M2314,DISP=SHR 00000280 C 00000290 C 00000300 REAL*8 PHI,LAM,ALAT,ALAM,OH,EH,NAME1,NAME2,DATE(5),GH 00000310 C 00000320 C READ CARD 1 00000330 C 00000340 READ 1070,IOCODE 00000350 C 00000360 C READ CARD 2 00000370 C 00000380 READ 1000,(DATE(I),I=1,5) 00000390 PRINT 1010,(DATE(I),I=1,5) 00000400 C 00000410 C J = COUNT OF NUMBER OF STATIONS ON THE FILE 00000420 C 00000430 J=0 00000440 C 00000450 C 0 = SELECTED DATA 1 = ALL DATA 00000460 C 00000470 10 IF(IOCODE.EQ.1)READ(2,1080,END=20)ISTN,NAME1,NAME2,PHI,LAM,S5,S6,S00000480 17,ALAT,ALAM,S8,S9,S10,OH,S11,GH,S12,EH,S13,XSI,ETA,S14,S15 00000490 IF(IOCODE.EQ.0)READ(2,1020,END=20)ISTN,NAME1,NAME2,PHI,LAM,ALAT, 00000500 1ALAM,OH,EH,XSI,ETA 00000510 C 00000520 C CHECK FOR BLANK RECORD 00000530 C 00000540 IF(ISTN.EQ.0)GO TO 10 00000550 J=J+1 00000560 CALL RADARC(PHI,ID,IM,S1) 00000570 CALL RADARC(LAM,JD,JM,S2) 00000580 CALL RADARC(ALAT,KD,KM,S3) 00000590 CALL RADARC(ALAM,LD,LM,S4) 00000600 IF(MOD(J,27).EQ.1.AND.IOCODE.EQ.0)PRINT 1030 00000610 IF(J.EQ.1.AND.IOCODE.EQ.1)PRINT 1090 00000620 IF(IOCODE.EQ.0)PRINT 1040,ISTN,NAME1,NAME2,ID,IM,S1,JD,JM, 00000630 1 S2,OH,EH,XSI,ETA 00000640 IF(IOCODE.EQ.0.AND.KD.NE.0)PRINT 1050,KD,KM,S3,LD,LM,S4 00000650 IF(IOCODE.EQ.1)PRINT 1100,ISTN,NAME1,NAME2,ID,IM,S1,JD,JM, 00000660 1 S2,S5,S6,S7,KD,KM,S3,LD,LM,S4,S8,S9,S10,OH,S11,GH, 00000670 2 S12,EH,S13,XSI,ETA,S14,S15 00000680 GO TO 10 00000690 20 PRINT 1060,J 00000700 STOP 00000710 1000 FORMAT(5A4) 00000720 1010 FORMAT('1',20(/),25X,83('*'),2(/25X,'*',81X,'*')/25X,'*',7X, 00000730 1'CONTENTS OF FILE SE.GEODESY.STATIONS.MASTER ON ',5A4,T108,'*', 00000740 22(/25X,'*',81X,'*')/25X,83('*')) 00000750 1020 FORMAT(I9,2A8,2F19.16,24X,2F19.16,24X,F8.3,24X,F8.3,8X,2F8.3) 00000760 1030 FORMAT('1',' STATION STATION GEODETIC GEODET00000770 1IC ASTRONOMIC ASTRONOMIC ORTHOMETRIC ELLIPSOID XSI 00000780 2 ETA'/3X,'NUMBER NAME LATITUDE LONGTI00000790 3TUDE LATITUDE LONGTITUDE HEIGHT HEIGHT'/33X, 00000800 462X,'(METRES) (METRES) (ARCSEC) (ARCSEC)'/1X,132('_')) 00000810 1040 FORMAT('0',I9,2X,2A8,2X,2(I4,I3,F7.3),T93,4F10.3) 00000820 1050 FORMAT('+',T61,2(I6,I3,F7.3)) 00000830 1060 FORMAT('-',15X,'***** THERE ARE',I6,' RECORDS ON THE FILE') 00000840 1070 FORMAT(I1) 00000850 1080 FORMAT(I9,2A8,2(2F19.16,3F8.3),10F8.3) 00000860 1090 FORMAT('1'//40X,'FORMAT OF OUTPUT IS'//5X,'STATION NUMBER STATIO00000870 1N NAME GEODETIC LATITUDE GEODETIC LONGTITUDE VARIANCE LAT V00000880 2ARIANCE LONG COVARIANCE LAT,LONG'//1X,'ASTRO LATITUDE ASTRO LONG00000890 3TITUDE VAR ASTRO LAT VAR ASTRO LONG COVAR ASTRO LAT,ASTRO LONG 00000900 4 ORTHOMETRIC HEIGHT VAR ORTH HEIGHT'//3X,'GEOID HEIGHT VAR GEOID00000910 5 HEIGHT ELLIPSOID HEIGHT VAR ELLIPSOID HEIGHT MERIDIAN DEFLECTI00000920 6ON PRIME VERT DEFL VAR XSI VAR ETA'/'1') 00000930 1100 FORMAT('-',I9,4X,2A8,3X,2I3,F7.3,5X,I4,I3,F7.3,4X,3F10.3/6X,2I3,F700000940 1.3,4X,I4,I3,F7.3,4X,3F10.3,4X,F8.3,4X,F8.3/5X,8(F8.3,4X)) 00000950 END 00000960 C 00000970 C SUBROUTINE 'RADARC' CONVERTS RADIANS TO DEGREES MINUTES AND 00000980 C SECONDS. FOR NEGATIVE ANGLES ONLY THE LEFTMOST NONZERO VALUE IS 00000990 C NEGATIVE (EGS. -50,15,30.5 ; 0,-35,30.0 ; 0,0,-50.5) 00001000 C 00001010 C NOTE: THE 0.0005 VALUE IS TO GUARD AGAINST ROUNDOFF 00001020 C 00001030 C INPUT: A = RADIAN VALUE OF ANGLE (REAL*8) 00001040 C 00001050 C OUTPUT: I = DEGREES (INTEGER) 00001060 C J = MINUTES (INTEGER) 00001070 C S = SECONDS (REAL*4) 00001080 C 00001090 SUBROUTINE RADARC(A,I,J,S) 00001100 DOUBLE PRECISION A,SEC,AD,AJ,RHO, SIGN 00001110 DATA RHO/206264.8062470963D0/ 00001120 C 00001130 C CHECK SIGN OF 'A' -- SET SIGN=-1 IF NEGATIVE AND CONVERT 'A' TO 00001140 C POSITIVE VALUE 00001150 C 00001160 SIGN=1.0D0 00001170 IF(A.LT.0.0)SIGN=-1.0D0 00001180 IF(SIGN.LT.0.0)A=-A 00001190 C 00001200 C CONVERT 'A' TO ARCSECONDS 00001210 C 00001220 SEC=A*RHO+0.0005D0 00001230 C 00001240 C FIND INTEGER DEGREES 00001250 C 00001260 I=SEC/3600.0D0 00001270 AD=I 00001280 C 00001290 C FIND INTEGER MINUTES 00001300 C 00001310 J=SEC/60.0D0-AD*60.0D0 00001320 AJ=J 00001330 C 00001340 C FIND REAL*4 SECONDS 00001350 C 00001360 S=SEC-AD*3600.0D0-AJ*60.0D0-0.0005D0 00001370 C 00001380 C SET LEFTMOST VALUE NEGATIVE IF SIGN=-1 00001390 C 00001400 IF(I.NE.0)GO TO 20 00001410 IF(J.EQ.0)GO TO 10 00001420 J=J*SIGN 00001430 GO TO 30 00001440 10 S=S*SIGN 00001450 GO TO 30 00001460 20 I=I*SIGN 00001470 C 00001480 C CONVERT 'A' BACK TO NEGATIVE IF SIGN=-1 00001490 C 00001500 30 IF(SIGN.LT.0.0)A=-A 00001510 RETURN 00001520 END 00001530