C 00000030 C PROGRAM 'CHANSTAN' (CHANGE STATION) IS USED TO CORRECT ANY PIECE OF 00000040 C INFORMATION ON THE 'SE.GEODESY.STATIONS.MASTER' FILE. THE NAMELIST00000050 C I/O STATEMENT IS USED (EXCEPT FOR STATION NAME) THE NAMELIST 00000060 C NAME BEING &CHANGE 00000070 C 00000080 C THE VARIABLE NAMES TO BE USED ARE AS FOLLOWS: 00000090 C GEODETIC LATITUDE ; DPHI,MPHI,SPHI 00000100 C GEODETIC LONGTITUDE ; DLON,MLON,SLON 00000110 C VARIANCE PHI ; VGLAT 00000120 C VARIANCE LONG ; VGLONG 00000130 C COVARIANCE PHI,LONG ; CVG 00000140 C ASTRO LATITUDE ; DAPHI,MAPHI,SAPHI 00000150 C ASTRO LONGTITUDE ; DALON,MALON,SALON 00000160 C VARIANCE PHI ; VALAT 00000170 C VARIANCE LONG ; VALONG 00000180 C COVARIANCE PHI,LONG ; CVA 00000190 C ORTHOMETRIC HEIGHT ; OH 00000200 C VARIANCE ; VOH 00000210 C GEOID HEIGHT ; N 00000220 C VARIANCE ; VN 00000230 C ELLIPSOID HEIGHT ; EH 00000240 C VARIANCE ; VEH 00000250 C MERIDIAN DEFL. ; XSI 00000260 C PRIME VERT. DEFL. ; ETA 00000270 C VARIANCE XSI ; VXSI 00000280 C VARIANCE ETA ; VETA 00000290 C 00000300 C TO CHANGE THE STATION NAME PUT A 1 IN COLUMN 1 OF DATA CARD 4 AND 00000310 C THEN THE NEW NAME, OTHERWISE LEAVE DATA CARD 4 BLANK (IT MUST BE 00000320 C THERE EVEN IF THE NAME DOES NOT CHANGE) 00000330 C 00000340 C INPUT FORMAT: 00000350 C CARD 1 -- DATE ON WHICH PROGRAM RUN FORMAT 5A4 00000360 C CARD 2 -- STATION NUMBER OF RECORD TO BE CHANGED FORMAT00000370 C CARD 3 -- CHANGES FORMAT &CHANGE ,,, &END 00000380 C CARD 4 -- CHANGE OF NAME FORMAT I1,2A8 00000390 C 00000400 C NOTE: AS MANY CHANGES AS DESIRED CAN BE MADE TO EACH RECORD 00000410 C NOTE: IF MORE THAN ONE RECORD IS TO BE CHANGED REPEAT CARDS 2 TO 4 00000420 C FOR EACH RECORD TO BE CHANGED 00000430 C NOTE: IF CHANGING LATITUDE OR LONGTITUDE (DPHI,MPHI,DLON,MLON,DAPHI, 00000440 C MAPHI,DALON,MALON) ARE INTEGER DEGREES AND MINUTES THAT WILL 00000450 C BE CHANGED TO RADIANS. ALL OTHER UNITS ARE AS ON THE FILE 00000460 C DOCUMENTATION 00000470 C 00000480 C 00000490 DOUBLE PRECISION NAME1,NAME2,PHI,LAM,APHI,ALAM,OH,N,EH,DATE(5), 00000500 1TEMP1,TEMP2 00000510 INTEGER DPHI,DLON,DAPHI,DALON 00000520 C 00000530 C NAMELIST 'CHANGE' - DEFINITION OF VARIABLE NAMES 00000540 C 00000550 NAMELIST /CHANGE/ISTN,DPHI,MPHI,SPHI,DLON,MLON,SLON, 00000560 1VGLAT,VGLONG,CVG,DAPHI,MAPHI,SAPHI,DALON,MALON,SALON,VALAT,VALONG,00000570 2CVA,OH,VOH,N,VN,EH,VEH,XSI,ETA,VXSI,VETA 00000580 DEFINE FILE 1(800,230,L,M1) 00000590 C 00000600 C READ DATA CARD 1 00000610 C 00000620 READ 1000,(DATE(I),I=1,5) 00000630 PRINT 1010,(DATE(I),I=1,5) 00000640 C 00000650 C READ DATA CARD 2 00000660 C 00000670 10 READ(5,1020,END=50)NSTN 00000680 PRINT 1030,NSTN 00000690 C 00000700 C FIND RECORD ON THE FILE 00000710 C 00000720 DO 20 I=1,201 00000730 IF(I.EQ.1)MASH=MOD(NSTN,797) 00000740 IF(I.GT.1)MASH=MOD((MASH+NSTN),799) 00000750 IF(MASH.EQ.0)MASH=1 00000760 IF(I.EQ.200)MASH=800 00000770 IF(I.EQ.201)MASH=799 00000780 READ(1'MASH,1020)NTMP 00000790 IF(NTMP.EQ.NSTN)GO TO 30 00000800 20 CONTINUE 00000810 C 00000820 C ERROR EXIT - STATION NOT FOUND 00000830 C 00000840 GO TO 40 00000850 C 00000860 C READ AND PRINT OLD INFORMATION 00000870 C 00000880 30 READ(1'MASH,1060)ISTN,NAME1,NAME2,PHI,LAM,VGLAT,VGLONG,CVG, 00000890 1 APHI,ALAM,VALAT,VALONG,CVA,OH,VOH,N,VN,EH,VEH,XSI,ETA,VXSI,VETA00000900 C 00000910 C CONVERT TO DEGREES,MINUTES,SECONDS 00000920 C 00000930 CALL RADARC(PHI,DPHI,MPHI,SPHI) 00000940 CALL RADARC(LAM,DLON,MLON,SLON) 00000950 CALL RADARC(APHI,DAPHI,MAPHI,SAPHI) 00000960 CALL RADARC(ALAM,DALON,MALON,SALON) 00000970 PRINT 1070,ISTN,NAME1,NAME2,DPHI,MPHI,SPHI,DLON,MLON,SLON, 00000980 1 VGLAT,VGLONG,CVG,DAPHI,MAPHI,SAPHI,DALON,MALON,SALON,VALAT, 00000990 2 VALONG,CVA,OH,VOH,N,VN,EH,VEH,XSI,ETA,VXSI,VETA 00001000 C 00001010 C READ DATA CARDS 3 AND 4 00001020 C 00001030 READ(5,CHANGE) 00001040 READ(5,1080)INCH,TEMP1,TEMP2 00001050 IF(INCH.EQ.0)GO TO 35 00001060 NAME1=TEMP1 00001070 NAME2=TEMP2 00001080 C 00001090 C CONVERT TO RADIANS 00001100 C 00001110 35 CALL ARCRAD(DPHI,MPHI,SPHI,PHI) 00001120 CALL ARCRAD(DLON,MLON,SLON,LAM) 00001130 CALL ARCRAD(DAPHI,MAPHI,SAPHI,APHI) 00001140 CALL ARCRAD(DALON,MALON,SALON,ALAM) 00001150 C 00001160 C WRITE NEW INFORMATION ON FILE 00001170 C 00001180 WRITE(1'MASH,1060)ISTN,NAME1,NAME2,PHI,LAM,VGLAT,VGLONG, 00001190 1 CVG,APHI,ALAM,VALAT,VALONG,CVA,OH,VOH,N,VN,EH,VEH,XSI,ETA00001200 2 ,VXSI,VETA 00001210 PRINT 1040 00001220 PRINT 1070,ISTN,NAME1,NAME2,DPHI,MPHI,SPHI,DLON,MLON,SLON,00001230 1 VGLAT,VGLONG,CVG,DAPHI,MAPHI,SAPHI,DALON,MALON,SALON, 00001240 2 VALAT,VALONG,CVA,OH,VOH,N,VN,EH,VEH,XSI,ETA,VXSI,VETA 00001250 GO TO 10 00001260 C 00001270 C MESSAGE FOR STATIONS NOT FOUND ON THE FILE 00001280 C 00001290 40 PRINT 1050,NSTN 00001300 READ(5,CHANGE) 00001310 READ(5,1080)INCH,TEMP1,TEMP2 00001320 GO TO 10 00001330 50 STOP 00001340 1000 FORMAT(5A4) 00001350 1010 FORMAT('1'//33X,'CHANGES MADE TO FILE ''SE.GEODESY.STATIONS.MASTER00001360 1'' ON ',5A4///) 00001370 1020 FORMAT(I9) 00001380 1030 FORMAT('0',54X,'STATION NUMBER ',I9/'+',54X,24('_')//56X,'OLD RECO00001390 1RD CONTAINED') 00001400 1040 FORMAT('0',55X,'NEW RECORD CONTAINS') 00001410 1050 FORMAT('-',10X,'***** ERROR STATION # ',I9,' IS NOT ON THE FIL00001420 1E') 00001430 1060 FORMAT(I9,2A8,2(2F19.16,3F8.3),10F8.3) 00001440 1070 FORMAT('0',41X,'ISTN= ',I9,5X,'NAME1,NAME2= ',2A8/ 00001450 113X,'DPHI,MPHI,SPHI= ',2I3,F7.3,5X,'DLON,MLON,SLON= ',I4,I3,F7.3, 00001460 25X,'VGLAT,VGLONG,CVG= ',3F8.3/ 00001470 310X,'DAPHI,MAPHI,SAPHI= ',2I3,F7.3,5X,'DALON,MALON,SALON= ',I4,I3,00001480 4F7.3,5X,'VALAT,VALONG,CVA= ',3F8.3/ 00001490 551X,'OH= ',F8.3,5X,'VOH= ',F8.3/ 00001500 652X,'N= ',F8.3,5X,'VN= ',F8.3/ 00001510 751X,'EH= ',F8.3,5X,'VEH= ',F8.3/ 00001520 831X,'XSI= ',F8.3,5X,'ETA= ',F8.3,5X,'VXSI= ',F8.3,5X,'VETA= ', 00001530 9F8.3) 00001540 1080 FORMAT(I1,2A8) 00001550 END 00001560 C***********************************************************************00001570 C* *00001580 C* S U B R O U T I N E A R C R A D *00001590 C* *00001600 C***********************************************************************00001610 C 00001620 C 00001630 C SUBROUTINE 'ARCRAD' CONVERTS DEGREES MINUTES AND SECONDS TO 00001640 C RADIANS. FOR NEGATIVE VALUES OF THE ANGLE ONLY THE LEFTMOST NON-ZERO 00001650 C VALUE IS NEGATIVE. (EGS. -30,15,30.0;0,-25,15.5;0,0,-37.2) 00001660 C 00001670 C INPUT: I = DEGREES (INTEGER) 00001680 C J = MINUTES (INTEGER) 00001690 C S = SECONDS (REAL*4) 00001700 C 00001710 C OUTPUT: RADS = ANGLE IN RADIANS (REAL*8) 00001720 C 00001730 C 00001740 SUBROUTINE ARCRAD(I,J,S,RADS) 00001750 REAL*8 RADS,DABS,DFLOAT,DBLE,SIGN,RH0/57.29577951308233D0/ 00001760 C 00001770 C CHECK FOR POSITIVE OR NEGATIVE ANGLES 00001780 C 00001790 SIGN=1.0D0 00001800 IF(I.LT.0.OR.J.LT.0.OR.S.LT.0.0)SIGN=-1.0D0 00001810 C 00001820 C CHECK FOR ANGLE OF ZERO -- IF ZERO SET RADS EXACTLY 0.0D0 00001830 C 00001840 IF(I.EQ.0.AND.J.EQ.0.AND.S.EQ.0.0)GO TO 10 00001850 C 00001860 C COMPUTE RADIAN VALUE 00001870 C 00001880 RADS=((DABS(DFLOAT(I))+DABS(DFLOAT(J)/60.0D0)+DABS(DBLE(S)/3600.0D00001890 10))/RH0)*SIGN 00001900 RETURN 00001910 10 RADS=0.0D0 00001920 RETURN 00001930 END 00001940 C 00001950 C SUBROUTINE 'RADARC' CONVERTS RADIANS TO DEGREES MINUTES AND 00001960 C SECONDS. FOR NEGATIVE ANGLES ONLY THE LEFTMOST NONZERO VALUE IS 00001970 C NEGATIVE (EGS. -50,15,30.5 ; 0,-35,30.0 ; 0,0,-50.5) 00001980 C 00001990 C NOTE: THE 0.0005 VALUE IS TO GUARD AGAINST ROUNDOFF 00002000 C 00002010 C INPUT: A = RADIAN VALUE OF ANGLE (REAL*8) 00002020 C 00002030 C OUTPUT: I = DEGREES (INTEGER) 00002040 C J = MINUTES (INTEGER) 00002050 C S = SECONDS (REAL*4) 00002060 C 00002070 SUBROUTINE RADARC(A,I,J,S) 00002080 DOUBLE PRECISION A,SEC,AD,AJ,RHO, SIGN 00002090 DATA RHO/206264.8062470963D0/ 00002100 C 00002110 C CHECK SIGN OF 'A' -- SET SIGN=-1 IF NEGATIVE AND CONVERT 'A' TO 00002120 C POSITIVE VALUE 00002130 C 00002140 SIGN=1.0D0 00002150 IF(A.LT.0.0)SIGN=-1.0D0 00002160 IF(SIGN.LT.0.0)A=-A 00002170 C 00002180 C CONVERT 'A' TO ARCSECONDS 00002190 C 00002200 SEC=A*RHO+0.0005D0 00002210 C 00002220 C FIND INTEGER DEGREES 00002230 C 00002240 I=SEC/3600.0D0 00002250 AD=I 00002260 C 00002270 C FIND INTEGER MINUTES 00002280 C 00002290 J=SEC/60.0D0-AD*60.0D0 00002300 AJ=J 00002310 C 00002320 C FIND REAL*4 SECONDS 00002330 C 00002340 S=SEC-AD*3600.0D0-AJ*60.0D0-0.0005D0 00002350 C 00002360 C SET LEFTMOST VALUE NEGATIVE IF SIGN=-1 00002370 C 00002380 IF(I.NE.0)GO TO 20 00002390 IF(J.EQ.0)GO TO 10 00002400 J=J*SIGN 00002410 GO TO 30 00002420 10 S=S*SIGN 00002430 GO TO 30 00002440 20 I=I*SIGN 00002450 C 00002460 C CONVERT 'A' BACK TO NEGATIVE IF SIGN=-1 00002470 C 00002480 30 IF(SIGN.LT.0.0)A=-A 00002490 RETURN 00002500 END 00002510