C C C LTC136 AZIMUTH FROM SOLAR OBSERVATION C 13670020 C C CARD #1 COLUMNS 1 SERIAL NUMBER OF DATA CARD (I1) C 2-14 POINT OF OBSERVATION(3A4) C 15-17 ORIGIN MERIDIAN(F3.0) C 18-19 LATITUDE OF THE OBSERVER(DEGS F2.0) C 20-21 (MINS F2.0) C 20-21 (SECS F2.0) C 24-26 LONGITUDE OF THE OBSERVER(DEGS F3.0) C 27-28 (MINS F2.0) C 29-30 (SECS F2.0) C 31-32 WATCH TIME (HOURS F2.0) C 33-34 (MINS F2.0) C 35-36 (SECS F2.0) C REPEAT THIS PROCEDURE FOR SIX(6) SETS OF WATCH READINGS C C C CARD #2 COLUMNS 1 SERIAL NUMBER OF DATA CARD(I1) C 2-14 NAME OF REFERENCE OBJECT(3A4) C 15 ALLOWABLE ERROR IN MINUTES BETWEEN THREE(3) SETS OF C AZIMUTH COMPUTATIONS C 16-18 VCR OF ZENITH IN THE THEODOLITE(I3) C 19-21 HCR (DEGS F3.0) C 22-24 (MINS F3.1) C REPEAT THIS PROCEDURE FOR EIGHT(8) SETS OF HCR READINGS C (SEE NOTE ON INPUT OF HCR READINGS AT THE END OF THESE C INSTRUCTIONS) C C C CARD #3 COLUMNS 1 SERIAL NUMBER OF DATA CARD(I1) C 2-7 DAY,MONTH AND YEAR OF DATE(3A2) C 8-10 DECLINATION AT 0 HOURS GMT (DEGS F3.0) C 11-13 (MINS F3.1) C 14-17 DAILY DIFFERENCE IN DECLINATION (F4.1) C 18-20 WATCH ERROR (MINS F3.0) C 21-22 (SECS F2.0) C 23-24 AST(AT) OR ADST(DT) (A2) C 25-27 TEMP IN DEGREES F (F3.0) C 28-30 BAR. PRESSURE IN INCHES (F3.1) C 31-33 VCR (DEGS F3.0) C 34-36 (MINS F3.1) C REPEAT VCR PATTERN FOR SIX(6) SETS OF READINGS C C C NOTE: WHEN ENTERING HCR READINGS,THE FIRST AND SECOND VALUES ENTERED MUST C BE THE INITIALSIGHTING ON THE R.O. AND THE FINAL R.O. SIGHTING C RESPECTIVLY. C C C DOUBLE PRECISION A,CONP 13670021 INTEGER ER1,ER2,ER3,PT,DT 13670022 DIMENSION WH(6),WM(6),WS(6),HD(8),HM(8),VD(6),VM(6),AZ(3) 13670023 DIMENSION IC1(19),IC2(19),IC3(19) 13670024 DATA ER1/' ER1'/,ER2/' ER2'/,ER3/' ER3'/,PT/'AT'/,DT/'DT'/ 13670025 C READ IN DATA 13670030 C 13670035 CALL REREAD 13670040 JGO=1 13670050 10 READ (5,11,END=900)ISER,OM,DP,TP,SP,DL,TL,SL, 13670060 1 (WH(I),WM(I),WS(I),I=1,6) 13670061 11 FORMAT (I1,13X,F3.0,3F2.0,F3.0,2F2.0,18F2.0) 13670070 READ(99,21)IC1 13670075 21 FORMAT(2A1,17A4) 13670080 IF (ISER-1)25,40,25 13670090 25 GO TO (30,26),JGO 13670100 26 WRITE (6,81) 13670110 JGO=1 13670120 30 IC1(19)=ER1 13670130 WRITE (6,31)IC1 13670150 31 FORMAT(1H ,2A1,17A4) 13670160 GO TO 10 13670170 40 READ (5,41)ISER,AEM,IZ,(HD(I),HM(I),I=1,8) 13670180 41 FORMAT (I1,13X,F1.0,I3,F3.0,F3.1,F3.0,F3.1,F3.0,F3.1,F3.0,F3.1,F3.13670190 10,F3.1,F3.0,F3.1,F3.0,F3.1,F3.0,F3.1) 13670200 READ(99,21)IC2 13670205 IF (ISER-2)45,60,45 13670210 45 GO TO (50,46),JGO 13670220 46 WRITE (6,81) 13670230 JGO=1 13670240 50 IC2(19)=ER2 13670250 WRITE (6,31)IC1 13670270 WRITE (6,31)IC2 13670280 GO TO 10 13670290 60 READ (5,61)ISER,JD,JM,JY,DECD,DECM,DDD,WEM,WES,IPD,TEMP,BAR,(VD(I)13670300 1,VM(I),I=1,6) 13670310 61 FORMAT (I1,3A2,F3.0,F3.1,F4.1,F3.0,F2.0,A2,F3.0,F3.1,F3.0,F3.1,F3.13670320 10,F3.1,F3.0,F3.1,F3.0,F3.1,F3.0,F3.1,F3.0,F3.1) 13670330 READ(99,21)IC3 13670335 IF (ISER-3)65,80,65 13670340 65 GO TO (70,66),JGO 13670350 66 WRITE (6,81) 13670360 JGO=1 13670370 70 IC3(19)=ER3 13670380 WRITE (6,31)IC1 13670400 WRITE (6,31)IC2 13670410 WRITE (6,31)IC3 13670420 GO TO 10 13670430 C 13670440 C PRINT DATA AS READ IN 13670450 C 13670460 80 WRITE (6,81) 13670470 81 FORMAT (1H1) 13670480 WRITE (6,31)IC1 13670490 WRITE (6,31)IC2 13670500 WRITE (6,31)IC3 13670510 C 13670520 C PRINT HEADINGS 13670530 C 13670540 IC1(1)=BLK 13670550 IC2(1)=BLK 13670560 WRITE(6,91)(IC1(I),I=1,5) 13670570 91 FORMAT(////18H SOLAR AZIMUTH AT ,2A1,3A4) 13670580 WRITE(6,92)(IC2(I),I=1,5) 13670590 92 FORMAT(1H0,12X,5HR.O. ,2A1,3A4) 13670600 WRITE (6,93)JD,JM,JY 13670610 93 FORMAT (9H0DATE ,A2,1H/,A2,1H/,A2) 13670620 C 13670630 C COMPUTE HORIZONTAL MEANS 13670640 C 13670650 DO 330 I=1,8 13670660 HD(I)=.01745329*HD(I)+.2908882E-3*HM(I) 13670670 IF (I-I/2*2)200,200,330 13670680 200 IF (HD(I)+HD(I-1))205,205,210 13670690 205 NSETS=(I-4)/2 13670700 GO TO 332 13670710 210 IF (I-6)214,212,214 13670720 212 SAVE=HD(I-1) 13670730 HD(I-1)=HD(I) 13670740 HD(I)=SAVE 13670750 214 HD(I)=HD(I)-3.141593 13670760 IF (HD(I))220,290,290 13670770 220 HD(I)=HD(I)+6.283185 13670780 290 IF (ABS(HD(I-1)-HD(I)).GT.3.141593)HD(I)=HD(I)+6.283185 13670790 310 HD(I-1)=(HD(I)+HD(I-1))*.5 13670810 IF(HD(I-1).GE.6.283185)HD(I-1)=HD(I-1)-6.283185 13670820 330 CONTINUE 13670840 NSETS=3 13670850 332 IF (NSETS)334,334,336 13670860 334 WRITE (6,335) 13670870 335 FORMAT (24H0OBSERVATIONS INCOMPLETE////) 13670880 GO TO 10 13670890 336 SUB=HD(1) 13670900 DO 345 I=1,NSETS 13670910 J=I*2+1 13670920 HD(I)=HD(J)-SUB 13670930 IF(HD(I).LT.0.) HD(I)=HD(I)+6.283185 13670940 345 CONTINUE 13670950 C 13671010 C COMPUTE GMT OF OBSERVATIONS 13671020 C 13671030 IF(IPD.EQ.PT)GO TO 130 13671040 IF(IPD.EQ.DT)GO TO 140 13671050 120 WRITE (6,121) 13671060 121 FORMAT (1H ,'AST OR ADST NOT SPECIFIED',////) 13671070 GO TO 10 13671080 130 G=4. 13671090 GO TO 150 13671100 140 G=3. 13671110 150 IF (WEM)160,170,170 13671120 160 WES=-WES 13671130 170 WEH=WEM/60.+WES/3600. 13671140 DO175 I=1,NSETS 13671150 K=I+I 13671160 J=K-1 13671170 WH(I)=(WH(J)+WH(K)+(WM(J)+WM(K))/60.+(WS(J)+WS(K))/3600.)*.5 13671180 IF (WH(I))334,334,175 13671190 175 WH(I)=WH(I)-WEH+G 13671200 C 13671290 C COMPUTE VERTICAL MEANS 13671300 C 13671310 N2=NSETS+NSETS 13671320 IF (IZ)360,350,360 13671330 350 IZ=1 13671340 GO TO 370 13671350 360 IZ=2 13671360 370 DO 460 I=1,N2 13671370 VD(I)=.01745329 *VD(I)+.2908882E-3*VM(I) 13671380 IF (VD(I))334,334,375 13671390 375 IF(VD(I).GT.3.141593)GO TO 390 13671400 380 VD(I)=1.570796-VD(I) 13671410 GO TO 400 13671420 390 VD(I)=VD(I)-4.712389 13671430 400 GO TO (420,410),IZ 13671440 410 VD(I)=-VD(I) 13671450 420 J=I/2 13671460 IF (I-J*2)460,430,460 13671470 430 VD(J)=(VD(I)+VD(I-1))*.5 13671480 460 CONTINUE 13671490 C 13671540 C CORRECT FOR REFRACTION AND PARALLAX 13671550 C 13671560 TDIF=50.-TEMP 13671570 IF (TDIF)480,480,470 13671580 470 TFAC=1.+TDIF*.002186 13671590 GO TO 490 13671600 480 TFAC=1.+TDIF*.001771 13671610 490 F=(1.+(BAR-30.)*.03275)*TFAC 13671620 510 F=F*.0002812 13671650 DO 530 I=1,NSETS 13671660 COSVD=COS(VD(I)) 13671670 VD(I)=VD(I)-F*COSVD/SIN(VD(I))+.0000427*COSVD 13671680 530 CONTINUE 13671730 C 13671740 C COMPUTE AZIMUTH OF SUN AND R.0. 13671750 C 13671760 FLAT=.01745329*DP+.2908882E-3*TP+.484814E-5*SP 13671770 FLON=.01745329*DL+.2908882E-3*TL+.484814E-5*SL 13671780 AZ(3)=0. 13671790 IF (DECD)600,610,610 13671800 600 DECM=-DECM 13671810 610 DECZ=.01745329*DECD+.2908882E-3*DECM 13671820 DO 760 I=1,NSETS 13671830 DEC=DECZ+.1212034E-4*DDD*WH(I) 13671840 P=1.570796-DEC 13671850 630 S=(VD(I)+FLAT+P)*.5 13671940 A=(ATAN(SQRT((1./COS(S))*SIN(S-VD(I))*SIN(S-FLAT)*(1./COS(S-P)))))13671950 1*2. 13671960 IF(WH(I)-19.)680,640,635 13671970 635 IF (WH(I)-20.)640,640,650 13671980 640 WRITE (6,641)I 13671990 641 FORMAT (15H0 SET,I2,27H OBSERVED TOO CLOSE TO NOON) 13672000 A=0. 13672010 GO TO 680 13672020 650 A=6.283185 -A 13672030 680 A=A-HD(I) 13672070 IF (A)690,700,700 13672080 690 A=A+6.283185 13672090 700 AZ(I)=A 13672100 CALL LLSS04(A,I,K1,K2,K3) 13672110 WRITE (6,701)I,K1,K2,K3 13672120 701 FORMAT (15H0 AZIMUTH SET,I2,A4,A3,A4) 13672130 760 CONTINUE 13672140 C 13672150 C COMPUTE MEAN AZIMUTH 13672160 C 13672170 IF (NSETS-1)770,770,780 13672180 770 A=AZ(1) 13672190 IGO=1 13672200 GO TO 850 13672210 780 AMIN=AZ(1) 13672220 AMAX=AMIN 13672230 DO 820 I=2,NSETS 13672240 IF (AZ(I)-AMAX)790,820,800 13672250 790 IF (AMIN-AZ(I))820,820,810 13672260 800 AMAX=AZ(I) 13672270 GO TO 820 13672280 810 AMIN=AZ(I) 13672290 820 CONTINUE 13672300 IF (AMAX-AMIN-AEM*.0002908882 )840,840,830 13672310 830 IGO=2 13672320 GO TO 850 13672330 840 IGO=1 13672340 DIV=NSETS 13672350 A=(AZ(1)+AZ(2)+AZ(3))/DIV 13672360 CALL LLSS04(A,IGO,K1,K2,K3) 13672370 WRITE(6,841)K1,K2,K3 13672380 841 FORMAT(17H0 MEAN AZIMUTH =,A4,A3,A4) 13672390 850 CONV=(FLON-.01745329 *OM)*SIN(FLAT) 13672400 JGO=2 13672410 LCP015=0 13672420 IF(CONV.LT.0.)LCP015=536870912 13672430 854 CONP=ABS(CONV) 13672450 CALL LLSS04(CONP,IGO,K1,K2,K3) 13672460 K1=K1+LCP015 13672470 WRITE(6,855)K1,K2,K3 13672480 855 FORMAT(17H0 CONVERGENCE =,A4,A3,A4) 13672490 GO TO (860,10),IGO 13672500 860 A=A+CONV 13672510 IF (A)870,880,880 13672520 870 A=A+6.283185 13672530 880 K=0 13672540 CALL LLSS04(A,K,K1,K2,K3) 13672550 MO=OM 13672560 WRITE(6,881)K1,K2,K3,MO 13672570 881 FORMAT(17H0 GRID BEARING =,A4,A3,A4,21H REFERRED TO MERIDIAN,I4) 13672580 GO TO 10 13672590 900 STOP 13672600 END 13672610 SUBROUTINE LLSS04(R,ICQ,ID,IM,IS) LEG04 10 C CONVERTS RADIANS TO BEARING OR ANGLE FOR A FORMAT OUTPUT LEG04 15 DOUBLE PRECISION R LEG04 20 1 IF(R-6.2831853072D0)3,2,2 LEG04 30 2 R = R - 6.2831853072D0 LEG04 40 GO TO 1 LEG04 50 3 IF(ICQ)24,4,24 LEG04 60 4 DO 6 L=1,4 LEG04 70 IF(R-1.5707963268D0)7,6,6 LEG04 80 6 R = R - 1.5707963268D0 LEG04 90 7 IF(R-.000002424D0)10,10,8 LEG04100 8 IF(R-1.5707939D0)16,9,9 LEG04110 9 L = L+1 LEG04120 10 ID = 1077952576 LEG04130 IM = 1077952576 LEG04140 IF(L-2)11,12,13 LEG04150 11 IM = 1077990720 LEG04160 IS = -690363448 LEG04170 RETURN LEG04180 12 IS = -977149213 LEG04190 RETURN LEG04200 13 IF(L-3)12,14,15 LEG04210 14 IM = 1077994048 LEG04220 IS = -689642552 LEG04230 RETURN LEG04240 15 IS = -423238941 LEG04250 RETURN LEG04260 16 IF(L-2)17,18,20 LEG04270 17 KNS = -1769472 LEG04280 GO TO 19 LEG04290 18 KNS = -917504 LEG04300 R = 1.5707963268D0 - R LEG04310 19 KEW = 133 LEG04320 GO TO 24 LEG04330 20 IF(L-3)18,21,22 LEG04340 21 KNS = -917504 LEG04350 GO TO 23 LEG04360 22 KNS = -1769472 LEG04370 R = 1.5707963268D0 - R LEG04380 23 KEW = 166 LEG04390 24 IS = R*206264.806247D0 + .5D0 LEG04400 ID = IS/3600 LEG04410 IS = IS - ID*3600 LEG04420 IM = IS/60 LEG04430 IS = IS - IM*60 LEG04440 IH = ID/100 LEG04450 ID = ID - IH*100 LEG04460 IT = ID/10 LEG04470 ID = ID + IT*246 +IH*65536 + 1089532144 LEG04480 IT = IM/10 LEG04490 IM = IM*256 + IT*62976 + 1089531968 LEG04500 IT = IS/10 LEG04510 IS = IS*256 + IT*62976 + 1089531968 LEG04520 IF(ICQ)26,25,26 LEG04530 25 ID = ID + KNS LEG04540 IS = IS + KEW LEG04550 26 RETURN LEG04560 END LEG04570