C PROGRAM DRUMS. C************************************************************************ C * C PROGRAM DRUMS. * C * C DETERMINATION OF THE EQUATORIAL DRUM VALUE OF A WILD T-4 * C UNIVERSAL THEODOLITE. * C * C ORDER OF INPUT DATA CARDS. * C * C (1) INSTRUMENT CARD. * C * C COLS. 1-12 INSTRUMENT TYPE. * C COLS. 13-18 INSTRUMENT NUMBER. * C COLS. 13-18 INSTRUMENT NUMBER. * C COLS. 20-21 DAY OF OBSERVATION. * C COLS. 23-24 MONTH OF OBSERVATION. * C COLS. 26-29 YEAR OF OBSERVATION. * C * C (2) UPDATED STARS POSITIONS DECK : OUTPUT OF PROGRAM UPDATE. * C * C (3) BLANK CARD TO INDICATE END OF DECK. * C * C (4) STAR CARD - STAR NUMBER OF STAR OBSERVED. * C * C COLS. 1-5 STAR NUMBER. * C * C (5) OBSERVATIONS DECK. * C * C COLS. 1-6 MICROMETER TURNS (2 DECIMALS). * C COLS. 7-13 SECONDS OF SCALED TIME (2 DECIMALS) * C * C (6) BLANK CARD TO END OBSERVATIONS DECK. * C * C (7) BLANK CARD TO TERMINATE PROGRAMME OTHERWISE REPEAT FROM (3). * C * C************************************************************************ C * IMPLICIT REAL *8(A-H,O-Z) INTEGER STAR(20),ISTAR(20) DIMENSION V(20),R(20),CDEC(20) PI=3.14159265358979 C C NUM=NUMBER OF STARS OBSERVED. C NUM=0 C C READING UPDATED STARS POSITIONS. C READ(5,30) A1,A2,A3,INST,IDAY,MO,IYEAR 30 FORMAT(3A4,I6,2I3,I5) DO 1 J=1,20 READ(5,2) STAR(J),FMAG,IP,MP,SP,IL,ML,SL 2 FORMAT(' ',I5,F6.2,2I3,F7.3,I4,I3,F6.2) IF(STAR(J).EQ.0) GO TO 39 IF(IL.LT.0) GO TO 41 CDEC(J)= ( IL+ML/60.D0+SL/3600.D0)*PI/180.D0 GO TO 42 41 CDEC(J)=-(-IL+ML/60.D0+SL/3600.D0)*PI/180.D0 42 NUM=NUM+1 1 CONTINUE 39 WRITE(6,20) A1,A2,A3,INST,IDAY,MO,IYEAR 20 FORMAT('1',14X,'DETERMINATION OF THE EQUATORIAL VALUE,R,',/,23X,'O 1F THE MICROMETER SCREW',//,19X,'INSTRUMENT:',1X,3A4,'NO',I6,/,19X, 2'DATE',2I3,I5,//,22X,'STAR',7X,'R',5X,'RESIDUAL',/,23X,'NO',6X,'(S 3EC)',4X,'(SEC)',/) N=0 3 N=N+1 C C READING STAR NUMBER OF STAR OBSERVED. C READ(5,4) ISTAR(N) 4 FORMAT(I5) C C SEARCHING FOR STAR IN UPDATED STARS DECK. C IF(ISTAR(N).EQ.0) GO TO 11 DO 5 J=1,NUM IF(ISTAR(N).EQ.STAR(J)) GO TO 7 5 CONTINUE WRITE(6,6) ISTAR(N) 6 FORMAT(' ',39X,'STAR NO', I6,2X,'NOT UPDATED') CDEC(J)=0. 7 DEC=DCOS(CDEC(J)) SUMX=0. SUMT=0. SUMXX=0. SUMXT=0. DO 9 J=1,20 C C READING OBSERVATIONS - TURNS OF MICROMETER,SECONDS OF SCALED TIME. C NOTE - THE NUMBER OF INPUT SECONDS SHALL BE THE NUMBER OF SECONDS C AFTER THE STARTING MINUTE MARK.SIXTY SECONDS SHALL THEREFORE BE C ADDAED FOR EVERY ADDITIONAL MINUTE MARK. C READ(5,8) X,T IF(T.EQ.0.) GO TO 10 8 FORMAT(F6.2,F7.2) SUMX=SUMX+X SUMT=SUMT+T SUMXX=SUMXX+X*X SUMXT=SUMXT+X*T 9 CONTINUE 10 IF(DEC.EQ.0.) GO TO 22 J=J-1 C C COMPUTING EQUATORIAL VALUE FROM STAR OBSERVATION. C R(N)=((SUMXT-(SUMX*SUMT)/J)/(SUMXX-(SUMX*SUMX)/J))*DEC*15.D0 C CONVERTING SOLAR TO SIDERIAL INTERVAL. R(N)=R(N)*1.0027379093 22 GO TO 3 11 SUM=0 N=N-1 DO 12 J=1,N SUM=SUM+R(J) 12 CONTINUE C C COMPUTING MEAN. C XMEAN=SUM/N SUM=0 DO 14 J=1,N V(J)=XMEAN-R(J) SUM=SUM+V(J)*V(J) WRITE(6,13) ISTAR(J),R(J),V(J) 13 FORMAT(' ',20X,I5,F11.3,F8.3) 14 CONTINUE X=N STDM=SUM/(DSQRT(X*(X-1.D0))) WRITE(6,16) XMEAN,STDM 16 FORMAT(' ',/,23X,'MEAN',F12.3,/,23X,'STD.DEV.+',F7.3,/,31X,'-') WRITE(6,100) 100 FORMAT('1') STOP END