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                                                                       
