C PROGRAM LONLIST 0001 C COMPILES AN OBSERVING STAR LIST LONGITUDE OBSERVATIONS BY MAYER'S 0002 C METHOD. 0003 C PROGRAM ASSUMES THE USE OF A WILD T4 UNIVERSAL THEODOLITE. 0004 C 0005 C ORDER OF INPUT DATA CARDS. 0006 C _________________________ 0007 C _________________________ 0008 C 0009 C (1) JOB CARD 0010 C 0011 C (2) THE FOLLOWING J C L CARDS (STARTING IN COLUMN ONE) 0012 C (THESE J C L ARE FOR SORTING THE UPDATED STARS IN ASCENDING R-A ORDER 0013 C //SORT EXEC SORT2314 0014 C //SORTOUT DD DSN=&&OUT,UNIT=SYSDA,SPACE=(TRK,(100,20)), 0015 C // DCB=(RECFM=FB,LRECL=80,BLKSIZE=800),DISP=(,PASS) 0016 C //SYSIN DD * 0017 C SORT FIELDS=(14,2,A,17,2,A,20,2,A),FOMAT=CH,SIZE=E2500 0018 C //SORTIN DD * 0019 C 0020 C (3) UPDATED STARS DECK FROM PROGRAM UPDATE. 0021 C SUFFICIENT TO COVER PERIOD OF OBSERVATION. 0022 C 0023 C (4) THE FOLLOWING J C L CARDS (STARTING IN COLUMN ONE) 0024 C // EXEC FORTGCG 0025 C //FORT.SYSIN DD * 0026 C 0027 C (5) THE PROGRAM LONLIST 0028 C 0029 C (6) THE FOLLOWING J C L CARDS (STARTING IN COLUMN ONE) 0030 C //GO.FT08F001 DD DSN=&&OUT,DISP=(OLD,DELETE),UNIT=SYSDA, 0031 C // VOL=REF=*.SORT.SORT.SORTOUT 0032 C 0033 C (7) STATION CARD. 0034 C 0035 C COLS. 1-16 STATION NAME. 0036 C COLS. 18-19 DEGREES OF LATITUDE (NEGATIVE SIGN FOR SOUTH) 0037 C COLS. 21-22 MINUTES OF LATITUDE. 0038 C COLS. 23-25 HOURS OF LONGITUDE (NEGATIVE SIGN FOR WEST). 0039 C COLS. 27-28 MINUTES OF LONGITUDE. 0040 C COLS. 30-34 SECONDS OF LONGITUDE. 0041 C COLS. 36-37 DAY OF OBSERVATION. 0042 C COLS. 39-40 MONTH OF OBSERVATION. 0043 C COLS. 42-45 YEAR OF OBSERVATION. 0044 C (8) TIME CARD. 0045 C 0046 C COLS. 2-3 HOURS OF CIVIL TIME FOR BEGGINING OF OBSERVATION. 0047 C COLS. 5-6 MINUTES OF STARTING TIME. 0048 C COLS. 8-9 HOURS OF ENDING TIME. 0049 C COLS. 11-12 MINUTES OF ENDING TIME. 0050 C COLS. 14-15 ZONAL CORRECTION(HOURS) 0051 C 0052 C NOTE - IF CARD IS BLANK AN OBSERVING LIST WILL BE MADE OUT OF ALL THE 0053 C INPUT UPDATED STARS DECK. 0054 C 0055 C (9) BLANK CARD TO TERMINATE PROGRAM. 0056 C 0057 C (10) THE FOLLOWING J C L CARDS (STARTING IN COLUMN ONE) 0058 C /* 0059 C // 0060 C 0061 C 0062 C 0063 C 0064 C 0065 C*********************************************************************** 0066 IMPLICIT REAL *8(A-H,O-Z) 0067 INTEGER STAR 0068 DIMENSION ILATD(3),ILATM(3),PHI(3),ZD1(3),ZD2(3),ID1(3),ID2(3),M1( 0069 13),M2(3),S1(3),S2(3),T(2) 0070 REAL * 8 JD,LST(2),LAMDA,MIURA,MIUDEC 0071 DATA PI,RHO,SOLSID/3.14159265358979D0,206264.80625D0,0.9972695664D 0072 10/ 0073 DEGRAD=180.D0/PI 0074 TWOPI=2.D0*PI 0075 CENT=36525.D0 0076 ZDMAX=60.D0/DEGRAD 0077 REWIND 8 0078 C READ STATION CARD - STATION NAME,LATITUDE(DEG.,MIN.),LONGITUDE(HR. 0079 C MIN.,SEC.),LOCAL DATE(DAY.MONTH,YEAR). 0080 READ(5,1) P1,P2,P3,P4,ILATD(2),ILATM(2), ILONGH,ILONGM,SECLON,IDAY 0081 1,MO,IYEAR 0082 1 FORMAT(4A4,2I3,2I3,F6.2,2I3,I5) 0083 CALL JULDAT(IDAY,MO,IYEAR,JD) 0084 IF(ILONGH.LT.0.) GO TO 53 0085 LAMDA= ( ILONGH+ILONGM/60.D0) 0086 GO TO 52 0087 53 LAMDA=-(-ILONGH+ILONGM/60.D0) 0088 52 PHI(2)=(ILATD(2)+ILATM(2)/60.D0)/DEGRAD 0089 C READ TIME CARD - STARTING AND CLOSING CIVIL TIME FOR OBSERVATION 0090 C ERROR OF LOCAL TIME ON UT (HOURS) 0091 READ(5,2) IH1,MB,IH2,ME,IZH 0092 2 FORMAT(5I3) 0093 T(1)=IH1+MB/60. 0094 T(2)=IH2+ME/60. 0095 IF(T(2).LT.T(1)) T(2)=T(2)+24.D0 0096 DT=IZH 0097 DO 4 I=1,2 0098 UTC=T(I)+DT 0099 IF(UTC.LT.24.) GO TO 3 0100 UTC=UTC-24.D0 0101 JD=JD+1. 0102 3 IF(UTC.GT.0.) GO TO 5 0103 UTC=UTC+24.D0 0104 JD=JD-1.D0 0105 5 T1=JD/CENT 0106 GMSTO=6.64606555556D0+(8640184.542D0*T1+0.0929D0*T1* T1)/3600.D0 0107 IGMST=GMSTO/24.D0 0108 GMSTO=GMSTO-IGMST*24.D0 0109 GMST=GMSTO+UTC/SOLSID 0110 IF(GMST.LT.24.) GO TO 35 0111 GMST=GMST-24.D0 0112 35 LST(I)=GMST+LAMDA+24.D0 0113 33 IF(LST(I)- 24) 4,34,34 0114 34 LST(I)=LST(I)-24.D0 0115 GO TO 33 0116 4 CONTINUE 0117 NUPAGE=0 0118 I=1 0119 J=5 0120 8 ILATD(2-I)=ILATD(2) 0121 ILATM(2-I)=ILATM(2)-J 0122 IF(ILATM(2-I).LT.60) GO TO 13 0123 ILATM(2-I)=ILATM(2-I)-60 0124 ILATD(2-I)=ILATD(2-I)+1 0125 13 PHI(2-I)=(ILATD(2-I)+ILATM(2-I)/60.D0)/DEGRAD 0126 IF(I.EQ.-1)GO TO 14 0127 I=-I 0128 J=-J 0129 GO TO 8 0130 14 NEW=1 0131 NUPAGE=NUPAGE+1 0132 WRITE(6,15) IYEAR,ILATD(1),ILATM(1),ILATD(2),ILATM(2),ILATD(3),ILA 0133 1TM(3),NUPAGE 0134 15 FORMAT('1',16X,I4,2X,'STARLIST FOR LATS',3(I5,I3,1X), 0135 13X,'A-FACTOR',10X,'PAGE',I4,//,14X,'STAR', ' 0136 2 MAG',5X,'RA',6X,'DEC',5X,3('ZD',7X),/,42X,3('360-ZD',3X),//) 0137 IF(NUPAGE.GT.1) GO TO 11 0138 C SEARCHING STAR DECK. 0139 16 READ(8,9) STAR,FMAG,IRAH,IRAM,SECRA,IDECD,IDECM,SECDEC,DRA,DDEC 0140 9 FORMAT(' ',I5,F6.2,2I3,F7.3,I4,I3,F6.2,2F7.3) 0141 36 IF( STAR.EQ.0) GO TO 12 0142 CALL ARCRAD(IDECD,IDECM,SECDEC,DEC) 0143 RA=(( SECRA/60.D0+IRAM)/60.D0)+IRAH 0144 IF(SECDEC.GT.30.) IDECM=IDECM+1 0145 IF(FMAG.GT.7.) GO TO 16 0146 IF(DABS(LST(1)-LST(2)).LT.0.000005) GO TO 18 0147 IF(LST(1).GT.LST(2)) GO TO 17 0148 IF(RA.LT.LST(1).OR.RA.GT.LST(2)) GO TO 16 0149 GO TO 18 0150 17 IF(RA.LT.LST(1).AND.RA.GT.LST(2)) GO TO 16 0151 18 DO 10 I=1,3 0152 ZD1(I)=PHI(I)-DEC 0153 IF(DABS(ZD1(I)).GT.ZDMAX) GO TO 16 0154 A=DSIN(ZD1(I)/DCOS(DEC)) 0155 ZD2(I)=TWOPI-DABS(ZD1(I)) 0156 CALL ARCS(ZD1(I),ID1(I),M1(I)) 0157 CALL ARCS(ZD2(I),ID2(I),M2(I)) 0158 ISECRA=SECRA 0159 10 CONTINUE 0160 IF(NEW.EQ.14) GO TO 14 0161 C NEGATIVE ZENITH DISTANCE SIGNIFIES A NORTH STAR 0162 11 WRITE(6,7) STAR,FMAG,IRAH,IRAM,ISECRA,IDECD,IDECM,ID1(1),M1(1),ID1 0163 1(2),M1(2),ID1(3),M1(3),A,ID2(1),M2(1),ID2(2),M2(2),ID2(3),M2(3) 0164 7 FORMAT(' ',I17,F5.1,I4,2I3,I4,I3,3(I4,I3,2X),F10.3,/,' ',39X,3(I4, 0165 1I3,2X),//) 0166 NEW=NEW+1 0167 GO TO 16 0168 12 WRITE(6,19) 0169 19 FORMAT('1') 0170 STOP 0171 END 0172 SUBROUTINE ARCS(H,I,J) 0173 IMPLICIT REAL *8(A-H,O-Z) 0174 PI=3.141592654 0175 TWOPI=PI*2. 0176 DEGRAD=57.295779513 0177 DH=DABS(H) 0178 4 IF(DH.LT.TWOPI) GO TO 3 0179 DH=DH-TWOPI 0180 GO TO 4 0181 3 DEG=DH*DEGRAD 0182 2 I=DEG 0183 1 FM=(DEG-I)*60. 0184 J=FM 0185 IF((FM-J).GT.0.5) J=J+1 0186 IF(J.LT.60) GO TO 5 0187 J=J-60 0188 I=I+1 0189 5 IF(H.LT.0.) I=-I 0190 IF(I.EQ.0.AND.H.LT.0.) J=-J 0191 RETURN 0192 END 0193 SUBROUTINE ARCRAD(ID,MI,SE,RAD) 0194 C SIGN OF ANGLE OR TIME MUST BE PLACED JUST BEFORE THE FIRST 0195 C NON-ZERO ELEMENT 0196 IMPLICIT REAL *8(A-H,O-Z) 0197 MUL=1 0198 RHO=206264.80625 0199 IF(ID) 10,20,50 0200 20 IF(MI) 10,50,50 0201 10 MUL=-1 0202 50 RAD=((IABS(ID)*60+IABS(MI))*60+SE)*MUL/RHO 0203 RETURN 0204 END 0205 C 0206 SUBROUTINE JULDAT(IDAY,MO,IYEAR,JD) 0207 IMPLICIT REAL * 8(A-H,O-Z) 0208 REAL *8 JD,JC 0209 INTEGER MON(12)/31,28,31,30,31,30,31,31,30,31,30,31/ 0210 C DAY ZERO IS 1900 JAN 0.5 U.T. 0211 C CHECK IF YEAR IS 1900 0212 JY=1900 0213 C CORRECTIONS FOR YEAR LATER THAN 1900 0214 C (1) ASSUMING NO LEAP YEARS. (IYEAR-JY)*365 0215 C (2)LEAP YEAR CORRECTIONS (IYEAR-JY+3)/4 0216 ID=(IYEAR-JY)*365+(IYEAR-JY+3)/4 0217 IY=1600 0218 INT=-2 0219 1 J=0 0220 3 IY=IY+100 0221 IF((IYEAR-IY).LE.0) GO TO 200 0222 J=J+1 0223 IF(J.EQ.4) GO TO 1 0224 INT=INT+1 0225 GO TO 3 0226 200 MON(2)=28 0227 Y=IYEAR 0228 X=IYEAR/4 0229 Z=IYEAR/400 0230 C=IYEAR/100 0231 IF(X.NE.Y/4) GO TO 500 0232 IF(C.NE.Y/100) GO TO 100 0233 IF(Z.NE.Y/400) GO TO 500 0234 100 MON(2)=29 0235 500 IM=MO-1 0236 ND=0 0237 IF(IM.LE.0) GO TO 400 0238 DO 300 I=1,IM 0239 300 ND=ND+MON(I) 0240 400 JD=ND+IDAY+ID-INT-0.5D0 0241 RETURN 0242 END 0243